Amr Gharbeia
9492e00318
Sidebar: replace manual (incf y) tracking with flat list construction. sidebar-lines returns (text . color-key) pairs; view-sidebar loops over them. Version footer stays at h-2. No more fragile y arithmetic. Input panel: use cl-tty.input text-input's render method instead of manual word-wrap + cursor-position computation. Layout node set each frame for dynamic position. Chat: extract msg->pairs (message to renderable lines) and render-pair (draw one line pair) as separate functions. Replace reverse-iteration scroll culling with forward scan that skips by scroll-offset. Same behavior, less nesting.
518 lines
22 KiB
Org Mode
518 lines
22 KiB
Org Mode
#+TITLE: Passepartout TUI — View
|
|
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
|
|
* View
|
|
|
|
|Pure render functions. Each takes the cl-tty backend and current state.
|
|
|State is read via ~(st :key)~ — no mutation here.
|
|
|
|
** Contract
|
|
|
|
1. (view-status fb w h): no-op. Status bar is a clean black line.
|
|
2. (view-chat fb w h): renders scrolled chat messages. User messages
|
|
get amber left border (│), agent messages no border, streaming
|
|
agent gets grey left border. Gate traces/tool calls use ╎ prefix.
|
|
3. (view-input fb w h): renders expanding light grey input box,
|
|
multi-line word-wrapped prompt, hint bar at h-2. Text and cursor
|
|
rendered by cl-tty.input text-input's render method.
|
|
4. (view-sidebar fb w h): renders sidebar panels using ~sidebar-lines~.
|
|
5. (sidebar-lines): builds a flat list of (text . color-key) pairs for
|
|
the sidebar: gate trace, rules, cost, files, version.
|
|
6. (msg->pairs msg index bordered-w unbordered-w is-search): converts
|
|
a message to renderable ~(border border-color text text-color &optional bg)~
|
|
lines. Handles markdown, gate trace, tool calls, search highlight.
|
|
7. (render-pair fb hpad y pair): draws one message line pair.
|
|
8. (redraw fb w h): wraps view-status/chat/input in begin-sync/end-sync,
|
|
dispatches per dirty flags, fills global :bg first.
|
|
9. ~cl-tty.box:char-width~ for terminal column width.
|
|
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
|
|
Tab = 8. Used by cl-tty.box:word-wrap for accurate line counting.
|
|
10. (sidebar-visible-p w): returns T if sidebar should show given width W
|
|
and current :sidebar-mode (:auto >120, :visible always, :hidden never).
|
|
|
|
** 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-trace~ field 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(in-package :passepartout.channel-tui)
|
|
|
|
(defun sidebar-visible-p (w)
|
|
"Compute whether sidebar should be shown given terminal width W
|
|
and current sidebar mode (:auto/:visible/:hidden)."
|
|
(let ((mode (st :sidebar-mode)))
|
|
(or (eq mode :visible)
|
|
(and (eq mode :auto) (> w 120)))))
|
|
|
|
(defun view-status (fb w h)
|
|
(declare (ignore fb w h))
|
|
;; Status bar is now a clean black line — blends with global :bg.
|
|
;; No clock, no dot, no text. Everything clean.
|
|
)
|
|
|
|
(defun input-panel-top (chat-w h)
|
|
"Compute the top row of the input panel based on current input text."
|
|
(let* ((hpad 2)
|
|
(inner-w (- chat-w (* 2 hpad)))
|
|
(prompt-w (- inner-w 2))
|
|
(text (cl-tty.input:text-input-value (st :text-input)))
|
|
(lines (cl-tty.box:word-wrap text prompt-w))
|
|
(n-lines (max 1 (length lines)))
|
|
(panel-rows (max 4 (+ n-lines 2))))
|
|
(- h 4 panel-rows -1)))
|
|
#+end_src
|
|
|
|
;; Build simple tab-like blocks
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(in-package :passepartout.channel-tui)
|
|
|
|
(defun msg->pairs (msg index bordered-w unbordered-w is-search)
|
|
"Convert a message to a list of (border-str border-color text-str text-color &optional bg) lines."
|
|
(let* ((role (getf msg :role))
|
|
(content (getf msg :content))
|
|
(cs (if is-search (cl-tty.markdown:search-highlight content (st :search-query)) content))
|
|
(pairs nil)
|
|
(think-bg (theme-color :thinking-bg))
|
|
(sym-bdr (theme-color :symbolic-border))
|
|
(agent-bdr (theme-color :agent-border))
|
|
(user-bdr (theme-color :user-border))
|
|
(user-fg (theme-color :user-fg))
|
|
(agent-fg (theme-color :agent-fg))
|
|
(system-fg (theme-color :system)))
|
|
(case role
|
|
(:user
|
|
(dolist (l (cl-tty.box:word-wrap cs bordered-w))
|
|
(push (list "│" user-bdr l user-fg) pairs)))
|
|
(:agent
|
|
(let* ((streaming (getf msg :streaming))
|
|
(think-rect (if streaming think-bg nil))
|
|
(bdr (if streaming nil agent-bdr))
|
|
(bstr (if streaming nil "│"))
|
|
(wrap-w (if streaming unbordered-w bordered-w))
|
|
(nodes (cl-tty.markdown:parse-blocks cs))
|
|
(raw-body (or (and nodes (cl-tty.markdown:render-md nodes)) (list "")))
|
|
(body (mapcan (lambda (l) (cl-tty.box:word-wrap l wrap-w)) raw-body)))
|
|
(dolist (l body)
|
|
(push (list bstr bdr l agent-fg think-rect) pairs))))
|
|
(t (dolist (l (cl-tty.box:word-wrap cs unbordered-w))
|
|
(push (list nil nil l system-fg) pairs))))
|
|
;; Gate trace
|
|
(let ((gt (getf msg :gate-trace)))
|
|
(when (and gt (eq role :agent))
|
|
(if (member index (st :collapsed-gates))
|
|
(push (list "│" sym-bdr (format nil "Gate trace: ~a gates" (length gt)) sym-bdr) pairs)
|
|
(dolist (entry (passepartout::gate-trace-lines gt))
|
|
(let ((ec (theme-color (getf (cdr entry) :fgcolor))))
|
|
(dolist (l (cl-tty.box:word-wrap (car entry) bordered-w))
|
|
(push (list "│" sym-bdr l ec) pairs)))))))
|
|
;; Tool calls
|
|
(let ((tc (getf msg :tool-calls)))
|
|
(when tc
|
|
(if (member index (st :collapsed-tools))
|
|
(let* ((n (or (getf (first tc) :name) "tool"))
|
|
(d (or (getf (first tc) :duration) 0.0)))
|
|
(push (list "│" (theme-color :tool-done) (format nil "~a … ~,1fs" n d) (theme-color :tool-done)) pairs))
|
|
(dolist (call tc)
|
|
(let* ((name (or (getf call :name) "tool"))
|
|
(dur (or (getf call :duration) 0.0))
|
|
(st (getf call :status))
|
|
(out (getf call :output))
|
|
(bc (theme-color
|
|
(cond ((eq st :running) :tool-running)
|
|
((eq st :error) :tool-error)
|
|
(t :tool-done))))
|
|
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
|
|
(ol (when out (cl-tty.box:word-wrap out bordered-w))))
|
|
(push (list "│" bc (format nil "~a ~a ~,1fs" pfx name dur) bc) pairs)
|
|
(dolist (l ol)
|
|
(push (list "│" bc l bc) pairs)))))))
|
|
(nreverse pairs)))
|
|
|
|
(defun render-pair (fb hpad y pair)
|
|
"Draw a single (border-str border-color text-str text-color &optional bg) line."
|
|
(destructuring-bind (bstr bcolor tstr tcolor &optional rect-bg) pair
|
|
(when rect-bg
|
|
(cl-tty.backend:draw-rect fb 0 y 1 1 :bg rect-bg))
|
|
(let ((has-border (and bstr (> (length bstr) 0))))
|
|
(when has-border
|
|
(cl-tty.backend:draw-text fb hpad y bstr bcolor (theme-color :bg)))
|
|
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor (theme-color :bg)))))
|
|
|
|
(defun view-chat (fb w h)
|
|
(let* ((w (or (and (numberp w) (> w 0) w) 80))
|
|
(h (or (and (numberp h) (> h 0) h) 24))
|
|
(hpad 2)
|
|
(sidebar-w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
|
(chat-w (- w sidebar-w))
|
|
(msgs (st :messages)) (total (length msgs))
|
|
(panel-top (input-panel-top chat-w h))
|
|
(max-lines (max 0 panel-top)) (is-search (st :search-mode))
|
|
(bordered-w (- chat-w (* 2 hpad) 2))
|
|
(unbordered-w (- chat-w (* 2 hpad)))
|
|
(y 0))
|
|
;; Search header
|
|
(when is-search
|
|
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
|
|
(query (st :search-query))
|
|
(hdr (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
|
|
(length matches) query (1+ idx) (length matches))))
|
|
(cl-tty.backend:draw-text fb hpad y hdr (theme-color :accent) nil)
|
|
(incf y) (decf max-lines)))
|
|
;; Build all message lines once
|
|
(let* ((msg-lines (map 'vector
|
|
(lambda (msg i) (msg->pairs msg i bordered-w unbordered-w is-search))
|
|
msgs
|
|
(make-array total :initial-contents (loop for i below total collect i))))
|
|
(heights (map 'vector #'length msg-lines))
|
|
(scroll-skip (st :scroll-offset))
|
|
(i 0))
|
|
;; Forward scan: skip messages scrolled past, then render visible ones
|
|
(loop while (< i total)
|
|
do (let ((hgt (aref heights i)))
|
|
(if (> scroll-skip 0)
|
|
(decf scroll-skip hgt)
|
|
(let ((msg-y y))
|
|
(dolist (pair (aref msg-lines i))
|
|
(when (>= msg-y panel-top) (return))
|
|
(render-pair fb hpad msg-y pair)
|
|
(incf msg-y))
|
|
(setf y (1+ msg-y)) ;; +1 spacer between messages
|
|
(when (>= y panel-top) (return)))))
|
|
(incf i)))))
|
|
#+END_SRC
|
|
|
|
** Input Line
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(defun view-input (fb w h)
|
|
(let* ((w (or (and (numberp w) (> w 0) w) 80))
|
|
(h (or (and (numberp h) (> h 0) h) 24))
|
|
(hpad 2)
|
|
(sidebar-w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
|
(chat-w (- w sidebar-w))
|
|
(inner-w (- chat-w (* 2 hpad)))
|
|
(prompt-w (- inner-w 2))
|
|
(input (st :text-input))
|
|
(n-lines (max 1 (length (cl-tty.box:word-wrap (cl-tty.input:text-input-value input) prompt-w))))
|
|
(panel-rows (max 4 (+ n-lines 2)))
|
|
(panel-top (input-panel-top chat-w h))
|
|
(bg-i (theme-color :bg-input))
|
|
(hint-fg (theme-color :hint)))
|
|
;; Fill input panel
|
|
(cl-tty.backend:draw-rect fb hpad panel-top inner-w panel-rows :bg bg-i)
|
|
;; Speaker lines for all input rows
|
|
(dotimes (r panel-rows)
|
|
(cl-tty.backend:draw-text fb hpad (+ panel-top r) "│" (theme-color :input-prompt) nil))
|
|
;; Render text-input widget (word-wrap + cursor)
|
|
(let ((ln (make-layout-node)))
|
|
(setf (layout-node-x ln) (+ hpad 2)
|
|
(layout-node-y ln) (1+ panel-top)
|
|
(layout-node-width ln) prompt-w)
|
|
(setf (cl-tty.input:text-input-layout-node input) ln)
|
|
(cl-tty.box:render input fb))
|
|
;; Hint bar at h-2
|
|
(let* ((focal (or (st :foveal-id) "-"))
|
|
(focal-str (format nil "F:~a" focal))
|
|
(mcp-str (format nil "MCP:~d" (or (st :mcp-count) 0)))
|
|
(left-str (format nil "~a ~a" focal-str mcp-str))
|
|
(msg-count (max 1 (length (st :messages))))
|
|
(ctx-est (* msg-count 60))
|
|
(ctx-limit 8192)
|
|
(ctx-pct (min 100 (floor (* 100 ctx-est) ctx-limit)))
|
|
(ctx-tok (if (< ctx-est 1000)
|
|
(format nil "~d" ctx-est)
|
|
(format nil "~dK" (floor ctx-est 1000))))
|
|
(ctx-str (format nil "~a (~d%%)" ctx-tok ctx-pct))
|
|
(hint-str "ctrl+p | /help")
|
|
(ctx-fg (cond ((< ctx-pct 50) (theme-color :tool-done))
|
|
((< ctx-pct 80) (theme-color :input-prompt))
|
|
(t (theme-color :error))))
|
|
(hint-x (- chat-w (length hint-str) 2))
|
|
(ctx-x (- hint-x 1 (length ctx-str))))
|
|
(cl-tty.backend:draw-text fb hpad (- h 2) left-str hint-fg (theme-color :bg))
|
|
(cl-tty.backend:draw-text fb ctx-x (- h 2) ctx-str ctx-fg (theme-color :bg))
|
|
(cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg)))))
|
|
#+end_src
|
|
|
|
** Sidebar
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(defun sidebar-lines ()
|
|
"Collect all sidebar lines as (text . color-key) pairs."
|
|
(let* ((msgs (st :messages))
|
|
(last-gt (loop for i from (1- (length msgs)) downto 0
|
|
for m = (aref msgs i)
|
|
when (getf m :gate-trace)
|
|
return (getf m :gate-trace)))
|
|
(blocked (loop for i below (length msgs)
|
|
for m = (aref msgs i)
|
|
sum (loop for g in (getf m :gate-trace)
|
|
count (eq (getf g :result) :blocked))))
|
|
(ver (or (st :daemon-version) ""))
|
|
(ver-label (if (> (length ver) 0) (format nil "passepartout ~a" ver) "passepartout"))
|
|
(dot (if (st :connected) "●" "○"))
|
|
(dot-color (if (st :connected) :dot-connected :dot-disconnected)))
|
|
(append
|
|
;; Gate Trace
|
|
'("GATE TRACE" . :accent)
|
|
(if last-gt
|
|
(mapcan (lambda (g)
|
|
(let* ((name (getf g :gate))
|
|
(result (getf g :result))
|
|
(reason (getf g :reason))
|
|
(glyph (case result (:passed "✓") (:blocked "✗") (:approval "→") (t "?")))
|
|
(color (case result
|
|
(:passed :tool-done)
|
|
(:blocked :error)
|
|
(:approval :input-prompt)
|
|
(t :dim))))
|
|
(if reason
|
|
(list (cons (format nil " ~a ~a" glyph name) color)
|
|
(cons (format nil " ~a" reason) :dim))
|
|
(list (cons (format nil " ~a ~a" glyph name) color)))))
|
|
last-gt)
|
|
'((cons " (none)" :dim)))
|
|
;; Rules
|
|
'("" nil)
|
|
'("RULES" . :accent)
|
|
(list (cons (format nil " ~d active" (or (st :rule-count) 0)) :agent-fg))
|
|
(list (cons (format nil " ~d blocked" blocked)
|
|
(if (> blocked 0) :error :dim)))
|
|
;; Cost
|
|
'("" nil)
|
|
'("COST" . :accent)
|
|
(list (cons (format nil " $~,2f" (or (st :session-cost) 0.0)) :status-fg))
|
|
;; Files
|
|
'("" nil)
|
|
'("FILES" . :accent)
|
|
'(" (not yet)" . :dim)
|
|
;; spacer
|
|
'("" nil)
|
|
;; Version footer — rendered at h-2, not in the loop
|
|
(list (cons (format nil "~a ~a" dot ver-label) dot-color)))))
|
|
|
|
(defun view-sidebar (fb w h)
|
|
(let* ((w (or (and (numberp w) (> w 0) w) 80))
|
|
(h (or (and (numberp h) (> h 0) h) 24))
|
|
(x (- w (or (st :sidebar-width) 42)))
|
|
(lines (sidebar-lines))
|
|
(content-lines (butlast lines))
|
|
(footer-line (car (last lines))))
|
|
(cl-tty.backend:draw-rect fb x 0 (- w x) (1- h) :bg (theme-color :bg-panel))
|
|
(loop for (text . color-key) in content-lines
|
|
for y from 0
|
|
when text
|
|
do (cl-tty.backend:draw-text fb (+ x 2) y text
|
|
(if color-key (theme-color color-key) (theme-color :dim))
|
|
(theme-color :bg-panel)))
|
|
;; Version footer at h-2
|
|
(when footer-line
|
|
(cl-tty.backend:draw-text fb (+ x 2) (- h 2) (car footer-line)
|
|
(theme-color (cdr footer-line))
|
|
(theme-color :bg-panel)))))
|
|
#+END_SRC
|
|
|
|
** Redraw (dirty-flag dispatch)
|
|
#+begin_src lisp
|
|
(defun redraw (fb w h)
|
|
(setq w (or (and (numberp w) (> w 0) w) 80)
|
|
h (or (and (numberp h) (> h 0) h) 24))
|
|
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
|
|
(handler-case
|
|
(progn
|
|
(cl-tty.backend:with-frame (fb)
|
|
(cl-tty.backend:draw-rect fb 0 0 w h :bg (theme-color :bg))
|
|
(view-status fb w h)
|
|
(view-chat fb w h)
|
|
(view-input fb w h)
|
|
(when (sidebar-visible-p w)
|
|
(view-sidebar fb w h)))
|
|
(setf (st :dirty) (list nil nil nil)))
|
|
(error (c)
|
|
(add-msg :system (format nil "* Render error: ~a *" c))))))
|
|
|
|
#+END_SRC
|
|
|
|
* v0.7.2 — Gate Trace
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(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 :tool-done)
|
|
(:blocked :error)
|
|
(:approval :accent)
|
|
(t :dim)))
|
|
(prefix (case result
|
|
(:passed " \u2713 ")
|
|
(:blocked " \u2717 ")
|
|
(:approval " \u2192 ")
|
|
(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)))
|
|
#+END_SRC
|
|
|
|
* Test Suite
|
|
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
|
(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-markdown-bold
|
|
"parse-inline detects **bold**."
|
|
(let ((nodes (cl-tty.markdown:parse-inline "hello **world**!")))
|
|
(is (= 3 (length nodes)))
|
|
(is (eq :bold (getf (second nodes) :type)))))
|
|
|
|
(test test-markdown-plain
|
|
"parse-inline returns text node for plain input."
|
|
(let ((nodes (cl-tty.markdown:parse-inline "plain")))
|
|
(is (= 1 (length nodes)))
|
|
(is (eq :text (getf (first nodes) :type)))))
|
|
|
|
(test test-markdown-url
|
|
"parse-inline returns text nodes including URLs (no built-in auto-link)."
|
|
(let ((nodes (cl-tty.markdown:parse-inline "see https://example.com for more")))
|
|
(is (>= (length nodes) 1))))
|
|
|
|
(test test-markdown-blocks
|
|
"parse-blocks detects code blocks."
|
|
(let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
|
|
(nodes (cl-tty.markdown:parse-blocks text)))
|
|
(is (= 3 (length nodes)))
|
|
(is (eq :code-block (getf (second nodes) :type)))
|
|
(is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline)
|
|
(getf (second nodes) :content))))))
|
|
|
|
(test test-markdown-blocks-no-close
|
|
"parse-blocks returns code-block even when unclosed."
|
|
(let* ((text "```~%unclosed code")
|
|
(nodes (cl-tty.markdown:parse-blocks text)))
|
|
(is (eq :code-block (getf (first nodes) :type)))))
|
|
|
|
(test test-syntax-highlight
|
|
"highlight-code returns segment pairs for Lisp code."
|
|
(let ((result (cl-tty.markdown:highlight-code "(defun foo (x) (+ x 1))" "lisp")))
|
|
(is (listp result))
|
|
(is (> (length result) 0))))
|
|
|
|
(test test-syntax-highlight-keyword
|
|
"highlight-code classifies keywords."
|
|
(let ((result (cl-tty.markdown:highlight-code "(let ((x 1)) (+ x 2))" "lisp")))
|
|
(is (find :keyword result :key #'cdr))))
|
|
|
|
(test test-syntax-highlight-function
|
|
"highlight-code classifies function calls."
|
|
(let ((result (cl-tty.markdown:highlight-code "(+ 1 2)" "lisp")))
|
|
(is (listp result))
|
|
(is (> (length result) 0))))
|
|
|
|
(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 :tool-done (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))))
|
|
|
|
(test test-sidebar-state
|
|
"Contract v0.8.0: init-state includes :sidebar-mode (:auto) and :sidebar-width (42)."
|
|
(passepartout.channel-tui::init-state)
|
|
(is (eq :auto (passepartout.channel-tui::st :sidebar-mode)))
|
|
(is (= 42 (passepartout.channel-tui::st :sidebar-width))))
|
|
|
|
(defun sidebar-visible-p (w)
|
|
"Compute whether sidebar should be shown given terminal width W
|
|
and current sidebar mode."
|
|
(let ((mode (passepartout.channel-tui::st :sidebar-mode)))
|
|
(or (eq mode :visible)
|
|
(and (eq mode :auto) (> w 120)))))
|
|
|
|
(test test-sidebar-auto-wide
|
|
"Contract v0.8.0: sidebar auto-shows when terminal > 120 cols."
|
|
(passepartout.channel-tui::init-state)
|
|
(setf (passepartout.channel-tui::st :sidebar-mode) :auto)
|
|
(is (sidebar-visible-p 140))
|
|
(is (not (sidebar-visible-p 100))))
|
|
|
|
(test test-sidebar-visible-mode
|
|
"Contract v0.8.0: :visible mode shows sidebar regardless of width."
|
|
(passepartout.channel-tui::init-state)
|
|
(setf (passepartout.channel-tui::st :sidebar-mode) :visible)
|
|
(is (sidebar-visible-p 40))
|
|
(is (sidebar-visible-p 140)))
|
|
|
|
(test test-sidebar-hidden-mode
|
|
"Contract v0.8.0: :hidden mode hides sidebar regardless of width."
|
|
(passepartout.channel-tui::init-state)
|
|
(setf (passepartout.channel-tui::st :sidebar-mode) :hidden)
|
|
(is (not (sidebar-visible-p 140)))
|
|
(is (not (sidebar-visible-p 40))))
|
|
|
|
(test test-status-bar-tokens
|
|
"v0.9.0: status bar uses :status-fg and :status-bg theme tokens."
|
|
(is (stringp (passepartout.channel-tui:theme-color :status-fg)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :status-bg))))
|
|
|
|
(test test-new-theme-keys
|
|
"v0.10.0: theme has all zone keys."
|
|
(is (stringp (passepartout.channel-tui:theme-color :bg)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :bg-panel)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :bg-element)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :bg-input)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :agent-border)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :thinking-bg)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :symbolic-border)))
|
|
(is (stringp (passepartout.channel-tui:theme-color :text-muted))))
|
|
#+END_SRC
|