docs: port TUI roadmap to cl-tty, mark Emacs as secondary client
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.
This commit is contained in:
@@ -72,35 +72,62 @@ 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)
|
||||
** v0.8.0 — Conversation View: ScrollBox + Markdown
|
||||
|
||||
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 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.
|
||||
|
||||
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.
|
||||
Each message type has a dedicated render function:
|
||||
|
||||
The wizard reuses the overlay infrastructure built for the command
|
||||
palette and sidebar — same window creation patterns, same Croatoan
|
||||
rendering primitives.
|
||||
- *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's
|
||||
~parse-blocks~ + ~render-md~ for 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-calls~ state).
|
||||
- *Gate traces*: ~render-gate-trace~ — collapsible block (Ctrl+G
|
||||
toggles per-message via ~collapsed-gates~ state).
|
||||
|
||||
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
|
||||
|
||||
1. (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).
|
||||
2. (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).
|
||||
msg count, scroll offset, rule counter, focus map, and timestamp.
|
||||
Two lines: line 1 (status + rules), line 2 (focus + time).
|
||||
2. (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.
|
||||
3. (view-input win): renders the input line with cursor and typing
|
||||
indicator.
|
||||
4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~
|
||||
flags (status, chat, input). Minimizes terminal writes.
|
||||
5. (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).
|
||||
6. (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).
|
||||
7. (render-sys-msg win content w y): renders a system message in
|
||||
yellow, dim style. Returns next y (v0.8.0).
|
||||
8. (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).
|
||||
9. (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).
|
||||
5. (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).
|
||||
@@ -185,7 +212,76 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(setf result (concatenate 'string result (subseq content pos)))
|
||||
(if (string= result "") content result))))
|
||||
|
||||
(defun view-chat (win h)
|
||||
(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))
|
||||
@@ -194,7 +290,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(max-lines (- h 2))
|
||||
(is-search (st :search-mode))
|
||||
(y 1))
|
||||
;; v0.7.2: search mode header
|
||||
;; Search mode header
|
||||
(when is-search
|
||||
(let* ((matches (st :search-matches))
|
||||
(idx (st :search-match-idx))
|
||||
@@ -204,26 +300,28 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(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
|
||||
;; 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) ""))
|
||||
(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)))
|
||||
(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 the correct starting message
|
||||
;; 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
|
||||
@@ -232,36 +330,28 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(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))
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Input Line
|
||||
@@ -283,7 +373,7 @@ that the TUI actuator attaches to the response plist before transmission.
|
||||
(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 cd (view-conversation cw ch))
|
||||
(when id (view-input iw))
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
#+end_src
|
||||
@@ -616,46 +706,56 @@ Respects CJK/emoji char widths via char-width."
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
;; ── 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))
|
||||
@@ -667,49 +767,77 @@ Respects CJK/emoji char widths via char-width."
|
||||
(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)))
|
||||
(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))
|
||||
(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)))
|
||||
(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)
|
||||
(- y 1)))
|
||||
(1- y)))
|
||||
|
||||
(defun view-minibuffer (win)
|
||||
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
|
||||
@@ -718,7 +846,7 @@ Respects CJK/emoji char widths via char-width."
|
||||
(:wizard (view-wizard-in-panel win))
|
||||
(t nil)))
|
||||
|
||||
(defvar *slash-commands* nil) ; forward declaration — defined in channel-tui-main
|
||||
(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."
|
||||
@@ -912,20 +1040,8 @@ Respects CJK/emoji char widths via char-width."
|
||||
(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."
|
||||
"Contract v0.8.0: init-state no longer has legacy palette/wizard fields."
|
||||
(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))))))
|
||||
(is (null (getf passepartout.channel-tui::*state* :mode)))
|
||||
(is (null (getf passepartout.channel-tui::*state* :palette-visible))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user