Amr Gharbeia
2f1abee930
The position-cursor function now uses cursor-line/cursor-col stored by view-input instead of recomputing from scratch, guaranteeing alignment with the rendered text. The boundary check uses (< pos (+ accum len)) to avoid falsely matching the first character of the next wrapped line. Removed the speculative reset-recovery code that sent cursor to end when pos was 0, since that broke legitimate navigation to the beginning of the input.
494 lines
23 KiB
Org Mode
494 lines
23 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, Emacs-style reverse-video cursor,
|
|
right-aligned lowercase hint at h-2.
|
|
4. (redraw fb w h): wraps view-status/chat/input in begin-sync/end-sync,
|
|
dispatches per dirty flags, fills global :bg first.
|
|
5. (char-width ch): returns 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).
|
|
6. (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 buffer."
|
|
(let* ((hpad 2)
|
|
(inner-w (- chat-w (* 2 hpad)))
|
|
(prompt-w (- inner-w 2))
|
|
(text (input-string))
|
|
(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)))
|
|
|
|
|
|
;; 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 (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))
|
|
(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)))
|
|
(let ((msg-lines (make-array total)) (msg-heights (make-array total)))
|
|
(dotimes (i total)
|
|
(let* ((msg (aref msgs i)) (role (getf msg :role))
|
|
(content (getf msg :content))
|
|
(cs (if is-search (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 i (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 i (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)))))))
|
|
(setf (aref msg-lines i) (nreverse pairs))
|
|
(setf (aref msg-heights i) (length pairs))))
|
|
(let ((msg-count 0) (lines-remaining max-lines))
|
|
(loop for i from (1- total) downto 0
|
|
while (> lines-remaining 0)
|
|
do (let ((mh (aref msg-heights i))
|
|
(spacer (if (< i (1- total)) 1 0)))
|
|
(if (<= (+ mh spacer) lines-remaining)
|
|
(progn (decf lines-remaining (+ mh spacer)) (incf msg-count))
|
|
(setf lines-remaining 0))))
|
|
(let* ((scroll-skip (st :scroll-offset))
|
|
(start (max 0 (- total msg-count scroll-skip))))
|
|
(loop for i from start below total while (< y panel-top)
|
|
do (let ((pairs (aref msg-lines i)))
|
|
(dolist (pair pairs)
|
|
(when (>= y panel-top) (return))
|
|
(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 nil))
|
|
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor nil)))
|
|
(incf y))
|
|
;; spacer between message blocks
|
|
(when (< i (1- total))
|
|
(incf y)))))))))
|
|
#+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))
|
|
(text (input-string))
|
|
(pos (or (st :cursor-pos) 0))
|
|
(lines (cl-tty.box:word-wrap text prompt-w))
|
|
(n-lines (max 1 (length lines)))
|
|
(panel-rows (max 4 (+ n-lines 2)))
|
|
(panel-top (input-panel-top chat-w h))
|
|
(bg-i (theme-color :bg-input))
|
|
(input-fg (theme-color :input-fg))
|
|
(hint-fg (theme-color :hint)))
|
|
;; Fill input panel: panel-top to h-4, indented by hpad
|
|
(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))
|
|
;; Draw each wrapped input line, tracking display position of cursor
|
|
(let ((accum 0) (cl 0) (cc 0))
|
|
(dotimes (i n-lines)
|
|
(let* ((line (nth i lines))
|
|
(row (+ panel-top 1 i))
|
|
(len (length line)))
|
|
(when (>= row (- h 4)) (return))
|
|
(cl-tty.backend:draw-text fb (+ hpad 2) row line input-fg nil)
|
|
(when (and (>= pos accum) (or (< pos (+ accum len)) (= i (1- n-lines))))
|
|
(setf cl i cc (- pos accum)))
|
|
(incf accum len)))
|
|
(setf (st :cursor-line) cl (st :cursor-col) cc))
|
|
;; Hint bar at h-2: F:/MCP: on left, token gauge + keybindings on right
|
|
(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 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)))
|
|
(bg-panel (theme-color :bg-panel))
|
|
(y 0))
|
|
(cl-tty.backend:draw-rect fb x 0 (- w x) (1- h) :bg bg-panel)
|
|
(cl-tty.backend:draw-text fb x (1- h) (make-string (- w x) :initial-element #\Space) nil bg-panel)
|
|
;; Gate Trace — from latest agent message
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "GATE TRACE" (theme-color :accent) bg-panel)
|
|
(incf y)
|
|
(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))))
|
|
(if last-gt
|
|
(dolist (g last-gt)
|
|
(let* ((name (getf g :gate))
|
|
(result (getf g :result))
|
|
(reason (getf g :reason))
|
|
(glyph (case result (:passed "✓") (:blocked "✗") (:approval "→") (t "?")))
|
|
(color (case result
|
|
(:passed (theme-color :tool-done))
|
|
(:blocked (theme-color :error))
|
|
(:approval (theme-color :input-prompt))
|
|
(t (theme-color :dim)))))
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) (format nil " ~a ~a" glyph name) color bg-panel)
|
|
(when reason
|
|
(incf y)
|
|
(cl-tty.backend:draw-text fb (+ x 4) (incf y) reason (theme-color :dim) bg-panel))))
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) " (none)" (theme-color :dim) bg-panel))
|
|
(incf y 2))
|
|
;; Rules + Block Count
|
|
(let ((blocked (loop for i below (length (st :messages))
|
|
for m = (aref (st :messages) i)
|
|
sum (loop for g in (getf m :gate-trace)
|
|
count (eq (getf g :result) :blocked)))))
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "RULES" (theme-color :accent) bg-panel)
|
|
(incf y)
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
|
(format nil " ~d active" (or (st :rule-count) 0))
|
|
(theme-color :agent-fg) bg-panel)
|
|
(incf y)
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
|
(format nil " ~d blocked" blocked)
|
|
(if (> blocked 0) (theme-color :error) (theme-color :dim)) bg-panel)
|
|
(incf y 2))
|
|
;; Cost
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "COST" (theme-color :accent) bg-panel)
|
|
(incf y)
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y)
|
|
(format nil " $~,2f" (or (st :session-cost) 0.0))
|
|
(theme-color :status-fg) bg-panel)
|
|
(incf y 2)
|
|
;; Files (stub)
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) "FILES" (theme-color :accent) bg-panel)
|
|
(incf y)
|
|
(cl-tty.backend:draw-text fb (+ x 2) (incf y) " (not yet)" (theme-color :dim) bg-panel)
|
|
(incf y 2)
|
|
;; Version footer
|
|
(let* ((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) (theme-color :dot-connected) (theme-color :dot-disconnected))))
|
|
(cl-tty.backend:draw-text fb (+ x 2) (- h 2) dot dot-color bg-panel)
|
|
(cl-tty.backend:draw-text fb (+ x 4) (- h 2) ver-label (theme-color :text-muted) 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)))
|
|
(cl-tty.backend:begin-sync 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))
|
|
(cl-tty.backend:end-sync fb)
|
|
(position-cursor fb w h)
|
|
(setf (st :dirty) (list nil nil nil))))
|
|
|
|
(defun position-cursor (fb w h)
|
|
"Draw cursor at the input insertion point using reverse video (Emacs-style).
|
|
Uses cursor-line/cursor-col stored by view-input to stay aligned with rendering."
|
|
(let* ((text (input-string))
|
|
(text-len (length text))
|
|
(pos (or (st :cursor-pos) 0))
|
|
(cl (or (st :cursor-line) 0))
|
|
(cc (or (st :cursor-col) 0))
|
|
(hpad 2)
|
|
(sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
|
|
(cw (- w sw))
|
|
(inner-w (- cw (* 2 hpad)))
|
|
(prompt-w (- inner-w 2))
|
|
(lines (cl-tty.box:word-wrap text prompt-w))
|
|
(n-lines (max 1 (length lines)))
|
|
(panel-rows (max 4 (+ n-lines 2)))
|
|
(panel-top (- h 4 panel-rows -1))
|
|
(bg-i (theme-color :bg-input))
|
|
(input-fg (theme-color :input-fg)))
|
|
(let ((cx (+ hpad 2 cc))
|
|
(cy (+ panel-top 1 cl)))
|
|
(if (< pos text-len)
|
|
(let ((ch (char text pos)))
|
|
(cl-tty.backend:draw-text fb cx cy (string ch) bg-i input-fg))
|
|
(cl-tty.backend:draw-text fb cx cy " " bg-i input-fg))
|
|
(finish-output (cl-tty.backend::backend-output-stream fb)))))
|
|
#+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-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 (getf passepartout.channel-tui::*tui-theme* :status-fg))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))
|
|
|
|
(test test-new-theme-keys
|
|
"v0.10.0: theme has all zone keys."
|
|
(is (getf passepartout.channel-tui::*tui-theme* :bg))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :bg-panel))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :bg-element))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :bg-input))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :agent-border))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :thinking-bg))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :symbolic-border))
|
|
(is (getf passepartout.channel-tui::*tui-theme* :text-muted)))
|
|
#+END_SRC
|