37 KiB
Passepartout TUI — View
- View
- Implementation — v0.7.0 additions
- v0.7.1 — Markdown Rendering
- v0.7.2 — Gate Trace
- v0.8.0 — Sidebar + Palette View
- Test Suite
- v0.8.0 Tests — Sidebar 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 (passepartout::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 (passepartout::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 (passepartout::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))))
Implementation — v0.7.0 additions
(in-package :passepartout)
(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)
(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)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bold bold :underline underline
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(incf x (length text))))
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)
(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 :gate-passed)
(:blocked :gate-blocked)
(:approval :gate-approval)
(t :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 + Palette 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)
(box win (theme-color :border) (theme-color :background))
(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 (passepartout::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 palette-filter (items query)
"Return items from categorized list whose :name or :desc contains QUERY (case-insensitive)."
(if (or (null query) (string= query ""))
items
(let ((q (string-downcase query)))
(loop for group in items
for category = (getf group :category)
for gitems = (getf group :items)
for filtered = (loop for item in gitems
when (or (search q (string-downcase (getf item :name)))
(search q (string-downcase (or (getf item :desc) ""))))
collect item)
when filtered
collect (list :category category :items filtered)))))
(defun view-palette (win)
"Render centered command palette overlay with filtered items, selection highlight."
(clear win)
(box win (theme-color :border) (theme-color :background))
(let* ((w (or (width win) 50))
(h (or (height win) 20))
(y 1)
(query (or (st :palette-filter) ""))
(items (palette-filter (st :palette-items) query))
(selected (st :palette-selected-idx))
(flat-index 0)
(visible-start (max 0 (- selected (floor (- h 6) 2)))))
(add-string win (format nil " Command Palette ") :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y)
(add-string win (format nil " > ~a" (if (> (length query) 0) query "type to filter..."))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :input) :attributes '(:underline t))
(incf y)
(dolist (group items)
(let ((category (getf group :category))
(gitems (getf group :items)))
(when (and gitems (< y (1- h)))
(incf y)
(add-string win (format nil "── ~a ──" category) :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(dolist (item gitems)
(when (< y (1- h))
(incf y)
(let* ((name (getf item :name))
(desc (getf item :desc))
(shortcut (getf item :shortcut))
(is-selected (= flat-index selected))
(fg (if is-selected (theme-color :accent) (theme-color :agent))))
(when is-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 :accent)))
(add-string win (format nil " ~a" name) :y y :x 3 :n (- w 6) :fgcolor fg)
(when (and shortcut (> (- w 6) (+ 4 (length shortcut))))
(add-string win shortcut :y y :x (- w (length shortcut) 3) :n (length shortcut) :fgcolor (theme-color :dim)))
(incf flat-index)))))))
(add-string win (format nil " ↑↓ Navigate Enter Execute Esc Close")
:y (- h 1) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(refresh win)
(- h 1)))
(defun view-wizard (win)
"Render setup wizard overlay: step title, prompt, input, error, progress."
(clear win)
(box win (theme-color :border) (theme-color :background))
(let* ((w (or (width win) 60))
(h (or (height win) 15))
(y 1)
(steps (passepartout.channel-tui::wizard-steps))
(step-idx (st :wizard-step))
(step (when (< step-idx (length steps)) (nth step-idx steps)))
(prompt (getf step :prompt))
(title (getf step :title))
(total (length steps))
(error-msg (st :wizard-error))
(input (or (st :wizard-input) "")))
(add-string win "Setup Wizard" :y y :x 2 :n (- w 4) :fgcolor (theme-color :accent))
(incf y 2)
(add-string win (format nil "Step ~d/~d" (1+ step-idx) total) :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(incf y)
(when title
(add-string win title :y y :x 3 :n (- w 6) :fgcolor (theme-color :accent))
(incf y))
(when prompt
(add-string win prompt :y y :x 3 :n (- w 6) :fgcolor (theme-color :agent))
(incf y))
(incf y)
(add-string win (format nil "> ~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))
(add-string win "Enter=Next Esc=Cancel Bksp=Edit" :y (- h 2) :x 2 :n (- w 4) :fgcolor (theme-color :dim))
(refresh win)
(- h 1)))
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 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (passepartout::char-width #\日))))
(test test-char-width-null
"Contract 5: null has width 0."
(is (= 0 (passepartout::char-width #\Nul))))
(test test-markdown-bold
"Contract 7: parse-markdown-spans detects **bold**."
(let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
(is (= 3 (length segments)))))
(test test-markdown-plain
"Contract 7: plain text returns single segment."
(let ((segments (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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 (passepartout::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))))
v0.8.0 Tests — Sidebar 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-palette-filter-matches-substring
"Contract v0.8.0: palette-filter returns items matching query."
(let* ((items (list (list :category "Session" :items
(list (list :name "/focus" :desc "Set context" :shortcut nil :action nil)
(list :name "/scope" :desc "Change scope" :shortcut nil :action nil)))))
(filtered (passepartout.channel-tui::palette-filter items "focus")))
(is (= 1 (length (getf (first filtered) :items))))
(is (string= "/focus" (getf (first (getf (first filtered) :items)) :name)))))
(test test-palette-filter-case-insensitive
"Contract v0.8.0: palette-filter is case-insensitive."
(let* ((items (list (list :category "View" :items
(list (list :name "/theme" :desc "Switch color" :shortcut nil :action nil)))))
(filtered (passepartout.channel-tui::palette-filter items "THEME")))
(is (= 1 (length (getf (first filtered) :items))))))
(test test-palette-filter-no-match-empty
"Contract v0.8.0: palette-filter returns empty categories on no match."
(let* ((items (list (list :category "View" :items
(list (list :name "/theme" :desc "Colors" :shortcut nil :action nil)))))
(filtered (passepartout.channel-tui::palette-filter items "xyznonexistent")))
(is (null (getf (first filtered) :items)))))