Amr Gharbeia
00211cf685
- Unified minibuffer slash-command panel (panel-based wizard, settings, help sub-mode stack) — channel-tui state/view changes - ROADMAP: v0.8.0 broken into atomic DONE items, v0.9.1 added with Emacs major mode + M-x command surface TODOs - Semver discipline from v0.7.1 onward (X.Y.Z)
41 KiB
41 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 — TUI Setup Wizard (deferred from v0.7.0)
The TUI setup wizard replaces the terminal-based passepartout configure
flow with an in-TUI onboarding sequence. Users select LLM providers,
enter API keys, and verify connections — all within the same interface
they'll use daily.
The wizard is a multi-step overlay with progress indicator. Each step
defines a title, prompt text, validation function, and next-step function.
On validation failure, the step displays an error and stays on the current
step. On success, it advances. The last step writes configuration to
.env and triggers daemon reload.
The wizard reuses the overlay infrastructure built for the command palette and sidebar — same window creation patterns, same Croatoan rendering primitives.
Contract
- (view-status win): renders the status bar with connection info, msg count, scroll offset, rule counter, focus map (v0.4.0), and timestamp. Two lines: line 1 (status + rules), line 2 (focus + time).
- (view-chat win h): renders the scrolled chat message list. Takes window and available height. Messages are color-coded: green (user), white (agent), yellow (system).
- (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. - (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 view-chat (win h)
(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))
;; v0.7.2: 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)))
;; Count visible messages from end, accounting for word wrap
(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) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting 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) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(is-panel (getf msg :panel))
(is-resolved (getf msg :panel-resolved))
(content-show (if is-search
(search-highlight content (st :search-query))
content))
(line-text (format nil "~a [~a] ~a" prefix time content-show))
(wrapped (word-wrap line-text (- w 2))))
;; HITL panel: render with colored border
(when is-panel
(setf color (if is-resolved
(theme-color :dim)
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(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-chat 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)
(defun view-sidebar (win)
"Render 42-column sidebar with 7 panels: 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)
(gate-trace (st :gate-trace))
(foveal-id (st :foveal-id))
(rule-count (or (st :rule-count) 0))
(context-usage (st :context-usage))
(modified-files (st :modified-files))
(session-cost (st :session-cost))
(block-counts (st :block-counts)))
;; Panel 1: Gate Trace
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if gate-trace
(dolist (entry (gate-trace-lines gate-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)))
;; Panel 2: Focus
(incf y)
(add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
;; Panel 3: Rules
(incf y 2)
(add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
;; Panel 4: Context gauge
(incf y 2)
(add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(let* ((pct (or 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))
;; Panel 5: Files
(incf y 2)
(add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if modified-files
(dolist (f modified-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)))
;; Panel 6: Cost
(incf y 2)
(add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if session-cost
(progn
(add-string win (format nil " Total: $~,4f" (getf session-cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)
(add-string win (format nil " Calls: ~d" (getf session-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)))
;; Panel 7: Protection
(incf y 2)
(add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent))
(incf y)
(if (and block-counts (> (getf block-counts :total) 0))
(let ((by-gate (getf block-counts :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)))
(refresh win)
(- y 1)))
(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)))
(defvar *slash-commands* nil) ; 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 includes minibuffer-mode, selected-idx, filter; excludes palette and wizard-visible."
(passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :minibuffer-mode)))
(is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx)))
(is (string= "" (passepartout.channel-tui::st :minibuffer-filter)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible)))
(is (null (getf passepartout.channel-tui::*state* :wizard-visible))))
(test test-slash-commands-entry-count
"Contract v0.8.0: *slash-commands* has at least 19 entries, each with :name, :desc, :action."
(let ((cmds passepartout.channel-tui::*slash-commands*))
(is (>= (length cmds) 19))
(dolist (c cmds)
(is (stringp (getf c :name)))
(is (stringp (getf c :desc)))
(is (functionp (getf c :action))))))