Phase 4 — sidebar, input, chat cleanup
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.
This commit is contained in:
@@ -13,14 +13,21 @@
|
||||
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,
|
||||
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.
|
||||
5. ~cl-tty.box:char-width~ for terminal column width.
|
||||
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.
|
||||
6. (sidebar-visible-p w): returns T if sidebar should show given width W
|
||||
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
|
||||
@@ -73,28 +80,9 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
|
||||
(in-package :passepartout.channel-tui)
|
||||
|
||||
(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))
|
||||
(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)
|
||||
@@ -125,7 +113,7 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
;; Gate trace
|
||||
(let ((gt (getf msg :gate-trace)))
|
||||
(when (and gt (eq role :agent))
|
||||
(if (member i (st :collapsed-gates))
|
||||
(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))))
|
||||
@@ -134,7 +122,7 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
;; Tool calls
|
||||
(let ((tc (getf msg :tool-calls)))
|
||||
(when tc
|
||||
(if (member i (st :collapsed-tools))
|
||||
(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))
|
||||
@@ -152,33 +140,59 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
(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))
|
||||
(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))))
|
||||
(incf y))
|
||||
;; spacer between message blocks
|
||||
(when (< i (1- total))
|
||||
(incf y)))))))))
|
||||
(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
|
||||
@@ -192,36 +206,23 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
(inner-w (- chat-w (* 2 hpad)))
|
||||
(prompt-w (- inner-w 2))
|
||||
(input (st :text-input))
|
||||
(text (cl-tty.input:text-input-value input))
|
||||
(pos (cl-tty.input:text-input-cursor input))
|
||||
(lines (cl-tty.box:word-wrap text prompt-w))
|
||||
(n-lines (max 1 (length lines)))
|
||||
(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))
|
||||
(input-fg (theme-color :input-fg))
|
||||
(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))
|
||||
;; Draw each wrapped input line
|
||||
(let ((accum 0) (cursor-line 0) (cursor-col 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 cursor-line i
|
||||
cursor-col (- pos accum)))
|
||||
(incf accum (1+ len))))
|
||||
;; Draw block cursor at insertion point
|
||||
(let* ((cx (+ hpad 2 cursor-col))
|
||||
(cy (+ panel-top 1 cursor-line)))
|
||||
(cl-tty.backend:draw-text fb cx cy "█" :bright-white 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))
|
||||
@@ -248,73 +249,79 @@ and current sidebar mode (:auto/:visible/:hidden)."
|
||||
|
||||
** 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)
|
||||
(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))))
|
||||
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
|
||||
(dolist (g 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 (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))
|
||||
(: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
|
||||
(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))))
|
||||
'("" 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)
|
||||
|
||||
Reference in New Issue
Block a user