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

38
docs/ROADMAP.org
View File

@@ -34,32 +34,29 @@ On release:
2. Extract DONE items from ROADMAP (all items with LOGBOOK timestamps since the last release tag) and use as the release notes body 2. Extract DONE items from ROADMAP (all items with LOGBOOK timestamps since the last release tag) and use as the release notes body
3. If a ~CHANGELOG.md~ is needed for packaging tools, auto-generate it from ROADMAP DONE items 3. If a ~CHANGELOG.md~ is needed for packaging tools, auto-generate it from ROADMAP DONE items
** TODO v0.8.0: Information Radiator (Foundation) ** DONE v0.8.0: Information Radiator (Foundation)
Sidebar (6 panels), sidebar overlay mode (<120 cols), command palette (Ctrl+P), TrueColor theme (8 presets), unified minibuffer panel with slash-command context menu and sub-mode navigation (wizard, settings, help) — all built on ~cl-tty~ v1.1.0. Sidebar (6 panels), sidebar overlay mode (<120 cols), command palette (Ctrl+P), TrueColor theme (8 presets), unified minibuffer panel with slash-command context menu and sub-mode navigation (wizard, settings, help) — all built on ~cl-tty~ v1.1.0.
The croatoan TUI is replaced entirely. cl-tty provides the widget set (box, text, scrollbox, select, markdown, dialog), keybinding system, and theme engine. Passepartout's job is wiring — cl-tty components call the daemon's TCP API and render its response structures. The croatoan TUI is replaced entirely. cl-tty provides the widget set (box, text, scrollbox, select, markdown, dialog), keybinding system, and theme engine. Passepartout's job is wiring — cl-tty components call the daemon's TCP API and render its response structures.
*** TODO Minibuffer — cl-tty dialog stack *** DONE Minibuffer — cl-tty dialog stack
:PROPERTIES: :PROPERTIES:
:ID: id-v080-minibuffer :ID: id-v080-minibuffer
:CREATED: [2026-05-10 Sat] :CREATED: [2026-05-10 Sat]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-opens a ~select-dialog~ with ~25 slash commands (filtered in real time). Selecting =/wizard= transitions to a ~prompt-dialog~ in the same panel — cl-tty's ~*dialog-stack*~ handles push/pop, Esc dismisses. Future sub-modes (=/settings=, =/help=) slot in as additional dialog types. *** DONE Conversation view — cl-tty ScrollBox + Markdown
- Define ~*slash-commands*~ — the same data structure, now driving cl-tty's ~Select~ options
- Wire ~select-dialog~ on-Enter to push the next dialog type (wizard, settings, help)
- Implement ~wizard-dialog~ subclass — validates UUID, writes ~/.passepartout/config.lisp~
- Daisy-chain dialog state: wizard enters UUID → settings panel controls hotkeys/theme → help panel shows slash command reference
~80 lines (down from ~150 — cl-tty's Select+Dialog replaces custom modal dispatch).
*** TODO Conversation view — cl-tty ScrollBox + Markdown
:PROPERTIES: :PROPERTIES:
:ID: id-v080-conversation :ID: id-v080-conversation
:CREATED: [2026-05-13 Wed] :CREATED: [2026-05-13 Wed]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
- ~ScrollBox~ with ~sticky-scroll~ (auto-follows new content, respects manual scroll-up) - ~ScrollBox~ with ~sticky-scroll~ (auto-follows new content, respects manual scroll-up)
- User messages rendered as ~Box~ (role-colored left border) - User messages rendered as ~Box~ (role-colored left border)
@@ -69,11 +66,14 @@ Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-ope
~150 lines. ~150 lines.
*** TODO Command palette — cl-tty Select *** DONE Command palette — cl-tty Select
:PROPERTIES: :PROPERTIES:
:ID: id-v080-palette :ID: id-v080-palette
:CREATED: [2026-05-13 Wed] :CREATED: [2026-05-13 Wed]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
- Ctrl+P opens a ~select-dialog~ with all daemon commands - Ctrl+P opens a ~select-dialog~ with all daemon commands
- Fuzzy-filtered with categories (session, memory, system, help) - Fuzzy-filtered with categories (session, memory, system, help)
@@ -81,11 +81,14 @@ Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-ope
~40 lines. ~40 lines.
*** TODO Sidebar — cl-tty slot system *** DONE Sidebar — cl-tty slot system
:PROPERTIES: :PROPERTIES:
:ID: id-v080-sidebar :ID: id-v080-sidebar
:CREATED: [2026-05-13 Wed] :CREATED: [2026-05-13 Wed]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
- 6 panels as cl-tty ~slot~ registrations (gate trace, focus, rules, context, cost, files) - 6 panels as cl-tty ~slot~ registrations (gate trace, focus, rules, context, cost, files)
- Toggle with Ctrl+B or auto-hide on narrow terminals (<120 cols) - Toggle with Ctrl+B or auto-hide on narrow terminals (<120 cols)
@@ -93,11 +96,14 @@ Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-ope
~80 lines. ~80 lines.
*** TODO Status bar — cl-tty Box + Theme *** DONE Status bar — cl-tty Box + Theme
:PROPERTIES: :PROPERTIES:
:ID: id-v080-statusbar :ID: id-v080-statusbar
:CREATED: [2026-05-13 Wed] :CREATED: [2026-05-13 Wed]
:END: :END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-13 Wed]
:END:
- Bottom-most line: directory, LSP status (green dot), MCP count, ~/status~ hint - Bottom-most line: directory, LSP status (green dot), MCP count, ~/status~ hint
- Degraded-mode signaling (amber when ~*degraded-components*~ non-nil) - Degraded-mode signaling (amber when ~*degraded-components*~ non-nil)
@@ -105,7 +111,7 @@ Replace ad-hoc overlay windows with cl-tty's ~Dialog~ stack. Typing =/= auto-ope
~30 lines. ~30 lines.
*** TODO Keybinding layer — cl-tty keymap *** DONE Keybinding layer — cl-tty keymap
:PROPERTIES: :PROPERTIES:
:ID: id-v080-keybindings :ID: id-v080-keybindings
:CREATED: [2026-05-13 Wed] :CREATED: [2026-05-13 Wed]

190
lisp/channel-tui-main.lisp
View File

@@ -570,9 +570,45 @@
(keyword (let ((s (string ch))) (keyword (let ((s (string ch)))
(and (= (length s) 1) (char-downcase (char s 0))))) (and (= (length s) 1) (char-downcase (char s 0)))))
(t nil)))) (t nil))))
(when (and chr (graphic-char-p chr)) (when (and chr (graphic-char-p chr))
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))) (setf (st :dirty) (list nil nil t))
(when (and (char= chr #\/) (null (st :dialog-stack))
(= (length (st :input-buffer)) 1))
(minibuffer-show-commands)))))))
;; v0.8.0 — minibuffer dialog for slash commands
(defun minibuffer-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :minibuffer-active) nil)
(setf (st :input-buffer) (reverse (coerce cmd 'list)))
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list nil nil t)))))
(sel (cl-tty.select:make-select :options *slash-commands* :on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Commands"
:content sel)))
(push dlg (st :dialog-stack))
(setf (st :minibuffer-active) t)))
;; v0.8.0 — command palette for daemon commands (Ctrl+P)
(defun command-palette-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(add-msg :system (format nil "Dispatching: ~s" cmd))
(send-daemon (list :type :event :payload cmd))
(setf (st :busy) t)
(setf (st :dirty) (list t t nil)))))
(sel (cl-tty.select:make-select :options *daemon-commands* :on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Command Palette"
:content sel)))
(push dlg (st :dialog-stack))
(setf (st :command-palette-active) t)))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
@@ -601,12 +637,10 @@
(cond (cond
;; New headline ;; New headline
((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*)) ((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*))
;; Flush previous section if in one
(when (and in-section section-content) (when (and in-section section-content)
(push (cons in-section (string-trim '(#\Space #\Newline) (push (cons in-section (string-trim '(#\Space #\Newline)
(format nil "~{~a~^ ~}" (reverse section-content)))) (format nil "~{~a~^ ~}" (reverse section-content))))
results)) results))
;; Check if this headline matches topic
(let ((title (string-trim '(#\Space #\*) trimmed))) (let ((title (string-trim '(#\Space #\*) trimmed)))
(if (search topic title :test #'char-equal) (if (search topic title :test #'char-equal)
(setf in-section title (setf in-section title
@@ -618,7 +652,6 @@
(when (and (> (length trimmed) 0) (when (and (> (length trimmed) 0)
(not (eql (char trimmed 0) #\#))) (not (eql (char trimmed 0) #\#)))
(push trimmed section-content)))))) (push trimmed section-content))))))
;; Flush last section
(when (and in-section section-content) (when (and in-section section-content)
(push (cons in-section (string-trim '(#\Space #\Newline) (push (cons in-section (string-trim '(#\Space #\Newline)
(format nil "~{~a~^ ~}" (reverse section-content)))) (format nil "~{~a~^ ~}" (reverse section-content))))
@@ -770,6 +803,32 @@
(setf (st :stream) nil (st :connected) nil) (setf (st :stream) nil (st :connected) nil)
(add-msg :system "* Disconnected *"))) (add-msg :system "* Disconnected *")))
;; v0.8.0 — Global keymap
(eval-when (:load-toplevel :execute)
(cl-tty.input:defkeymap :global
(:ctrl+q (lambda (e) (declare (ignore e))
(setf (st :running) nil)))
(:ctrl+p (lambda (e) (declare (ignore e))
(command-palette-show-commands)))
(:ctrl+b (lambda (e) (declare (ignore e))
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
(setf (st :dirty) (list t t nil))))
(:ppage (lambda (e) (declare (ignore e))
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil))))
(:npage (lambda (e) (declare (ignore e))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))))))
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
(cl-tty.input:defkeymap :local
(:enter (lambda (e) (declare (ignore e)) (on-key :enter)))
(:up (lambda (e) (declare (ignore e)) (on-key :up)))
(:down (lambda (e) (declare (ignore e)) (on-key :down)))
(:escape (lambda (e) (declare (ignore e)) (on-key :escape)))))
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history) (load-history)
@@ -819,35 +878,74 @@
(cl-tty.input:key-event (cl-tty.input:key-event
(cl-tty.input:key-event-key data)) (cl-tty.input:key-event-key data))
(t data)))) (t data))))
(cond (cond
((eql ch :escape) ((st :dialog-stack)
(when (st :streaming-text) (let* ((dlg (car (st :dialog-stack)))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (sel (cl-tty.dialog:dialog-content dlg)))
(when (> (length (st :messages)) 0) (cond
(let ((idx (1- (length (st :messages))))) ((eql ch :escape)
(setf (getf (aref (st :messages) idx) :content) (pop (st :dialog-stack))
(concatenate 'string (setf (st :minibuffer-active) nil)
(getf (aref (st :messages) idx) :content) (setf (st :command-palette-active) nil)
" [interrupted]")) (setf (st :dirty) (list t t nil)))
(setf (getf (aref (st :messages) idx) :streaming) nil) ((member ch '(:up :down))
(setf (getf (aref (st :messages) idx) :time) (now)))) (if (eql ch :up) (cl-tty.select:select-prev sel)
(setf (st :streaming-text) nil) (cl-tty.select:select-next sel)))
(setf (st :busy) nil) ((member ch '(:enter 13 10 #\Newline #\Return))
(setf (st :dirty) (list t t nil))) (let* ((filtered (cl-tty.select:select-filtered-options sel))
(when (st :search-mode) (idx (cl-tty.select:select-selected-index sel))
(setf (st :search-mode) nil (item (when (< idx (length filtered))
(st :search-matches) nil (third (nth idx filtered)))))
(st :search-query) "") (when item
(setf (st :dirty) (list nil t nil)) (let ((cb (cl-tty.select:select-on-select sel)))
(add-msg :system "Search exited"))) (when cb (funcall cb item))))))
(t (on-key ch))))))) ((and (characterp ch) (graphic-char-p ch))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (setf (cl-tty.select:select-filter sel)
(cl-tty.backend:backend-clear be) (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
(redraw curr-fb w h) ((member ch '(:backspace 127 8))
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (let ((f (cl-tty.select:select-filter sel)))
(rotatef prev-fb curr-fb)) (when (> (length f) 0)
(sleep 0.1)))) (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))))
(disconnect-daemon)))) ((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my (floor (- h dh) 2)))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg :bright-black))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :highlight))
(t (theme-color :agent)))
nil :bold sel-p)
(incf y-off)))))))
(sleep 0.1))))
(disconnect-daemon))))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
@@ -1323,3 +1421,25 @@
(setf (st :scroll-offset) 3) (setf (st :scroll-offset) 3)
(on-key :npage) (on-key :npage)
(fiveam:is (= 0 (st :scroll-offset)))) (fiveam:is (= 0 (st :scroll-offset))))
;; ── v0.8.0 Minibuffer ──
(fiveam:test test-slash-commands-defined
"Contract v0.8.0: *slash-commands* is non-nil list of option plists."
(fiveam:is (listp passepartout.channel-tui::*slash-commands*))
(fiveam:is (> (length passepartout.channel-tui::*slash-commands*) 0))
(fiveam:is (every (lambda (opt)
(and (getf opt :title) (getf opt :value) (getf opt :category)))
passepartout.channel-tui::*slash-commands*)))
(fiveam:test test-minibuffer-state
"Contract v0.8.0: init-state has :dialog-stack and :minibuffer-active fields."
(init-state)
(fiveam:is (null (st :dialog-stack)))
(fiveam:is (null (st :minibuffer-active))))
(fiveam:test test-command-palette-state
"Contract v0.8.0: init-state has :command-palette-active and :command-palette-dialog as nil."
(init-state)
(fiveam:is (null (st :command-palette-active)))
(fiveam:is (null (st :command-palette-dialog))))

81
lisp/channel-tui-state.lisp
View File

@@ -29,8 +29,10 @@
;; Differentiator (v0.4.0) ;; Differentiator (v0.4.0)
:rule-count :cyan :focus-map :yellow :rule-count :cyan :focus-map :yellow
;; UI ;; UI
:dim :white :highlight :cyan :accent :green) :dim :white :highlight :cyan :accent :green
"Color theme plist. 27 semantic keys → hex color strings. ;; Degraded
:degraded :bright-yellow)
"Color theme plist. 28 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(defvar *tui-theme-presets* (defvar *tui-theme-presets*
@@ -41,7 +43,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
:scroll-indicator :cyan :border :white :background :black :scroll-indicator :cyan :border :white :background :black
:rule-count :cyan :focus-map :yellow :rule-count :cyan :focus-map :yellow
:dim :white :highlight :cyan :accent :green) :dim :white :highlight :cyan :accent :green
:degraded :bright-yellow)
:light (:user :blue :agent :black :system :red :light (:user :blue :agent :black :system :red
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow :input :black :timestamp :yellow :help :blue :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :black :connected :green :disconnected :red :busy :magenta :idle :black
@@ -49,7 +52,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
:scroll-indicator :blue :border :black :background :white :scroll-indicator :blue :border :black :background :white
:rule-count :blue :focus-map :red :rule-count :blue :focus-map :red
:dim :white :highlight :blue :accent :green) :dim :white :highlight :blue :accent :green
:degraded :bright-yellow)
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f" :gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f" :input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984" :connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
@@ -57,7 +61,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2" :tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
:scroll-indicator "#83a598" :border "#a89984" :background "#282828" :scroll-indicator "#83a598" :border "#a89984" :background "#282828"
:rule-count "#83a598" :focus-map "#fabd2f" :rule-count "#83a598" :focus-map "#fabd2f"
:dim "#928374" :highlight "#83a598" :accent "#b8bb26") :dim "#928374" :highlight "#83a598" :accent "#b8bb26"
:degraded "#fabd2f")
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900" :solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900" :input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83" :connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
@@ -65,7 +70,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496" :tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36" :scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
:rule-count "#2aa198" :focus-map "#b58900" :rule-count "#2aa198" :focus-map "#b58900"
:dim "#586e75" :highlight "#2aa198" :accent "#859900")) :dim "#586e75" :highlight "#2aa198" :accent "#859900"
:degraded "#b58900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.") "Named theme presets. /theme <name> loads one into *tui-theme*.")
(defvar *tui-theme-current-name* :dark (defvar *tui-theme-current-name* :dark
@@ -109,6 +115,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF") (:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF") (:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000") (:white "#FFFFFF") (:black "#000000")
(:bright-yellow "#FFD700")
(t "#FFFFFF")))))) (t "#FFFFFF"))))))
(defun st (key) (getf *state* key)) (defun st (key) (getf *state* key))
@@ -126,10 +133,24 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:collapsed-gates nil ; v0.7.2 :collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2 :search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0 :search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0 :sidebar-visible nil ; v0.8.0
:expand-tool-calls nil ; v0.8.0 :sidebar-width 30 ; v0.8.0
:mcp-count 0 ; v0.8.0 :expand-tool-calls nil ; v0.8.0
:dirty (list nil nil nil)))) :mcp-count 0 ; v0.8.0
:dialog-stack nil ; v0.8.0
:minibuffer-active nil ; v0.8.0
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:dirty (list nil nil nil))))
(defvar *sidebar-panels*
'((:id :gate-trace :title "Gate Trace" :width 28)
(:id :focus :title "Focus" :width 28)
(:id :rules :title "Rules" :width 28)
(:id :context :title "Context" :width 28)
(:id :cost :title "Cost" :width 28)
(:id :files :title "Files" :width 28))
"Sidebar panel definitions for cl-tty slot registrations.")
(defun now () (defun now ()
(multiple-value-bind (s m h) (get-decoded-time) (multiple-value-bind (s m h) (get-decoded-time)
@@ -165,6 +186,46 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(setf (st :scroll-notify) t)) (setf (st :scroll-notify) t))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
(defvar *slash-commands*
'((:title "/eval <expr> — Evaluate Lisp" :value "/eval" :category :session)
(:title "/undo — Undo last operation" :value "/undo" :category :session)
(:title "/redo — Redo last operation" :value "/redo" :category :session)
(:title "/reconnect — Re-establish daemon" :value "/reconnect" :category :session)
(:title "/quit — Save history and exit" :value "/quit" :category :session)
(:title "/q — Quick quit" :value "/q" :category :session)
(:title "/why — Show last gate trace" :value "/why" :category :memory)
(:title "/identity — Edit IDENTITY.org" :value "/identity" :category :memory)
(:title "/tags — List tag severities" :value "/tags" :category :memory)
(:title "/audit <id> — Inspect memory" :value "/audit" :category :memory)
(:title "/audit verify — Memory integrity" :value "/audit verify" :category :memory)
(:title "/rewind <n> — Rewind to snapshot" :value "/rewind" :category :memory)
(:title "/sessions — Show memory snapshots" :value "/sessions" :category :memory)
(:title "/resume <n> — Resume from snapshot" :value "/resume" :category :memory)
(:title "/focus <project> — Set context" :value "/focus" :category :system)
(:title "/scope <scope> — Change scope" :value "/scope" :category :system)
(:title "/unfocus — Pop context" :value "/unfocus" :category :system)
(:title "/theme [name] — Show/switch theme" :value "/theme" :category :system)
(:title "/context — Show context summary" :value "/context" :category :system)
(:title "/context why <id> — Debug memory" :value "/context why" :category :system)
(:title "/context dropped — Estimate pruned" :value "/context dropped" :category :system)
(:title "/search <query> — Search messages" :value "/search" :category :navigation)
(:title "/help — Show commands" :value "/help" :category :help)
(:title "/help <topic> — Search manual" :value "/help <topic>" :category :help))
"Slash commands for minibuffer select-dialog.")
(defvar *daemon-commands*
'((:title "Status — Daemon health info" :value (:action :status) :category :session)
(:title "Stats — Daemon statistics" :value (:action :stats) :category :session)
(:title "Ping — Daemon reachability" :value (:action :ping) :category :session)
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot) :category :memory)
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild) :category :memory)
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact) :category :memory)
(:title "Reload Config — Reload configuration" :value (:action :reload-config) :category :system)
(:title "Reload Identity — Reload identity file" :value (:action :reload-identity) :category :system)
(:title "List Skills — Available skills" :value (:action :list-skills) :category :system)
(:title "Help — Show daemon help" :value (:action :help) :category :help))
"Daemon commands for the command palette (Ctrl+P).")
(defun queue-event (ev) (defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*))) (bt:with-lock-held (*event-lock*) (push ev *event-queue*)))

228
lisp/channel-tui-view.lisp
View File

@@ -15,20 +15,19 @@ Returns a list of strings, one per line."
(defun view-status (fb w) (defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout) (let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) (boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) (symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
'(:degraded :unhealthy)))) (bg (if degraded (theme-color :degraded) nil)))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1 (cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected") (if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode))) (string-upcase (string (st :mode)))
(length (st :messages)) (length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0) (or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]" (if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" ""))) (if (st :busy) " …thinking" "")))
(theme-color (if (st :connected) :connected :disconnected)) bg) (theme-color (if (st :connected) :connected :disconnected)) bg)
;; Line 2: Focus + Timestamp ;; Line 2: Focus + Timestamp
(let ((focus-info (or (st :foveal-id) ""))) (let ((focus-info (or (st :foveal-id) "")))
@@ -40,14 +39,18 @@ Returns a list of strings, one per line."
;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0) ;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd))) (let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
(dir (subseq cwd (max 0 (- (length cwd) (- w 45))))) (dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
(lsp-color (if (st :connected) :green :dim))
(mcp-count (or (st :mcp-count) 0)) (mcp-count (or (st :mcp-count) 0))
(hint " Ctrl+P: commands /help: help")) (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 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) (cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
(theme-color :dim) bg) (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 ;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query) (defun search-highlight (content query)
@@ -72,7 +75,7 @@ Returns a list of strings, one per line."
(max-lines (- h 2)) (max-lines (- h 2))
(is-search (st :search-mode)) (is-search (st :search-mode))
(y 1)) (y 1))
;; v0.7.2: search mode header ;; v0.8.0: search mode header
(when is-search (when is-search
(let* ((matches (st :search-matches)) (let* ((matches (st :search-matches))
(idx (st :search-match-idx)) (idx (st :search-match-idx))
@@ -82,60 +85,74 @@ Returns a list of strings, one per line."
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil) (cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y) (incf y)
(decf max-lines))) (decf max-lines)))
;; Count visible messages from end, accounting for word wrap ;; Pre-compute display lines for each message
(let* ((msg-count 0) (let ((msg-lines (make-array total)))
(lines-remaining max-lines)) (dotimes (i total)
(loop for i from (1- total) downto 0 (let* ((msg (aref msgs i))
while (> lines-remaining 0) (role (getf msg :role))
do (let* ((msg (aref msgs i)) (content (getf msg :content))
(role (getf msg :role)) (time (or (getf msg :time) ""))
(content (getf msg :content)) (content-show (if is-search (search-highlight content (st :search-query)) content))
(time (or (getf msg :time) "")) (lines (case role
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (:user (cl-tty.box:word-wrap
(content-show (if is-search (format nil "│ [~a] ~a" time content-show) (- w 2)))
(search-highlight content (st :search-query)) (:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
content)) (md-lines (and nodes (cl-tty.markdown:render-md nodes))))
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (if md-lines
(wrapped (word-wrap line-text (- w 2))) (progn (setf (first md-lines)
(nlines (length wrapped))) (format nil "[~a] ~a" time (first md-lines)))
(if (<= nlines lines-remaining) md-lines)
(progn (decf lines-remaining nlines) (incf msg-count)) (list (format nil "[~a] " time)))))
(setf lines-remaining 0)))) (t (cl-tty.box:word-wrap
;; Render from the correct starting message (format nil " [~a] ~a" time content-show) (- w 2))))))
(let* ((scroll-skip (st :scroll-offset)) ;; v0.8.0: tool calls — collapsible
(start (max 0 (- total msg-count scroll-skip)))) (let ((tc (getf msg :tool-calls)))
(loop for i from start below total (when tc
while (< y (1- h)) (if (st :expand-tool-calls)
do (let* ((msg (aref msgs i)) (dolist (call tc)
(role (getf msg :role)) (setf lines (append lines
(content (getf msg :content)) (list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
(time (or (getf msg :time) "")) (setf lines (append lines
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (list (format nil " ╎ ~a tool call(s)" (length tc))))))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) ;; v0.8.0: gate trace — collapsible with left border
(is-panel (getf msg :panel)) (let ((gt (getf msg :gate-trace)))
(is-resolved (getf msg :panel-resolved)) (when gt
(content-show (if is-search (if (member i (st :collapsed-gates))
(search-highlight content (st :search-query)) (setf lines (append lines
content)) (list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (length gt)))))
(wrapped (word-wrap line-text (- w 2)))) (dolist (entry (passepartout::gate-trace-lines gt))
;; HITL panel: render with colored border (setf lines (append lines
(when is-panel (list (concatenate 'string "╎ " (car entry)))))))))
(setf color (if is-resolved (setf (aref msg-lines i) lines)))
(theme-color :dim) ;; Count visible messages from end
(theme-color :hitl)))) (let ((msg-count 0) (lines-remaining max-lines))
(dolist (line wrapped) (loop for i from (1- total) downto 0
(when (< y (1- h)) while (> lines-remaining 0)
(cl-tty.backend:draw-text fb 1 y line color nil) do (let ((nlines (length (aref msg-lines i))))
(incf y))) (if (<= nlines lines-remaining)
;; v0.7.2: gate trace below agent messages (progn (decf lines-remaining nlines) (incf msg-count))
(let ((gate-trace (getf msg :gate-trace))) (setf lines-remaining 0))))
(when (and gate-trace (not (member i (st :collapsed-gates)))) ;; Render from the correct starting message
(dolist (entry (passepartout::gate-trace-lines gate-trace)) (let* ((scroll-skip (st :scroll-offset))
(when (< y (1- h)) (start (max 0 (- total msg-count scroll-skip))))
(cl-tty.backend:draw-text fb 3 y (car entry) (loop for i from start below total
(or (getf (cdr entry) :fgcolor) :dim) nil) while (< y (1- h))
(incf y))))))))))) 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))))))))))
(defun view-input (fb w) (defun view-input (fb w)
(let* ((text (input-string)) (let* ((text (input-string))
@@ -144,12 +161,56 @@ Returns a list of strings, one per line."
(visible (subseq text display-start (min (length text) (+ display-start w))))) (visible (subseq text display-start (min (length text) (+ display-start w)))))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil))) (cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
(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)))))
(defun redraw (fb w h) (defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty) (destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status fb w)) (let* ((degraded (and (find-package :passepartout)
(when cd (view-chat fb w (- h 5))) (boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(when id (view-input fb w)) (symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(setf (st :dirty) (list nil nil nil)))) (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)))))
(in-package :passepartout) (in-package :passepartout)
@@ -428,3 +489,24 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(passepartout.channel-tui::init-state) (passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates))) (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg)))) (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)))

191
org/channel-tui-main.org
View File

@@ -604,9 +604,45 @@ Event handlers + daemon I/O + main loop.
(keyword (let ((s (string ch))) (keyword (let ((s (string ch)))
(and (= (length s) 1) (char-downcase (char s 0))))) (and (= (length s) 1) (char-downcase (char s 0)))))
(t nil)))) (t nil))))
(when (and chr (graphic-char-p chr)) (when (and chr (graphic-char-p chr))
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))) (setf (st :dirty) (list nil nil t))
(when (and (char= chr #\/) (null (st :dialog-stack))
(= (length (st :input-buffer)) 1))
(minibuffer-show-commands)))))))
;; v0.8.0 — minibuffer dialog for slash commands
(defun minibuffer-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :minibuffer-active) nil)
(setf (st :input-buffer) (reverse (coerce cmd 'list)))
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list nil nil t)))))
(sel (cl-tty.select:make-select :options *slash-commands* :on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Commands"
:content sel)))
(push dlg (st :dialog-stack))
(setf (st :minibuffer-active) t)))
;; v0.8.0 — command palette for daemon commands (Ctrl+P)
(defun command-palette-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(add-msg :system (format nil "Dispatching: ~s" cmd))
(send-daemon (list :type :event :payload cmd))
(setf (st :busy) t)
(setf (st :dirty) (list t t nil)))))
(sel (cl-tty.select:make-select :options *daemon-commands* :on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Command Palette"
:content sel)))
(push dlg (st :dialog-stack))
(setf (st :command-palette-active) t)))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
@@ -635,12 +671,10 @@ Event handlers + daemon I/O + main loop.
(cond (cond
;; New headline ;; New headline
((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*)) ((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*))
;; Flush previous section if in one
(when (and in-section section-content) (when (and in-section section-content)
(push (cons in-section (string-trim '(#\Space #\Newline) (push (cons in-section (string-trim '(#\Space #\Newline)
(format nil "~{~a~^ ~}" (reverse section-content)))) (format nil "~{~a~^ ~}" (reverse section-content))))
results)) results))
;; Check if this headline matches topic
(let ((title (string-trim '(#\Space #\*) trimmed))) (let ((title (string-trim '(#\Space #\*) trimmed)))
(if (search topic title :test #'char-equal) (if (search topic title :test #'char-equal)
(setf in-section title (setf in-section title
@@ -652,7 +686,6 @@ Event handlers + daemon I/O + main loop.
(when (and (> (length trimmed) 0) (when (and (> (length trimmed) 0)
(not (eql (char trimmed 0) #\#))) (not (eql (char trimmed 0) #\#)))
(push trimmed section-content)))))) (push trimmed section-content))))))
;; Flush last section
(when (and in-section section-content) (when (and in-section section-content)
(push (cons in-section (string-trim '(#\Space #\Newline) (push (cons in-section (string-trim '(#\Space #\Newline)
(format nil "~{~a~^ ~}" (reverse section-content)))) (format nil "~{~a~^ ~}" (reverse section-content))))
@@ -813,6 +846,33 @@ Event handlers + daemon I/O + main loop.
** Main Loop ** Main Loop
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp #+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
;; v0.8.0 — Global keymap
(eval-when (:load-toplevel :execute)
(cl-tty.input:defkeymap :global
(:ctrl+q (lambda (e) (declare (ignore e))
(setf (st :running) nil)))
(:ctrl+p (lambda (e) (declare (ignore e))
(command-palette-show-commands)))
(:ctrl+b (lambda (e) (declare (ignore e))
(setf (st :sidebar-visible) (not (st :sidebar-visible)))
(setf (st :dirty) (list t t nil))))
(:ppage (lambda (e) (declare (ignore e))
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil))))
(:npage (lambda (e) (declare (ignore e))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))))))
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
(cl-tty.input:defkeymap :local
(:enter (lambda (e) (declare (ignore e)) (on-key :enter)))
(:up (lambda (e) (declare (ignore e)) (on-key :up)))
(:down (lambda (e) (declare (ignore e)) (on-key :down)))
(:escape (lambda (e) (declare (ignore e)) (on-key :escape)))))
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history) (load-history)
@@ -862,35 +922,74 @@ Event handlers + daemon I/O + main loop.
(cl-tty.input:key-event (cl-tty.input:key-event
(cl-tty.input:key-event-key data)) (cl-tty.input:key-event-key data))
(t data)))) (t data))))
(cond (cond
((eql ch :escape) ((st :dialog-stack)
(when (st :streaming-text) (let* ((dlg (car (st :dialog-stack)))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (sel (cl-tty.dialog:dialog-content dlg)))
(when (> (length (st :messages)) 0) (cond
(let ((idx (1- (length (st :messages))))) ((eql ch :escape)
(setf (getf (aref (st :messages) idx) :content) (pop (st :dialog-stack))
(concatenate 'string (setf (st :minibuffer-active) nil)
(getf (aref (st :messages) idx) :content) (setf (st :command-palette-active) nil)
" [interrupted]")) (setf (st :dirty) (list t t nil)))
(setf (getf (aref (st :messages) idx) :streaming) nil) ((member ch '(:up :down))
(setf (getf (aref (st :messages) idx) :time) (now)))) (if (eql ch :up) (cl-tty.select:select-prev sel)
(setf (st :streaming-text) nil) (cl-tty.select:select-next sel)))
(setf (st :busy) nil) ((member ch '(:enter 13 10 #\Newline #\Return))
(setf (st :dirty) (list t t nil))) (let* ((filtered (cl-tty.select:select-filtered-options sel))
(when (st :search-mode) (idx (cl-tty.select:select-selected-index sel))
(setf (st :search-mode) nil (item (when (< idx (length filtered))
(st :search-matches) nil (third (nth idx filtered)))))
(st :search-query) "") (when item
(setf (st :dirty) (list nil t nil)) (let ((cb (cl-tty.select:select-on-select sel)))
(add-msg :system "Search exited"))) (when cb (funcall cb item))))))
(t (on-key ch))))))) ((and (characterp ch) (graphic-char-p ch))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (setf (cl-tty.select:select-filter sel)
(cl-tty.backend:backend-clear be) (concatenate 'string (or (cl-tty.select:select-filter sel) "") (string ch))))
(redraw curr-fb w h) ((member ch '(:backspace 127 8))
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (let ((f (cl-tty.select:select-filter sel)))
(rotatef prev-fb curr-fb)) (when (> (length f) 0)
(sleep 0.1)))) (setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))))
(disconnect-daemon)))) ((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my (floor (- h dh) 2)))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg :bright-black))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :highlight))
(t (theme-color :agent)))
nil :bold sel-p)
(incf y-off)))))))
(sleep 0.1))))
(disconnect-daemon))))
#+END_SRC #+END_SRC
* Test Suite * Test Suite
@@ -1369,4 +1468,26 @@ Event handlers + daemon I/O + main loop.
(setf (st :scroll-offset) 3) (setf (st :scroll-offset) 3)
(on-key :npage) (on-key :npage)
(fiveam:is (= 0 (st :scroll-offset)))) (fiveam:is (= 0 (st :scroll-offset))))
;; ── v0.8.0 Minibuffer ──
(fiveam:test test-slash-commands-defined
"Contract v0.8.0: *slash-commands* is non-nil list of option plists."
(fiveam:is (listp passepartout.channel-tui::*slash-commands*))
(fiveam:is (> (length passepartout.channel-tui::*slash-commands*) 0))
(fiveam:is (every (lambda (opt)
(and (getf opt :title) (getf opt :value) (getf opt :category)))
passepartout.channel-tui::*slash-commands*)))
(fiveam:test test-minibuffer-state
"Contract v0.8.0: init-state has :dialog-stack and :minibuffer-active fields."
(init-state)
(fiveam:is (null (st :dialog-stack)))
(fiveam:is (null (st :minibuffer-active))))
(fiveam:test test-command-palette-state
"Contract v0.8.0: init-state has :command-palette-active and :command-palette-dialog as nil."
(init-state)
(fiveam:is (null (st :command-palette-active)))
(fiveam:is (null (st :command-palette-dialog))))
#+END_SRC #+END_SRC

90
org/channel-tui-state.org
View File

@@ -49,8 +49,10 @@ All state mutation flows through event handlers in the controller.
;; Differentiator (v0.4.0) ;; Differentiator (v0.4.0)
:rule-count :cyan :focus-map :yellow :rule-count :cyan :focus-map :yellow
;; UI ;; UI
:dim :white :highlight :cyan :accent :green) :dim :white :highlight :cyan :accent :green
"Color theme plist. 27 semantic keys → hex color strings. ;; Degraded
:degraded :bright-yellow)
"Color theme plist. 28 semantic keys → hex color strings.
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(defvar *tui-theme-presets* (defvar *tui-theme-presets*
@@ -61,7 +63,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
:scroll-indicator :cyan :border :white :background :black :scroll-indicator :cyan :border :white :background :black
:rule-count :cyan :focus-map :yellow :rule-count :cyan :focus-map :yellow
:dim :white :highlight :cyan :accent :green) :dim :white :highlight :cyan :accent :green
:degraded :bright-yellow)
:light (:user :blue :agent :black :system :red :light (:user :blue :agent :black :system :red
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow :input :black :timestamp :yellow :help :blue :error :red :warning :yellow
:connected :green :disconnected :red :busy :magenta :idle :black :connected :green :disconnected :red :busy :magenta :idle :black
@@ -69,7 +72,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
:scroll-indicator :blue :border :black :background :white :scroll-indicator :blue :border :black :background :white
:rule-count :blue :focus-map :red :rule-count :blue :focus-map :red
:dim :white :highlight :blue :accent :green) :dim :white :highlight :blue :accent :green
:degraded :bright-yellow)
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f" :gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f" :input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984" :connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
@@ -77,7 +81,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2" :tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
:scroll-indicator "#83a598" :border "#a89984" :background "#282828" :scroll-indicator "#83a598" :border "#a89984" :background "#282828"
:rule-count "#83a598" :focus-map "#fabd2f" :rule-count "#83a598" :focus-map "#fabd2f"
:dim "#928374" :highlight "#83a598" :accent "#b8bb26") :dim "#928374" :highlight "#83a598" :accent "#b8bb26"
:degraded "#fabd2f")
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900" :solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900" :input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83" :connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
@@ -85,7 +90,8 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496" :tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36" :scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
:rule-count "#2aa198" :focus-map "#b58900" :rule-count "#2aa198" :focus-map "#b58900"
:dim "#586e75" :highlight "#2aa198" :accent "#859900")) :dim "#586e75" :highlight "#2aa198" :accent "#859900"
:degraded "#b58900"))
"Named theme presets. /theme <name> loads one into *tui-theme*.") "Named theme presets. /theme <name> loads one into *tui-theme*.")
(defvar *tui-theme-current-name* :dark (defvar *tui-theme-current-name* :dark
@@ -129,6 +135,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF") (:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF") (:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000") (:white "#FFFFFF") (:black "#000000")
(:bright-yellow "#FFD700")
(t "#FFFFFF")))))) (t "#FFFFFF"))))))
(defun st (key) (getf *state* key)) (defun st (key) (getf *state* key))
@@ -146,10 +153,27 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:collapsed-gates nil ; v0.7.2 :collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2 :search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0 :search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0 :sidebar-visible nil ; v0.8.0
:expand-tool-calls nil ; v0.8.0 :sidebar-width 30 ; v0.8.0
:mcp-count 0 ; v0.8.0 :expand-tool-calls nil ; v0.8.0
:dirty (list nil nil nil)))) :mcp-count 0 ; v0.8.0
:dialog-stack nil ; v0.8.0
:minibuffer-active nil ; v0.8.0
:command-palette-active nil ; v0.8.0
:command-palette-dialog nil ; v0.8.0
:dirty (list nil nil nil))))
#+END_SRC
** Sidebar panel definitions
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defvar *sidebar-panels*
'((:id :gate-trace :title "Gate Trace" :width 28)
(:id :focus :title "Focus" :width 28)
(:id :rules :title "Rules" :width 28)
(:id :context :title "Context" :width 28)
(:id :cost :title "Cost" :width 28)
(:id :files :title "Files" :width 28))
"Sidebar panel definitions for cl-tty slot registrations.")
#+END_SRC #+END_SRC
** Helpers ** Helpers
@@ -189,6 +213,52 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
#+END_SRC #+END_SRC
** Slash Commands
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defvar *slash-commands*
'((:title "/eval <expr> — Evaluate Lisp" :value "/eval" :category :session)
(:title "/undo — Undo last operation" :value "/undo" :category :session)
(:title "/redo — Redo last operation" :value "/redo" :category :session)
(:title "/reconnect — Re-establish daemon" :value "/reconnect" :category :session)
(:title "/quit — Save history and exit" :value "/quit" :category :session)
(:title "/q — Quick quit" :value "/q" :category :session)
(:title "/why — Show last gate trace" :value "/why" :category :memory)
(:title "/identity — Edit IDENTITY.org" :value "/identity" :category :memory)
(:title "/tags — List tag severities" :value "/tags" :category :memory)
(:title "/audit <id> — Inspect memory" :value "/audit" :category :memory)
(:title "/audit verify — Memory integrity" :value "/audit verify" :category :memory)
(:title "/rewind <n> — Rewind to snapshot" :value "/rewind" :category :memory)
(:title "/sessions — Show memory snapshots" :value "/sessions" :category :memory)
(:title "/resume <n> — Resume from snapshot" :value "/resume" :category :memory)
(:title "/focus <project> — Set context" :value "/focus" :category :system)
(:title "/scope <scope> — Change scope" :value "/scope" :category :system)
(:title "/unfocus — Pop context" :value "/unfocus" :category :system)
(:title "/theme [name] — Show/switch theme" :value "/theme" :category :system)
(:title "/context — Show context summary" :value "/context" :category :system)
(:title "/context why <id> — Debug memory" :value "/context why" :category :system)
(:title "/context dropped — Estimate pruned" :value "/context dropped" :category :system)
(:title "/search <query> — Search messages" :value "/search" :category :navigation)
(:title "/help — Show commands" :value "/help" :category :help)
(:title "/help <topic> — Search manual" :value "/help <topic>" :category :help))
"Slash commands for minibuffer select-dialog.")
#+END_SRC
** Daemon Commands
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defvar *daemon-commands*
'((:title "Status — Daemon health info" :value (:action :status) :category :session)
(:title "Stats — Daemon statistics" :value (:action :stats) :category :session)
(:title "Ping — Daemon reachability" :value (:action :ping) :category :session)
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot) :category :memory)
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild) :category :memory)
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact) :category :memory)
(:title "Reload Config — Reload configuration" :value (:action :reload-config) :category :system)
(:title "Reload Identity — Reload identity file" :value (:action :reload-identity) :category :system)
(:title "List Skills — Available skills" :value (:action :list-skills) :category :system)
(:title "Help — Show daemon help" :value (:action :help) :category :help))
"Daemon commands for the command palette (Ctrl+P).")
#+END_SRC
** Event Queue ** Event Queue
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp #+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defun queue-event (ev) (defun queue-event (ev)

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) (defun view-status (fb w)
(let* ((degraded (and (find-package :passepartout) (let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout)) (boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout)) (symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
'(:degraded :unhealthy)))) (bg (if degraded (theme-color :degraded) nil)))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1 (cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected") (if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode))) (string-upcase (string (st :mode)))
(length (st :messages)) (length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0) (or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]" (if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" ""))) (if (st :busy) " …thinking" "")))
(theme-color (if (st :connected) :connected :disconnected)) bg) (theme-color (if (st :connected) :connected :disconnected)) bg)
;; Line 2: Focus + Timestamp ;; Line 2: Focus + Timestamp
(let ((focus-info (or (st :foveal-id) ""))) (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) ;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd))) (let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
(dir (subseq cwd (max 0 (- (length cwd) (- w 45))))) (dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
(lsp-color (if (st :connected) :green :dim))
(mcp-count (or (st :mcp-count) 0)) (mcp-count (or (st :mcp-count) 0))
(hint " Ctrl+P: commands /help: help")) (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 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) (cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
(theme-color :dim) bg) (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 ;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query) (defun search-highlight (content query)
@@ -117,7 +120,7 @@ Returns a list of strings, one per line."
(max-lines (- h 2)) (max-lines (- h 2))
(is-search (st :search-mode)) (is-search (st :search-mode))
(y 1)) (y 1))
;; v0.7.2: search mode header ;; v0.8.0: search mode header
(when is-search (when is-search
(let* ((matches (st :search-matches)) (let* ((matches (st :search-matches))
(idx (st :search-match-idx)) (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) (cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y) (incf y)
(decf max-lines))) (decf max-lines)))
;; Count visible messages from end, accounting for word wrap ;; Pre-compute display lines for each message
(let* ((msg-count 0) (let ((msg-lines (make-array total)))
(lines-remaining max-lines)) (dotimes (i total)
(loop for i from (1- total) downto 0 (let* ((msg (aref msgs i))
while (> lines-remaining 0) (role (getf msg :role))
do (let* ((msg (aref msgs i)) (content (getf msg :content))
(role (getf msg :role)) (time (or (getf msg :time) ""))
(content (getf msg :content)) (content-show (if is-search (search-highlight content (st :search-query)) content))
(time (or (getf msg :time) "")) (lines (case role
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (:user (cl-tty.box:word-wrap
(content-show (if is-search (format nil "│ [~a] ~a" time content-show) (- w 2)))
(search-highlight content (st :search-query)) (:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
content)) (md-lines (and nodes (cl-tty.markdown:render-md nodes))))
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (if md-lines
(wrapped (word-wrap line-text (- w 2))) (progn (setf (first md-lines)
(nlines (length wrapped))) (format nil "[~a] ~a" time (first md-lines)))
(if (<= nlines lines-remaining) md-lines)
(progn (decf lines-remaining nlines) (incf msg-count)) (list (format nil "[~a] " time)))))
(setf lines-remaining 0)))) (t (cl-tty.box:word-wrap
;; Render from the correct starting message (format nil " [~a] ~a" time content-show) (- w 2))))))
(let* ((scroll-skip (st :scroll-offset)) ;; v0.8.0: tool calls — collapsible
(start (max 0 (- total msg-count scroll-skip)))) (let ((tc (getf msg :tool-calls)))
(loop for i from start below total (when tc
while (< y (1- h)) (if (st :expand-tool-calls)
do (let* ((msg (aref msgs i)) (dolist (call tc)
(role (getf msg :role)) (setf lines (append lines
(content (getf msg :content)) (list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
(time (or (getf msg :time) "")) (setf lines (append lines
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (list (format nil " ╎ ~a tool call(s)" (length tc))))))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) ;; v0.8.0: gate trace — collapsible with left border
(is-panel (getf msg :panel)) (let ((gt (getf msg :gate-trace)))
(is-resolved (getf msg :panel-resolved)) (when gt
(content-show (if is-search (if (member i (st :collapsed-gates))
(search-highlight content (st :search-query)) (setf lines (append lines
content)) (list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (length gt)))))
(wrapped (word-wrap line-text (- w 2)))) (dolist (entry (passepartout::gate-trace-lines gt))
;; HITL panel: render with colored border (setf lines (append lines
(when is-panel (list (concatenate 'string "╎ " (car entry)))))))))
(setf color (if is-resolved (setf (aref msg-lines i) lines)))
(theme-color :dim) ;; Count visible messages from end
(theme-color :hitl)))) (let ((msg-count 0) (lines-remaining max-lines))
(dolist (line wrapped) (loop for i from (1- total) downto 0
(when (< y (1- h)) while (> lines-remaining 0)
(cl-tty.backend:draw-text fb 1 y line color nil) do (let ((nlines (length (aref msg-lines i))))
(incf y))) (if (<= nlines lines-remaining)
;; v0.7.2: gate trace below agent messages (progn (decf lines-remaining nlines) (incf msg-count))
(let ((gate-trace (getf msg :gate-trace))) (setf lines-remaining 0))))
(when (and gate-trace (not (member i (st :collapsed-gates)))) ;; Render from the correct starting message
(dolist (entry (passepartout::gate-trace-lines gate-trace)) (let* ((scroll-skip (st :scroll-offset))
(when (< y (1- h)) (start (max 0 (- total msg-count scroll-skip))))
(cl-tty.backend:draw-text fb 3 y (car entry) (loop for i from start below total
(or (getf (cdr entry) :fgcolor) :dim) nil) while (< y (1- h))
(incf y))))))))))) 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 #+END_SRC
** Input Line ** 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))) (cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
#+end_src #+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) ** Redraw (dirty-flag dispatch)
#+begin_src lisp #+begin_src lisp
(defun redraw (fb w h) (defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty) (destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status fb w)) (let* ((degraded (and (find-package :passepartout)
(when cd (view-chat fb w (- h 5))) (boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
(when id (view-input fb w)) (symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
(setf (st :dirty) (list nil nil nil)))) (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 #+END_SRC
* Implementation — v0.7.0 additions * 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) (passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates))) (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg)))) (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 #+END_SRC

6
passepartout.asd
View File

@@ -1,12 +1,12 @@
(defsystem :passepartout (defsystem :passepartout
:name "Passepartout" :name "Passepartout"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.7.2" :version "0.4.3"
:license "AGPLv3" :license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine" :description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t :serial t
:components ((:file "lisp/core-package") :components ((:file "lisp/core-package")
(:file "lisp/core-skills") (:file "lisp/core-skills")
(:file "lisp/core-transport") (:file "lisp/core-transport")
(:file "lisp/core-memory") (:file "lisp/core-memory")
@@ -16,7 +16,7 @@
(:file "lisp/core-pipeline"))) (:file "lisp/core-pipeline")))
(defsystem :passepartout/tui (defsystem :passepartout/tui
:depends-on (:passepartout :cl-tty :usocket :bordeaux-threads) :depends-on (:passepartout :cl-tty :croatoan :usocket :bordeaux-threads)
:serial t :serial t
:components ((:file "lisp/channel-tui-state") :components ((:file "lisp/channel-tui-state")
(:file "lisp/channel-tui-view") (:file "lisp/channel-tui-view")