Amr Gharbeia
2d18fa4525
v0.8.0: Information Radiator now built on cl-tty v1.1.0. Minibuffer uses cl-tty Dialog stack. New TODO items: conversation view (ScrollBox + Markdown), command palette (Select), sidebar (slot system), status bar (Box + Theme), keybindings (keymap). v0.9.1: Emacs is now an optional secondary client, not the primary bridge. cl-tty is the primary TUI.
46 KiB
46 KiB
Passepartout TUI — View
- View
- Test Suite
- Implementation — v0.7.0 additions
- v0.7.1 — Markdown Rendering
- v0.7.2 — Gate Trace
- v0.8.0 — Sidebar + Minibuffer View
- v0.8.0 Tests — Sidebar View + Minibuffer View
View
Pure render functions. Each takes a Croatoan window and current state.
State is read via (st :key) — no mutation here.
v0.8.0 — Sidebar: The Information Radiator
The sidebar is Passepartout's permanent UX differentiator. No competitor can render gate traces, focus maps, or rule counters because none has deterministic gates, foveal-peripheral context, or rule synthesis. The sidebar makes this data permanently visible in a 42-column panel at the right of the terminal.
Seven panels stack vertically:
- Gate Trace — per-message trace from the most recent agent response, colored by gate state: green for passed, red for blocked, yellow for HITL-required. Mirrors the per-message gate trace from v0.7.2 but always visible.
- Focus — the current foveal node ID from
*loop-focus-id*plus a related-node count from the last context assembly. Shows the user what the agent is "looking at." - Rules — the Dispatcher's
*hitl-pending*count with a progress bar toward certification threshold. Shows how many user decisions the Dispatcher has learned from. - Context — token gauge bar with percentage and color coding (green
< 50%, yellow 50-80%, orange 80-95%, red > 95%). Data from
token-economicscontext-usage-percentage. - Files — list of files modified in the most recent tool execution. Each entry shows filepath and +/- line count where computable.
- Cost — session cost from
cost-tracker: total USD spent, call count, per-provider breakdown. - Protection — gate effectiveness counter from the Dispatcher's
*dispatcher-block-counts*: how many actions each gate blocked this session. This is the specific-value-proposition panel — no competitor has deterministic gates to count.
The sidebar is a fourth Croatoan window at the right of the terminal when
width ≥ 120 columns. At < 120 columns, it becomes an absolute-positioned
overlay toggled via /sidebar or Ctrl+X+B. The overlay uses the same
rendering function (view-sidebar) and same data paths.
v0.8.0 — Command Palette
The command palette provides a single discoverable entry point for all
TUI commands. Currently, commands are invisible — the user must know
/help exists to discover /focus, /rewind, /context, etc. The
palette solves this with a fuzzy-searchable overlay (Ctrl+P) organized
by category:
- Session —
/focus,/scope,/unfocus,/rename - Agent —
/approve,/deny,/why,/audit,/context - View —
/theme,/sidebar,/search,/clear - System —
/eval,/status,/reconnect,/quit
The palette renders as a centered Croatoan window overlay. Typing filters items by fuzzy substring match on both command name and description. Up/Down navigates; Enter executes; Esc dismisses. Keyboard shortcuts (Ctrl+G, Ctrl+F, Ctrl+D, etc.) are displayed as hints next to each item.
This mirrors OpenCode's command palette pattern — a proven UX convention that makes power commands discoverable without reading documentation.
v0.8.0 — Conversation View: ScrollBox + Markdown
The chat conversation is the primary TUI surface — it shows every
message exchanged with the daemon. The v0.8.0 refactoring replaces
the ad-hoc view-chat with a ScrollBox-driven conversation view
using cl-tty's markdown renderer and component model.
Each message type has a dedicated render function:
- User messages:
render-user-msg— a colored line with role prefix (green, "⬆ user"). Content is plain-text with word wrap. - Agent messages:
render-agent-msg— rendered through cl-tty'sparse-blocks+render-mdfor full markdown (bold, code, links, blockquotes, code blocks with syntax highlighting, diffs). - System messages:
render-sys-msg— yellow, dimmed. - Tool executions:
render-tool-call— collapsible block showing tool name, status (running ✓ ✗), duration, and truncated output. Tab toggles expansion (expand-tool-callsstate). - Gate traces:
render-gate-trace— collapsible block (Ctrl+G toggles per-message viacollapsed-gatesstate).
Sticky-scroll: when the user is at the bottom (scroll-offset 0),
new messages auto-scroll into view. Manual scroll-up sets
sticky-scroll nil until the user scrolls back to bottom.
view-conversation replaces view-chat. The redraw function
calls view-conversation instead.
Contract
- (view-status win): renders the status bar with connection info, msg count, scroll offset, rule counter, focus map, and timestamp. Two lines: line 1 (status + rules), line 2 (focus + time).
- (view-conversation win h): renders the scrolled conversation using
cl-tty ScrollBox model. Dispatches per-role to dedicated render
functions (
render-user-msg,render-agent-msg,render-sys-msg,render-tool-call,render-gate-trace). Sticky-scroll auto-follows when at bottom. - (view-input win): renders the input line with cursor and typing indicator.
- (redraw sw cw ch iw): dispatches redraws based on
(st :dirty)flags (status, chat, input). Minimizes terminal writes. - (render-user-msg win content time w y): renders a user message with green role-prefix, timestamp, and word-wrapped content. Returns next y (v0.8.0).
- (render-agent-msg win content time gate-trace w y collapsed):
renders an agent message through cl-tty's
render-markdown. Gate trace rendered after content when not collapsed (v0.8.0). - (render-sys-msg win content w y): renders a system message in yellow, dim style. Returns next y (v0.8.0).
- (render-tool-call win tool-name status content w y): renders a tool call with status indicator (running ✓ ✗), truncated output, expandable via Tab. Returns next y (v0.8.0).
- (render-gate-trace win trace w y): renders gate decisions as colored lines (green passed, red blocked, yellow HITL). Collapsible via Ctrl+G per message. Returns next y (v0.8.0).
- (char-width ch): returns the terminal column width of character CH. ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
- (view-status win): v0.7.0 — timestamp right-aligned at (- w 12) on line 2, focus info at :x 1. No overlap.
- (redraw sw cw sidebar-w ch iw): v0.8.0 — redraw dispatches to five windows: status, chat, sidebar (when visible and ≥120 cols), input. In overlay mode (<120 cols), sidebar is rendered as an absolute-positioned overlay window on top of chat.
- (view-sidebar window): renders 42-column sidebar with 7 panels
stacked vertically: Gate Trace, Focus, Rules, Context gauge,
Files, Cost, Protection. Each panel title uses
:accentcolor. Returns number of lines rendered (v0.8.0). - (view-palette window items filter-query selected-idx): renders command palette as centered overlay (~60% width, ~50% height). Shows category headers, filtered items with highlighted selection, keyboard shortcut hints. Scrolls when items exceed available height (v0.8.0).
- (view-wizard window step input error): renders setup wizard UI:
step title (
:accent), prompt text (:agent), input area, error message in:errorcolor, progress indicator "Step N/M" at bottom (v0.8.0).
Status Bar
The status bar, as of v0.4.0, renders Passepartout's three differentiator visualizations — data only available because of the deterministic gate architecture:
- Rule counter (
Rules:N): the number of pending HITL actions from the Dispatcher's*hitl-pending*hash table. The user watches this tick up as they teach the agent their preferences through approve/deny decisions. - Focus map (
[Focus: <id>]): the foveal focus from the daemon's signal context. Shows the user what the agent is currently looking at. - Gate trace (not rendered in status bar — attached to individual
messages via
:gate-tracefield for future collapsible rendering per message).
All three enrichments cost 0 LLM tokens — they are daemon-state queries that the TUI actuator attaches to the response plist before transmission.
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
"Wrap occurrences of QUERY in CONTENT with **bold** markers."
(let ((lower-content (string-downcase content))
(lower-query (string-downcase query))
(result "") (pos 0))
(when (and query (> (length query) 0))
(loop
(let ((found (search lower-query lower-content :start2 pos)))
(unless found (return))
(setf result (concatenate 'string result
(subseq content pos found)
"**" (subseq content found (+ found (length query))) "**"))
(setf pos (+ found (length query)))))
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun render-user-msg (win content time w y)
"Render a user message with green role-prefix and timestamp. Returns next y."
(let* ((prefix (format nil "⬆ [~a] " time))
(line-text (concatenate 'string prefix content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :user))
(incf y)))
y))
(defun render-agent-msg (win content time w y)
"Render an agent message using cl-tty's markdown renderer. Returns next y."
(let* ((prefix (format nil "⬇ [~a] " time))
(header-len (length prefix)))
;; Role prefix line
(add-string win prefix :y y :x 1 :n header-len :fgcolor (theme-color :agent))
(incf y)
;; Markdown content — cl-tty's render-markdown produces ANSI-styled lines
(let ((md-lines (cl-tty.markdown:render-md
(cl-tty.markdown:parse-blocks content))))
(dolist (line md-lines)
(when (< y 9999)
;; Each line may contain ANSI escape codes; render through add-string
(add-string win line :y y :x 1 :n (- w 2) :fgcolor (theme-color :agent))
(incf y))))
y))
(defun render-sys-msg (win content w y)
"Render a system message in yellow, dim style. Returns next y."
(let* ((line-text (format nil " ~a" content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :system))
(incf y)))
y))
(defun render-tool-call (win tool-name status duration content w y tab-expanded)
"Render a tool call with status indicator. Tab toggles full output. Returns next y."
(let* ((status-char (case status (:running "…") (:success "✓") (:failure "✗") (t "?")))
(status-color (case status (:running (theme-color :tool-running))
(:success (theme-color :tool-success))
(:failure (theme-color :tool-failure))
(t (theme-color :dim))))
(summary (format nil " ~a ~a~@[ (~,1fs)~]" status-char tool-name duration)))
;; Summary line
(add-string win summary :y y :x 1 :n (- w 2) :fgcolor status-color)
(incf y)
;; Expanded output (when Tab pressed)
(when tab-expanded
(dolist (line (word-wrap content (- w 6)))
(when (< y 9999)
(add-string win (format nil " ~a" line) :y y :x 1 :n (- w 4) :fgcolor (theme-color :tool-output))
(incf y))))
y))
(defun render-gate-trace (win trace w y collapsed)
"Render gate decisions as colored lines. Ctrl+G toggles. Returns next y."
(unless collapsed
(dolist (entry (gate-trace-lines trace))
(when (< y 9999)
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))
y)
(defun view-conversation (win h)
"Render scrolled message list using cl-tty ScrollBox model.
Sticky-scroll: auto-follows new content when at bottom.
Each message role dispatched to its dedicated render function."
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
(y 1))
;; Search mode header
(when is-search
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(incf y)
(decf max-lines)))
;; Sticky-scroll: if at bottom, auto-follow
(when (and (zerop (st :scroll-offset)) (> total 0))
(setf (st :scroll-at-bottom) t))
;; Count visible messages from end
(let* ((msg-count 0)
(lines-remaining max-lines))
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(nlines (case role
(:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2))))
(:agent (let ((header (format nil "⬇ [~a]" time)))
(+ 1 (length (cl-tty.markdown:render-md
(cl-tty.markdown:parse-blocks content))))))
(t (length (word-wrap (format nil " ~a" content) (- w 2)))))))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0))))
;; Render from start message
(let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(gate-trace (getf msg :gate-trace))
(collapsed (member i (st :collapsed-gates)))
(tool-name (getf msg :tool))
(tool-status (getf msg :tool-status))
(tool-duration (getf msg :tool-duration))
(tool-expanded (member i (st :expand-tool-calls))))
(setf y (case role
(:user (render-user-msg win content time w y))
(:agent (progn
(setf y (render-agent-msg win content time w y))
(when gate-trace
(setf y (render-gate-trace win gate-trace w y collapsed)))
y))
(t (render-sys-msg win content w y))))
;; Tool call block (attached to any role message)
(when tool-name
(setf y (render-tool-call win tool-name tool-status tool-duration
content w y tool-expanded)))))))
;; Sticky-scroll update
(when (and (st :scroll-at-bottom) (plusp (length msgs)))
(setf (st :scroll-offset) 0))
(refresh win)))Input Line
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))Redraw (dirty-flag dispatch)
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-conversation cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))Test Suite
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (char-width #\a)))
(is (= 1 (char-width #\Space)))
(is (= 1 (char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (parse-markdown-spans "plain")))
(is (= 1 (length segments)))
(is (string= "plain" (caar segments)))))
(test test-markdown-url
"Contract 7: parse-markdown-spans detects URLs."
(let ((segments (parse-markdown-spans "see https://example.com for more")))
(is (>= (length segments) 2))
(is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
(test test-markdown-blocks
"Contract 8: parse-markdown-blocks detects code blocks."
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
(segs (parse-markdown-blocks text)))
(is (= 3 (length segs)))
(let ((code (second segs)))
(is (eq t (getf code :code-block)))
(is (string= "lisp" (getf code :lang)))
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
(test test-markdown-blocks-no-close
"Contract 8: unclosed code block returns content."
(let* ((text (format nil "```~%unclosed code"))
(segs (parse-markdown-blocks text)))
(is (= 1 (length segs)))
(is (eq t (getf (first segs) :code-block)))))
(test test-syntax-highlight
"Contract 9: syntax-highlight colors Lisp code."
(let ((segs (syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
(is (>= (length segs) 3))))
(test test-syntax-highlight-keyword
"Contract 9: syntax-highlight colors keywords."
(let ((segs (syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
(is (>= (length segs) 2))
(is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-syntax-highlight-function
"Contract 9: syntax-highlight colors function calls."
(let ((segs (syntax-highlight "(+ 1 2)" "lisp")))
(is (>= (length segs) 2))
(is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
(test test-gate-trace-lines-passed
"Contract 9: gate-trace-lines for passed gate."
(let ((lines (gate-trace-lines
'((:gate "path" :result :passed)))))
(is (= 1 (length lines)))
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
(test test-gate-trace-lines-blocked
"Contract 9: gate-trace-lines for blocked gate."
(let ((lines (gate-trace-lines
'((:gate "shell" :result :blocked :reason "rm")))))
(is (= 1 (length lines)))
(is (search "rm" (caar lines)))))
(test test-gate-trace-lines-approval
"Contract 9: gate-trace-lines for approval gate."
(let ((lines (gate-trace-lines
'((:gate "network" :result :approval)))))
(is (= 1 (length lines)))
(is (search "HITL" (caar lines)))))
(test test-init-state-has-collapsed-gates
"Contract v0.7.2: init-state includes :collapsed-gates field."
(passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))Implementation — v0.7.0 additions
(in-package :passepartout.channel-tui)
(defun char-width (ch)
"Returns the terminal column width of character CH.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(let ((code (char-code ch)))
(cond
((= code 9) 8)
((< code 32) 0)
((<= code 127) 1)
((<= #x4E00 code #x9FFF) 2)
((<= #x3400 code #x4DBF) 2)
((<= #x3040 code #x309F) 2)
((<= #x30A0 code #x30FF) 2)
((<= #xAC00 code #xD7AF) 2)
((<= #xFF01 code #xFF60) 2)
((<= #xFFE0 code #xFFE6) 2)
((<= #x1F300 code #x1F9FF) 2)
((<= #x2600 code #x27BF) 2)
((<= #x0300 code #x036F) 0)
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))
(defun word-wrap (text max-width)
"Split TEXT into lines that fit within MAX-WIDTH columns.
Word-breaks at spaces when possible; breaks mid-word if necessary.
Respects CJK/emoji char widths via char-width."
(let ((lines nil)
(start 0)
(end (length text)))
(loop while (< start end) do
(let* ((col 0)
(pos start)
(last-break start))
(loop while (< pos end)
for width = (char-width (char text pos)) do
(when (char= (char text pos) #\Space)
(setf last-break pos))
(when (> (+ col width) max-width)
(return))
(incf col width)
(incf pos)
(when (>= pos end) (return)))
(let ((line-end (if (> pos start) pos (1+ start))))
(when (>= line-end end) (setf line-end end))
(push (subseq text start line-end) lines)
(setf start (if (and (< line-end end) (char= (char text line-end) #\Space))
(1+ line-end)
line-end)))))
(nreverse lines)))v0.7.1 — Markdown Rendering
(in-package :passepartout.channel-tui)
(defun parse-markdown-spans (text)
"Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
(let ((results nil) (pos 0) (len (length text)))
(labels ((earliest (a b) (cond ((and a (or (null b) (< a b))) a) (b b))))
(loop
(when (>= pos len) (return))
(let* ((bold (search "**" text :start2 pos))
(code (search "`" text :start2 pos))
(italic (search "*" text :start2 pos))
(http (search "http://" text :start2 pos))
(https (search "https://" text :start2 pos))
(url-s (or https http)))
(flet ((pick (tag delim)
(let ((end (search delim text :start2 (+ pos (length delim)))))
(when end
(push (cons (subseq text (+ pos (length delim)) end)
(case tag (:bold '(:bold t))
(:code '(:code t :bgcolor :dim))
(:underline '(:underline t))
(:url '(:url t))))
results)
(setf pos (+ end (length delim)))
t)))
(url-end (start)
(or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
text :start start)
len)))
(let ((next (earliest (earliest (earliest bold code) italic) url-s)))
(cond ((and bold (eql bold next)) (unless (pick :bold "**") (incf pos 2)))
((and code (eql code next)) (unless (pick :code "`") (incf pos)))
((and italic (eql italic next)) (unless (pick :underline "*") (incf pos)))
((and url-s (eql url-s next))
(let ((ue (url-end url-s)))
(push (cons (subseq text url-s ue) '(:url t)) results)
(setf pos ue)))
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url))
(style-bits (append (when bold '(:bold))
(when underline '(:underline)))))
(when style-bits
(add-attributes win (get-bitmask style-bits)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(when style-bits
(remove-attributes win (get-bitmask style-bits)))
(incf x (length text))))
(1+ y))
(defun parse-markdown-blocks (text)
"Split text at ``` code block boundaries."
(let ((r nil) (p 0) (l (length text)))
(loop
(when (>= p l) (return))
(let ((bs (search "```" text :start2 p)))
(unless bs
(push (cons (subseq text p) nil) r)
(return))
(when (> bs p)
(push (cons (subseq text p bs) nil) r))
(let* ((ao (+ bs 3))
(le (or (position #\Newline text :start ao) l))
(lang (string-trim " \r\n\t" (if (< le l) (subseq text ao le) "")))
(cs (if (< le l) (1+ le) l))
(cp (search "```" text :start2 cs))
(ce (or cp l))
(content (string-trim "\r\n" (subseq text cs ce))))
(push (list :code-block t :lang lang :content content) r)
(setf p (if cp (+ cp 3) l)))))
(nreverse r)))
(defun syntax-highlight (code lang)
"Highlight Lisp code: strings, comments, keywords, function calls."
(declare (ignore lang))
(let* ((r nil) (p 0) (l (length code))
(kw '("defun" "defvar" "defparameter" "let" "let*" "lambda" "if" "when" "unless"
"cond" "loop" "dolist" "dotimes" "progn" "prog1" "return"
"setf" "setq" "format" "and" "or" "not" "list" "cons"
"quote" "function" "declare" "ignore" "t" "nil")))
(flet ((wordp (c) (or (alphanumericp c) (find c "-*+/?!_=<>"))))
(loop
(when (>= p l) (return))
(let* ((ss (position #\" code :start p))
(sc (position #\; code :start p))
(sp (position #\( code :start p))
(next (min (or ss l) (or sc l) (or sp l))))
(when (> next p)
(push (cons (subseq code p next) nil) r)
(setf p next))
(when (>= p l) (return))
(cond
((eql p ss)
(let ((e (or (position #\" code :start (1+ p)) l)))
(push (cons (subseq code p (min (1+ e) l)) '(:fgcolor :string)) r)
(setf p (min (1+ e) l))))
((eql p sc)
(let ((e (or (position #\Newline code :start p) l)))
(push (cons (subseq code p e) '(:fgcolor :comment)) r)
(setf p e)))
((eql p sp)
(push (cons "(" nil) r)
(incf p)
(let ((fe (loop for i from p below l for c = (char code i)
while (wordp c) finally (return i))))
(when (> fe p)
(let ((fs (subseq code p fe)))
(push (cons fs (list :fgcolor (if (member fs kw :test #'string=)
:keyword :function))) r)
(setf p fe)))))))))
(nreverse r)))v0.7.2 — Gate Trace
(in-package :passepartout.channel-tui)
(defun gate-trace-lines (trace)
"Convert gate-trace plist to display lines."
(let ((lines nil))
(dolist (entry trace)
(let* ((gate (getf entry :gate))
(result (getf entry :result))
(reason (getf entry :reason))
(name (or gate "unknown"))
(color (case result
(:passed (theme-color :gate-passed))
(:blocked (theme-color :gate-blocked))
(:approval (theme-color :gate-approval))
(t (theme-color :dim))))
(prefix (case result
(:passed " ✓ ")
(:blocked " ✗ ")
(:approval " → ")
(t " ? ")))
(text (format nil "~a~a~@[~a~]~@[~a~]"
prefix name
(when reason (format nil ": ~a" reason))
(if (eq result :approval) " (HITL required)" ""))))
(push (cons text (list :fgcolor color)) lines)))
(nreverse lines)))v0.8.0 — Sidebar + Minibuffer View
(in-package :passepartout.channel-tui)
;; ── Sidebar Panel Slots ──
;; Each sidebar panel is a cl-tty slot registration with :mode :replace.
;; The sidebar orchestrates them in order, passing (win w h y) and
;; receiving the next y position.
(defun render-sidebar-panel-header (win w y title)
(add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2)
:fgcolor (theme-color :accent))
(1+ y))
(cl-tty.slot:defslot :sidebar-gate-trace :mode :replace
:render-fn
(lambda (win w h y)
(let ((trace (st :gate-trace)))
(setf y (render-sidebar-panel-header win w y "Gate Trace"))
(if trace
(dolist (entry (gate-trace-lines trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 2 :n (- w 4)
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
(incf y)))
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
y)))
(cl-tty.slot:defslot :sidebar-focus :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (render-sidebar-panel-header win w y "Focus"))
(add-string win (format nil " ~a" (or (st :foveal-id) "(none)"))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
(+ y 2)))
(cl-tty.slot:defslot :sidebar-rules :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Rules"))
(add-string win (format nil " Rules: ~d" (or (st :rule-count) 0))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
(1+ y)))
(cl-tty.slot:defslot :sidebar-context :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Context"))
(let* ((pct (or (st :context-usage) 0))
(bar-width 30)
(filled (min bar-width (floor (* pct bar-width) 100)))
(gauge-color (cond ((< pct 50) (theme-color :connected))
((< pct 80) (theme-color :warning))
((< pct 95) (theme-color :tool-running))
(t (theme-color :error)))))
(add-string win (format nil " [~a~a] ~d%"
(make-string filled :initial-element #\█)
(make-string (- bar-width filled) :initial-element #\░)
pct)
:y y :x 2 :n (- w 4) :fgcolor gauge-color))
(1+ y)))
(cl-tty.slot:defslot :sidebar-files :mode :replace
:render-fn
(lambda (win w h y)
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Files"))
(let ((files (st :modified-files)))
(if files
(dolist (f files)
(when (< y (1- h))
(let ((fp (getf f :filepath))
(added (getf f :lines-added))
(removed (getf f :lines-removed)))
(add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]"
(subseq fp (max 0 (- (length fp) 30)))
(when (> added 0) added)
(when (> removed 0) removed))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y))))
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
y)))
(cl-tty.slot:defslot :sidebar-cost :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Cost"))
(let ((cost (st :session-cost)))
(if cost
(progn
(add-string win (format nil " Total: $~,4f" (getf cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(add-string win (format nil " Calls: ~d" (getf cost :calls))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
(1+ y))))
(cl-tty.slot:defslot :sidebar-protection :mode :replace
:render-fn
(lambda (win w h y)
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Protection"))
(let ((bc (st :block-counts)))
(if (and bc (> (getf bc :total) 0))
(let ((by-gate (getf bc :by-gate)))
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
(when (< y (1- h))
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
(incf y))))
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
y)))
(defun view-sidebar (win)
"Render 42-column sidebar with panel slots: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let ((w (or (width win) 42))
(h (or (height win) 24))
(y 1))
(dolist (panel '(:sidebar-gate-trace :sidebar-focus :sidebar-rules
:sidebar-context :sidebar-files :sidebar-cost
:sidebar-protection))
(let ((result (cl-tty.slot:slot-render panel win w h y)))
(when result (setf y (min (1- h) result)))))
(refresh win)
(1- y)))
(defun view-minibuffer (win)
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
(case (st :minibuffer-mode)
(:slash-menu (view-slash-menu win))
(:wizard (view-wizard-in-panel win))
(t nil)))
(declaim (special *slash-commands*)) ; forward declaration — defined in channel-tui-main
(defun view-slash-menu (win)
"Render the slash-command menu: filter bar, filtered command list, selection highlight."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 60))
(h (or (height win) 10))
(y 1)
(filter (or (st :minibuffer-filter) ""))
(commands passepartout.channel-tui::*slash-commands*)
(filtered (if (or (null filter) (string= filter ""))
(mapcar (lambda (c) (list :index (position c commands) :cmd c)) commands)
(let ((q (string-downcase filter)) (i 0) (r nil))
(dolist (c commands (nreverse r))
(when (or (search q (string-downcase (getf c :name)))
(search q (string-downcase (or (getf c :desc) ""))))
(push (list :index i :cmd c) r))
(incf i)))))
(sel (or (st :minibuffer-selected-idx) 0))
(max-visible (- h 3)))
;; Header: filter bar
(add-string win (format nil " Commands") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " > ~a_" (if (> (length filter) 0) filter "/"))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :input))
(incf y)
;; Command list
(if filtered
(let* ((start (max 0 (- sel (floor max-visible 2))))
(end (min (length filtered) (+ start max-visible)))
(flat-i 0))
(loop for entry across (subseq (coerce filtered 'vector) start end)
for fi from start
for cmd = (getf entry :cmd)
do (let* ((name (getf cmd :name))
(desc (getf cmd :desc))
(selected (= fi sel))
(fg (if selected (theme-color :highlight) (theme-color :agent))))
(when selected
(add-string win (make-string (- w 4) :initial-element #\Space) :y y :x 2 :n (- w 4)
:fgcolor (theme-color :dim) :bgcolor (theme-color :highlight)))
(let ((prefix (if selected " > " " ")))
(add-string win (format nil "~a~a" prefix name) :y y :x 3 :n (min (- w 6) 25) :fgcolor fg)
(when desc
(add-string win (format nil " — ~a" desc) :y y :x 28 :n (min (- w 30) (length desc)) :fgcolor (theme-color :dim))))
(incf y))))
(progn
(add-string win " (no matching commands)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)))
;; Footer
(add-string win " ↑↓ Navigate Enter Execute Esc Close"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(refresh win)
(- h 0)))
(defun view-wizard-in-panel (win)
"Render the setup wizard in the bottom-anchored minibuffer panel. Three modes: provider-list, key-entry, cascade-config."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let* ((w (or (width win) 70))
(h (or (height win) 14))
(y 1)
(mode (st :wizard-mode))
(error-msg (st :wizard-error))
(selected-idx (st :wizard-selected-idx))
(providers (passepartout.channel-tui::wizard-provider-list))
(configured (st :wizard-providers)))
(add-string win "Setup Wizard" :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y 2)
(case mode
(:provider-list
(let ((count (/ (length configured) 2)))
(add-string win (format nil "Configure Providers~a"
(if (> count 0) (format nil " — ~d configured" count) ""))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(loop for p in providers
for i from 0
do (let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(key (getf configured p))
(prefix (if (= i selected-idx) "> " " "))
(suffix (if key " ✓" ""))
(color (if (= i selected-idx)
(theme-color :highlight)
(theme-color :dim))))
(add-string win (format nil "~a~a~a" prefix name suffix)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)))
(incf y)
(add-string win " Done — configure cascade"
:y y :x 3 :n (- w 6)
:fgcolor (if (>= selected-idx (length providers))
(theme-color :highlight)
(theme-color :dim)))
(when (>= selected-idx (length providers))
(add-string win ">" :y y :x 1 :n 2 :fgcolor (theme-color :highlight))))
(:key-entry
(let* ((provider (st :wizard-current-provider))
(meta (passepartout.channel-tui::wizard-provider-meta provider))
(name (car meta))
(url (cadr meta))
(input (or (st :wizard-input) "")))
(add-string win (format nil "API Key: ~a" name) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(when url
(add-string win (format nil "Get key at: ~a" url) :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y))
(add-string win "Enter your API key." :y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y 2)
(add-string win (format nil "Key: > ~a" input) :y y :x 3 :n (- w 6) :fgcolor (theme-color :input))
(incf y)
(when error-msg
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error))
(incf y))
(incf y)
(add-string win "Enter=Save Esc=Back Bksp=Edit Ctrl+U=Clear"
:y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(return-from view-wizard-in-panel)))
(:cascade-config
(let* ((slot (st :wizard-cascade-slot))
(slot-providers (getf (st :wizard-cascade) slot))
(slot-label (cadr (assoc slot passepartout.channel-tui::*wizard-cascade-labels*)))
(count (/ (length configured) 2)))
(add-string win (format nil "Configure Cascade — ~d provider~:p" count)
:y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(add-string win (or slot-label "Unknown") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(let ((shown nil))
(loop for p in providers
for i from 0
do (when (getf configured p)
(let* ((meta (passepartout.channel-tui::wizard-provider-meta p))
(name (car meta))
(in-slot (member p slot-providers))
(prefix (if (= i selected-idx) "> " " "))
(mark (if in-slot " [✓]" " [ ]"))
(color (if (= i selected-idx)
(theme-color :highlight)
(if in-slot (theme-color :gate-passed) (theme-color :dim)))))
(add-string win (format nil "~a~a~a" prefix name mark)
:y y :x 3 :n (- w 6) :fgcolor color)
(incf y)
(push t shown))))
(unless shown
(add-string win " (no providers configured)"
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))
(incf y)))
(incf y)
(add-string win (format nil "Cascade: ~{~a~^, ~}"
(or slot-providers '("(none)")))
:y y :x 3 :n (- w 6) :fgcolor (theme-color :dim))))
(when error-msg
(incf y)
(add-string win (format nil "! ~a" error-msg) :y y :x 3 :n (- w 6) :fgcolor (theme-color :error)))
(let ((footer (case mode
(:provider-list "↑↓ Navigate Enter=Select Esc=Back Ctrl+D=Remove")
(:cascade-config "↑↓ Select Enter=Toggle Tab=Next Quadrant Ctrl+S=Save Esc=Back")
(t ""))))
(when footer
(add-string win footer :y (- h 0) :x 2 :n (- w 4) :fgcolor (theme-color :dim))))
(- h 0)))))v0.8.0 Tests — Sidebar View + Minibuffer View
(in-package :passepartout-tui-view-tests)
(test test-theme-hex-string-keys-exist
"v0.8.0: all 27 theme keys are present in *tui-theme*."
(let* ((theme passepartout.channel-tui::*tui-theme*)
(required '(:user :agent :system :input :timestamp :help :error :warning
:connected :disconnected :busy :idle
:gate-passed :gate-blocked :gate-approval :hitl
:tool-running :tool-success :tool-failure :tool-output
:scroll-indicator :border :background
:rule-count :focus-map
:dim :highlight :accent)))
(dolist (key required)
(is (getf theme key) (format nil "~a should be defined" key)))))
(test test-theme-presets-count
"v0.8.0: 8 presets defined: dark, light, solarized, gruvbox, nord, tokyonight, catppuccin, monokai."
(let* ((presets passepartout.channel-tui::*tui-theme-presets*)
(names '(:dark :light :solarized :gruvbox :nord :tokyonight :catppuccin :monokai)))
(dolist (name names)
(is (getf presets name) (format nil "~a preset should exist" name)))))
(test test-minibuffer-init-state-fields
"Contract v0.8.0: init-state no longer has legacy palette/wizard fields."
(passepartout.channel-tui::init-state)
(is (null (getf passepartout.channel-tui::*state* :mode)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible))))