Amr Gharbeia
4e87cf6a03
Gate trace lines rendered below each agent message in dim color. Collapsed-gates state field for Tab toggle (default: visible). Uses passepartout::gate-trace-lines for colored entries. - channel-tui-view: view-chat renders gate-trace after message content - channel-tui-state: :collapsed-gates field in init-state - View tests: 29/29 (1 new state-field test)
19 KiB
19 KiB
Passepartout TUI — View
View
Pure render functions. Each takes a Croatoan window and current state.
State is read via (st :key) — no mutation here.
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.
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))Chat Area
(defun word-wrap (text width)
"Break text into lines at word boundaries, each <= width chars.
Returns list of trimmed strings. Single words wider than width are split."
(let ((lines '())
(pos 0)
(len (length text)))
(loop while (< pos len)
do (let ((end (min len (+ pos width))))
(cond
((>= end len)
(push (string-trim '(#\Space) (subseq text pos len)) lines)
(setf pos len))
((char= (char text (1- end)) #\Space)
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))
(t
(let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
(if (and last-space (> last-space pos))
(progn
(push (string-trim '(#\Space) (subseq text pos last-space)) lines)
(setf pos (1+ last-space)))
(progn
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))))))))
(nreverse lines)))
(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))
(y 1))
;; 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 " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting message
(let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2))))
(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))))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 " \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)))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))))