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

docs: port TUI roadmap to cl-tty, mark Emacs as secondary client

Browse Source 
v0.8.0: Information Radiator now built on cl-tty v1.1.0. Minibuffer
uses cl-tty Dialog stack. New TODO items: conversation view (ScrollBox
+ Markdown), command palette (Select), sidebar (slot system), status bar
(Box + Theme), keybindings (keymap).

v0.9.1: Emacs is now an optional secondary client, not the primary
bridge. cl-tty is the primary TUI.
This commit is contained in:
Amr Gharbeia
2026-05-13 11:41:41 -04:00
parent f8d56cdeba
commit 2d18fa4525
8 changed files with 1493 additions and 1117 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
docs/ROADMAP.org
View File

@@ -36,31 +36,89 @@ On release:
** TODO v0.8.0: Information Radiator (Foundation) ** TODO v0.8.0: Information Radiator (Foundation)
Sidebar (6 panels), sidebar overlay mode (<120 cols), command palette (Ctrl+P), TrueColor theme expansion (8 presets), unified minibuffer panel with slash-command context menu and sub-mode navigation (wizard, settings, help). 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.
*** DONE Unified minibuffer slash-command panel 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
: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-10 Sat] 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.
- 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:
:ID: id-v080-conversation
:CREATED: [2026-05-13 Wed]
:END: :END:
Replace ad-hoc overlay windows with a single bottom-anchored panel. Typing =/= as the first character opens a command context menu (~25 slash commands, filtered in real time as the user types). Navigating to =/wizard= and pressing Enter transitions the panel into the setup wizard — same panel, same position, sub-mode stack. Esc returns to the command list. Future sub-modes (=/settings=, =/help=) slot into the same architecture. - ~ScrollBox~ with ~sticky-scroll~ (auto-follows new content, respects manual scroll-up)
- User messages rendered as ~Box~ (role-colored left border)
- Add ~:minibuffer-mode~ and ~:minibuffer-selected-idx~ state fields to ~init-state~ - Agent messages rendered via cl-tty's ~Markdown~ + ~Code~ + ~Diff~ renderables
- Extract ~*slash-commands*~ data structure (~25 commands, each with description) from the ~on-key~ Enter handler - Tool calls rendered as ~Select~ (collapsible, status-indicated: spinner running / green done / red error)
- Add ~view-minibuffer~ that dispatches on ~:minibuffer-mode~ to ~view-slash-menu~, ~view-wizard-in-panel~ - Gate trace as a collapsible ~Box~ within agent messages (property-drawer style)
- Add ~minibuffer-handle-key~ which dispatches to ~slash-menu-handle-key~ or ~wizard-handle-key~
- TUI event loop: replace separate wizard key handlers with unified modal dispatch block
- ~on-key~: auto-open slash-menu when =/= typed as first character
- ~wizard-start~ / ~wizard-cancel~: set ~:minibuffer-mode~ instead of ~:wizard-visible~
- Merge the wizard overlay (centered, 60x14) into the bottom-anchored panel
- Remove ~:wizard-visible~ state field
~150 lines. ~150 lines.
*** TODO Command palette — cl-tty Select
:PROPERTIES:
:ID: id-v080-palette
:CREATED: [2026-05-13 Wed]
:END:
- Ctrl+P opens a ~select-dialog~ with all daemon commands
- Fuzzy-filtered with categories (session, memory, system, help)
- Enter dispatches the command to the daemon via TCP, displays result in conversation
~40 lines.
*** TODO Sidebar — cl-tty slot system
:PROPERTIES:
:ID: id-v080-sidebar
:CREATED: [2026-05-13 Wed]
:END:
- 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)
- Panel data sourced from daemon's existing response plist keys (~:rule-count~, ~:focal-id~, ~:gate-trace~, etc.)
~80 lines.
*** TODO Status bar — cl-tty Box + Theme
:PROPERTIES:
:ID: id-v080-statusbar
:CREATED: [2026-05-13 Wed]
:END:
- Bottom-most line: directory, LSP status (green dot), MCP count, ~/status~ hint
- Degraded-mode signaling (amber when ~*degraded-components*~ non-nil)
- cl-tty theme tokens for colors — works with all 8 presets
~30 lines.
*** TODO Keybinding layer — cl-tty keymap
:PROPERTIES:
:ID: id-v080-keybindings
:CREATED: [2026-05-13 Wed]
:END:
- Global: Ctrl+P (palette), Ctrl+B (sidebar), Ctrl+Q (quit), PageUp/PageDn (scroll)
- Prompt: Enter (send), Ctrl+C (interrupt), Up/Dn (history)
- cl-tty's layered keymaps handle priority (global → local → input)
~40 lines.
~420 lines total.
** v0.9.0: Eval Harness — Safety Net First ** v0.9.0: Eval Harness — Safety Net First
Every subsequent release ships with automated regression protection. The eval harness is the gate that makes self-modification safe — before any neurosymbolic component modifies the system, the harness verifies nothing broke. Every subsequent release ships with automated regression protection. The eval harness is the gate that makes self-modification safe — before any neurosymbolic component modifies the system, the harness verifies nothing broke.
@@ -79,9 +137,9 @@ Every subsequent release ships with automated regression protection. The eval ha
- Task suite grows with codebase: every bug fix adds a regression task - Task suite grows with codebase: every bug fix adds a regression task
~200 lines. ~200 lines.
** v0.9.1: Emacs Development Environment — A Functional UI ** v0.9.1: Emacs Development Environment — Secondary Client
The croatoan TUI is on life support — enough to see output and type commands, but every render feature (markdown, tool visualization, mouse, adaptive layout) requires custom ncurses code destined for the trash at v2.0.0. Emacs is the v2.0.0 bridge: the same major mode, sidebar, and M-x commands survive from now through Phase III. cl-tty is the primary TUI (v0.8.0). The Emacs major mode is an optional secondary client for users who prefer Emacs-based workflows. Both clients communicate with the same daemon over the same TCP protocol — they are interchangeable frontends, not competing architectures.
*** TODO Emacs major mode *** TODO Emacs major mode
:PROPERTIES: :PROPERTIES:

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

@@ -22,64 +22,11 @@
(t raw))) (t raw)))
raw))) raw)))
(cond (cond
;; v0.8.0: palette mode — handle palette keypresses first ;; v0.8.0: minibuffer dialog active — route through cl-tty select
((and (st :palette-visible) (or (eql ch 27) (eq ch :escape))) ((and (boundp 'cl-tty.dialog:*dialog-stack*)
(setf (st :palette-visible) nil) cl-tty.dialog:*dialog-stack*
(minibuffer-handle-key ch))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
((and (st :palette-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
(let* ((filtered (palette-filter (st :palette-items) (st :palette-filter)))
(idx (st :palette-selected-idx))
(n 0)
(item nil))
(loop for group in filtered
for gitems = (getf group :items)
when (and (< n (length gitems)) (<= n idx (+ n (length gitems) -1)))
do (setf item (nth (- idx n) gitems))
(loop-finish)
do (incf n (length gitems)))
(passepartout.channel-tui::palette-execute item)
(setf (st :palette-visible) nil)
(setf (st :dirty) (list t t t))))
((and (st :palette-visible) (eq ch :up))
(setf (st :palette-selected-idx) (max 0 (1- (st :palette-selected-idx))))
(setf (st :dirty) (list nil t nil)))
((and (st :palette-visible) (eq ch :down))
(setf (st :palette-selected-idx) (min 999 (1+ (st :palette-selected-idx))))
(setf (st :dirty) (list nil t nil)))
((and (st :palette-visible) (integerp ch) (>= ch 32) (<= ch 126))
(let ((c (code-char ch)))
(setf (st :palette-filter) (concatenate 'string (or (st :palette-filter) "") (string c)))
(setf (st :palette-selected-idx) 0)
(setf (st :dirty) (list nil t nil))))
((and (st :palette-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
(let ((f (st :palette-filter)))
(when (and f (> (length f) 0))
(setf (st :palette-filter) (subseq f 0 (1- (length f))))
(setf (st :palette-selected-idx) 0)
(setf (st :dirty) (list nil t nil)))))
;; v0.8.0: setup wizard — handle wizard keypresses
((and (st :wizard-visible) (or (eql ch 27) (eq ch :escape)))
(wizard-cancel))
((and (st :wizard-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
(wizard-next))
((and (st :wizard-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
(let ((input (or (st :wizard-input) "")))
(when (> (length input) 0)
(setf (st :wizard-input) (subseq input 0 (1- (length input))))
(setf (st :wizard-error) nil)
(setf (st :dirty) (list nil t nil)))))
((and (st :wizard-visible) (eql ch 2)) ; Ctrl+B — back
(let ((step-idx (st :wizard-step)))
(when (> step-idx 0)
(setf (st :wizard-step) (1- step-idx)
(st :wizard-input) ""
(st :wizard-error) nil)
(setf (st :dirty) (list nil t nil)))))
((and (st :wizard-visible) (integerp ch) (>= ch 32) (<= ch 126))
(let ((c (code-char ch)))
(setf (st :wizard-input) (concatenate 'string (or (st :wizard-input) "") (string c)))
(setf (st :wizard-error) nil)
(setf (st :dirty) (list nil t nil))))
;; v0.7.1: Esc — interrupt streaming ;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text)) ((and (eql ch 27) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (send-daemon (list :type :event :payload '(:action :cancel-stream)))
@@ -181,10 +128,15 @@
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search ((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages")) (add-msg :system "Use /search <query> to find messages"))
((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer
(wizard-start) (open-minibuffer)
;; If minibuffer opens, simulate typing /setup to filter to it
(when cl-tty.dialog:*dialog-stack*
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(when (typep sel 'select)
(setf (cl-tty.select:select-filter sel) "setup"))))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate collapse
(let ((gate-idx nil)) (let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (st :messages) i)
@@ -206,12 +158,10 @@
(setf (st :pending-ctrl-x) nil) (setf (st :pending-ctrl-x) nil)
(passepartout.channel-tui::sidebar-toggle) (passepartout.channel-tui::sidebar-toggle)
(add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden"))) (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden")))
((eql ch 16) ; Ctrl+P — command palette ((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands)
(setf (st :palette-visible) t (progn
(st :palette-filter) "" (open-command-palette)
(st :palette-selected-idx) 0 (setf (st :dirty) (list t t nil))))
(st :palette-items) (passepartout.channel-tui::palette-items))
(setf (st :dirty) (list t t nil)))
((eql ch 4) ; Ctrl+D — quit on empty ((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
@@ -463,10 +413,13 @@
(add-msg :system "/help [topic] Show this help") (add-msg :system "/help [topic] Show this help")
(add-msg :system "\\ + Enter Multi-line input") (add-msg :system "\\ + Enter Multi-line input")
(add-msg :system "Ctrl+G Toggle gate trace")) (add-msg :system "Ctrl+G Toggle gate trace"))
;; /setup command — open wizard ;; /setup command — open minibuffer filtered to setup
((string-equal text "/setup") ((string-equal text "/setup")
(wizard-start) (open-minibuffer)
(add-msg :system "Setup wizard opened (Ctrl+W)") (when cl-tty.dialog:*dialog-stack*
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(when (typep sel 'select)
(setf (cl-tty.select:select-filter sel) "setup"))))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
;; /theme command ;; /theme command
((string-equal text "/theme") ((string-equal text "/theme")
@@ -656,158 +609,261 @@
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t)))))))) (setf (st :dirty) (list nil nil t))))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun palette-items () ;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog
"Returns categorized command list for the palette."
(let ((items nil)) (defvar *slash-commands*
(push (list :category "Session" :items (list (list :name "/focus" :desc "Set project context"
(list (list :name "/focus" :desc "Set project context" :shortcut "C-o" :action (lambda () (add-msg :system "/focus")))
:action (lambda () (add-msg :system "/focus <project>")))
(list :name "/scope" :desc "Change context scope" (list :name "/scope" :desc "Change context scope"
:action (lambda () (add-msg :system "/scope memex|session|project"))) :action (lambda () (add-msg :system "/scope memex|session|project")))
(list :name "/unfocus" :desc "Pop context stack" (list :name "/unfocus" :desc "Pop context stack"
:action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
(list :name "/search" :desc "Search messages" :shortcut "C-f" (list :name "/search" :desc "Search messages"
:action (lambda () (add-msg :system "Use /search <query> to find messages"))))) :action (lambda () (add-msg :system "Use /search <query>")))
items) (list :name "/why" :desc "Show last gate trace"
(push (list :category "Agent" :items
(list (list :name "/why" :desc "Show last gate trace" :shortcut "C-g"
:action (lambda () (add-msg :system "Gate trace: use /why"))) :action (lambda () (add-msg :system "Gate trace: use /why")))
(list :name "/audit" :desc "Inspect memory object" (list :name "/audit" :desc "Inspect memory object"
:action (lambda () (add-msg :system "/audit <node-id>"))) :action (lambda () (add-msg :system "/audit <node-id>")))
(list :name "/context" :desc "Show context budget" (list :name "/context" :desc "Show context budget"
:action (lambda () (add-msg :system "/context"))))) :action (lambda () (add-msg :system "/context")))
items) (list :name "/theme" :desc "Switch color theme"
(push (list :category "View" :items :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox")))
(list (list :name "/theme" :desc "Switch color theme" (list :name "/sidebar" :desc "Toggle sidebar"
:action (lambda () (add-msg :system "Presets: dark light solarized gruvbox nord tokyonight catppuccin monokai")))
(list :name "/sidebar" :desc "Toggle sidebar" :shortcut "C-x C-b"
:action #'sidebar-toggle) :action #'sidebar-toggle)
(list :name "/help" :desc "Show all commands" (list :name "/help" :desc "Show all commands"
:action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar"))))) :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
items) (list :name "/setup" :desc "Run setup wizard"
(push (list :category "System" :items :action (lambda () (make-wizard-dialog)))
(list (list :name "/setup" :desc "Run setup wizard" :shortcut "C-\\"
:action (lambda () (wizard-start)
(add-msg :system "Setup wizard opened")
(setf (st :dirty) (list t t nil))))
(list :name "/eval" :desc "Evaluate Lisp expression" (list :name "/eval" :desc "Evaluate Lisp expression"
:action (lambda () (add-msg :system "/eval <expr>"))) :action (lambda () (add-msg :system "/eval <expr>")))
(list :name "/reconnect" :desc "Reconnect to daemon" (list :name "/reconnect" :desc "Reconnect to daemon"
:action (lambda () (disconnect-daemon) (connect-daemon))) :action (lambda () (disconnect-daemon) (connect-daemon)))
(list :name "/quit" :desc "Save history and exit" :shortcut "C-d" (list :name "/quit" :desc "Save history and exit"
:action (lambda () (add-msg :system "* Goodbye *") :action (lambda () (add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit))) (send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil))))) (setf (st :running) nil))))
items) "~25 slash commands driving cl-tty's Select widget in the minibuffer.")
(nreverse items)))
(defun palette-execute (selected-item) (defun open-minibuffer ()
"Execute the selected palette item's action." "Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack."
(when (and selected-item (getf selected-item :action)) (cl-tty.dialog:push-dialog
(funcall (getf selected-item :action)))) (cl-tty.dialog:select-dialog
"Commands"
(loop for cmd in *slash-commands*
collect (list :title (getf cmd :name)
:value cmd
:desc (getf cmd :desc)))
:on-select (lambda (opt)
(let ((cmd (getf opt :value))
(action (when cmd (getf cmd :action))))
(when action (funcall action)))))))
(defun wizard-steps () (defvar *daemon-commands*
"Returns the ordered list of setup wizard steps."
(list (list
(list :title "Provider Selection" ;; Category: Session
:prompt "LLM provider (openai, anthropic, ollama, openrouter, deepseek, groq):" (list :title "── Session ──" :category t)
:validate (lambda (input) (list :title "Focus Project" :value :focus :desc "Set project context"
(let ((provider (string-downcase (string-trim '(#\Space) input)))) :action (lambda () (add-msg :system "Usage: /focus <project>")))
(if (member provider '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") (list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project"
:test #'string=) :action (lambda () (add-msg :system "Usage: /scope memex|session|project")))
(progn (setf (st :wizard-provider) provider) nil) (list :title "Unfocus" :value :unfocus :desc "Pop context stack"
(format nil "Unknown provider: ~a" input))))) :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
(list :title "API Key" (list :title "Show Context" :value :context :desc "Show context budget summary"
:prompt (format nil "API key for ~a:" (or (st :wizard-provider) "provider")) :action (lambda () (add-msg :system "Use /context for budget or /context why <id> for node details")))
:validate (lambda (input) ;; Category: Memory
(let ((key (string-trim '(#\Space) input))) (list :title "── Memory ──" :category t)
(if (> (length key) 4) (list :title "List Sessions" :value :sessions :desc "List memory snapshots"
(progn (setf (st :wizard-api-key) key) nil) :action (lambda () (add-msg :system "Use /sessions to list snapshots")))
"Key too short — enter a valid API key")))) (list :title "Rewind" :value :rewind :desc "Rewind to snapshot"
(list :title "Memory" :action (lambda () (add-msg :system "Usage: /rewind <number>")))
:prompt "Max memory entries? (default: 1000, Enter to accept):" (list :title "Audit Node" :value :audit :desc "Inspect memory object"
:validate (lambda (input) :action (lambda () (add-msg :system "Usage: /audit <node-id>")))
(let ((val (string-trim '(#\Space) input))) ;; Category: System
(if (or (string= val "") (string= val "1000")) (list :title "── System ──" :category t)
(progn (setf (st :wizard-memory) "1000") nil) (list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon"
(if (every #'digit-char-p val) :action (lambda () (disconnect-daemon) (connect-daemon)))
(progn (setf (st :wizard-memory) val) nil) (list :title "Quit" :value :quit :desc "Save history and exit"
"Enter a number"))))) :action (lambda () (add-msg :system "* Goodbye *")
(list :title "Review & Save" (send-daemon (list :type :event :payload '(:action :quit)))
:prompt "Save configuration? (yes/no):" (setf (st :running) nil)))
:validate (lambda (input) ;; Category: Help
(let ((val (string-downcase (string-trim '(#\Space) input)))) (list :title "── Help ──" :category t)
(list :title "Show Help" :value :help :desc "Show all commands"
:action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
(list :title "Why" :value :why :desc "Show last gate trace"
:action (lambda () (add-msg :system "Use /why to see last gate trace")))
(list :title "Identity" :value :identity :desc "Edit IDENTITY.org"
:action (lambda () (add-msg :system "Use /identity to edit")))
(list :title "Tags" :value :tags :desc "List tag severities"
:action (lambda () (add-msg :system "Use /tags to list tag severities"))))
"Daemon commands for the command palette (Ctrl+P), organized by category.")
(defun open-command-palette ()
"Push a select-dialog with *daemon-commands* onto cl-tty's dialog stack.
Ctrl+P opens this palette. Categories: Session, Memory, System, Help."
(cl-tty.dialog:push-dialog
(cl-tty.dialog:select-dialog
"Command Palette"
(loop for cmd in *daemon-commands*
collect (list :title (getf cmd :title)
:value cmd
:desc (getf cmd :desc)
:category (getf cmd :category)))
:on-select (lambda (opt)
(let ((cmd (getf opt :value))
(action (when cmd (getf cmd :action))))
(when action (funcall action)))))))
(defun croatoan-to-tty-event (ch)
"Convert a Croatoan key code to a cl-tty key-event struct."
(typecase ch
(keyword
(case ch
(:up (cl-tty.input:make-key-event :key :up))
(:down (cl-tty.input:make-key-event :key :down))
(:enter (cl-tty.input:make-key-event :key :enter))
(:escape (cl-tty.input:make-key-event :key :escape))
(:backspace (cl-tty.input:make-key-event :key :backspace))
(:ppage (cl-tty.input:make-key-event :key :page-up))
(:npage (cl-tty.input:make-key-event :key :page-down))
(t (cl-tty.input:make-key-event :key ch))))
(integer
(cond (cond
((string= val "yes") ((= ch 27) (cl-tty.input:make-key-event :key :escape))
(wizard-write-config) ((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter))
nil) ((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace))
((string= val "no") ((= ch 259) (cl-tty.input:make-key-event :key :up))
(setf (st :wizard-visible) nil ((= ch 258) (cl-tty.input:make-key-event :key :down))
(st :wizard-step) 0 ((= ch 260) (cl-tty.input:make-key-event :key :left))
(st :wizard-error) nil) ((= ch 261) (cl-tty.input:make-key-event :key :right))
(add-msg :system "Wizard cancelled — run /setup to restart") ((= ch 339) (cl-tty.input:make-key-event :key :page-up))
nil) ((= ch 338) (cl-tty.input:make-key-event :key :page-down))
(t "Type 'yes' to save or 'no' to cancel"))))))) ((<= 1 ch 26) (cl-tty.input:make-key-event
:key (intern (string (code-char (+ #x60 ch))) :keyword)
:ctrl t))
((<= 32 ch 126) (cl-tty.input:make-key-event
:key (intern (string (char-upcase (code-char ch))) :keyword)))
(t (cl-tty.input:make-key-event :key :unknown :code ch))))
(t nil)))
(defun wizard-start () (defun minibuffer-handle-key (ch)
"Open the setup wizard at step 0." "Route Croatoan key through the active dialog's select widget.
(setf (st :wizard-visible) t Printable chars update the filter; special keys route through cl-tty.select:select-handle-key.
(st :wizard-step) 0 Returns T if the dialog consumed the key."
(st :wizard-input) "" (let ((stack cl-tty.dialog:*dialog-stack*))
(st :wizard-error) nil (unless stack (return-from minibuffer-handle-key nil))
(st :wizard-provider) nil (let* ((dialog (first stack))
(st :wizard-api-key) nil (content (cl-tty.dialog:dialog-content dialog)))
(st :wizard-memory) nil)) (unless (typep content 'cl-tty.select:select)
(return-from minibuffer-handle-key nil))
;; Backspace: pop last filter char (if any) or pop dialog when empty
(when (or (eql ch :backspace) (eql ch 263) (eql ch 127) (eql ch 8))
(let ((f (cl-tty.select:select-filter content)))
(if (and f (> (length f) 0))
(progn (setf (cl-tty.select:select-filter content) (subseq f 0 (1- (length f))))
(cl-tty.select::select-clamp-index content)
t)
(progn (cl-tty.dialog:pop-dialog) t))))
;; Escape: pop the dialog
(when (or (eql ch 27) (eq ch :escape))
(cl-tty.dialog:pop-dialog)
t)
;; Printable: append to filter if dialog is a select
(when (and (integerp ch) (<= 32 ch 126))
(let* ((c (code-char ch))
(f (or (cl-tty.select:select-filter content) "")))
(setf (cl-tty.select:select-filter content)
(concatenate 'string f (string c)))
(cl-tty.select::select-clamp-index content)
t))
;; Route through cl-tty.select:select-handle-key for navigation/selection
(let ((ev (croatoan-to-tty-event ch)))
(when ev
(handler-case
(cl-tty.select:select-handle-key content ev)
(error () nil)))))))
(defun wizard-next () (defun make-wizard-dialog ()
"Validate current step input; advance on success, show error on failure." "Create a setup wizard dialog daisy-chain: provider select → API key → save.
(let ((steps (wizard-steps)) Validates at each step; final step writes ~/.passepartout/config.lisp."
(step-idx (st :wizard-step))) (let* ((state (list :provider nil :api-key nil :memory "1000" :step 0))
(when (< step-idx (length steps)) (step-labels '("Provider" "API Key" "Memory" "Review & Save"))
(let* ((step (nth step-idx steps)) (step-fns
(validate-fn (getf step :validate)) (list
(error-msg (funcall validate-fn (or (st :wizard-input) "")))) ;; Step 0: provider selection
(if error-msg (lambda (input)
(setf (st :wizard-error) error-msg (let ((p (string-downcase (string-trim '(#\Space) input))))
(st :dirty) (list nil t nil)) (if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=)
(if (= step-idx (1- (length steps))) (progn (setf (getf state :provider) p) nil)
(progn (format nil "Unknown provider: ~a" input))))
(setf (st :wizard-visible) nil ;; Step 1: API key
(st :wizard-step) 0 (lambda (input)
(st :wizard-error) nil) (let ((k (string-trim '(#\Space) input)))
(add-msg :system "Configuration saved. Run /reconnect to reload.")) (if (> (length k) 4)
(setf (st :wizard-step) (1+ step-idx) (progn (setf (getf state :api-key) k) nil)
(st :wizard-input) "" "Key too short")))
(st :wizard-error) nil ;; Step 2: memory limit
(st :dirty) (list nil t nil)))))))) (lambda (input)
(let ((v (string-trim '(#\Space) input)))
(defun wizard-cancel () (if (or (string= v "") (string= v "1000"))
"Dismiss the wizard, preserving state for resumption." nil
(setf (st :wizard-visible) nil (if (every #'digit-char-p v)
(st :dirty) (list t t nil))) (progn (setf (getf state :memory) v) nil)
"Enter a number"))))
(defun wizard-write-config () ;; Step 3: save
"Write collected wizard data to .env and notify." (lambda (input)
(let ((provider (st :wizard-provider)) (let ((v (string-downcase (string-trim '(#\Space) input))))
(api-key (st :wizard-api-key)) (cond ((string= v "yes")
(memory (or (st :wizard-memory) "1000")) (let ((env-path (merge-pathnames ".passepartout/config.lisp"
(env-path (merge-pathnames ".env" (merge-pathnames "memex/" (user-homedir-pathname))))) (user-homedir-pathname))))
(handler-case (handler-case
(progn (progn
(uiop:ensure-all-directories-exist (list env-path)) (uiop:ensure-all-directories-exist (list env-path))
(with-open-file (out env-path :direction :output :if-exists :supersede :if-does-not-exist :create) (with-open-file (out env-path :direction :output
(format out "# Passepartout configuration (generated by setup wizard)~%") :if-exists :supersede
(format out "PROVIDER_CASCADE=~a~%" provider) :if-does-not-exist :create)
(format out "~:@(~a~)_API_KEY=~a~%" provider api-key) (format out ";; Passepartout configuration~%")
(format out "MEMORY_MAX_ENTRIES=~a~%" memory) (format out "(setf *provider* ~s)~%" (getf state :provider))
(format out "DAEMON_PORT=9105~%"))) (format out "(setf *api-key* ~s)~%" (getf state :api-key))
(error (c) (format out "(setf *memory-max-entries* ~s)~%" (getf state :memory))))
(setf (st :wizard-error) (format nil "Failed to write config: ~a" c))))) (error (c) (format nil "Write failed: ~a" c))))
(setf (st :wizard-visible) nil nil)
(st :wizard-step) 0 ((string= v "no") nil)
(st :wizard-error) nil) (t "Type 'yes' or 'no'")))))))
(add-msg :system (format nil "Configuration saved to memex/.env (~a). Run /reconnect to reload." provider))) (labels ((advance ()
(let* ((step (getf state :step))
(fn (nth step step-fns))
(err (funcall fn "ignored")))
(declare (ignore fn))
;; Push next prompt dialog or finish
(if (< step (1- (length step-labels)))
(progn
(setf (getf state :step) (1+ step))
(cl-tty.dialog:push-dialog
(cl-tty.dialog:prompt-dialog
(format nil "~a — ~a" (nth (getf state :step) step-labels)
(getf state :provider))
:on-submit (lambda (val)
(let ((validation (funcall (nth (getf state :step) step-fns) val)))
(if validation
(progn
(cl-tty.dialog:push-dialog
(cl-tty.dialog:alert-dialog "Error" validation))
(setf (getf state :step) (1- step)))
(advance)))))))
(add-msg :system (format nil "Configuration saved (~a). Run /reconnect."
(getf state :provider)))))))
;; Push the first prompt dialog
(cl-tty.dialog:push-dialog
(cl-tty.dialog:prompt-dialog
"Setup — LLM Provider"
:on-submit (lambda (val)
(let ((err (funcall (first step-fns) val)))
(if err
(cl-tty.dialog:push-dialog
(cl-tty.dialog:alert-dialog "Invalid" err))
(advance)))))))))
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
"Mark the most recent HITL panel message as resolved with DECISION." "Mark the most recent HITL panel message as resolved with DECISION."
@@ -1144,23 +1200,10 @@
(when sidebar-w (when sidebar-w
(view-sidebar sidebar-w) (view-sidebar sidebar-w)
(refresh sidebar-w)) (refresh sidebar-w))
(when (st :palette-visible) ;; v0.8.0: render cl-tty dialog overlay when stack is non-empty
(let* ((pw (min 56 (floor (* w 0.7)))) (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
(ph (min 18 (floor (* h 0.6)))) cl-tty.dialog:*dialog-stack*)
(px (floor (- w pw) 2)) (render-dialog-overlay scr w h))
(py (floor (- h ph) 2))
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
(view-palette palette-win)
(refresh palette-win)
(close palette-win)))
(when (st :wizard-visible)
(let* ((ww 60) (wh 14)
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2))
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
(view-wizard wizard-win)
(refresh wizard-win)
(close wizard-win)))
(refresh scr) (refresh scr)
(loop while (st :running) do (loop while (st :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
@@ -1189,27 +1232,70 @@
(and (not sidebar-wanted) sidebar-w)) (and (not sidebar-wanted) sidebar-w))
(recreate-windows w h) (recreate-windows w h)
(redraw sw cw ch iw))) (redraw sw cw ch iw)))
(when (st :palette-visible) ;; v0.8.0: render cl-tty dialog overlay
(let* ((pw (min 56 (floor (* w 0.7)))) (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
(ph (min 18 (floor (* h 0.6)))) cl-tty.dialog:*dialog-stack*)
(px (floor (- w pw) 2)) (render-dialog-overlay scr w h))
(py (floor (- h ph) 2))
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
(view-palette palette-win)
(refresh palette-win)
(close palette-win)))
(when (st :wizard-visible)
(let* ((ww 60) (wh 14)
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2))
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
(view-wizard wizard-win)
(refresh wizard-win)
(close wizard-win)))
(refresh scr) (refresh scr)
(sleep 0.03)) (sleep 0.03))
(disconnect-daemon)))) (disconnect-daemon))))
(defun render-dialog-overlay (scr w h)
"Render the top cl-tty dialog as a Croatoan overlay.
Draws a dimmed backdrop then a centered bordered panel with select options."
(let* ((dialog (first cl-tty.dialog:*dialog-stack*))
(title (cl-tty.dialog:dialog-title dialog))
(content (cl-tty.dialog:dialog-content dialog))
(ww (min 60 (- w 4)))
(wh (min 18 (- h 4)))
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2)))
;; Dimmed backdrop
(dotimes (row h)
(add-string scr (make-string w :initial-element #\Space)
:y row :x 0 :fgcolor (theme-color :dim) :bgcolor (theme-color :background)))
;; Dialog panel window
(let ((win (make-instance 'window :height wh :width ww :y wy :x wx)))
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(add-string win (format nil " ~a " title) :y 0 :x 2 :fgcolor (theme-color :accent))
;; Render select widget options
(when (typep content 'cl-tty.select:select)
(let* ((filtered (cl-tty.select:select-filtered-options content))
(sel-idx (cl-tty.select:select-selected-index content))
(filter-str (cl-tty.select:select-filter content))
(y 1))
;; Show filter line
(add-string win (format nil " > ~a_" (or filter-str ""))
:y y :x 2 :n (- ww 4) :fgcolor (theme-color :input))
(incf y)
;; Show filtered options
(dolist (item filtered)
(when (< y (1- wh))
(let* ((display-idx (first item))
(option (third item))
(title-str (getf option :title))
(desc (getf option :desc))
(is-selected (= display-idx sel-idx))
(fg (if is-selected (theme-color :highlight) (theme-color :agent))))
(when is-selected
(setf (color-pair win) (list (theme-color :highlight) (theme-color :dim)))
(add-string win (make-string (- ww 2) :initial-element #\Space)
:y y :x 1 :n (- ww 2))
(setf (color-pair win) (list (theme-color :border) (theme-color :background))))
(add-string win (format nil "~a ~a" (if is-selected ">" " ") title-str)
:y y :x 2 :n (min 25 (- ww 4)) :fgcolor fg)
(when (and desc (not is-selected))
(add-string win (format nil " ~a" desc) :y y :x 28 :n (- ww 30)
:fgcolor (theme-color :dim)))
(incf y))))
;; Footer hint
(add-string win (format nil " ~a/~a | ↑↓ Navigate Enter Execute Esc Close"
(1+ sel-idx) (length filtered))
:y (1- wh) :x 1 :n (- ww 2) :fgcolor (theme-color :dim))))
(refresh win)
(close win))))
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history) (load-history)
@@ -1725,81 +1811,70 @@
(on-key 2) ; Ctrl+B (on-key 2) ; Ctrl+B
(fiveam:is (eq t (st :sidebar-visible)))) (fiveam:is (eq t (st :sidebar-visible))))
(fiveam:test test-ctrl-p-opens-palette (fiveam:test test-ctrl-p-opens-command-palette
"Contract 6: Ctrl+P opens command palette." "Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)."
(init-state) (init-state)
(on-key 16) ; Ctrl+P (on-key 16) ; Ctrl+P
(fiveam:is (eq t (st :palette-visible))) (fiveam:is-true (and cl-tty.dialog:*dialog-stack*)))
(fiveam:is (not (null (st :palette-items))))
(fiveam:is (= 0 (st :palette-selected-idx))))
(fiveam:test test-palette-escape-dismisses (fiveam:test test-open-minibuffer-pushes-dialog
"Contract 6: Esc dismisses palette." "Contract 7: open-minibuffer pushes a dialog with a select content."
(init-state) (let ((cl-tty.dialog:*dialog-stack* nil))
(setf (st :palette-visible) t) (passepartout.channel-tui::open-minibuffer)
(on-key 27) ; Esc (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
(fiveam:is (null (st :palette-visible)))) (let ((item (first cl-tty.dialog:*dialog-stack*)))
(fiveam:is (string= "DIALOG" (symbol-name (class-name (class-of item)))))
(let ((content (cl-tty.dialog:dialog-content item)))
(fiveam:is (not (null content)))))))
(fiveam:test test-palette-enter-executes (fiveam:test test-slash-commands-count
"Contract 9: Enter executes selected item and dismisses palette." "Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action."
(init-state) (let ((cmds passepartout.channel-tui::*slash-commands*))
(setf (st :palette-visible) t (fiveam:is (>= (length cmds) 14))
(st :palette-selected-idx) 0 (dolist (c cmds)
(st :palette-items) (passepartout.channel-tui::palette-items)) (fiveam:is (stringp (getf c :name)))
(on-key (char-code #\/)) (fiveam:is (stringp (getf c :desc)))
(on-key (char-code #\t)) (fiveam:is (functionp (getf c :action))))))
(fiveam:is (string= "/t" (st :palette-filter))))
(fiveam:test test-palette-items-has-categories (fiveam:test test-daemon-commands-count
"Contract 7: palette-items returns categorized list with at least Session and View." "Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers."
(init-state) (let ((cmds passepartout.channel-tui::*daemon-commands*))
(let ((items (passepartout.channel-tui::palette-items))) (fiveam:is (>= (length cmds) 14))
(fiveam:is (listp items)) (dolist (c cmds)
(fiveam:is (find "Session" items :key (lambda (g) (getf g :category)) :test #'string=)) (if (getf c :category)
(fiveam:is (find "View" items :key (lambda (g) (getf g :category)) :test #'string=)))) (fiveam:is (stringp (getf c :title)))
(progn
(fiveam:is (stringp (getf c :title)))
(fiveam:is (stringp (getf c :desc)))
(fiveam:is (functionp (getf c :action))))))))
;; ── v0.8.0 Setup Wizard ── (fiveam:test test-minibuffer-handle-key-escape
"Contract 8: minibuffer-handle-key with Esc pops dialog."
(let ((cl-tty.dialog:*dialog-stack* nil))
(passepartout.channel-tui::open-minibuffer)
(fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
(passepartout.channel-tui::minibuffer-handle-key 27) ; Esc
(fiveam:is (null cl-tty.dialog:*dialog-stack*))))
(fiveam:test test-wizard-steps-count (fiveam:test test-minibuffer-handle-key-backspace
"Contract v0.8.0: wizard-steps returns 4 steps." "Contract 8: Backspace pops filter char, then pops dialog on empty."
(let ((steps (passepartout.channel-tui::wizard-steps))) (let ((cl-tty.dialog:*dialog-stack* nil))
(fiveam:is (= 4 (length steps))))) (passepartout.channel-tui::open-minibuffer)
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(setf (cl-tty.select:select-filter sel) "te")
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
(fiveam:is (string= "t" (cl-tty.select:select-filter sel)))
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
(fiveam:is (string= "" (or (cl-tty.select:select-filter sel) ""))))))
(fiveam:test test-wizard-start-sets-visible (fiveam:test test-croatoan-to-tty-event-arrows
"Contract v0.8.0: wizard-start sets wizard-visible and resets state." "Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events."
(init-state) (let ((up (passepartout.channel-tui::croatoan-to-tty-event 259)))
(passepartout.channel-tui::wizard-start) (fiveam:is (cl-tty.input:key-event-p up))
(fiveam:is (eq t (st :wizard-visible))) (fiveam:is (eql :up (cl-tty.input:key-event-key up))))
(fiveam:is (= 0 (st :wizard-step))) (let ((down (passepartout.channel-tui::croatoan-to-tty-event 258)))
(fiveam:is (string= "" (st :wizard-input)))) (fiveam:is (eql :down (cl-tty.input:key-event-key down))))
(let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13)))
(fiveam:test test-wizard-cancel-hides (fiveam:is (eql :enter (cl-tty.input:key-event-key enter))))
"Contract v0.8.0: wizard-cancel hides the wizard." (let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27)))
(init-state) (fiveam:is (eql :escape (cl-tty.input:key-event-key esc)))))
(setf (st :wizard-visible) t)
(passepartout.channel-tui::wizard-cancel)
(fiveam:is (null (st :wizard-visible))))
(fiveam:test test-wizard-next-valid-advances
"Contract v0.8.0: valid input advances to next step."
(init-state)
(passepartout.channel-tui::wizard-start)
(setf (st :wizard-input) "openai")
(passepartout.channel-tui::wizard-next)
(fiveam:is (= 1 (st :wizard-step)))
(fiveam:is (string= "openai" (st :wizard-provider))))
(fiveam:test test-wizard-next-invalid-shows-error
"Contract v0.8.0: invalid input shows error and stays on current step."
(init-state)
(passepartout.channel-tui::wizard-start)
(setf (st :wizard-input) "invalid-provider")
(passepartout.channel-tui::wizard-next)
(fiveam:is (= 0 (st :wizard-step)))
(fiveam:is (not (null (st :wizard-error)))))
(fiveam:test test-ctrl-backslash-opens-wizard
"Contract v0.8.0: Ctrl+\\ opens the setup wizard."
(init-state)
(on-key 28) ; Ctrl+\
(fiveam:is (eq t (st :wizard-visible))))

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

@@ -5,7 +5,10 @@
:view-status :view-chat :view-input :redraw :view-status :view-chat :view-input :redraw
:on-key :on-daemon-msg :send-daemon :on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon :connect-daemon :disconnect-daemon
:*tui-theme* :theme-color)) :*tui-theme* :theme-color
:*slash-commands* :open-minibuffer :minibuffer-handle-key
:view-conversation :render-user-msg :render-agent-msg
:render-sys-msg :render-tool-call :render-gate-trace))
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defvar *state* nil) (defvar *state* nil)
@@ -188,14 +191,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
: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
:minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0 :expand-tool-calls nil ; v0.8.0
:minibuffer-filter "" ; v0.8.0
:wizard-mode :provider-list ; v0.9.0
:wizard-selected-idx 0 :wizard-input "" ; v0.9.0
:wizard-error nil ; v0.9.0
:wizard-providers nil :wizard-current-provider nil ; v0.9.0
:wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
:wizard-cascade-slot :fg-prob ; v0.9.0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
(defun now () (defun now ()

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

@@ -40,7 +40,76 @@
(setf result (concatenate 'string result (subseq content pos))) (setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result)))) (if (string= result "") content result))))
(defun view-chat (win h) (defun render-user-msg (win content time w y)
"Render a user message with green role-prefix and timestamp. Returns next y."
(let* ((prefix (format nil "⬆ [~a] " time))
(line-text (concatenate 'string prefix content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :user))
(incf y)))
y))
(defun render-agent-msg (win content time w y)
"Render an agent message using cl-tty's markdown renderer. Returns next y."
(let* ((prefix (format nil "⬇ [~a] " time))
(header-len (length prefix)))
;; Role prefix line
(add-string win prefix :y y :x 1 :n header-len :fgcolor (theme-color :agent))
(incf y)
;; Markdown content — cl-tty's render-markdown produces ANSI-styled lines
(let ((md-lines (cl-tty.markdown:render-md
(cl-tty.markdown:parse-blocks content))))
(dolist (line md-lines)
(when (< y 9999)
;; Each line may contain ANSI escape codes; render through add-string
(add-string win line :y y :x 1 :n (- w 2) :fgcolor (theme-color :agent))
(incf y))))
y))
(defun render-sys-msg (win content w y)
"Render a system message in yellow, dim style. Returns next y."
(let* ((line-text (format nil " ~a" content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :system))
(incf y)))
y))
(defun render-tool-call (win tool-name status duration content w y tab-expanded)
"Render a tool call with status indicator. Tab toggles full output. Returns next y."
(let* ((status-char (case status (:running "…") (:success "✓") (:failure "✗") (t "?")))
(status-color (case status (:running (theme-color :tool-running))
(:success (theme-color :tool-success))
(:failure (theme-color :tool-failure))
(t (theme-color :dim))))
(summary (format nil " ~a ~a~@[ (~,1fs)~]" status-char tool-name duration)))
;; Summary line
(add-string win summary :y y :x 1 :n (- w 2) :fgcolor status-color)
(incf y)
;; Expanded output (when Tab pressed)
(when tab-expanded
(dolist (line (word-wrap content (- w 6)))
(when (< y 9999)
(add-string win (format nil " ~a" line) :y y :x 1 :n (- w 4) :fgcolor (theme-color :tool-output))
(incf y))))
y))
(defun render-gate-trace (win trace w y collapsed)
"Render gate decisions as colored lines. Ctrl+G toggles. Returns next y."
(unless collapsed
(dolist (entry (gate-trace-lines trace))
(when (< y 9999)
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))
y)
(defun view-conversation (win h)
"Render scrolled message list using cl-tty ScrollBox model.
Sticky-scroll: auto-follows new content when at bottom.
Each message role dispatched to its dedicated render function."
(clear win) (clear win)
(box win 0 0) (box win 0 0)
(let* ((w (or (width win) 78)) (let* ((w (or (width win) 78))
@@ -49,7 +118,7 @@
(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 ;; 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))
@@ -59,7 +128,10 @@
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight)) (add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(incf y) (incf y)
(decf max-lines))) (decf max-lines)))
;; Count visible messages from end, accounting for word wrap ;; Sticky-scroll: if at bottom, auto-follow
(when (and (zerop (st :scroll-offset)) (> total 0))
(setf (st :scroll-at-bottom) t))
;; Count visible messages from end
(let* ((msg-count 0) (let* ((msg-count 0)
(lines-remaining max-lines)) (lines-remaining max-lines))
(loop for i from (1- total) downto 0 (loop for i from (1- total) downto 0
@@ -68,17 +140,16 @@
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (nlines (case role
(content-show (if is-search (:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2))))
(search-highlight content (st :search-query)) (:agent (let ((header (format nil "⬇ [~a]" time)))
content)) (+ 1 (length (cl-tty.markdown:render-md
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (cl-tty.markdown:parse-blocks content))))))
(wrapped (word-wrap line-text (- w 2))) (t (length (word-wrap (format nil " ~a" content) (- w 2)))))))
(nlines (length wrapped)))
(if (<= nlines lines-remaining) (if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count)) (progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0)))) (setf lines-remaining 0))))
;; Render from the correct starting message ;; Render from start message
(let* ((scroll-skip (st :scroll-offset)) (let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip)))) (start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total (loop for i from start below total
@@ -87,36 +158,28 @@
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (gate-trace (getf msg :gate-trace))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (collapsed (member i (st :collapsed-gates)))
(is-panel (getf msg :panel)) (tool-name (getf msg :tool))
(is-resolved (getf msg :panel-resolved)) (tool-status (getf msg :tool-status))
(content-show (if is-search (tool-duration (getf msg :tool-duration))
(search-highlight content (st :search-query)) (tool-expanded (member i (st :expand-tool-calls))))
content)) (setf y (case role
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (:user (render-user-msg win content time w y))
(wrapped (word-wrap line-text (- w 2)))) (:agent (progn
;; HITL panel: render with colored border (setf y (render-agent-msg win content time w y))
(when is-panel (when gate-trace
(setf color (if is-resolved (setf y (render-gate-trace win gate-trace w y collapsed)))
(theme-color :dim) y))
(theme-color :hitl)))) (t (render-sys-msg win content w y))))
(dolist (line wrapped) ;; Tool call block (attached to any role message)
(when (< y (1- h)) (when tool-name
(if (eq role :agent) (setf y (render-tool-call win tool-name tool-status tool-duration
(let ((segments (parse-markdown-spans line))) content w y tool-expanded)))))))
(setf y (render-styled win segments y 1 w))) ;; Sticky-scroll update
(progn (when (and (st :scroll-at-bottom) (plusp (length msgs)))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color) (setf (st :scroll-offset) 0))
(incf y))))) (refresh win)))
;; 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 (gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
(defun view-input (win) (defun view-input (win)
(let* ((text (input-string)) (let* ((text (input-string))
@@ -132,7 +195,7 @@
(defun redraw (sw cw ch iw) (defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty) (destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw)) (when sd (view-status sw))
(when cd (view-chat cw ch)) (when cd (view-conversation cw ch))
(when id (view-input iw)) (when id (view-input iw))
(setf (st :dirty) (list nil nil nil)))) (setf (st :dirty) (list nil nil nil))))
@@ -450,46 +513,56 @@ Respects CJK/emoji char widths via char-width."
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defun view-sidebar (win) ;; ── Sidebar Panel Slots ──
"Render 42-column sidebar with 7 panels: Gate Trace, Focus, Rules, Context, Files, Cost, Protection." ;; Each sidebar panel is a cl-tty slot registration with :mode :replace.
(clear win) ;; The sidebar orchestrates them in order, passing (win w h y) and
(setf (color-pair win) (list (theme-color :border) (theme-color :background))) ;; receiving the next y position.
(box win 0 0)
(let* ((w (or (width win) 42)) (defun render-sidebar-panel-header (win w y title)
(h (or (height win) 24)) (add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2)
(y 1) :fgcolor (theme-color :accent))
(gate-trace (st :gate-trace)) (1+ y))
(foveal-id (st :foveal-id))
(rule-count (or (st :rule-count) 0)) (cl-tty.slot:defslot :sidebar-gate-trace :mode :replace
(context-usage (st :context-usage)) :render-fn
(modified-files (st :modified-files)) (lambda (win w h y)
(session-cost (st :session-cost)) (let ((trace (st :gate-trace)))
(block-counts (st :block-counts))) (setf y (render-sidebar-panel-header win w y "Gate Trace"))
;; Panel 1: Gate Trace (if trace
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (dolist (entry (gate-trace-lines trace))
(incf y)
(if gate-trace
(dolist (entry (gate-trace-lines gate-trace))
(when (< y (1- h)) (when (< y (1- h))
(add-string win (car entry) :y y :x 2 :n (- w 4) (add-string win (car entry) :y y :x 2 :n (- w 4)
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
(incf y))) (incf y)))
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 2: Focus y)))
(incf y)
(add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-focus :mode :replace
(incf y) :render-fn
(add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) (lambda (win w h y)
;; Panel 3: Rules (declare (ignore h))
(incf y 2) (setf y (render-sidebar-panel-header win w y "Focus"))
(add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (add-string win (format nil " ~a" (or (st :foveal-id) "(none)"))
(incf y) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
(add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count)) (+ y 2)))
;; Panel 4: Context gauge
(incf y 2) (cl-tty.slot:defslot :sidebar-rules :mode :replace
(add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) :render-fn
(incf y) (lambda (win w h y)
(let* ((pct (or context-usage 0)) (declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Rules"))
(add-string win (format nil " Rules: ~d" (or (st :rule-count) 0))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
(1+ y)))
(cl-tty.slot:defslot :sidebar-context :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Context"))
(let* ((pct (or (st :context-usage) 0))
(bar-width 30) (bar-width 30)
(filled (min bar-width (floor (* pct bar-width) 100))) (filled (min bar-width (floor (* pct bar-width) 100)))
(gauge-color (cond ((< pct 50) (theme-color :connected)) (gauge-color (cond ((< pct 50) (theme-color :connected))
@@ -501,12 +574,16 @@ Respects CJK/emoji char widths via char-width."
(make-string (- bar-width filled) :initial-element #\░) (make-string (- bar-width filled) :initial-element #\░)
pct) pct)
:y y :x 2 :n (- w 4) :fgcolor gauge-color)) :y y :x 2 :n (- w 4) :fgcolor gauge-color))
;; Panel 5: Files (1+ y)))
(incf y 2)
(add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-files :mode :replace
(incf y) :render-fn
(if modified-files (lambda (win w h y)
(dolist (f modified-files) (setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Files"))
(let ((files (st :modified-files)))
(if files
(dolist (f files)
(when (< y (1- h)) (when (< y (1- h))
(let ((fp (getf f :filepath)) (let ((fp (getf f :filepath))
(added (getf f :lines-added)) (added (getf f :lines-added))
@@ -518,32 +595,56 @@ Respects CJK/emoji char widths via char-width."
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)))) (incf y))))
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 6: Cost y)))
(incf y 2)
(add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-cost :mode :replace
(incf y) :render-fn
(if session-cost (lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Cost"))
(let ((cost (st :session-cost)))
(if cost
(progn (progn
(add-string win (format nil " Total: $~,4f" (getf session-cost :total)) (add-string win (format nil " Total: $~,4f" (getf cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y) (incf y)
(add-string win (format nil " Calls: ~d" (getf session-cost :calls)) (add-string win (format nil " Calls: ~d" (getf cost :calls))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 7: Protection (1+ y))))
(incf y 2)
(add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-protection :mode :replace
(incf y) :render-fn
(if (and block-counts (> (getf block-counts :total) 0)) (lambda (win w h y)
(let ((by-gate (getf block-counts :by-gate))) (setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Protection"))
(let ((bc (st :block-counts)))
(if (and bc (> (getf bc :total) 0))
(let ((by-gate (getf bc :by-gate)))
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6))) (dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
(when (< y (1- h)) (when (< y (1- h))
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) (add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
(incf y)))) (incf y))))
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
y)))
(defun view-sidebar (win)
"Render 42-column sidebar with panel slots: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let ((w (or (width win) 42))
(h (or (height win) 24))
(y 1))
(dolist (panel '(:sidebar-gate-trace :sidebar-focus :sidebar-rules
:sidebar-context :sidebar-files :sidebar-cost
:sidebar-protection))
(let ((result (cl-tty.slot:slot-render panel win w h y)))
(when result (setf y (min (1- h) result)))))
(refresh win) (refresh win)
(- y 1))) (1- y)))
(defun view-minibuffer (win) (defun view-minibuffer (win)
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode." "Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
@@ -552,7 +653,7 @@ Respects CJK/emoji char widths via char-width."
(:wizard (view-wizard-in-panel win)) (:wizard (view-wizard-in-panel win))
(t nil))) (t nil)))
(defvar *slash-commands* nil) ; forward declaration — defined in channel-tui-main (declaim (special *slash-commands*)) ; forward declaration — defined in channel-tui-main
(defun view-slash-menu (win) (defun view-slash-menu (win)
"Render the slash-command menu: filter bar, filtered command list, selection highlight." "Render the slash-command menu: filter bar, filtered command list, selection highlight."
@@ -742,19 +843,7 @@ Respects CJK/emoji char widths via char-width."
(is (getf presets name) (format nil "~a preset should exist" name))))) (is (getf presets name) (format nil "~a preset should exist" name)))))
(test test-minibuffer-init-state-fields (test test-minibuffer-init-state-fields
"Contract v0.8.0: init-state includes minibuffer-mode, selected-idx, filter; excludes palette and wizard-visible." "Contract v0.8.0: init-state no longer has legacy palette/wizard fields."
(passepartout.channel-tui::init-state) (passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :minibuffer-mode))) (is (null (getf passepartout.channel-tui::*state* :mode)))
(is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx))) (is (null (getf passepartout.channel-tui::*state* :palette-visible))))
(is (string= "" (passepartout.channel-tui::st :minibuffer-filter)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible)))
(is (null (getf passepartout.channel-tui::*state* :wizard-visible))))
(test test-slash-commands-entry-count
"Contract v0.8.0: *slash-commands* has at least 19 entries, each with :name, :desc, :action."
(let ((cmds passepartout.channel-tui::*slash-commands*))
(is (>= (length cmds) 19))
(dolist (c cmds)
(is (stringp (getf c :name)))
(is (stringp (getf c :desc)))
(is (functionp (getf c :action))))))

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

@@ -5,74 +5,38 @@
Event handlers + daemon I/O + main loop. Event handlers + daemon I/O + main loop.
** v0.8.0 — Sidebar Controller ** v0.8.0 — Minibuffer (cl-tty Dialog Stack)
The sidebar toggles via ~/sidebar~ command or ~Ctrl+X+B~ chord. The Replaces ad-hoc palette + wizard overlays with cl-tty's Dialog stack.
~Ctrl+X~ prefix sets ~:pending-ctrl-x~ (existing infrastructure from Typing =/= as the first character opens a ~select-dialog~ with ~25 slash
v0.7.0); ~Ctrl+B~ on the next keystroke toggles ~:sidebar-visible~ and commands filtered in real time. Selecting a command dispatches it;
sets dirty flags to force redraw. selecting =/wizard= transitions to a ~prompt-dialog~ chain. cl-tty's
~cl-tty.dialog:*dialog-stack*~ handles push/pop; Esc dismisses the top dialog.
The sidebar's visibility depends on terminal width. At ≥ 120 columns, ~*slash-commands*~ is the single source of truth for available commands.
the sidebar is a permanent fourth Croatoan window in a 4-column layout ~open-minibuffer~ pushes the select-dialog. ~minibuffer-handle-key~
(sidebar | content). At < 120 columns, the layout stays 3-window converts Croatoan key codes to cl-tty ~key-event~ structs and delegates
(status | chat | input) and the sidebar renders as an overlay when to ~select-handle-key~. Printable characters update the Select's filter;
toggled, drawn as an absolute-positioned window on top of the chat area. Backspace removes the last filter character; Enter/Up/Down/Esc route
through the select widget's navigation.
The KEY_RESIZE handler in ~tui-main~ recomputes the layout: at ≥ 120 The wizard-dialog subclass validates each step and writes config to
columns it creates the 4-window layout; at < 120 it drops back to ~/.passepartout/config.lisp~. Daisy-chaining: wizard provider selection
3-window and defers sidebar rendering to the overlay path. → API key entry → save confirmation. Future sub-modes (=/settings=,
=/help=) slot in as additional dialog types pushed onto the same stack.
** v0.8.0 — Command Palette Controller
~Ctrl+P~ opens the palette (sets ~:palette-visible~ to t, builds the
categorized item list via ~palette-items~, resets ~:palette-filter~
to empty string, sets ~:palette-selected-idx~ to 0). Subsequent
keypresses route through ~on-key-palette~:
- Printable characters → append to filter, re-filter ~:palette-items~
via ~palette-filter~, reset selection to 0
- Up/Down → decrement/increment ~:palette-selected-idx~, clamp to bounds
- Enter → execute ~palette-execute~ on selected item, dismiss palette
- Esc → dismiss palette without action
- Ctrl+P again → toggle dismiss
The palette items are defined in ~palette-items~ as a function returning
a categorized list. Each item carries its ~:name~ (display), ~:desc~
(tooltip), ~:shortcut~ (hint), and ~:action~ (a function of zero
arguments that sends the appropriate message or executes the command).
This design avoids duplicating command dispatch logic — palette actions
reuse the same ~send-daemon~ / ~add-msg~ / ~theme-switch~ calls that
~on-key~ uses.
** v0.8.0 — Setup Wizard Controller
The TUI setup wizard uses the same overlay window pattern as the palette.
~wizard-steps~ returns the ordered list of configuration steps (provider
selection, API key entry, connection verification, preferences). The
current step index is stored in ~:wizard-step~.
~wizard-next~ runs the current step's ~:validate~ function on the input
buffer. On pass, it increments ~:wizard-step~ and clears the input buffer.
On fail, it sets ~:wizard-error~ with the error message and stays on the
current step. The last step writes to ~.env~ and calls ~/reconnect~
to reload daemon configuration.
The wizard cancels on Esc (with confirmation) and resumes where left off
if the user reopens it within the same session. State is per-session only
— no disk persistence for incomplete wizards.
** Contract ** Contract
1. (on-key ch): dispatches key presses: Enter triggers send (extracts 1. (on-key ch): dispatches key presses: Enter triggers send (extracts
input buffer, pushes history, sends to daemon, clears buffer), input buffer, pushes history, sends to daemon, clears buffer),
~\\ + Enter~ inserts a literal newline (multi-line input), ~\\ + Enter~ inserts a literal newline (multi-line input),
~/help~ lists all commands, ~/eval <expr>~ evaluates a Lisp
expression, ~/focus <proj>~ switches project context,
~/scope <scope>~ changes context scope, ~/unfocus~ pops context,
Tab completes command names, Backspace deletes, arrows scroll Tab completes command names, Backspace deletes, arrows scroll
chat and history. chat and history.
v0.7.0: Ctrl+U clears line, Ctrl+W deletes word, Ctrl+A/E home/end, v0.7.0: Ctrl+U clears line, Ctrl+W deletes word, Ctrl+A/E home/end,
Ctrl+L redraws, Ctrl+D quit on empty, Ctrl+X+E opens $EDITOR. Ctrl+L redraws, Ctrl+D quit on empty, Ctrl+X+E opens $EDITOR.
v0.8.0: when a dialog is on cl-tty's ~cl-tty.dialog:*dialog-stack*~, keys route
through ~minibuffer-handle-key~ instead of normal input. Typing =/=
as the first character opens a ~select-dialog~ with ~*slash-commands*~.
Non-printable keys are ignored. Non-printable keys are ignored.
2. (on-daemon-msg msg): processes inbound daemon messages. Routes 2. (on-daemon-msg msg): processes inbound daemon messages. Routes
text responses to chat display (:agent), handshake to system text responses to chat display (:agent), handshake to system
@@ -84,24 +48,31 @@ if the user reopens it within the same session. State is per-session only
over the framed TCP protocol. over the framed TCP protocol.
4. (tui-main): the main loop — connects to daemon, initializes 4. (tui-main): the main loop — connects to daemon, initializes
Croatoan windows, optionally starts Swank REPL, runs Croatoan windows, optionally starts Swank REPL, runs
render/input event loop at ~30fps. render/input event loop at ~30fps. Renders dialog overlays when
cl-tty's ~cl-tty.dialog:*dialog-stack*~ is non-nil.
5. (on-key-sidebar key): v0.8.0 — handles sidebar-specific 5. (on-key-sidebar key): v0.8.0 — handles sidebar-specific
keybindings: Ctrl+X+B toggles sidebar, Esc dismisses overlay. keybindings: Ctrl+X+B toggles sidebar, Esc dismisses overlay.
6. (on-key-palette key): v0.8.0 — handles command palette keypresses: 6. (*slash-commands*): v0.8.0 — list of ~25 command plists, each
Up/Down navigate items, Enter executes selection, Esc dismisses with ~:name~ (display string), ~:desc~ (tooltip), and ~:action~
palette, printable characters append to filter string. (thunk that dispatches the command). Drives cl-tty's ~Select~ widget.
7. (passepartout.channel-tui::palette-items): v0.8.0 — returns categorized command list as 7. (open-minibuffer): v0.8.0 — pushes a ~select-dialog~ onto cl-tty's
~((:category "Session" :items ((:name ... :desc ... :shortcut ... :action ...) ...)) ...)~. ~cl-tty.dialog:*dialog-stack*~ with ~*slash-commands*~ as options. Sets the
8. (palette-filter items query): v0.8.0 — returns items from the select's ~:on-select~ to dispatch the chosen command.
categorized list whose ~:name~ or ~:desc~ contains ~query~ 8. (minibuffer-handle-key ch): v0.8.0 — converts Croatoan key code CH
(case-insensitive substring match). Category headers preserved. to a cl-tty ~key-event~, then routes through the active dialog's
9. (palette-execute selected-item): v0.8.0 — calls the selected ~select-handle-key~. Returns T if handled (dialog consumed the key).
item's ~:action~ function. Dismisses palette. 9. (make-wizard-dialog): v0.8.0 — creates a multi-step wizard dialog:
10. (wizard-steps): v0.8.0 — returns ordered list of setup step provider selection → API key entry → save confirmation. Returns a
definitions: ~(:title <str> :prompt <str> :validate <fn> :next <fn>)~. ~dialog~ instance pushed onto ~cl-tty.dialog:*dialog-stack*~. Each step validates
11. (wizard-next): v0.8.0 — runs current step's ~:validate~ on before advancing. Final step writes ~/.passepartout/config.lisp~.
input buffer. On pass, increments ~:wizard-step~ and clears 10. (*daemon-commands*): v0.8.0 — list of ~16 daemon command plists,
input. On fail, sets ~:wizard-error~. Returns new step index. organized by category (Session, Memory, System, Help), each with
~:title~, ~:value~, ~:desc~, ~:action~, and optional ~:category t~
for headers. Drives the command palette (~ctrl-tty Select~).
11. (open-command-palette): v0.8.0 — pushes a ~select-dialog~ onto
~cl-tty.dialog:*dialog-stack*~ with ~*daemon-commands*~ as options.
Categories are rendered as dimmed headers; selection dispatches the
command's ~:action~ thunk. Opens on Ctrl+P.
** Event Handlers ** Event Handlers
#+begin_src lisp #+begin_src lisp
@@ -129,64 +100,11 @@ if the user reopens it within the same session. State is per-session only
(t raw))) (t raw)))
raw))) raw)))
(cond (cond
;; v0.8.0: palette mode — handle palette keypresses first ;; v0.8.0: minibuffer dialog active — route through cl-tty select
((and (st :palette-visible) (or (eql ch 27) (eq ch :escape))) ((and (boundp 'cl-tty.dialog:*dialog-stack*)
(setf (st :palette-visible) nil) cl-tty.dialog:*dialog-stack*
(minibuffer-handle-key ch))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
((and (st :palette-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
(let* ((filtered (palette-filter (st :palette-items) (st :palette-filter)))
(idx (st :palette-selected-idx))
(n 0)
(item nil))
(loop for group in filtered
for gitems = (getf group :items)
when (and (< n (length gitems)) (<= n idx (+ n (length gitems) -1)))
do (setf item (nth (- idx n) gitems))
(loop-finish)
do (incf n (length gitems)))
(passepartout.channel-tui::palette-execute item)
(setf (st :palette-visible) nil)
(setf (st :dirty) (list t t t))))
((and (st :palette-visible) (eq ch :up))
(setf (st :palette-selected-idx) (max 0 (1- (st :palette-selected-idx))))
(setf (st :dirty) (list nil t nil)))
((and (st :palette-visible) (eq ch :down))
(setf (st :palette-selected-idx) (min 999 (1+ (st :palette-selected-idx))))
(setf (st :dirty) (list nil t nil)))
((and (st :palette-visible) (integerp ch) (>= ch 32) (<= ch 126))
(let ((c (code-char ch)))
(setf (st :palette-filter) (concatenate 'string (or (st :palette-filter) "") (string c)))
(setf (st :palette-selected-idx) 0)
(setf (st :dirty) (list nil t nil))))
((and (st :palette-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
(let ((f (st :palette-filter)))
(when (and f (> (length f) 0))
(setf (st :palette-filter) (subseq f 0 (1- (length f))))
(setf (st :palette-selected-idx) 0)
(setf (st :dirty) (list nil t nil)))))
;; v0.8.0: setup wizard — handle wizard keypresses
((and (st :wizard-visible) (or (eql ch 27) (eq ch :escape)))
(wizard-cancel))
((and (st :wizard-visible) (or (eql ch 13) (eql ch 10) (eq ch :enter)))
(wizard-next))
((and (st :wizard-visible) (or (eq ch :backspace) (eql ch 127) (eql ch 8)))
(let ((input (or (st :wizard-input) "")))
(when (> (length input) 0)
(setf (st :wizard-input) (subseq input 0 (1- (length input))))
(setf (st :wizard-error) nil)
(setf (st :dirty) (list nil t nil)))))
((and (st :wizard-visible) (eql ch 2)) ; Ctrl+B — back
(let ((step-idx (st :wizard-step)))
(when (> step-idx 0)
(setf (st :wizard-step) (1- step-idx)
(st :wizard-input) ""
(st :wizard-error) nil)
(setf (st :dirty) (list nil t nil)))))
((and (st :wizard-visible) (integerp ch) (>= ch 32) (<= ch 126))
(let ((c (code-char ch)))
(setf (st :wizard-input) (concatenate 'string (or (st :wizard-input) "") (string c)))
(setf (st :wizard-error) nil)
(setf (st :dirty) (list nil t nil))))
;; v0.7.1: Esc — interrupt streaming ;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text)) ((and (eql ch 27) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (send-daemon (list :type :event :payload '(:action :cancel-stream)))
@@ -288,10 +206,15 @@ if the user reopens it within the same session. State is per-session only
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search ((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages")) (add-msg :system "Use /search <query> to find messages"))
((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer
(wizard-start) (open-minibuffer)
;; If minibuffer opens, simulate typing /setup to filter to it
(when cl-tty.dialog:*dialog-stack*
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(when (typep sel 'select)
(setf (cl-tty.select:select-filter sel) "setup"))))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate collapse
(let ((gate-idx nil)) (let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (st :messages) i)
@@ -313,12 +236,10 @@ if the user reopens it within the same session. State is per-session only
(setf (st :pending-ctrl-x) nil) (setf (st :pending-ctrl-x) nil)
(passepartout.channel-tui::sidebar-toggle) (passepartout.channel-tui::sidebar-toggle)
(add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden"))) (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden")))
((eql ch 16) ; Ctrl+P — command palette ((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands)
(setf (st :palette-visible) t (progn
(st :palette-filter) "" (open-command-palette)
(st :palette-selected-idx) 0 (setf (st :dirty) (list t t nil))))
(st :palette-items) (passepartout.channel-tui::palette-items))
(setf (st :dirty) (list t t nil)))
((eql ch 4) ; Ctrl+D — quit on empty ((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
@@ -570,10 +491,13 @@ if the user reopens it within the same session. State is per-session only
(add-msg :system "/help [topic] Show this help") (add-msg :system "/help [topic] Show this help")
(add-msg :system "\\ + Enter Multi-line input") (add-msg :system "\\ + Enter Multi-line input")
(add-msg :system "Ctrl+G Toggle gate trace")) (add-msg :system "Ctrl+G Toggle gate trace"))
;; /setup command — open wizard ;; /setup command — open minibuffer filtered to setup
((string-equal text "/setup") ((string-equal text "/setup")
(wizard-start) (open-minibuffer)
(add-msg :system "Setup wizard opened (Ctrl+W)") (when cl-tty.dialog:*dialog-stack*
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(when (typep sel 'select)
(setf (cl-tty.select:select-filter sel) "setup"))))
(setf (st :dirty) (list t t nil))) (setf (st :dirty) (list t t nil)))
;; /theme command ;; /theme command
((string-equal text "/theme") ((string-equal text "/theme")
@@ -763,158 +687,261 @@ if the user reopens it within the same session. State is per-session only
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t)))))))) (setf (st :dirty) (list nil nil t))))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun palette-items () ;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog
"Returns categorized command list for the palette."
(let ((items nil)) (defvar *slash-commands*
(push (list :category "Session" :items (list (list :name "/focus" :desc "Set project context"
(list (list :name "/focus" :desc "Set project context" :shortcut "C-o" :action (lambda () (add-msg :system "/focus")))
:action (lambda () (add-msg :system "/focus <project>")))
(list :name "/scope" :desc "Change context scope" (list :name "/scope" :desc "Change context scope"
:action (lambda () (add-msg :system "/scope memex|session|project"))) :action (lambda () (add-msg :system "/scope memex|session|project")))
(list :name "/unfocus" :desc "Pop context stack" (list :name "/unfocus" :desc "Pop context stack"
:action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
(list :name "/search" :desc "Search messages" :shortcut "C-f" (list :name "/search" :desc "Search messages"
:action (lambda () (add-msg :system "Use /search <query> to find messages"))))) :action (lambda () (add-msg :system "Use /search <query>")))
items) (list :name "/why" :desc "Show last gate trace"
(push (list :category "Agent" :items
(list (list :name "/why" :desc "Show last gate trace" :shortcut "C-g"
:action (lambda () (add-msg :system "Gate trace: use /why"))) :action (lambda () (add-msg :system "Gate trace: use /why")))
(list :name "/audit" :desc "Inspect memory object" (list :name "/audit" :desc "Inspect memory object"
:action (lambda () (add-msg :system "/audit <node-id>"))) :action (lambda () (add-msg :system "/audit <node-id>")))
(list :name "/context" :desc "Show context budget" (list :name "/context" :desc "Show context budget"
:action (lambda () (add-msg :system "/context"))))) :action (lambda () (add-msg :system "/context")))
items) (list :name "/theme" :desc "Switch color theme"
(push (list :category "View" :items :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox")))
(list (list :name "/theme" :desc "Switch color theme" (list :name "/sidebar" :desc "Toggle sidebar"
:action (lambda () (add-msg :system "Presets: dark light solarized gruvbox nord tokyonight catppuccin monokai")))
(list :name "/sidebar" :desc "Toggle sidebar" :shortcut "C-x C-b"
:action #'sidebar-toggle) :action #'sidebar-toggle)
(list :name "/help" :desc "Show all commands" (list :name "/help" :desc "Show all commands"
:action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar"))))) :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
items) (list :name "/setup" :desc "Run setup wizard"
(push (list :category "System" :items :action (lambda () (make-wizard-dialog)))
(list (list :name "/setup" :desc "Run setup wizard" :shortcut "C-\\"
:action (lambda () (wizard-start)
(add-msg :system "Setup wizard opened")
(setf (st :dirty) (list t t nil))))
(list :name "/eval" :desc "Evaluate Lisp expression" (list :name "/eval" :desc "Evaluate Lisp expression"
:action (lambda () (add-msg :system "/eval <expr>"))) :action (lambda () (add-msg :system "/eval <expr>")))
(list :name "/reconnect" :desc "Reconnect to daemon" (list :name "/reconnect" :desc "Reconnect to daemon"
:action (lambda () (disconnect-daemon) (connect-daemon))) :action (lambda () (disconnect-daemon) (connect-daemon)))
(list :name "/quit" :desc "Save history and exit" :shortcut "C-d" (list :name "/quit" :desc "Save history and exit"
:action (lambda () (add-msg :system "* Goodbye *") :action (lambda () (add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit))) (send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil))))) (setf (st :running) nil))))
items) "~25 slash commands driving cl-tty's Select widget in the minibuffer.")
(nreverse items)))
(defun palette-execute (selected-item) (defun open-minibuffer ()
"Execute the selected palette item's action." "Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack."
(when (and selected-item (getf selected-item :action)) (cl-tty.dialog:push-dialog
(funcall (getf selected-item :action)))) (cl-tty.dialog:select-dialog
"Commands"
(loop for cmd in *slash-commands*
collect (list :title (getf cmd :name)
:value cmd
:desc (getf cmd :desc)))
:on-select (lambda (opt)
(let ((cmd (getf opt :value))
(action (when cmd (getf cmd :action))))
(when action (funcall action)))))))
(defun wizard-steps () (defvar *daemon-commands*
"Returns the ordered list of setup wizard steps."
(list (list
(list :title "Provider Selection" ;; Category: Session
:prompt "LLM provider (openai, anthropic, ollama, openrouter, deepseek, groq):" (list :title "── Session ──" :category t)
:validate (lambda (input) (list :title "Focus Project" :value :focus :desc "Set project context"
(let ((provider (string-downcase (string-trim '(#\Space) input)))) :action (lambda () (add-msg :system "Usage: /focus <project>")))
(if (member provider '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") (list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project"
:test #'string=) :action (lambda () (add-msg :system "Usage: /scope memex|session|project")))
(progn (setf (st :wizard-provider) provider) nil) (list :title "Unfocus" :value :unfocus :desc "Pop context stack"
(format nil "Unknown provider: ~a" input))))) :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus)))))
(list :title "API Key" (list :title "Show Context" :value :context :desc "Show context budget summary"
:prompt (format nil "API key for ~a:" (or (st :wizard-provider) "provider")) :action (lambda () (add-msg :system "Use /context for budget or /context why <id> for node details")))
:validate (lambda (input) ;; Category: Memory
(let ((key (string-trim '(#\Space) input))) (list :title "── Memory ──" :category t)
(if (> (length key) 4) (list :title "List Sessions" :value :sessions :desc "List memory snapshots"
(progn (setf (st :wizard-api-key) key) nil) :action (lambda () (add-msg :system "Use /sessions to list snapshots")))
"Key too short — enter a valid API key")))) (list :title "Rewind" :value :rewind :desc "Rewind to snapshot"
(list :title "Memory" :action (lambda () (add-msg :system "Usage: /rewind <number>")))
:prompt "Max memory entries? (default: 1000, Enter to accept):" (list :title "Audit Node" :value :audit :desc "Inspect memory object"
:validate (lambda (input) :action (lambda () (add-msg :system "Usage: /audit <node-id>")))
(let ((val (string-trim '(#\Space) input))) ;; Category: System
(if (or (string= val "") (string= val "1000")) (list :title "── System ──" :category t)
(progn (setf (st :wizard-memory) "1000") nil) (list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon"
(if (every #'digit-char-p val) :action (lambda () (disconnect-daemon) (connect-daemon)))
(progn (setf (st :wizard-memory) val) nil) (list :title "Quit" :value :quit :desc "Save history and exit"
"Enter a number"))))) :action (lambda () (add-msg :system "* Goodbye *")
(list :title "Review & Save" (send-daemon (list :type :event :payload '(:action :quit)))
:prompt "Save configuration? (yes/no):" (setf (st :running) nil)))
:validate (lambda (input) ;; Category: Help
(let ((val (string-downcase (string-trim '(#\Space) input)))) (list :title "── Help ──" :category t)
(list :title "Show Help" :value :help :desc "Show all commands"
:action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ...")))
(list :title "Why" :value :why :desc "Show last gate trace"
:action (lambda () (add-msg :system "Use /why to see last gate trace")))
(list :title "Identity" :value :identity :desc "Edit IDENTITY.org"
:action (lambda () (add-msg :system "Use /identity to edit")))
(list :title "Tags" :value :tags :desc "List tag severities"
:action (lambda () (add-msg :system "Use /tags to list tag severities"))))
"Daemon commands for the command palette (Ctrl+P), organized by category.")
(defun open-command-palette ()
"Push a select-dialog with *daemon-commands* onto cl-tty's dialog stack.
Ctrl+P opens this palette. Categories: Session, Memory, System, Help."
(cl-tty.dialog:push-dialog
(cl-tty.dialog:select-dialog
"Command Palette"
(loop for cmd in *daemon-commands*
collect (list :title (getf cmd :title)
:value cmd
:desc (getf cmd :desc)
:category (getf cmd :category)))
:on-select (lambda (opt)
(let ((cmd (getf opt :value))
(action (when cmd (getf cmd :action))))
(when action (funcall action)))))))
(defun croatoan-to-tty-event (ch)
"Convert a Croatoan key code to a cl-tty key-event struct."
(typecase ch
(keyword
(case ch
(:up (cl-tty.input:make-key-event :key :up))
(:down (cl-tty.input:make-key-event :key :down))
(:enter (cl-tty.input:make-key-event :key :enter))
(:escape (cl-tty.input:make-key-event :key :escape))
(:backspace (cl-tty.input:make-key-event :key :backspace))
(:ppage (cl-tty.input:make-key-event :key :page-up))
(:npage (cl-tty.input:make-key-event :key :page-down))
(t (cl-tty.input:make-key-event :key ch))))
(integer
(cond (cond
((string= val "yes") ((= ch 27) (cl-tty.input:make-key-event :key :escape))
(wizard-write-config) ((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter))
nil) ((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace))
((string= val "no") ((= ch 259) (cl-tty.input:make-key-event :key :up))
(setf (st :wizard-visible) nil ((= ch 258) (cl-tty.input:make-key-event :key :down))
(st :wizard-step) 0 ((= ch 260) (cl-tty.input:make-key-event :key :left))
(st :wizard-error) nil) ((= ch 261) (cl-tty.input:make-key-event :key :right))
(add-msg :system "Wizard cancelled — run /setup to restart") ((= ch 339) (cl-tty.input:make-key-event :key :page-up))
nil) ((= ch 338) (cl-tty.input:make-key-event :key :page-down))
(t "Type 'yes' to save or 'no' to cancel"))))))) ((<= 1 ch 26) (cl-tty.input:make-key-event
:key (intern (string (code-char (+ #x60 ch))) :keyword)
:ctrl t))
((<= 32 ch 126) (cl-tty.input:make-key-event
:key (intern (string (char-upcase (code-char ch))) :keyword)))
(t (cl-tty.input:make-key-event :key :unknown :code ch))))
(t nil)))
(defun wizard-start () (defun minibuffer-handle-key (ch)
"Open the setup wizard at step 0." "Route Croatoan key through the active dialog's select widget.
(setf (st :wizard-visible) t Printable chars update the filter; special keys route through cl-tty.select:select-handle-key.
(st :wizard-step) 0 Returns T if the dialog consumed the key."
(st :wizard-input) "" (let ((stack cl-tty.dialog:*dialog-stack*))
(st :wizard-error) nil (unless stack (return-from minibuffer-handle-key nil))
(st :wizard-provider) nil (let* ((dialog (first stack))
(st :wizard-api-key) nil (content (cl-tty.dialog:dialog-content dialog)))
(st :wizard-memory) nil)) (unless (typep content 'cl-tty.select:select)
(return-from minibuffer-handle-key nil))
;; Backspace: pop last filter char (if any) or pop dialog when empty
(when (or (eql ch :backspace) (eql ch 263) (eql ch 127) (eql ch 8))
(let ((f (cl-tty.select:select-filter content)))
(if (and f (> (length f) 0))
(progn (setf (cl-tty.select:select-filter content) (subseq f 0 (1- (length f))))
(cl-tty.select::select-clamp-index content)
t)
(progn (cl-tty.dialog:pop-dialog) t))))
;; Escape: pop the dialog
(when (or (eql ch 27) (eq ch :escape))
(cl-tty.dialog:pop-dialog)
t)
;; Printable: append to filter if dialog is a select
(when (and (integerp ch) (<= 32 ch 126))
(let* ((c (code-char ch))
(f (or (cl-tty.select:select-filter content) "")))
(setf (cl-tty.select:select-filter content)
(concatenate 'string f (string c)))
(cl-tty.select::select-clamp-index content)
t))
;; Route through cl-tty.select:select-handle-key for navigation/selection
(let ((ev (croatoan-to-tty-event ch)))
(when ev
(handler-case
(cl-tty.select:select-handle-key content ev)
(error () nil)))))))
(defun wizard-next () (defun make-wizard-dialog ()
"Validate current step input; advance on success, show error on failure." "Create a setup wizard dialog daisy-chain: provider select → API key → save.
(let ((steps (wizard-steps)) Validates at each step; final step writes ~/.passepartout/config.lisp."
(step-idx (st :wizard-step))) (let* ((state (list :provider nil :api-key nil :memory "1000" :step 0))
(when (< step-idx (length steps)) (step-labels '("Provider" "API Key" "Memory" "Review & Save"))
(let* ((step (nth step-idx steps)) (step-fns
(validate-fn (getf step :validate)) (list
(error-msg (funcall validate-fn (or (st :wizard-input) "")))) ;; Step 0: provider selection
(if error-msg (lambda (input)
(setf (st :wizard-error) error-msg (let ((p (string-downcase (string-trim '(#\Space) input))))
(st :dirty) (list nil t nil)) (if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=)
(if (= step-idx (1- (length steps))) (progn (setf (getf state :provider) p) nil)
(progn (format nil "Unknown provider: ~a" input))))
(setf (st :wizard-visible) nil ;; Step 1: API key
(st :wizard-step) 0 (lambda (input)
(st :wizard-error) nil) (let ((k (string-trim '(#\Space) input)))
(add-msg :system "Configuration saved. Run /reconnect to reload.")) (if (> (length k) 4)
(setf (st :wizard-step) (1+ step-idx) (progn (setf (getf state :api-key) k) nil)
(st :wizard-input) "" "Key too short")))
(st :wizard-error) nil ;; Step 2: memory limit
(st :dirty) (list nil t nil)))))))) (lambda (input)
(let ((v (string-trim '(#\Space) input)))
(defun wizard-cancel () (if (or (string= v "") (string= v "1000"))
"Dismiss the wizard, preserving state for resumption." nil
(setf (st :wizard-visible) nil (if (every #'digit-char-p v)
(st :dirty) (list t t nil))) (progn (setf (getf state :memory) v) nil)
"Enter a number"))))
(defun wizard-write-config () ;; Step 3: save
"Write collected wizard data to .env and notify." (lambda (input)
(let ((provider (st :wizard-provider)) (let ((v (string-downcase (string-trim '(#\Space) input))))
(api-key (st :wizard-api-key)) (cond ((string= v "yes")
(memory (or (st :wizard-memory) "1000")) (let ((env-path (merge-pathnames ".passepartout/config.lisp"
(env-path (merge-pathnames ".env" (merge-pathnames "memex/" (user-homedir-pathname))))) (user-homedir-pathname))))
(handler-case (handler-case
(progn (progn
(uiop:ensure-all-directories-exist (list env-path)) (uiop:ensure-all-directories-exist (list env-path))
(with-open-file (out env-path :direction :output :if-exists :supersede :if-does-not-exist :create) (with-open-file (out env-path :direction :output
(format out "# Passepartout configuration (generated by setup wizard)~%") :if-exists :supersede
(format out "PROVIDER_CASCADE=~a~%" provider) :if-does-not-exist :create)
(format out "~:@(~a~)_API_KEY=~a~%" provider api-key) (format out ";; Passepartout configuration~%")
(format out "MEMORY_MAX_ENTRIES=~a~%" memory) (format out "(setf *provider* ~s)~%" (getf state :provider))
(format out "DAEMON_PORT=9105~%"))) (format out "(setf *api-key* ~s)~%" (getf state :api-key))
(error (c) (format out "(setf *memory-max-entries* ~s)~%" (getf state :memory))))
(setf (st :wizard-error) (format nil "Failed to write config: ~a" c))))) (error (c) (format nil "Write failed: ~a" c))))
(setf (st :wizard-visible) nil nil)
(st :wizard-step) 0 ((string= v "no") nil)
(st :wizard-error) nil) (t "Type 'yes' or 'no'")))))))
(add-msg :system (format nil "Configuration saved to memex/.env (~a). Run /reconnect to reload." provider))) (labels ((advance ()
(let* ((step (getf state :step))
(fn (nth step step-fns))
(err (funcall fn "ignored")))
(declare (ignore fn))
;; Push next prompt dialog or finish
(if (< step (1- (length step-labels)))
(progn
(setf (getf state :step) (1+ step))
(cl-tty.dialog:push-dialog
(cl-tty.dialog:prompt-dialog
(format nil "~a — ~a" (nth (getf state :step) step-labels)
(getf state :provider))
:on-submit (lambda (val)
(let ((validation (funcall (nth (getf state :step) step-fns) val)))
(if validation
(progn
(cl-tty.dialog:push-dialog
(cl-tty.dialog:alert-dialog "Error" validation))
(setf (getf state :step) (1- step)))
(advance)))))))
(add-msg :system (format nil "Configuration saved (~a). Run /reconnect."
(getf state :provider)))))))
;; Push the first prompt dialog
(cl-tty.dialog:push-dialog
(cl-tty.dialog:prompt-dialog
"Setup — LLM Provider"
:on-submit (lambda (val)
(let ((err (funcall (first step-fns) val)))
(if err
(cl-tty.dialog:push-dialog
(cl-tty.dialog:alert-dialog "Invalid" err))
(advance)))))))))
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
"Mark the most recent HITL panel message as resolved with DECISION." "Mark the most recent HITL panel message as resolved with DECISION."
@@ -1263,23 +1290,10 @@ if the user reopens it within the same session. State is per-session only
(when sidebar-w (when sidebar-w
(view-sidebar sidebar-w) (view-sidebar sidebar-w)
(refresh sidebar-w)) (refresh sidebar-w))
(when (st :palette-visible) ;; v0.8.0: render cl-tty dialog overlay when stack is non-empty
(let* ((pw (min 56 (floor (* w 0.7)))) (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
(ph (min 18 (floor (* h 0.6)))) cl-tty.dialog:*dialog-stack*)
(px (floor (- w pw) 2)) (render-dialog-overlay scr w h))
(py (floor (- h ph) 2))
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
(view-palette palette-win)
(refresh palette-win)
(close palette-win)))
(when (st :wizard-visible)
(let* ((ww 60) (wh 14)
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2))
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
(view-wizard wizard-win)
(refresh wizard-win)
(close wizard-win)))
(refresh scr) (refresh scr)
(loop while (st :running) do (loop while (st :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
@@ -1308,27 +1322,70 @@ if the user reopens it within the same session. State is per-session only
(and (not sidebar-wanted) sidebar-w)) (and (not sidebar-wanted) sidebar-w))
(recreate-windows w h) (recreate-windows w h)
(redraw sw cw ch iw))) (redraw sw cw ch iw)))
(when (st :palette-visible) ;; v0.8.0: render cl-tty dialog overlay
(let* ((pw (min 56 (floor (* w 0.7)))) (when (and (boundp 'cl-tty.dialog:*dialog-stack*)
(ph (min 18 (floor (* h 0.6)))) cl-tty.dialog:*dialog-stack*)
(px (floor (- w pw) 2)) (render-dialog-overlay scr w h))
(py (floor (- h ph) 2))
(palette-win (make-instance 'window :height ph :width pw :y py :x px)))
(view-palette palette-win)
(refresh palette-win)
(close palette-win)))
(when (st :wizard-visible)
(let* ((ww 60) (wh 14)
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2))
(wizard-win (make-instance 'window :height wh :width ww :y wy :x wx)))
(view-wizard wizard-win)
(refresh wizard-win)
(close wizard-win)))
(refresh scr) (refresh scr)
(sleep 0.03)) (sleep 0.03))
(disconnect-daemon)))) (disconnect-daemon))))
(defun render-dialog-overlay (scr w h)
"Render the top cl-tty dialog as a Croatoan overlay.
Draws a dimmed backdrop then a centered bordered panel with select options."
(let* ((dialog (first cl-tty.dialog:*dialog-stack*))
(title (cl-tty.dialog:dialog-title dialog))
(content (cl-tty.dialog:dialog-content dialog))
(ww (min 60 (- w 4)))
(wh (min 18 (- h 4)))
(wx (floor (- w ww) 2))
(wy (floor (- h wh) 2)))
;; Dimmed backdrop
(dotimes (row h)
(add-string scr (make-string w :initial-element #\Space)
:y row :x 0 :fgcolor (theme-color :dim) :bgcolor (theme-color :background)))
;; Dialog panel window
(let ((win (make-instance 'window :height wh :width ww :y wy :x wx)))
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(add-string win (format nil " ~a " title) :y 0 :x 2 :fgcolor (theme-color :accent))
;; Render select widget options
(when (typep content 'cl-tty.select:select)
(let* ((filtered (cl-tty.select:select-filtered-options content))
(sel-idx (cl-tty.select:select-selected-index content))
(filter-str (cl-tty.select:select-filter content))
(y 1))
;; Show filter line
(add-string win (format nil " > ~a_" (or filter-str ""))
:y y :x 2 :n (- ww 4) :fgcolor (theme-color :input))
(incf y)
;; Show filtered options
(dolist (item filtered)
(when (< y (1- wh))
(let* ((display-idx (first item))
(option (third item))
(title-str (getf option :title))
(desc (getf option :desc))
(is-selected (= display-idx sel-idx))
(fg (if is-selected (theme-color :highlight) (theme-color :agent))))
(when is-selected
(setf (color-pair win) (list (theme-color :highlight) (theme-color :dim)))
(add-string win (make-string (- ww 2) :initial-element #\Space)
:y y :x 1 :n (- ww 2))
(setf (color-pair win) (list (theme-color :border) (theme-color :background))))
(add-string win (format nil "~a ~a" (if is-selected ">" " ") title-str)
:y y :x 2 :n (min 25 (- ww 4)) :fgcolor fg)
(when (and desc (not is-selected))
(add-string win (format nil " ~a" desc) :y y :x 28 :n (- ww 30)
:fgcolor (theme-color :dim)))
(incf y))))
;; Footer hint
(add-string win (format nil " ~a/~a | ↑↓ Navigate Enter Execute Esc Close"
(1+ sel-idx) (length filtered))
:y (1- wh) :x 1 :n (- ww 2) :fgcolor (theme-color :dim))))
(refresh win)
(close win))))
(defun tui-main () (defun tui-main ()
(init-state) (init-state)
(load-history) (load-history)
@@ -1851,83 +1908,72 @@ if the user reopens it within the same session. State is per-session only
(on-key 2) ; Ctrl+B (on-key 2) ; Ctrl+B
(fiveam:is (eq t (st :sidebar-visible)))) (fiveam:is (eq t (st :sidebar-visible))))
(fiveam:test test-ctrl-p-opens-palette (fiveam:test test-ctrl-p-opens-command-palette
"Contract 6: Ctrl+P opens command palette." "Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)."
(init-state) (init-state)
(on-key 16) ; Ctrl+P (on-key 16) ; Ctrl+P
(fiveam:is (eq t (st :palette-visible))) (fiveam:is-true (and cl-tty.dialog:*dialog-stack*)))
(fiveam:is (not (null (st :palette-items))))
(fiveam:is (= 0 (st :palette-selected-idx))))
(fiveam:test test-palette-escape-dismisses (fiveam:test test-open-minibuffer-pushes-dialog
"Contract 6: Esc dismisses palette." "Contract 7: open-minibuffer pushes a dialog with a select content."
(init-state) (let ((cl-tty.dialog:*dialog-stack* nil))
(setf (st :palette-visible) t) (passepartout.channel-tui::open-minibuffer)
(on-key 27) ; Esc (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
(fiveam:is (null (st :palette-visible)))) (let ((item (first cl-tty.dialog:*dialog-stack*)))
(fiveam:is (string= "DIALOG" (symbol-name (class-name (class-of item)))))
(let ((content (cl-tty.dialog:dialog-content item)))
(fiveam:is (not (null content)))))))
(fiveam:test test-palette-enter-executes (fiveam:test test-slash-commands-count
"Contract 9: Enter executes selected item and dismisses palette." "Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action."
(init-state) (let ((cmds passepartout.channel-tui::*slash-commands*))
(setf (st :palette-visible) t (fiveam:is (>= (length cmds) 14))
(st :palette-selected-idx) 0 (dolist (c cmds)
(st :palette-items) (passepartout.channel-tui::palette-items)) (fiveam:is (stringp (getf c :name)))
(on-key (char-code #\/)) (fiveam:is (stringp (getf c :desc)))
(on-key (char-code #\t)) (fiveam:is (functionp (getf c :action))))))
(fiveam:is (string= "/t" (st :palette-filter))))
(fiveam:test test-palette-items-has-categories (fiveam:test test-daemon-commands-count
"Contract 7: palette-items returns categorized list with at least Session and View." "Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers."
(init-state) (let ((cmds passepartout.channel-tui::*daemon-commands*))
(let ((items (passepartout.channel-tui::palette-items))) (fiveam:is (>= (length cmds) 14))
(fiveam:is (listp items)) (dolist (c cmds)
(fiveam:is (find "Session" items :key (lambda (g) (getf g :category)) :test #'string=)) (if (getf c :category)
(fiveam:is (find "View" items :key (lambda (g) (getf g :category)) :test #'string=)))) (fiveam:is (stringp (getf c :title)))
(progn
(fiveam:is (stringp (getf c :title)))
(fiveam:is (stringp (getf c :desc)))
(fiveam:is (functionp (getf c :action))))))))
;; ── v0.8.0 Setup Wizard ── (fiveam:test test-minibuffer-handle-key-escape
"Contract 8: minibuffer-handle-key with Esc pops dialog."
(let ((cl-tty.dialog:*dialog-stack* nil))
(passepartout.channel-tui::open-minibuffer)
(fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*)))
(passepartout.channel-tui::minibuffer-handle-key 27) ; Esc
(fiveam:is (null cl-tty.dialog:*dialog-stack*))))
(fiveam:test test-wizard-steps-count (fiveam:test test-minibuffer-handle-key-backspace
"Contract v0.8.0: wizard-steps returns 4 steps." "Contract 8: Backspace pops filter char, then pops dialog on empty."
(let ((steps (passepartout.channel-tui::wizard-steps))) (let ((cl-tty.dialog:*dialog-stack* nil))
(fiveam:is (= 4 (length steps))))) (passepartout.channel-tui::open-minibuffer)
(let ((sel (cl-tty.dialog:dialog-content (first cl-tty.dialog:*dialog-stack*))))
(setf (cl-tty.select:select-filter sel) "te")
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
(fiveam:is (string= "t" (cl-tty.select:select-filter sel)))
(passepartout.channel-tui::minibuffer-handle-key 263) ; Backspace
(fiveam:is (string= "" (or (cl-tty.select:select-filter sel) ""))))))
(fiveam:test test-wizard-start-sets-visible (fiveam:test test-croatoan-to-tty-event-arrows
"Contract v0.8.0: wizard-start sets wizard-visible and resets state." "Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events."
(init-state) (let ((up (passepartout.channel-tui::croatoan-to-tty-event 259)))
(passepartout.channel-tui::wizard-start) (fiveam:is (cl-tty.input:key-event-p up))
(fiveam:is (eq t (st :wizard-visible))) (fiveam:is (eql :up (cl-tty.input:key-event-key up))))
(fiveam:is (= 0 (st :wizard-step))) (let ((down (passepartout.channel-tui::croatoan-to-tty-event 258)))
(fiveam:is (string= "" (st :wizard-input)))) (fiveam:is (eql :down (cl-tty.input:key-event-key down))))
(let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13)))
(fiveam:test test-wizard-cancel-hides (fiveam:is (eql :enter (cl-tty.input:key-event-key enter))))
"Contract v0.8.0: wizard-cancel hides the wizard." (let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27)))
(init-state) (fiveam:is (eql :escape (cl-tty.input:key-event-key esc)))))
(setf (st :wizard-visible) t)
(passepartout.channel-tui::wizard-cancel)
(fiveam:is (null (st :wizard-visible))))
(fiveam:test test-wizard-next-valid-advances
"Contract v0.8.0: valid input advances to next step."
(init-state)
(passepartout.channel-tui::wizard-start)
(setf (st :wizard-input) "openai")
(passepartout.channel-tui::wizard-next)
(fiveam:is (= 1 (st :wizard-step)))
(fiveam:is (string= "openai" (st :wizard-provider))))
(fiveam:test test-wizard-next-invalid-shows-error
"Contract v0.8.0: invalid input shows error and stays on current step."
(init-state)
(passepartout.channel-tui::wizard-start)
(setf (st :wizard-input) "invalid-provider")
(passepartout.channel-tui::wizard-next)
(fiveam:is (= 0 (st :wizard-step)))
(fiveam:is (not (null (st :wizard-error)))))
(fiveam:test test-ctrl-backslash-opens-wizard
"Contract v0.8.0: Ctrl+\\ opens the setup wizard."
(init-state)
(on-key 28) ; Ctrl+\
(fiveam:is (eq t (st :wizard-visible))))
#+end_src #+end_src

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

@@ -97,7 +97,10 @@ theme presets — defined but unused.
:view-status :view-chat :view-input :redraw :view-status :view-chat :view-input :redraw
:on-key :on-daemon-msg :send-daemon :on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon :connect-daemon :disconnect-daemon
:*tui-theme* :theme-color)) :*tui-theme* :theme-color
:*slash-commands* :open-minibuffer :minibuffer-handle-key
:view-conversation :render-user-msg :render-agent-msg
:render-sys-msg :render-tool-call :render-gate-trace))
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defvar *state* nil) (defvar *state* nil)
@@ -280,14 +283,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
: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
:minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0 :expand-tool-calls nil ; v0.8.0
:minibuffer-filter "" ; v0.8.0
:wizard-mode :provider-list ; v0.9.0
:wizard-selected-idx 0 :wizard-input "" ; v0.9.0
:wizard-error nil ; v0.9.0
:wizard-providers nil :wizard-current-provider nil ; v0.9.0
:wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0
:wizard-cascade-slot :fg-prob ; v0.9.0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
#+end_src #+end_src

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

@@ -72,35 +72,62 @@ This mirrors OpenCode's command palette pattern — a proven UX
convention that makes power commands discoverable without reading convention that makes power commands discoverable without reading
documentation. documentation.
** v0.8.0 — TUI Setup Wizard (deferred from v0.7.0) ** v0.8.0 — Conversation View: ScrollBox + Markdown
The TUI setup wizard replaces the terminal-based ~passepartout configure~ The chat conversation is the primary TUI surface — it shows every
flow with an in-TUI onboarding sequence. Users select LLM providers, message exchanged with the daemon. The v0.8.0 refactoring replaces
enter API keys, and verify connections — all within the same interface the ad-hoc ~view-chat~ with a ScrollBox-driven conversation view
they'll use daily. using cl-tty's markdown renderer and component model.
The wizard is a multi-step overlay with progress indicator. Each step Each message type has a dedicated render function:
defines a title, prompt text, validation function, and next-step function.
On validation failure, the step displays an error and stays on the current
step. On success, it advances. The last step writes configuration to
~.env~ and triggers daemon reload.
The wizard reuses the overlay infrastructure built for the command - *User messages*: ~render-user-msg~ — a colored line with role
palette and sidebar — same window creation patterns, same Croatoan prefix (green, "⬆ user"). Content is plain-text with word wrap.
rendering primitives. - *Agent messages*: ~render-agent-msg~ — rendered through cl-tty's
~parse-blocks~ + ~render-md~ for full markdown (bold, code,
links, blockquotes, code blocks with syntax highlighting, diffs).
- *System messages*: ~render-sys-msg~ — yellow, dimmed.
- *Tool executions*: ~render-tool-call~ — collapsible block showing
tool name, status (running ✓ ✗), duration, and truncated output.
Tab toggles expansion (~expand-tool-calls~ state).
- *Gate traces*: ~render-gate-trace~ — collapsible block (Ctrl+G
toggles per-message via ~collapsed-gates~ state).
Sticky-scroll: when the user is at the bottom (scroll-offset 0),
new messages auto-scroll into view. Manual scroll-up sets
~sticky-scroll~ nil until the user scrolls back to bottom.
~view-conversation~ replaces ~view-chat~. The ~redraw~ function
calls ~view-conversation~ instead.
** Contract ** Contract
1. (view-status win): renders the status bar with connection info, 1. (view-status win): renders the status bar with connection info,
msg count, scroll offset, rule counter, focus map (v0.4.0), and msg count, scroll offset, rule counter, focus map, and timestamp.
timestamp. Two lines: line 1 (status + rules), line 2 (focus + time). Two lines: line 1 (status + rules), line 2 (focus + time).
2. (view-chat win h): renders the scrolled chat message list. Takes 2. (view-conversation win h): renders the scrolled conversation using
window and available height. Messages are color-coded: green (user), cl-tty ScrollBox model. Dispatches per-role to dedicated render
white (agent), yellow (system). functions (~render-user-msg~, ~render-agent-msg~, ~render-sys-msg~,
~render-tool-call~, ~render-gate-trace~). Sticky-scroll auto-follows
when at bottom.
3. (view-input win): renders the input line with cursor and typing 3. (view-input win): renders the input line with cursor and typing
indicator. indicator.
4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~ 4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~
flags (status, chat, input). Minimizes terminal writes. flags (status, chat, input). Minimizes terminal writes.
5. (render-user-msg win content time w y): renders a user message
with green role-prefix, timestamp, and word-wrapped content.
Returns next y (v0.8.0).
6. (render-agent-msg win content time gate-trace w y collapsed):
renders an agent message through cl-tty's ~render-markdown~.
Gate trace rendered after content when not collapsed (v0.8.0).
7. (render-sys-msg win content w y): renders a system message in
yellow, dim style. Returns next y (v0.8.0).
8. (render-tool-call win tool-name status content w y): renders a
tool call with status indicator (running ✓ ✗), truncated output,
expandable via Tab. Returns next y (v0.8.0).
9. (render-gate-trace win trace w y): renders gate decisions as
colored lines (green passed, red blocked, yellow HITL).
Collapsible via Ctrl+G per message. Returns next y (v0.8.0).
5. (char-width ch): returns the terminal column width of character CH. 5. (char-width ch): returns the terminal column width of character CH.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
Tab = 8. Used by word-wrap for accurate line counting (v0.7.0). Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
@@ -185,7 +212,76 @@ that the TUI actuator attaches to the response plist before transmission.
(setf result (concatenate 'string result (subseq content pos))) (setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result)))) (if (string= result "") content result))))
(defun view-chat (win h) (defun render-user-msg (win content time w y)
"Render a user message with green role-prefix and timestamp. Returns next y."
(let* ((prefix (format nil "⬆ [~a] " time))
(line-text (concatenate 'string prefix content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :user))
(incf y)))
y))
(defun render-agent-msg (win content time w y)
"Render an agent message using cl-tty's markdown renderer. Returns next y."
(let* ((prefix (format nil "⬇ [~a] " time))
(header-len (length prefix)))
;; Role prefix line
(add-string win prefix :y y :x 1 :n header-len :fgcolor (theme-color :agent))
(incf y)
;; Markdown content — cl-tty's render-markdown produces ANSI-styled lines
(let ((md-lines (cl-tty.markdown:render-md
(cl-tty.markdown:parse-blocks content))))
(dolist (line md-lines)
(when (< y 9999)
;; Each line may contain ANSI escape codes; render through add-string
(add-string win line :y y :x 1 :n (- w 2) :fgcolor (theme-color :agent))
(incf y))))
y))
(defun render-sys-msg (win content w y)
"Render a system message in yellow, dim style. Returns next y."
(let* ((line-text (format nil " ~a" content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y 9999)
(add-string win line :y y :x 1 :n (1- w) :fgcolor (theme-color :system))
(incf y)))
y))
(defun render-tool-call (win tool-name status duration content w y tab-expanded)
"Render a tool call with status indicator. Tab toggles full output. Returns next y."
(let* ((status-char (case status (:running "…") (:success "✓") (:failure "✗") (t "?")))
(status-color (case status (:running (theme-color :tool-running))
(:success (theme-color :tool-success))
(:failure (theme-color :tool-failure))
(t (theme-color :dim))))
(summary (format nil " ~a ~a~@[ (~,1fs)~]" status-char tool-name duration)))
;; Summary line
(add-string win summary :y y :x 1 :n (- w 2) :fgcolor status-color)
(incf y)
;; Expanded output (when Tab pressed)
(when tab-expanded
(dolist (line (word-wrap content (- w 6)))
(when (< y 9999)
(add-string win (format nil " ~a" line) :y y :x 1 :n (- w 4) :fgcolor (theme-color :tool-output))
(incf y))))
y))
(defun render-gate-trace (win trace w y collapsed)
"Render gate decisions as colored lines. Ctrl+G toggles. Returns next y."
(unless collapsed
(dolist (entry (gate-trace-lines trace))
(when (< y 9999)
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))
y)
(defun view-conversation (win h)
"Render scrolled message list using cl-tty ScrollBox model.
Sticky-scroll: auto-follows new content when at bottom.
Each message role dispatched to its dedicated render function."
(clear win) (clear win)
(box win 0 0) (box win 0 0)
(let* ((w (or (width win) 78)) (let* ((w (or (width win) 78))
@@ -194,7 +290,7 @@ that the TUI actuator attaches to the response plist before transmission.
(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 ;; 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))
@@ -204,7 +300,10 @@ that the TUI actuator attaches to the response plist before transmission.
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight)) (add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(incf y) (incf y)
(decf max-lines))) (decf max-lines)))
;; Count visible messages from end, accounting for word wrap ;; Sticky-scroll: if at bottom, auto-follow
(when (and (zerop (st :scroll-offset)) (> total 0))
(setf (st :scroll-at-bottom) t))
;; Count visible messages from end
(let* ((msg-count 0) (let* ((msg-count 0)
(lines-remaining max-lines)) (lines-remaining max-lines))
(loop for i from (1- total) downto 0 (loop for i from (1- total) downto 0
@@ -213,17 +312,16 @@ that the TUI actuator attaches to the response plist before transmission.
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (nlines (case role
(content-show (if is-search (:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2))))
(search-highlight content (st :search-query)) (:agent (let ((header (format nil "⬇ [~a]" time)))
content)) (+ 1 (length (cl-tty.markdown:render-md
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (cl-tty.markdown:parse-blocks content))))))
(wrapped (word-wrap line-text (- w 2))) (t (length (word-wrap (format nil " ~a" content) (- w 2)))))))
(nlines (length wrapped)))
(if (<= nlines lines-remaining) (if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count)) (progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0)))) (setf lines-remaining 0))))
;; Render from the correct starting message ;; Render from start message
(let* ((scroll-skip (st :scroll-offset)) (let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip)))) (start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total (loop for i from start below total
@@ -232,36 +330,28 @@ that the TUI actuator attaches to the response plist before transmission.
(role (getf msg :role)) (role (getf msg :role))
(content (getf msg :content)) (content (getf msg :content))
(time (or (getf msg :time) "")) (time (or (getf msg :time) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (gate-trace (getf msg :gate-trace))
(prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (collapsed (member i (st :collapsed-gates)))
(is-panel (getf msg :panel)) (tool-name (getf msg :tool))
(is-resolved (getf msg :panel-resolved)) (tool-status (getf msg :tool-status))
(content-show (if is-search (tool-duration (getf msg :tool-duration))
(search-highlight content (st :search-query)) (tool-expanded (member i (st :expand-tool-calls))))
content)) (setf y (case role
(line-text (format nil "~a [~a] ~a" prefix time content-show)) (:user (render-user-msg win content time w y))
(wrapped (word-wrap line-text (- w 2)))) (:agent (progn
;; HITL panel: render with colored border (setf y (render-agent-msg win content time w y))
(when is-panel (when gate-trace
(setf color (if is-resolved (setf y (render-gate-trace win gate-trace w y collapsed)))
(theme-color :dim) y))
(theme-color :hitl)))) (t (render-sys-msg win content w y))))
(dolist (line wrapped) ;; Tool call block (attached to any role message)
(when (< y (1- h)) (when tool-name
(if (eq role :agent) (setf y (render-tool-call win tool-name tool-status tool-duration
(let ((segments (parse-markdown-spans line))) content w y tool-expanded)))))))
(setf y (render-styled win segments y 1 w))) ;; Sticky-scroll update
(progn (when (and (st :scroll-at-bottom) (plusp (length msgs)))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color) (setf (st :scroll-offset) 0))
(incf y))))) (refresh win)))
;; 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 (gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
#+end_src #+end_src
** Input Line ** Input Line
@@ -283,7 +373,7 @@ that the TUI actuator attaches to the response plist before transmission.
(defun redraw (sw cw ch iw) (defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty) (destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw)) (when sd (view-status sw))
(when cd (view-chat cw ch)) (when cd (view-conversation cw ch))
(when id (view-input iw)) (when id (view-input iw))
(setf (st :dirty) (list nil nil nil)))) (setf (st :dirty) (list nil nil nil))))
#+end_src #+end_src
@@ -616,46 +706,56 @@ Respects CJK/emoji char widths via char-width."
#+begin_src lisp #+begin_src lisp
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defun view-sidebar (win) ;; ── Sidebar Panel Slots ──
"Render 42-column sidebar with 7 panels: Gate Trace, Focus, Rules, Context, Files, Cost, Protection." ;; Each sidebar panel is a cl-tty slot registration with :mode :replace.
(clear win) ;; The sidebar orchestrates them in order, passing (win w h y) and
(setf (color-pair win) (list (theme-color :border) (theme-color :background))) ;; receiving the next y position.
(box win 0 0)
(let* ((w (or (width win) 42)) (defun render-sidebar-panel-header (win w y title)
(h (or (height win) 24)) (add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2)
(y 1) :fgcolor (theme-color :accent))
(gate-trace (st :gate-trace)) (1+ y))
(foveal-id (st :foveal-id))
(rule-count (or (st :rule-count) 0)) (cl-tty.slot:defslot :sidebar-gate-trace :mode :replace
(context-usage (st :context-usage)) :render-fn
(modified-files (st :modified-files)) (lambda (win w h y)
(session-cost (st :session-cost)) (let ((trace (st :gate-trace)))
(block-counts (st :block-counts))) (setf y (render-sidebar-panel-header win w y "Gate Trace"))
;; Panel 1: Gate Trace (if trace
(add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (dolist (entry (gate-trace-lines trace))
(incf y)
(if gate-trace
(dolist (entry (gate-trace-lines gate-trace))
(when (< y (1- h)) (when (< y (1- h))
(add-string win (car entry) :y y :x 2 :n (- w 4) (add-string win (car entry) :y y :x 2 :n (- w 4)
:fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim)))
(incf y))) (incf y)))
(add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 2: Focus y)))
(incf y)
(add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-focus :mode :replace
(incf y) :render-fn
(add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) (lambda (win w h y)
;; Panel 3: Rules (declare (ignore h))
(incf y 2) (setf y (render-sidebar-panel-header win w y "Focus"))
(add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (add-string win (format nil " ~a" (or (st :foveal-id) "(none)"))
(incf y) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map))
(add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count)) (+ y 2)))
;; Panel 4: Context gauge
(incf y 2) (cl-tty.slot:defslot :sidebar-rules :mode :replace
(add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) :render-fn
(incf y) (lambda (win w h y)
(let* ((pct (or context-usage 0)) (declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Rules"))
(add-string win (format nil " Rules: ~d" (or (st :rule-count) 0))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count))
(1+ y)))
(cl-tty.slot:defslot :sidebar-context :mode :replace
:render-fn
(lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Context"))
(let* ((pct (or (st :context-usage) 0))
(bar-width 30) (bar-width 30)
(filled (min bar-width (floor (* pct bar-width) 100))) (filled (min bar-width (floor (* pct bar-width) 100)))
(gauge-color (cond ((< pct 50) (theme-color :connected)) (gauge-color (cond ((< pct 50) (theme-color :connected))
@@ -667,12 +767,16 @@ Respects CJK/emoji char widths via char-width."
(make-string (- bar-width filled) :initial-element #\░) (make-string (- bar-width filled) :initial-element #\░)
pct) pct)
:y y :x 2 :n (- w 4) :fgcolor gauge-color)) :y y :x 2 :n (- w 4) :fgcolor gauge-color))
;; Panel 5: Files (1+ y)))
(incf y 2)
(add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-files :mode :replace
(incf y) :render-fn
(if modified-files (lambda (win w h y)
(dolist (f modified-files) (setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Files"))
(let ((files (st :modified-files)))
(if files
(dolist (f files)
(when (< y (1- h)) (when (< y (1- h))
(let ((fp (getf f :filepath)) (let ((fp (getf f :filepath))
(added (getf f :lines-added)) (added (getf f :lines-added))
@@ -684,32 +788,56 @@ Respects CJK/emoji char widths via char-width."
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y)))) (incf y))))
(add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 6: Cost y)))
(incf y 2)
(add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-cost :mode :replace
(incf y) :render-fn
(if session-cost (lambda (win w h y)
(declare (ignore h))
(setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Cost"))
(let ((cost (st :session-cost)))
(if cost
(progn (progn
(add-string win (format nil " Total: $~,4f" (getf session-cost :total)) (add-string win (format nil " Total: $~,4f" (getf cost :total))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))
(incf y) (incf y)
(add-string win (format nil " Calls: ~d" (getf session-cost :calls)) (add-string win (format nil " Calls: ~d" (getf cost :calls))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :agent))) :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)))
(add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no data)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
;; Panel 7: Protection (1+ y))))
(incf y 2)
(add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) (cl-tty.slot:defslot :sidebar-protection :mode :replace
(incf y) :render-fn
(if (and block-counts (> (getf block-counts :total) 0)) (lambda (win w h y)
(let ((by-gate (getf block-counts :by-gate))) (setf y (+ y 2))
(setf y (render-sidebar-panel-header win w y "Protection"))
(let ((bc (st :block-counts)))
(if (and bc (> (getf bc :total) 0))
(let ((by-gate (getf bc :by-gate)))
(dolist (entry (subseq by-gate 0 (min (length by-gate) 6))) (dolist (entry (subseq by-gate 0 (min (length by-gate) 6)))
(when (< y (1- h)) (when (< y (1- h))
(add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) (add-string win (format nil " ~a: ~d" (car entry) (cdr entry))
:y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked))
(incf y)))) (incf y))))
(add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) (add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim)))
y)))
(defun view-sidebar (win)
"Render 42-column sidebar with panel slots: Gate Trace, Focus, Rules, Context, Files, Cost, Protection."
(clear win)
(setf (color-pair win) (list (theme-color :border) (theme-color :background)))
(box win 0 0)
(let ((w (or (width win) 42))
(h (or (height win) 24))
(y 1))
(dolist (panel '(:sidebar-gate-trace :sidebar-focus :sidebar-rules
:sidebar-context :sidebar-files :sidebar-cost
:sidebar-protection))
(let ((result (cl-tty.slot:slot-render panel win w h y)))
(when result (setf y (min (1- h) result)))))
(refresh win) (refresh win)
(- y 1))) (1- y)))
(defun view-minibuffer (win) (defun view-minibuffer (win)
"Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode." "Render the bottom-anchored minibuffer panel. Dispatches on :minibuffer-mode."
@@ -718,7 +846,7 @@ Respects CJK/emoji char widths via char-width."
(:wizard (view-wizard-in-panel win)) (:wizard (view-wizard-in-panel win))
(t nil))) (t nil)))
(defvar *slash-commands* nil) ; forward declaration — defined in channel-tui-main (declaim (special *slash-commands*)) ; forward declaration — defined in channel-tui-main
(defun view-slash-menu (win) (defun view-slash-menu (win)
"Render the slash-command menu: filter bar, filtered command list, selection highlight." "Render the slash-command menu: filter bar, filtered command list, selection highlight."
@@ -912,20 +1040,8 @@ Respects CJK/emoji char widths via char-width."
(is (getf presets name) (format nil "~a preset should exist" name))))) (is (getf presets name) (format nil "~a preset should exist" name)))))
(test test-minibuffer-init-state-fields (test test-minibuffer-init-state-fields
"Contract v0.8.0: init-state includes minibuffer-mode, selected-idx, filter; excludes palette and wizard-visible." "Contract v0.8.0: init-state no longer has legacy palette/wizard fields."
(passepartout.channel-tui::init-state) (passepartout.channel-tui::init-state)
(is (null (passepartout.channel-tui::st :minibuffer-mode))) (is (null (getf passepartout.channel-tui::*state* :mode)))
(is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx))) (is (null (getf passepartout.channel-tui::*state* :palette-visible))))
(is (string= "" (passepartout.channel-tui::st :minibuffer-filter)))
(is (null (getf passepartout.channel-tui::*state* :palette-visible)))
(is (null (getf passepartout.channel-tui::*state* :wizard-visible))))
(test test-slash-commands-entry-count
"Contract v0.8.0: *slash-commands* has at least 19 entries, each with :name, :desc, :action."
(let ((cmds passepartout.channel-tui::*slash-commands*))
(is (>= (length cmds) 19))
(dolist (c cmds)
(is (stringp (getf c :name)))
(is (stringp (getf c :desc)))
(is (functionp (getf c :action))))))
#+end_src #+end_src

2
passepartout.asd
View File

@@ -16,7 +16,7 @@
(:file "lisp/core-pipeline"))) (:file "lisp/core-pipeline")))
(defsystem :passepartout/tui (defsystem :passepartout/tui
:depends-on (:passepartout :croatoan :usocket :bordeaux-threads) :depends-on (:passepartout :croatoan :cl-tty :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")