amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

bump passepartout: v0.8.0 TUI upgrade — all 6 items

Browse Source 
Minibuffer (dialog stack), conversation view (ScrollBox+Markdown),
command palette (Ctrl+P), sidebar (6 panels, Ctrl+B), status bar
(degraded-mode signaling), keybinding layer (defkeymap).
This commit is contained in:
Amr Gharbeia
2026-05-13 17:57:54 -04:00
parent 60ce9c894c
commit b5a07a5dcb
8 changed files with 800 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files

231
org/channel-tui-view.org
View File

@@ -60,20 +60,19 @@ Returns a list of strings, one per line."
(defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(bg (if degraded (theme-color :degraded) nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1
(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" "")))
(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" "")))
(theme-color (if (st :connected) :connected :disconnected)) bg)
;; Line 2: Focus + Timestamp
(let ((focus-info (or (st :foveal-id) "")))
@@ -85,14 +84,18 @@ Returns a list of strings, one per line."
;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
(dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
(lsp-color (if (st :connected) :green :dim))
(mcp-count (or (st :mcp-count) 0))
(hint " Ctrl+P: commands /help: help"))
(cl-tty.backend:draw-text fb 1 3 (format nil " ~a" dir) (theme-color :dim) bg)
(cl-tty.backend:draw-text fb (+ 2 (length dir)) 3 "●" (theme-color lsp-color) bg)
(cl-tty.backend:draw-text fb (+ 2 (length dir)) 3 "●" (theme-color :accent) bg)
(cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
(theme-color :dim) bg)
(cl-tty.backend:draw-text fb (- w (length hint) 2) 3 hint (theme-color :timestamp) bg))))
(cl-tty.backend:draw-text fb (- w (length hint) 2) 3 hint (theme-color :timestamp) bg))
;; Line 4: Degraded mode warning (v0.8.0)
(when degraded
(cl-tty.backend:draw-text fb 1 4 " ⚠ Degraded mode — components unavailable"
(theme-color :warning) (theme-color :degraded)))))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -117,7 +120,7 @@ Returns a list of strings, one per line."
(max-lines (- h 2))
(is-search (st :search-mode))
(y 1))
;; v0.7.2: search mode header
;; v0.8.0: search mode header
(when is-search
(let* ((matches (st :search-matches))
(idx (st :search-match-idx))
@@ -127,60 +130,74 @@ Returns a list of strings, one per line."
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; 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 " ")))
(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)))
(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 " ")))
(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))
(cl-tty.backend:draw-text fb 1 y line color nil)
(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))
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
;; Pre-compute display lines for each message
(let ((msg-lines (make-array total)))
(dotimes (i total)
(let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(content-show (if is-search (search-highlight content (st :search-query)) content))
(lines (case role
(:user (cl-tty.box:word-wrap
(format nil "│ [~a] ~a" time content-show) (- w 2)))
(:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
(md-lines (and nodes (cl-tty.markdown:render-md nodes))))
(if md-lines
(progn (setf (first md-lines)
(format nil "[~a] ~a" time (first md-lines)))
md-lines)
(list (format nil "[~a] " time)))))
(t (cl-tty.box:word-wrap
(format nil " [~a] ~a" time content-show) (- w 2))))))
;; v0.8.0: tool calls — collapsible
(let ((tc (getf msg :tool-calls)))
(when tc
(if (st :expand-tool-calls)
(dolist (call tc)
(setf lines (append lines
(list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
(setf lines (append lines
(list (format nil " ╎ ~a tool call(s)" (length tc))))))))
;; v0.8.0: gate trace — collapsible with left border
(let ((gt (getf msg :gate-trace)))
(when gt
(if (member i (st :collapsed-gates))
(setf lines (append lines
(list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
(length gt)))))
(dolist (entry (passepartout::gate-trace-lines gt))
(setf lines (append lines
(list (concatenate 'string "╎ " (car entry)))))))))
(setf (aref msg-lines i) lines)))
;; 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 ((nlines (length (aref msg-lines i))))
(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))
(lines (aref msg-lines i))
(color (theme-color
(case role
(:user :user) (:agent :agent) (:system :system) (t :agent))))
(is-panel (getf msg :panel))
(is-resolved (getf msg :panel-resolved)))
;; HITL panel coloring
(when is-panel
(setf color (if is-resolved (theme-color :dim) (theme-color :hitl))))
(dolist (line lines)
(when (< y (1- h))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y))))))))))
#+END_SRC
** Input Line
@@ -193,14 +210,61 @@ Returns a list of strings, one per line."
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
#+end_src
** Sidebar
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-sidebar (fb w h)
(let ((x (- w (st :sidebar-width))))
;; Vertical separator
(dotimes (row h)
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg :dim))
;; Render panels
(let ((y 1))
;; Focus panel
(when (st :foveal-id)
(cl-tty.backend:draw-text fb (1+ x) y " Focus" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~a" (st :foveal-id)) (theme-color :agent) nil)
(incf y 2))
;; Rules panel
(let ((rules (or (st :rule-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " Rules" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d active" rules) (theme-color :agent) nil)
(incf y 2))
;; Context panel — token gauge
(cl-tty.backend:draw-text fb (1+ x) y " Context" (theme-color :highlight) nil)
(incf y)
(let* ((msg-count (length (st :messages)))
(est (* msg-count 60))
(limit 8192)
(pct (min 100 (floor (* 100 est) limit)))
(bar-len (floor pct 10))
(bar (make-string bar-len :initial-element #\#)))
(cl-tty.backend:draw-text fb (1+ x) y (format nil " [~a~a]" bar (make-string (- 10 bar-len) :initial-element #\Space)) (theme-color :dim) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d%" pct) (theme-color :timestamp) nil)
(incf y 2))
;; MCP count
(let ((mcp (or (st :mcp-count) 0)))
(cl-tty.backend:draw-text fb (1+ x) y " MCP" (theme-color :highlight) nil)
(incf y)
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d server~:p" mcp) (theme-color :agent) nil)))))
#+END_SRC
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(chat-h (- h (if degraded 6 5))))
(when sd (view-status fb w))
(when cd (view-chat fb w chat-h))
(when id (view-input fb w))
(when (and (st :sidebar-visible) (>= w 120))
(view-sidebar fb w h))
(setf (st :dirty) (list nil nil nil)))))
#+END_SRC
* Implementation — v0.7.0 additions
@@ -491,4 +555,25 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(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-visible (nil) and :sidebar-width (30)."
(passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :sidebar-visible)))
(is (= 30 (passepartout.channel-tui::st :sidebar-width))))
(test test-sidebar-not-shown-narrow
"Contract v0.8.0: sidebar is skipped in redraw when terminal width < 120."
(passepartout.channel-tui::init-state)
(setf (passepartout.channel-tui::st :sidebar-visible) t)
;; Simulating redraw logic: should not invoke view-sidebar when w < 120.
;; If view-sidebar were called with a nil fb it would error; this verifies
;; the guard in redraw protects the call.
(let ((fb nil) (w 100) (h 24))
(is (not (and (passepartout.channel-tui::st :sidebar-visible) (>= w 120))))))
(test test-status-bar-tokens
"v0.8.0: status bar uses :degraded and :warning theme tokens."
(is (getf passepartout.channel-tui::*tui-theme* :degraded))
(is (getf passepartout.channel-tui::*tui-theme* :warning)))
#+END_SRC