diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index 18c924a..e340433 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -36,31 +36,89 @@ On release: ** 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: :ID: id-v080-minibuffer :CREATED: [2026-05-10 Sat] :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: -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. - -- Add ~:minibuffer-mode~ and ~:minibuffer-selected-idx~ state fields to ~init-state~ -- Extract ~*slash-commands*~ data structure (~25 commands, each with description) from the ~on-key~ Enter handler -- Add ~view-minibuffer~ that dispatches on ~:minibuffer-mode~ to ~view-slash-menu~, ~view-wizard-in-panel~ -- 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 +- ~ScrollBox~ with ~sticky-scroll~ (auto-follows new content, respects manual scroll-up) +- User messages rendered as ~Box~ (role-colored left border) +- Agent messages rendered via cl-tty's ~Markdown~ + ~Code~ + ~Diff~ renderables +- Tool calls rendered as ~Select~ (collapsible, status-indicated: spinner running / green done / red error) +- Gate trace as a collapsible ~Box~ within agent messages (property-drawer style) ~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 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 ~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 :PROPERTIES: diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index fda24f2..cf3fbc8 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -21,66 +21,13 @@ (338 :npage) (t raw))) raw))) - (cond - ;; v0.8.0: palette mode — handle palette keypresses first - ((and (st :palette-visible) (or (eql ch 27) (eq ch :escape))) - (setf (st :palette-visible) 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 + (cond + ;; v0.8.0: minibuffer dialog active — route through cl-tty select + ((and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack* + (minibuffer-handle-key ch)) + (setf (st :dirty) (list t t nil))) + ;; v0.7.1: Esc — interrupt streaming ((and (eql ch 27) (st :streaming-text)) (send-daemon (list :type :event :payload '(:action :cancel-stream))) (when (> (length (st :messages)) 0) @@ -181,10 +128,15 @@ (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) ((eql ch 6) ; v0.7.2 Ctrl+F — message search (add-msg :system "Use /search to find messages")) - ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard - (wizard-start) + ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer + (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))) - ((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)) (loop for i from (1- (length (st :messages))) downto 0 for m = (aref (st :messages) i) @@ -206,35 +158,33 @@ (setf (st :pending-ctrl-x) nil) (passepartout.channel-tui::sidebar-toggle) (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden"))) - ((eql ch 16) ; Ctrl+P — command palette - (setf (st :palette-visible) t - (st :palette-filter) "" - (st :palette-selected-idx) 0 - (st :palette-items) (passepartout.channel-tui::palette-items)) - (setf (st :dirty) (list t t nil))) - ((eql ch 4) ; Ctrl+D — quit on empty - (when (or (null (st :input-buffer)) (string= "" (input-string))) - (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) - ((eql ch 6) ; v0.7.2 Ctrl+F — message search - (add-msg :system "Use /search to find messages")) - ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse - (let ((gate-idx nil)) - (loop for i from (1- (length (st :messages))) downto 0 - for m = (aref (st :messages) i) - when (and (getf m :gate-trace) (listp (getf m :gate-trace))) - do (setf gate-idx i) (loop-finish)) - (if gate-idx - (let ((cg (st :collapsed-gates))) - (if (member gate-idx cg) - (setf (st :collapsed-gates) (remove gate-idx cg)) - (push gate-idx (st :collapsed-gates))) - (add-msg :system (format nil "Gate trace ~a for msg ~a" - (if (member gate-idx (st :collapsed-gates)) "hidden" "shown") - gate-idx)) - (setf (st :dirty) (list nil t nil))) - (add-msg :system "No gate trace to toggle")))) - ((eql ch 24) ; Ctrl+X prefix - (setf (st :pending-ctrl-x) t)) + ((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands) + (progn + (open-command-palette) + (setf (st :dirty) (list t t nil)))) + ((eql ch 4) ; Ctrl+D — quit on empty + (when (or (null (st :input-buffer)) (string= "" (input-string))) + (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) + ((eql ch 6) ; v0.7.2 Ctrl+F — message search + (add-msg :system "Use /search to find messages")) + ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse + (let ((gate-idx nil)) + (loop for i from (1- (length (st :messages))) downto 0 + for m = (aref (st :messages) i) + when (and (getf m :gate-trace) (listp (getf m :gate-trace))) + do (setf gate-idx i) (loop-finish)) + (if gate-idx + (let ((cg (st :collapsed-gates))) + (if (member gate-idx cg) + (setf (st :collapsed-gates) (remove gate-idx cg)) + (push gate-idx (st :collapsed-gates))) + (add-msg :system (format nil "Gate trace ~a for msg ~a" + (if (member gate-idx (st :collapsed-gates)) "hidden" "shown") + gate-idx)) + (setf (st :dirty) (list nil t nil))) + (add-msg :system "No gate trace to toggle")))) + ((eql ch 24) ; Ctrl+X prefix + (setf (st :pending-ctrl-x) t)) ((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor (setf (st :pending-ctrl-x) nil) (add-msg :system "Opening $EDITOR... save and exit to return.") @@ -463,11 +413,14 @@ (add-msg :system "/help [topic] Show this help") (add-msg :system "\\ + Enter Multi-line input") (add-msg :system "Ctrl+G Toggle gate trace")) - ;; /setup command — open wizard - ((string-equal text "/setup") - (wizard-start) - (add-msg :system "Setup wizard opened (Ctrl+W)") - (setf (st :dirty) (list t t nil))) + ;; /setup command — open minibuffer filtered to setup + ((string-equal text "/setup") + (open-minibuffer) + (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))) ;; /theme command ((string-equal text "/theme") (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" @@ -647,167 +600,270 @@ (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) page-size)))) (setf (st :dirty) (list nil t nil))) ;; Printable - (t - (let ((chr (typecase ch - (character ch) - (integer (code-char ch)) - (t nil)))) - (when (and chr (graphic-char-p chr)) - (input-insert-char chr) - (setf (st :dirty) (list nil nil t)))))))) + (t + (let ((chr (typecase ch + (character ch) + (integer (code-char ch)) + (t nil)))) + (when (and chr (graphic-char-p chr)) + (input-insert-char chr) + (setf (st :dirty) (list nil nil t)))))))) -;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny -(defun palette-items () - "Returns categorized command list for the palette." - (let ((items nil)) - (push (list :category "Session" :items - (list (list :name "/focus" :desc "Set project context" :shortcut "C-o" - :action (lambda () (add-msg :system "/focus "))) - (list :name "/scope" :desc "Change context scope" - :action (lambda () (add-msg :system "/scope memex|session|project"))) - (list :name "/unfocus" :desc "Pop context stack" - :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) - (list :name "/search" :desc "Search messages" :shortcut "C-f" - :action (lambda () (add-msg :system "Use /search to find messages"))))) - items) - (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"))) - (list :name "/audit" :desc "Inspect memory object" - :action (lambda () (add-msg :system "/audit "))) - (list :name "/context" :desc "Show context budget" - :action (lambda () (add-msg :system "/context"))))) - items) - (push (list :category "View" :items - (list (list :name "/theme" :desc "Switch color theme" - :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) - (list :name "/help" :desc "Show all commands" - :action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar"))))) - items) - (push (list :category "System" :items - (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" - :action (lambda () (add-msg :system "/eval "))) - (list :name "/reconnect" :desc "Reconnect to daemon" - :action (lambda () (disconnect-daemon) (connect-daemon))) - (list :name "/quit" :desc "Save history and exit" :shortcut "C-d" - :action (lambda () (add-msg :system "* Goodbye *") - (send-daemon (list :type :event :payload '(:action :quit))) - (setf (st :running) nil))))) - items) - (nreverse items))) -(defun palette-execute (selected-item) - "Execute the selected palette item's action." - (when (and selected-item (getf selected-item :action)) - (funcall (getf selected-item :action)))) +;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog -(defun wizard-steps () - "Returns the ordered list of setup wizard steps." +(defvar *slash-commands* + (list (list :name "/focus" :desc "Set project context" + :action (lambda () (add-msg :system "/focus"))) + (list :name "/scope" :desc "Change context scope" + :action (lambda () (add-msg :system "/scope memex|session|project"))) + (list :name "/unfocus" :desc "Pop context stack" + :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) + (list :name "/search" :desc "Search messages" + :action (lambda () (add-msg :system "Use /search "))) + (list :name "/why" :desc "Show last gate trace" + :action (lambda () (add-msg :system "Gate trace: use /why"))) + (list :name "/audit" :desc "Inspect memory object" + :action (lambda () (add-msg :system "/audit "))) + (list :name "/context" :desc "Show context budget" + :action (lambda () (add-msg :system "/context"))) + (list :name "/theme" :desc "Switch color theme" + :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox"))) + (list :name "/sidebar" :desc "Toggle sidebar" + :action #'sidebar-toggle) + (list :name "/help" :desc "Show all commands" + :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ..."))) + (list :name "/setup" :desc "Run setup wizard" + :action (lambda () (make-wizard-dialog))) + (list :name "/eval" :desc "Evaluate Lisp expression" + :action (lambda () (add-msg :system "/eval "))) + (list :name "/reconnect" :desc "Reconnect to daemon" + :action (lambda () (disconnect-daemon) (connect-daemon))) + (list :name "/quit" :desc "Save history and exit" + :action (lambda () (add-msg :system "* Goodbye *") + (send-daemon (list :type :event :payload '(:action :quit))) + (setf (st :running) nil)))) + "~25 slash commands driving cl-tty's Select widget in the minibuffer.") + +(defun open-minibuffer () + "Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack." + (cl-tty.dialog:push-dialog + (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))))))) + +(defvar *daemon-commands* (list - (list :title "Provider Selection" - :prompt "LLM provider (openai, anthropic, ollama, openrouter, deepseek, groq):" - :validate (lambda (input) - (let ((provider (string-downcase (string-trim '(#\Space) input)))) - (if (member provider '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") - :test #'string=) - (progn (setf (st :wizard-provider) provider) nil) - (format nil "Unknown provider: ~a" input))))) - (list :title "API Key" - :prompt (format nil "API key for ~a:" (or (st :wizard-provider) "provider")) - :validate (lambda (input) - (let ((key (string-trim '(#\Space) input))) - (if (> (length key) 4) - (progn (setf (st :wizard-api-key) key) nil) - "Key too short — enter a valid API key")))) - (list :title "Memory" - :prompt "Max memory entries? (default: 1000, Enter to accept):" - :validate (lambda (input) - (let ((val (string-trim '(#\Space) input))) - (if (or (string= val "") (string= val "1000")) - (progn (setf (st :wizard-memory) "1000") nil) - (if (every #'digit-char-p val) - (progn (setf (st :wizard-memory) val) nil) - "Enter a number"))))) - (list :title "Review & Save" - :prompt "Save configuration? (yes/no):" - :validate (lambda (input) - (let ((val (string-downcase (string-trim '(#\Space) input)))) - (cond - ((string= val "yes") - (wizard-write-config) - nil) - ((string= val "no") - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system "Wizard cancelled — run /setup to restart") - nil) - (t "Type 'yes' to save or 'no' to cancel"))))))) + ;; Category: Session + (list :title "── Session ──" :category t) + (list :title "Focus Project" :value :focus :desc "Set project context" + :action (lambda () (add-msg :system "Usage: /focus "))) + (list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project" + :action (lambda () (add-msg :system "Usage: /scope memex|session|project"))) + (list :title "Unfocus" :value :unfocus :desc "Pop context stack" + :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) + (list :title "Show Context" :value :context :desc "Show context budget summary" + :action (lambda () (add-msg :system "Use /context for budget or /context why for node details"))) + ;; Category: Memory + (list :title "── Memory ──" :category t) + (list :title "List Sessions" :value :sessions :desc "List memory snapshots" + :action (lambda () (add-msg :system "Use /sessions to list snapshots"))) + (list :title "Rewind" :value :rewind :desc "Rewind to snapshot" + :action (lambda () (add-msg :system "Usage: /rewind "))) + (list :title "Audit Node" :value :audit :desc "Inspect memory object" + :action (lambda () (add-msg :system "Usage: /audit "))) + ;; Category: System + (list :title "── System ──" :category t) + (list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon" + :action (lambda () (disconnect-daemon) (connect-daemon))) + (list :title "Quit" :value :quit :desc "Save history and exit" + :action (lambda () (add-msg :system "* Goodbye *") + (send-daemon (list :type :event :payload '(:action :quit))) + (setf (st :running) nil))) + ;; Category: Help + (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 wizard-start () - "Open the setup wizard at step 0." - (setf (st :wizard-visible) t - (st :wizard-step) 0 - (st :wizard-input) "" - (st :wizard-error) nil - (st :wizard-provider) nil - (st :wizard-api-key) nil - (st :wizard-memory) nil)) +(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 wizard-next () - "Validate current step input; advance on success, show error on failure." - (let ((steps (wizard-steps)) - (step-idx (st :wizard-step))) - (when (< step-idx (length steps)) - (let* ((step (nth step-idx steps)) - (validate-fn (getf step :validate)) - (error-msg (funcall validate-fn (or (st :wizard-input) "")))) - (if error-msg - (setf (st :wizard-error) error-msg - (st :dirty) (list nil t nil)) - (if (= step-idx (1- (length steps))) - (progn - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system "Configuration saved. Run /reconnect to reload.")) - (setf (st :wizard-step) (1+ step-idx) - (st :wizard-input) "" - (st :wizard-error) nil - (st :dirty) (list nil t nil)))))))) +(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 + ((= ch 27) (cl-tty.input:make-key-event :key :escape)) + ((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter)) + ((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace)) + ((= ch 259) (cl-tty.input:make-key-event :key :up)) + ((= ch 258) (cl-tty.input:make-key-event :key :down)) + ((= ch 260) (cl-tty.input:make-key-event :key :left)) + ((= ch 261) (cl-tty.input:make-key-event :key :right)) + ((= ch 339) (cl-tty.input:make-key-event :key :page-up)) + ((= ch 338) (cl-tty.input:make-key-event :key :page-down)) + ((<= 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-cancel () - "Dismiss the wizard, preserving state for resumption." - (setf (st :wizard-visible) nil - (st :dirty) (list t t nil))) +(defun minibuffer-handle-key (ch) + "Route Croatoan key through the active dialog's select widget. + Printable chars update the filter; special keys route through cl-tty.select:select-handle-key. + Returns T if the dialog consumed the key." + (let ((stack cl-tty.dialog:*dialog-stack*)) + (unless stack (return-from minibuffer-handle-key nil)) + (let* ((dialog (first stack)) + (content (cl-tty.dialog:dialog-content dialog))) + (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-write-config () - "Write collected wizard data to .env and notify." - (let ((provider (st :wizard-provider)) - (api-key (st :wizard-api-key)) - (memory (or (st :wizard-memory) "1000")) - (env-path (merge-pathnames ".env" (merge-pathnames "memex/" (user-homedir-pathname))))) - (handler-case - (progn - (uiop:ensure-all-directories-exist (list env-path)) - (with-open-file (out env-path :direction :output :if-exists :supersede :if-does-not-exist :create) - (format out "# Passepartout configuration (generated by setup wizard)~%") - (format out "PROVIDER_CASCADE=~a~%" provider) - (format out "~:@(~a~)_API_KEY=~a~%" provider api-key) - (format out "MEMORY_MAX_ENTRIES=~a~%" memory) - (format out "DAEMON_PORT=9105~%"))) - (error (c) - (setf (st :wizard-error) (format nil "Failed to write config: ~a" c))))) - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system (format nil "Configuration saved to memex/.env (~a). Run /reconnect to reload." provider))) +(defun make-wizard-dialog () + "Create a setup wizard dialog daisy-chain: provider select → API key → save. + Validates at each step; final step writes ~/.passepartout/config.lisp." + (let* ((state (list :provider nil :api-key nil :memory "1000" :step 0)) + (step-labels '("Provider" "API Key" "Memory" "Review & Save")) + (step-fns + (list + ;; Step 0: provider selection + (lambda (input) + (let ((p (string-downcase (string-trim '(#\Space) input)))) + (if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=) + (progn (setf (getf state :provider) p) nil) + (format nil "Unknown provider: ~a" input)))) + ;; Step 1: API key + (lambda (input) + (let ((k (string-trim '(#\Space) input))) + (if (> (length k) 4) + (progn (setf (getf state :api-key) k) nil) + "Key too short"))) + ;; Step 2: memory limit + (lambda (input) + (let ((v (string-trim '(#\Space) input))) + (if (or (string= v "") (string= v "1000")) + nil + (if (every #'digit-char-p v) + (progn (setf (getf state :memory) v) nil) + "Enter a number")))) + ;; Step 3: save + (lambda (input) + (let ((v (string-downcase (string-trim '(#\Space) input)))) + (cond ((string= v "yes") + (let ((env-path (merge-pathnames ".passepartout/config.lisp" + (user-homedir-pathname)))) + (handler-case + (progn + (uiop:ensure-all-directories-exist (list env-path)) + (with-open-file (out env-path :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (format out ";; Passepartout configuration~%") + (format out "(setf *provider* ~s)~%" (getf state :provider)) + (format out "(setf *api-key* ~s)~%" (getf state :api-key)) + (format out "(setf *memory-max-entries* ~s)~%" (getf state :memory)))) + (error (c) (format nil "Write failed: ~a" c)))) + nil) + ((string= v "no") nil) + (t "Type 'yes' or 'no'"))))))) + (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) "Mark the most recent HITL panel message as resolved with DECISION." @@ -1144,23 +1200,10 @@ (when sidebar-w (view-sidebar sidebar-w) (refresh sidebar-w)) - (when (st :palette-visible) - (let* ((pw (min 56 (floor (* w 0.7)))) - (ph (min 18 (floor (* h 0.6)))) - (px (floor (- w pw) 2)) - (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))) + ;; v0.8.0: render cl-tty dialog overlay when stack is non-empty + (when (and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack*) + (render-dialog-overlay scr w h)) (refresh scr) (loop while (st :running) do (dolist (ev (drain-queue)) @@ -1189,27 +1232,70 @@ (and (not sidebar-wanted) sidebar-w)) (recreate-windows w h) (redraw sw cw ch iw))) - (when (st :palette-visible) - (let* ((pw (min 56 (floor (* w 0.7)))) - (ph (min 18 (floor (* h 0.6)))) - (px (floor (- w pw) 2)) - (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))) + ;; v0.8.0: render cl-tty dialog overlay + (when (and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack*) + (render-dialog-overlay scr w h)) (refresh scr) (sleep 0.03)) (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 () (init-state) (load-history) @@ -1725,81 +1811,70 @@ (on-key 2) ; Ctrl+B (fiveam:is (eq t (st :sidebar-visible)))) -(fiveam:test test-ctrl-p-opens-palette - "Contract 6: Ctrl+P opens command palette." +(fiveam:test test-ctrl-p-opens-command-palette + "Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)." (init-state) (on-key 16) ; Ctrl+P - (fiveam:is (eq t (st :palette-visible))) - (fiveam:is (not (null (st :palette-items)))) - (fiveam:is (= 0 (st :palette-selected-idx)))) + (fiveam:is-true (and cl-tty.dialog:*dialog-stack*))) -(fiveam:test test-palette-escape-dismisses - "Contract 6: Esc dismisses palette." - (init-state) - (setf (st :palette-visible) t) - (on-key 27) ; Esc - (fiveam:is (null (st :palette-visible)))) +(fiveam:test test-open-minibuffer-pushes-dialog + "Contract 7: open-minibuffer pushes a dialog with a select content." + (let ((cl-tty.dialog:*dialog-stack* nil)) + (passepartout.channel-tui::open-minibuffer) + (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*))) + (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 - "Contract 9: Enter executes selected item and dismisses palette." - (init-state) - (setf (st :palette-visible) t - (st :palette-selected-idx) 0 - (st :palette-items) (passepartout.channel-tui::palette-items)) - (on-key (char-code #\/)) - (on-key (char-code #\t)) - (fiveam:is (string= "/t" (st :palette-filter)))) +(fiveam:test test-slash-commands-count + "Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action." + (let ((cmds passepartout.channel-tui::*slash-commands*)) + (fiveam:is (>= (length cmds) 14)) + (dolist (c cmds) + (fiveam:is (stringp (getf c :name))) + (fiveam:is (stringp (getf c :desc))) + (fiveam:is (functionp (getf c :action)))))) -(fiveam:test test-palette-items-has-categories - "Contract 7: palette-items returns categorized list with at least Session and View." - (init-state) - (let ((items (passepartout.channel-tui::palette-items))) - (fiveam:is (listp items)) - (fiveam:is (find "Session" items :key (lambda (g) (getf g :category)) :test #'string=)) - (fiveam:is (find "View" items :key (lambda (g) (getf g :category)) :test #'string=)))) +(fiveam:test test-daemon-commands-count + "Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers." + (let ((cmds passepartout.channel-tui::*daemon-commands*)) + (fiveam:is (>= (length cmds) 14)) + (dolist (c cmds) + (if (getf c :category) + (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 - "Contract v0.8.0: wizard-steps returns 4 steps." - (let ((steps (passepartout.channel-tui::wizard-steps))) - (fiveam:is (= 4 (length steps))))) +(fiveam:test test-minibuffer-handle-key-backspace + "Contract 8: Backspace pops filter char, then pops dialog on empty." + (let ((cl-tty.dialog:*dialog-stack* nil)) + (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 - "Contract v0.8.0: wizard-start sets wizard-visible and resets state." - (init-state) - (passepartout.channel-tui::wizard-start) - (fiveam:is (eq t (st :wizard-visible))) - (fiveam:is (= 0 (st :wizard-step))) - (fiveam:is (string= "" (st :wizard-input)))) - -(fiveam:test test-wizard-cancel-hides - "Contract v0.8.0: wizard-cancel hides the wizard." - (init-state) - (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)))) +(fiveam:test test-croatoan-to-tty-event-arrows + "Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events." + (let ((up (passepartout.channel-tui::croatoan-to-tty-event 259))) + (fiveam:is (cl-tty.input:key-event-p up)) + (fiveam:is (eql :up (cl-tty.input:key-event-key up)))) + (let ((down (passepartout.channel-tui::croatoan-to-tty-event 258))) + (fiveam:is (eql :down (cl-tty.input:key-event-key down)))) + (let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13))) + (fiveam:is (eql :enter (cl-tty.input:key-event-key enter)))) + (let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27))) + (fiveam:is (eql :escape (cl-tty.input:key-event-key esc))))) diff --git a/lisp/channel-tui-state.lisp b/lisp/channel-tui-state.lisp index 638d9ef..168b165 100644 --- a/lisp/channel-tui-state.lisp +++ b/lisp/channel-tui-state.lisp @@ -5,7 +5,10 @@ :view-status :view-chat :view-input :redraw :on-key :on-daemon-msg :send-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) (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-matches nil :search-match-idx 0 :sidebar-visible nil ; v0.8.0 - :minibuffer-mode nil :minibuffer-selected-idx 0 ; 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 + :expand-tool-calls nil ; v0.8.0 :dirty (list nil nil nil)))) (defun now () diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index ce020e4..003601c 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -40,7 +40,76 @@ (setf result (concatenate 'string result (subseq content pos))) (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) (box win 0 0) (let* ((w (or (width win) 78)) @@ -49,7 +118,7 @@ (max-lines (- h 2)) (is-search (st :search-mode)) (y 1)) - ;; v0.7.2: search mode header + ;; Search mode header (when is-search (let* ((matches (st :search-matches)) (idx (st :search-match-idx)) @@ -59,26 +128,28 @@ (add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight)) (incf y) (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) (lines-remaining max-lines)) (loop for i from (1- total) downto 0 while (> lines-remaining 0) do (let* ((msg (aref msgs i)) - (role (getf msg :role)) - (content (getf msg :content)) - (time (or (getf msg :time) "")) - (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) - (content-show (if is-search - (search-highlight content (st :search-query)) - content)) - (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2))) - (nlines (length wrapped))) + (role (getf msg :role)) + (content (getf msg :content)) + (time (or (getf msg :time) "")) + (nlines (case role + (:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2)))) + (:agent (let ((header (format nil "⬇ [~a]" time))) + (+ 1 (length (cl-tty.markdown:render-md + (cl-tty.markdown:parse-blocks content)))))) + (t (length (word-wrap (format nil " ~a" content) (- w 2))))))) (if (<= nlines lines-remaining) (progn (decf lines-remaining nlines) (incf msg-count)) (setf lines-remaining 0)))) - ;; Render from the correct starting message + ;; Render from start message (let* ((scroll-skip (st :scroll-offset)) (start (max 0 (- total msg-count scroll-skip)))) (loop for i from start below total @@ -87,36 +158,28 @@ (role (getf msg :role)) (content (getf msg :content)) (time (or (getf msg :time) "")) - (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) - (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) - (is-panel (getf msg :panel)) - (is-resolved (getf msg :panel-resolved)) - (content-show (if is-search - (search-highlight content (st :search-query)) - content)) - (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2)))) - ;; HITL panel: render with colored border - (when is-panel - (setf color (if is-resolved - (theme-color :dim) - (theme-color :hitl)))) - (dolist (line wrapped) - (when (< y (1- h)) - (if (eq role :agent) - (let ((segments (parse-markdown-spans line))) - (setf y (render-styled win segments y 1 w))) - (progn - (add-string win line :y y :x 1 :n (1- w) :fgcolor color) - (incf y))))) - ;; v0.7.2: gate trace below agent messages - (let ((gate-trace (getf msg :gate-trace))) - (when (and gate-trace (not (member i (st :collapsed-gates)))) - (dolist (entry (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)) + (gate-trace (getf msg :gate-trace)) + (collapsed (member i (st :collapsed-gates))) + (tool-name (getf msg :tool)) + (tool-status (getf msg :tool-status)) + (tool-duration (getf msg :tool-duration)) + (tool-expanded (member i (st :expand-tool-calls)))) + (setf y (case role + (:user (render-user-msg win content time w y)) + (:agent (progn + (setf y (render-agent-msg win content time w y)) + (when gate-trace + (setf y (render-gate-trace win gate-trace w y collapsed))) + y)) + (t (render-sys-msg win content w y)))) + ;; Tool call block (attached to any role message) + (when tool-name + (setf y (render-tool-call win tool-name tool-status tool-duration + content w y tool-expanded))))))) + ;; Sticky-scroll update + (when (and (st :scroll-at-bottom) (plusp (length msgs))) + (setf (st :scroll-offset) 0)) + (refresh win))) (defun view-input (win) (let* ((text (input-string)) @@ -132,7 +195,7 @@ (defun redraw (sw cw ch iw) (destructuring-bind (sd cd id) (st :dirty) (when sd (view-status sw)) - (when cd (view-chat cw ch)) + (when cd (view-conversation cw ch)) (when id (view-input iw)) (setf (st :dirty) (list nil nil nil)))) @@ -450,46 +513,56 @@ Respects CJK/emoji char widths via char-width." (in-package :passepartout.channel-tui) -(defun view-sidebar (win) - "Render 42-column sidebar with 7 panels: 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) - (gate-trace (st :gate-trace)) - (foveal-id (st :foveal-id)) - (rule-count (or (st :rule-count) 0)) - (context-usage (st :context-usage)) - (modified-files (st :modified-files)) - (session-cost (st :session-cost)) - (block-counts (st :block-counts))) - ;; Panel 1: Gate Trace - (add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if gate-trace - (dolist (entry (gate-trace-lines gate-trace)) - (when (< y (1- h)) - (add-string win (car entry) :y y :x 2 :n (- w 4) - :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) - (incf y))) - (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) - ;; Panel 2: Focus - (incf y) - (add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) - ;; Panel 3: Rules - (incf y 2) - (add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count)) - ;; Panel 4: Context gauge - (incf y 2) - (add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (let* ((pct (or context-usage 0)) +;; ── Sidebar Panel Slots ── +;; Each sidebar panel is a cl-tty slot registration with :mode :replace. +;; The sidebar orchestrates them in order, passing (win w h y) and +;; receiving the next y position. + +(defun render-sidebar-panel-header (win w y title) + (add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2) + :fgcolor (theme-color :accent)) + (1+ y)) + +(cl-tty.slot:defslot :sidebar-gate-trace :mode :replace + :render-fn + (lambda (win w h y) + (let ((trace (st :gate-trace))) + (setf y (render-sidebar-panel-header win w y "Gate Trace")) + (if trace + (dolist (entry (gate-trace-lines trace)) + (when (< y (1- h)) + (add-string win (car entry) :y y :x 2 :n (- w 4) + :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) + (incf y))) + (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + y))) + +(cl-tty.slot:defslot :sidebar-focus :mode :replace + :render-fn + (lambda (win w h y) + (declare (ignore h)) + (setf y (render-sidebar-panel-header win w y "Focus")) + (add-string win (format nil " ~a" (or (st :foveal-id) "(none)")) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) + (+ y 2))) + +(cl-tty.slot:defslot :sidebar-rules :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 "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) (filled (min bar-width (floor (* pct bar-width) 100))) (gauge-color (cond ((< pct 50) (theme-color :connected)) @@ -501,49 +574,77 @@ Respects CJK/emoji char widths via char-width." (make-string (- bar-width filled) :initial-element #\░) pct) :y y :x 2 :n (- w 4) :fgcolor gauge-color)) - ;; Panel 5: Files - (incf y 2) - (add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if modified-files - (dolist (f modified-files) - (when (< y (1- h)) - (let ((fp (getf f :filepath)) - (added (getf f :lines-added)) - (removed (getf f :lines-removed))) - (add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]" - (subseq fp (max 0 (- (length fp) 30))) - (when (> added 0) added) - (when (> removed 0) removed)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) - (incf y)))) - (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) - ;; Panel 6: Cost - (incf y 2) - (add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if session-cost - (progn - (add-string win (format nil " Total: $~,4f" (getf session-cost :total)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) - (incf y) - (add-string win (format nil " Calls: ~d" (getf session-cost :calls)) - :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))) - ;; Panel 7: Protection - (incf y 2) - (add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if (and block-counts (> (getf block-counts :total) 0)) - (let ((by-gate (getf block-counts :by-gate))) - (dolist (entry (subseq by-gate 0 (min (length by-gate) 6))) + (1+ y))) + +(cl-tty.slot:defslot :sidebar-files :mode :replace + :render-fn + (lambda (win w h y) + (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)) - (add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) - (incf y)))) - (add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + (let ((fp (getf f :filepath)) + (added (getf f :lines-added)) + (removed (getf f :lines-removed))) + (add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]" + (subseq fp (max 0 (- (length fp) 30))) + (when (> added 0) added) + (when (> removed 0) removed)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) + (incf y)))) + (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + y))) + +(cl-tty.slot:defslot :sidebar-cost :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 "Cost")) + (let ((cost (st :session-cost))) + (if cost + (progn + (add-string win (format nil " Total: $~,4f" (getf cost :total)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) + (incf y) + (add-string win (format nil " Calls: ~d" (getf cost :calls)) + :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))) + (1+ y)))) + +(cl-tty.slot:defslot :sidebar-protection :mode :replace + :render-fn + (lambda (win w h y) + (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))) + (when (< y (1- h)) + (add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) + (incf y)))) + (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) - (- y 1))) + (1- y))) (defun view-minibuffer (win) "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)) (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) "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))))) (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) - (is (null (passepartout.channel-tui::st :minibuffer-mode))) - (is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx))) - (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)))))) + (is (null (getf passepartout.channel-tui::*state* :mode))) + (is (null (getf passepartout.channel-tui::*state* :palette-visible)))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 4b0ae97..bfbe8ae 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -5,74 +5,38 @@ 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 -~Ctrl+X~ prefix sets ~:pending-ctrl-x~ (existing infrastructure from -v0.7.0); ~Ctrl+B~ on the next keystroke toggles ~:sidebar-visible~ and -sets dirty flags to force redraw. +Replaces ad-hoc palette + wizard overlays with cl-tty's Dialog stack. +Typing =/= as the first character opens a ~select-dialog~ with ~25 slash +commands filtered in real time. Selecting a command dispatches it; +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, -the sidebar is a permanent fourth Croatoan window in a 4-column layout -(sidebar | content). At < 120 columns, the layout stays 3-window -(status | chat | input) and the sidebar renders as an overlay when -toggled, drawn as an absolute-positioned window on top of the chat area. +~*slash-commands*~ is the single source of truth for available commands. +~open-minibuffer~ pushes the select-dialog. ~minibuffer-handle-key~ +converts Croatoan key codes to cl-tty ~key-event~ structs and delegates +to ~select-handle-key~. Printable characters update the Select's filter; +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 -columns it creates the 4-window layout; at < 120 it drops back to -3-window and defers sidebar rendering to the overlay path. - -** 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. +The wizard-dialog subclass validates each step and writes config to +~/.passepartout/config.lisp~. Daisy-chaining: wizard provider selection +→ API key entry → save confirmation. Future sub-modes (=/settings=, +=/help=) slot in as additional dialog types pushed onto the same stack. ** Contract 1. (on-key ch): dispatches key presses: Enter triggers send (extracts input buffer, pushes history, sends to daemon, clears buffer), ~\\ + Enter~ inserts a literal newline (multi-line input), - ~/help~ lists all commands, ~/eval ~ evaluates a Lisp - expression, ~/focus ~ switches project context, - ~/scope ~ changes context scope, ~/unfocus~ pops context, Tab completes command names, Backspace deletes, arrows scroll chat and history. 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. + 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. 2. (on-daemon-msg msg): processes inbound daemon messages. Routes 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. 4. (tui-main): the main loop — connects to daemon, initializes 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 keybindings: Ctrl+X+B toggles sidebar, Esc dismisses overlay. -6. (on-key-palette key): v0.8.0 — handles command palette keypresses: - Up/Down navigate items, Enter executes selection, Esc dismisses - palette, printable characters append to filter string. -7. (passepartout.channel-tui::palette-items): v0.8.0 — returns categorized command list as - ~((:category "Session" :items ((:name ... :desc ... :shortcut ... :action ...) ...)) ...)~. -8. (palette-filter items query): v0.8.0 — returns items from the - categorized list whose ~:name~ or ~:desc~ contains ~query~ - (case-insensitive substring match). Category headers preserved. -9. (palette-execute selected-item): v0.8.0 — calls the selected - item's ~:action~ function. Dismisses palette. -10. (wizard-steps): v0.8.0 — returns ordered list of setup step - definitions: ~(:title :prompt :validate :next )~. -11. (wizard-next): v0.8.0 — runs current step's ~:validate~ on - input buffer. On pass, increments ~:wizard-step~ and clears - input. On fail, sets ~:wizard-error~. Returns new step index. +6. (*slash-commands*): v0.8.0 — list of ~25 command plists, each + with ~:name~ (display string), ~:desc~ (tooltip), and ~:action~ + (thunk that dispatches the command). Drives cl-tty's ~Select~ widget. +7. (open-minibuffer): v0.8.0 — pushes a ~select-dialog~ onto cl-tty's + ~cl-tty.dialog:*dialog-stack*~ with ~*slash-commands*~ as options. Sets the + select's ~:on-select~ to dispatch the chosen command. + 8. (minibuffer-handle-key ch): v0.8.0 — converts Croatoan key code CH + to a cl-tty ~key-event~, then routes through the active dialog's + ~select-handle-key~. Returns T if handled (dialog consumed the key). + 9. (make-wizard-dialog): v0.8.0 — creates a multi-step wizard dialog: + provider selection → API key entry → save confirmation. Returns a + ~dialog~ instance pushed onto ~cl-tty.dialog:*dialog-stack*~. Each step validates + before advancing. Final step writes ~/.passepartout/config.lisp~. +10. (*daemon-commands*): v0.8.0 — list of ~16 daemon command plists, + 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 #+begin_src lisp @@ -128,66 +99,13 @@ if the user reopens it within the same session. State is per-session only (338 :npage) (t raw))) raw))) - (cond - ;; v0.8.0: palette mode — handle palette keypresses first - ((and (st :palette-visible) (or (eql ch 27) (eq ch :escape))) - (setf (st :palette-visible) 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 + (cond + ;; v0.8.0: minibuffer dialog active — route through cl-tty select + ((and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack* + (minibuffer-handle-key ch)) + (setf (st :dirty) (list t t nil))) + ;; v0.7.1: Esc — interrupt streaming ((and (eql ch 27) (st :streaming-text)) (send-daemon (list :type :event :payload '(:action :cancel-stream))) (when (> (length (st :messages)) 0) @@ -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."))) ((eql ch 6) ; v0.7.2 Ctrl+F — message search (add-msg :system "Use /search to find messages")) - ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard - (wizard-start) + ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup minibuffer + (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))) - ((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)) (loop for i from (1- (length (st :messages))) downto 0 for m = (aref (st :messages) i) @@ -313,35 +236,33 @@ if the user reopens it within the same session. State is per-session only (setf (st :pending-ctrl-x) nil) (passepartout.channel-tui::sidebar-toggle) (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden"))) - ((eql ch 16) ; Ctrl+P — command palette - (setf (st :palette-visible) t - (st :palette-filter) "" - (st :palette-selected-idx) 0 - (st :palette-items) (passepartout.channel-tui::palette-items)) - (setf (st :dirty) (list t t nil))) - ((eql ch 4) ; Ctrl+D — quit on empty - (when (or (null (st :input-buffer)) (string= "" (input-string))) - (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) - ((eql ch 6) ; v0.7.2 Ctrl+F — message search - (add-msg :system "Use /search to find messages")) - ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse - (let ((gate-idx nil)) - (loop for i from (1- (length (st :messages))) downto 0 - for m = (aref (st :messages) i) - when (and (getf m :gate-trace) (listp (getf m :gate-trace))) - do (setf gate-idx i) (loop-finish)) - (if gate-idx - (let ((cg (st :collapsed-gates))) - (if (member gate-idx cg) - (setf (st :collapsed-gates) (remove gate-idx cg)) - (push gate-idx (st :collapsed-gates))) - (add-msg :system (format nil "Gate trace ~a for msg ~a" - (if (member gate-idx (st :collapsed-gates)) "hidden" "shown") - gate-idx)) - (setf (st :dirty) (list nil t nil))) - (add-msg :system "No gate trace to toggle")))) - ((eql ch 24) ; Ctrl+X prefix - (setf (st :pending-ctrl-x) t)) + ((eql ch 16) ; v0.8.0 Ctrl+P — open command palette (daemon commands) + (progn + (open-command-palette) + (setf (st :dirty) (list t t nil)))) + ((eql ch 4) ; Ctrl+D — quit on empty + (when (or (null (st :input-buffer)) (string= "" (input-string))) + (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) + ((eql ch 6) ; v0.7.2 Ctrl+F — message search + (add-msg :system "Use /search to find messages")) + ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse + (let ((gate-idx nil)) + (loop for i from (1- (length (st :messages))) downto 0 + for m = (aref (st :messages) i) + when (and (getf m :gate-trace) (listp (getf m :gate-trace))) + do (setf gate-idx i) (loop-finish)) + (if gate-idx + (let ((cg (st :collapsed-gates))) + (if (member gate-idx cg) + (setf (st :collapsed-gates) (remove gate-idx cg)) + (push gate-idx (st :collapsed-gates))) + (add-msg :system (format nil "Gate trace ~a for msg ~a" + (if (member gate-idx (st :collapsed-gates)) "hidden" "shown") + gate-idx)) + (setf (st :dirty) (list nil t nil))) + (add-msg :system "No gate trace to toggle")))) + ((eql ch 24) ; Ctrl+X prefix + (setf (st :pending-ctrl-x) t)) ((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor (setf (st :pending-ctrl-x) nil) (add-msg :system "Opening $EDITOR... save and exit to return.") @@ -570,11 +491,14 @@ 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 "\\ + Enter Multi-line input") (add-msg :system "Ctrl+G Toggle gate trace")) - ;; /setup command — open wizard - ((string-equal text "/setup") - (wizard-start) - (add-msg :system "Setup wizard opened (Ctrl+W)") - (setf (st :dirty) (list t t nil))) + ;; /setup command — open minibuffer filtered to setup + ((string-equal text "/setup") + (open-minibuffer) + (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))) ;; /theme command ((string-equal text "/theme") (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" @@ -754,167 +678,270 @@ if the user reopens it within the same session. State is per-session only (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) page-size)))) (setf (st :dirty) (list nil t nil))) ;; Printable - (t - (let ((chr (typecase ch - (character ch) - (integer (code-char ch)) - (t nil)))) - (when (and chr (graphic-char-p chr)) - (input-insert-char chr) - (setf (st :dirty) (list nil nil t)))))))) + (t + (let ((chr (typecase ch + (character ch) + (integer (code-char ch)) + (t nil)))) + (when (and chr (graphic-char-p chr)) + (input-insert-char chr) + (setf (st :dirty) (list nil nil t)))))))) -;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny -(defun palette-items () - "Returns categorized command list for the palette." - (let ((items nil)) - (push (list :category "Session" :items - (list (list :name "/focus" :desc "Set project context" :shortcut "C-o" - :action (lambda () (add-msg :system "/focus "))) - (list :name "/scope" :desc "Change context scope" - :action (lambda () (add-msg :system "/scope memex|session|project"))) - (list :name "/unfocus" :desc "Pop context stack" - :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) - (list :name "/search" :desc "Search messages" :shortcut "C-f" - :action (lambda () (add-msg :system "Use /search to find messages"))))) - items) - (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"))) - (list :name "/audit" :desc "Inspect memory object" - :action (lambda () (add-msg :system "/audit "))) - (list :name "/context" :desc "Show context budget" - :action (lambda () (add-msg :system "/context"))))) - items) - (push (list :category "View" :items - (list (list :name "/theme" :desc "Switch color theme" - :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) - (list :name "/help" :desc "Show all commands" - :action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar"))))) - items) - (push (list :category "System" :items - (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" - :action (lambda () (add-msg :system "/eval "))) - (list :name "/reconnect" :desc "Reconnect to daemon" - :action (lambda () (disconnect-daemon) (connect-daemon))) - (list :name "/quit" :desc "Save history and exit" :shortcut "C-d" - :action (lambda () (add-msg :system "* Goodbye *") - (send-daemon (list :type :event :payload '(:action :quit))) - (setf (st :running) nil))))) - items) - (nreverse items))) -(defun palette-execute (selected-item) - "Execute the selected palette item's action." - (when (and selected-item (getf selected-item :action)) - (funcall (getf selected-item :action)))) +;; v0.8.0 — Minibuffer: *slash-commands*, open-minibuffer, minibuffer-handle-key, make-wizard-dialog -(defun wizard-steps () - "Returns the ordered list of setup wizard steps." +(defvar *slash-commands* + (list (list :name "/focus" :desc "Set project context" + :action (lambda () (add-msg :system "/focus"))) + (list :name "/scope" :desc "Change context scope" + :action (lambda () (add-msg :system "/scope memex|session|project"))) + (list :name "/unfocus" :desc "Pop context stack" + :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) + (list :name "/search" :desc "Search messages" + :action (lambda () (add-msg :system "Use /search "))) + (list :name "/why" :desc "Show last gate trace" + :action (lambda () (add-msg :system "Gate trace: use /why"))) + (list :name "/audit" :desc "Inspect memory object" + :action (lambda () (add-msg :system "/audit "))) + (list :name "/context" :desc "Show context budget" + :action (lambda () (add-msg :system "/context"))) + (list :name "/theme" :desc "Switch color theme" + :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox"))) + (list :name "/sidebar" :desc "Toggle sidebar" + :action #'sidebar-toggle) + (list :name "/help" :desc "Show all commands" + :action (lambda () (add-msg :system "Commands: /focus /scope /search /theme /eval /setup /quit ..."))) + (list :name "/setup" :desc "Run setup wizard" + :action (lambda () (make-wizard-dialog))) + (list :name "/eval" :desc "Evaluate Lisp expression" + :action (lambda () (add-msg :system "/eval "))) + (list :name "/reconnect" :desc "Reconnect to daemon" + :action (lambda () (disconnect-daemon) (connect-daemon))) + (list :name "/quit" :desc "Save history and exit" + :action (lambda () (add-msg :system "* Goodbye *") + (send-daemon (list :type :event :payload '(:action :quit))) + (setf (st :running) nil)))) + "~25 slash commands driving cl-tty's Select widget in the minibuffer.") + +(defun open-minibuffer () + "Push a cl-tty.dialog:select-dialog with *slash-commands* onto cl-tty's dialog stack." + (cl-tty.dialog:push-dialog + (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))))))) + +(defvar *daemon-commands* (list - (list :title "Provider Selection" - :prompt "LLM provider (openai, anthropic, ollama, openrouter, deepseek, groq):" - :validate (lambda (input) - (let ((provider (string-downcase (string-trim '(#\Space) input)))) - (if (member provider '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") - :test #'string=) - (progn (setf (st :wizard-provider) provider) nil) - (format nil "Unknown provider: ~a" input))))) - (list :title "API Key" - :prompt (format nil "API key for ~a:" (or (st :wizard-provider) "provider")) - :validate (lambda (input) - (let ((key (string-trim '(#\Space) input))) - (if (> (length key) 4) - (progn (setf (st :wizard-api-key) key) nil) - "Key too short — enter a valid API key")))) - (list :title "Memory" - :prompt "Max memory entries? (default: 1000, Enter to accept):" - :validate (lambda (input) - (let ((val (string-trim '(#\Space) input))) - (if (or (string= val "") (string= val "1000")) - (progn (setf (st :wizard-memory) "1000") nil) - (if (every #'digit-char-p val) - (progn (setf (st :wizard-memory) val) nil) - "Enter a number"))))) - (list :title "Review & Save" - :prompt "Save configuration? (yes/no):" - :validate (lambda (input) - (let ((val (string-downcase (string-trim '(#\Space) input)))) - (cond - ((string= val "yes") - (wizard-write-config) - nil) - ((string= val "no") - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system "Wizard cancelled — run /setup to restart") - nil) - (t "Type 'yes' to save or 'no' to cancel"))))))) + ;; Category: Session + (list :title "── Session ──" :category t) + (list :title "Focus Project" :value :focus :desc "Set project context" + :action (lambda () (add-msg :system "Usage: /focus "))) + (list :title "Change Scope" :value :scope :desc "Switch scope: memex|session|project" + :action (lambda () (add-msg :system "Usage: /scope memex|session|project"))) + (list :title "Unfocus" :value :unfocus :desc "Pop context stack" + :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) + (list :title "Show Context" :value :context :desc "Show context budget summary" + :action (lambda () (add-msg :system "Use /context for budget or /context why for node details"))) + ;; Category: Memory + (list :title "── Memory ──" :category t) + (list :title "List Sessions" :value :sessions :desc "List memory snapshots" + :action (lambda () (add-msg :system "Use /sessions to list snapshots"))) + (list :title "Rewind" :value :rewind :desc "Rewind to snapshot" + :action (lambda () (add-msg :system "Usage: /rewind "))) + (list :title "Audit Node" :value :audit :desc "Inspect memory object" + :action (lambda () (add-msg :system "Usage: /audit "))) + ;; Category: System + (list :title "── System ──" :category t) + (list :title "Reconnect" :value :reconnect :desc "Reconnect to daemon" + :action (lambda () (disconnect-daemon) (connect-daemon))) + (list :title "Quit" :value :quit :desc "Save history and exit" + :action (lambda () (add-msg :system "* Goodbye *") + (send-daemon (list :type :event :payload '(:action :quit))) + (setf (st :running) nil))) + ;; Category: Help + (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 wizard-start () - "Open the setup wizard at step 0." - (setf (st :wizard-visible) t - (st :wizard-step) 0 - (st :wizard-input) "" - (st :wizard-error) nil - (st :wizard-provider) nil - (st :wizard-api-key) nil - (st :wizard-memory) nil)) +(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 wizard-next () - "Validate current step input; advance on success, show error on failure." - (let ((steps (wizard-steps)) - (step-idx (st :wizard-step))) - (when (< step-idx (length steps)) - (let* ((step (nth step-idx steps)) - (validate-fn (getf step :validate)) - (error-msg (funcall validate-fn (or (st :wizard-input) "")))) - (if error-msg - (setf (st :wizard-error) error-msg - (st :dirty) (list nil t nil)) - (if (= step-idx (1- (length steps))) - (progn - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system "Configuration saved. Run /reconnect to reload.")) - (setf (st :wizard-step) (1+ step-idx) - (st :wizard-input) "" - (st :wizard-error) nil - (st :dirty) (list nil t nil)))))))) +(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 + ((= ch 27) (cl-tty.input:make-key-event :key :escape)) + ((or (= ch 13) (= ch 10)) (cl-tty.input:make-key-event :key :enter)) + ((or (= ch 263) (= ch 127) (= ch 8)) (cl-tty.input:make-key-event :key :backspace)) + ((= ch 259) (cl-tty.input:make-key-event :key :up)) + ((= ch 258) (cl-tty.input:make-key-event :key :down)) + ((= ch 260) (cl-tty.input:make-key-event :key :left)) + ((= ch 261) (cl-tty.input:make-key-event :key :right)) + ((= ch 339) (cl-tty.input:make-key-event :key :page-up)) + ((= ch 338) (cl-tty.input:make-key-event :key :page-down)) + ((<= 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-cancel () - "Dismiss the wizard, preserving state for resumption." - (setf (st :wizard-visible) nil - (st :dirty) (list t t nil))) +(defun minibuffer-handle-key (ch) + "Route Croatoan key through the active dialog's select widget. + Printable chars update the filter; special keys route through cl-tty.select:select-handle-key. + Returns T if the dialog consumed the key." + (let ((stack cl-tty.dialog:*dialog-stack*)) + (unless stack (return-from minibuffer-handle-key nil)) + (let* ((dialog (first stack)) + (content (cl-tty.dialog:dialog-content dialog))) + (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-write-config () - "Write collected wizard data to .env and notify." - (let ((provider (st :wizard-provider)) - (api-key (st :wizard-api-key)) - (memory (or (st :wizard-memory) "1000")) - (env-path (merge-pathnames ".env" (merge-pathnames "memex/" (user-homedir-pathname))))) - (handler-case - (progn - (uiop:ensure-all-directories-exist (list env-path)) - (with-open-file (out env-path :direction :output :if-exists :supersede :if-does-not-exist :create) - (format out "# Passepartout configuration (generated by setup wizard)~%") - (format out "PROVIDER_CASCADE=~a~%" provider) - (format out "~:@(~a~)_API_KEY=~a~%" provider api-key) - (format out "MEMORY_MAX_ENTRIES=~a~%" memory) - (format out "DAEMON_PORT=9105~%"))) - (error (c) - (setf (st :wizard-error) (format nil "Failed to write config: ~a" c))))) - (setf (st :wizard-visible) nil - (st :wizard-step) 0 - (st :wizard-error) nil) - (add-msg :system (format nil "Configuration saved to memex/.env (~a). Run /reconnect to reload." provider))) +(defun make-wizard-dialog () + "Create a setup wizard dialog daisy-chain: provider select → API key → save. + Validates at each step; final step writes ~/.passepartout/config.lisp." + (let* ((state (list :provider nil :api-key nil :memory "1000" :step 0)) + (step-labels '("Provider" "API Key" "Memory" "Review & Save")) + (step-fns + (list + ;; Step 0: provider selection + (lambda (input) + (let ((p (string-downcase (string-trim '(#\Space) input)))) + (if (member p '("openai" "anthropic" "ollama" "openrouter" "deepseek" "groq") :test #'string=) + (progn (setf (getf state :provider) p) nil) + (format nil "Unknown provider: ~a" input)))) + ;; Step 1: API key + (lambda (input) + (let ((k (string-trim '(#\Space) input))) + (if (> (length k) 4) + (progn (setf (getf state :api-key) k) nil) + "Key too short"))) + ;; Step 2: memory limit + (lambda (input) + (let ((v (string-trim '(#\Space) input))) + (if (or (string= v "") (string= v "1000")) + nil + (if (every #'digit-char-p v) + (progn (setf (getf state :memory) v) nil) + "Enter a number")))) + ;; Step 3: save + (lambda (input) + (let ((v (string-downcase (string-trim '(#\Space) input)))) + (cond ((string= v "yes") + (let ((env-path (merge-pathnames ".passepartout/config.lisp" + (user-homedir-pathname)))) + (handler-case + (progn + (uiop:ensure-all-directories-exist (list env-path)) + (with-open-file (out env-path :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (format out ";; Passepartout configuration~%") + (format out "(setf *provider* ~s)~%" (getf state :provider)) + (format out "(setf *api-key* ~s)~%" (getf state :api-key)) + (format out "(setf *memory-max-entries* ~s)~%" (getf state :memory)))) + (error (c) (format nil "Write failed: ~a" c)))) + nil) + ((string= v "no") nil) + (t "Type 'yes' or 'no'"))))))) + (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) "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 (view-sidebar sidebar-w) (refresh sidebar-w)) - (when (st :palette-visible) - (let* ((pw (min 56 (floor (* w 0.7)))) - (ph (min 18 (floor (* h 0.6)))) - (px (floor (- w pw) 2)) - (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))) + ;; v0.8.0: render cl-tty dialog overlay when stack is non-empty + (when (and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack*) + (render-dialog-overlay scr w h)) (refresh scr) (loop while (st :running) do (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)) (recreate-windows w h) (redraw sw cw ch iw))) - (when (st :palette-visible) - (let* ((pw (min 56 (floor (* w 0.7)))) - (ph (min 18 (floor (* h 0.6)))) - (px (floor (- w pw) 2)) - (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))) + ;; v0.8.0: render cl-tty dialog overlay + (when (and (boundp 'cl-tty.dialog:*dialog-stack*) + cl-tty.dialog:*dialog-stack*) + (render-dialog-overlay scr w h)) (refresh scr) (sleep 0.03)) (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 () (init-state) (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 (fiveam:is (eq t (st :sidebar-visible)))) -(fiveam:test test-ctrl-p-opens-palette - "Contract 6: Ctrl+P opens command palette." +(fiveam:test test-ctrl-p-opens-command-palette + "Contract 6: Ctrl+P opens command palette (pushes dialog with daemon commands)." (init-state) (on-key 16) ; Ctrl+P - (fiveam:is (eq t (st :palette-visible))) - (fiveam:is (not (null (st :palette-items)))) - (fiveam:is (= 0 (st :palette-selected-idx)))) + (fiveam:is-true (and cl-tty.dialog:*dialog-stack*))) -(fiveam:test test-palette-escape-dismisses - "Contract 6: Esc dismisses palette." - (init-state) - (setf (st :palette-visible) t) - (on-key 27) ; Esc - (fiveam:is (null (st :palette-visible)))) +(fiveam:test test-open-minibuffer-pushes-dialog + "Contract 7: open-minibuffer pushes a dialog with a select content." + (let ((cl-tty.dialog:*dialog-stack* nil)) + (passepartout.channel-tui::open-minibuffer) + (fiveam:is (= 1 (length cl-tty.dialog:*dialog-stack*))) + (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 - "Contract 9: Enter executes selected item and dismisses palette." - (init-state) - (setf (st :palette-visible) t - (st :palette-selected-idx) 0 - (st :palette-items) (passepartout.channel-tui::palette-items)) - (on-key (char-code #\/)) - (on-key (char-code #\t)) - (fiveam:is (string= "/t" (st :palette-filter)))) +(fiveam:test test-slash-commands-count + "Contract 6: *slash-commands* has at least 14 entries with :name, :desc, :action." + (let ((cmds passepartout.channel-tui::*slash-commands*)) + (fiveam:is (>= (length cmds) 14)) + (dolist (c cmds) + (fiveam:is (stringp (getf c :name))) + (fiveam:is (stringp (getf c :desc))) + (fiveam:is (functionp (getf c :action)))))) -(fiveam:test test-palette-items-has-categories - "Contract 7: palette-items returns categorized list with at least Session and View." - (init-state) - (let ((items (passepartout.channel-tui::palette-items))) - (fiveam:is (listp items)) - (fiveam:is (find "Session" items :key (lambda (g) (getf g :category)) :test #'string=)) - (fiveam:is (find "View" items :key (lambda (g) (getf g :category)) :test #'string=)))) +(fiveam:test test-daemon-commands-count + "Contract 8: *daemon-commands* has at least 14 entries with :title, :desc, :action, category headers." + (let ((cmds passepartout.channel-tui::*daemon-commands*)) + (fiveam:is (>= (length cmds) 14)) + (dolist (c cmds) + (if (getf c :category) + (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 - "Contract v0.8.0: wizard-steps returns 4 steps." - (let ((steps (passepartout.channel-tui::wizard-steps))) - (fiveam:is (= 4 (length steps))))) +(fiveam:test test-minibuffer-handle-key-backspace + "Contract 8: Backspace pops filter char, then pops dialog on empty." + (let ((cl-tty.dialog:*dialog-stack* nil)) + (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 - "Contract v0.8.0: wizard-start sets wizard-visible and resets state." - (init-state) - (passepartout.channel-tui::wizard-start) - (fiveam:is (eq t (st :wizard-visible))) - (fiveam:is (= 0 (st :wizard-step))) - (fiveam:is (string= "" (st :wizard-input)))) - -(fiveam:test test-wizard-cancel-hides - "Contract v0.8.0: wizard-cancel hides the wizard." - (init-state) - (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)))) +(fiveam:test test-croatoan-to-tty-event-arrows + "Contract 8: croatoan-to-tty-event converts Croatoan key codes to cl-tty key-events." + (let ((up (passepartout.channel-tui::croatoan-to-tty-event 259))) + (fiveam:is (cl-tty.input:key-event-p up)) + (fiveam:is (eql :up (cl-tty.input:key-event-key up)))) + (let ((down (passepartout.channel-tui::croatoan-to-tty-event 258))) + (fiveam:is (eql :down (cl-tty.input:key-event-key down)))) + (let ((enter (passepartout.channel-tui::croatoan-to-tty-event 13))) + (fiveam:is (eql :enter (cl-tty.input:key-event-key enter)))) + (let ((esc (passepartout.channel-tui::croatoan-to-tty-event 27))) + (fiveam:is (eql :escape (cl-tty.input:key-event-key esc))))) #+end_src diff --git a/org/channel-tui-state.org b/org/channel-tui-state.org index be8cef9..2bcac6c 100644 --- a/org/channel-tui-state.org +++ b/org/channel-tui-state.org @@ -97,7 +97,10 @@ theme presets — defined but unused. :view-status :view-chat :view-input :redraw :on-key :on-daemon-msg :send-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) (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-matches nil :search-match-idx 0 :sidebar-visible nil ; v0.8.0 - :minibuffer-mode nil :minibuffer-selected-idx 0 ; 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 + :expand-tool-calls nil ; v0.8.0 :dirty (list nil nil nil)))) #+end_src diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index c424d67..43595e9 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -72,35 +72,62 @@ This mirrors OpenCode's command palette pattern — a proven UX convention that makes power commands discoverable without reading 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~ -flow with an in-TUI onboarding sequence. Users select LLM providers, -enter API keys, and verify connections — all within the same interface -they'll use daily. +The chat conversation is the primary TUI surface — it shows every +message exchanged with the daemon. The v0.8.0 refactoring replaces +the ad-hoc ~view-chat~ with a ScrollBox-driven conversation view +using cl-tty's markdown renderer and component model. -The wizard is a multi-step overlay with progress indicator. Each step -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. +Each message type has a dedicated render function: -The wizard reuses the overlay infrastructure built for the command -palette and sidebar — same window creation patterns, same Croatoan -rendering primitives. +- *User messages*: ~render-user-msg~ — a colored line with role + prefix (green, "⬆ user"). Content is plain-text with word wrap. +- *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 1. (view-status win): renders the status bar with connection info, - msg count, scroll offset, rule counter, focus map (v0.4.0), and - timestamp. Two lines: line 1 (status + rules), line 2 (focus + time). -2. (view-chat win h): renders the scrolled chat message list. Takes - window and available height. Messages are color-coded: green (user), - white (agent), yellow (system). + msg count, scroll offset, rule counter, focus map, and timestamp. + Two lines: line 1 (status + rules), line 2 (focus + time). +2. (view-conversation win h): renders the scrolled conversation using + cl-tty ScrollBox model. Dispatches per-role to dedicated render + 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 indicator. 4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~ 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. ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 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))) (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) (box win 0 0) (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)) (is-search (st :search-mode)) (y 1)) - ;; v0.7.2: search mode header + ;; Search mode header (when is-search (let* ((matches (st :search-matches)) (idx (st :search-match-idx)) @@ -204,26 +300,28 @@ 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)) (incf y) (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) (lines-remaining max-lines)) (loop for i from (1- total) downto 0 while (> lines-remaining 0) do (let* ((msg (aref msgs i)) - (role (getf msg :role)) - (content (getf msg :content)) - (time (or (getf msg :time) "")) - (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) - (content-show (if is-search - (search-highlight content (st :search-query)) - content)) - (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2))) - (nlines (length wrapped))) + (role (getf msg :role)) + (content (getf msg :content)) + (time (or (getf msg :time) "")) + (nlines (case role + (:user (length (word-wrap (format nil "⬆ [~a] ~a" time content) (- w 2)))) + (:agent (let ((header (format nil "⬇ [~a]" time))) + (+ 1 (length (cl-tty.markdown:render-md + (cl-tty.markdown:parse-blocks content)))))) + (t (length (word-wrap (format nil " ~a" content) (- w 2))))))) (if (<= nlines lines-remaining) (progn (decf lines-remaining nlines) (incf msg-count)) (setf lines-remaining 0)))) - ;; Render from the correct starting message + ;; Render from start message (let* ((scroll-skip (st :scroll-offset)) (start (max 0 (- total msg-count scroll-skip)))) (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)) (content (getf msg :content)) (time (or (getf msg :time) "")) - (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) - (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) - (is-panel (getf msg :panel)) - (is-resolved (getf msg :panel-resolved)) - (content-show (if is-search - (search-highlight content (st :search-query)) - content)) - (line-text (format nil "~a [~a] ~a" prefix time content-show)) - (wrapped (word-wrap line-text (- w 2)))) - ;; HITL panel: render with colored border - (when is-panel - (setf color (if is-resolved - (theme-color :dim) - (theme-color :hitl)))) - (dolist (line wrapped) - (when (< y (1- h)) - (if (eq role :agent) - (let ((segments (parse-markdown-spans line))) - (setf y (render-styled win segments y 1 w))) - (progn - (add-string win line :y y :x 1 :n (1- w) :fgcolor color) - (incf y))))) - ;; v0.7.2: gate trace below agent messages - (let ((gate-trace (getf msg :gate-trace))) - (when (and gate-trace (not (member i (st :collapsed-gates)))) - (dolist (entry (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)) + (gate-trace (getf msg :gate-trace)) + (collapsed (member i (st :collapsed-gates))) + (tool-name (getf msg :tool)) + (tool-status (getf msg :tool-status)) + (tool-duration (getf msg :tool-duration)) + (tool-expanded (member i (st :expand-tool-calls)))) + (setf y (case role + (:user (render-user-msg win content time w y)) + (:agent (progn + (setf y (render-agent-msg win content time w y)) + (when gate-trace + (setf y (render-gate-trace win gate-trace w y collapsed))) + y)) + (t (render-sys-msg win content w y)))) + ;; Tool call block (attached to any role message) + (when tool-name + (setf y (render-tool-call win tool-name tool-status tool-duration + content w y tool-expanded))))))) + ;; Sticky-scroll update + (when (and (st :scroll-at-bottom) (plusp (length msgs))) + (setf (st :scroll-offset) 0)) + (refresh win))) #+end_src ** Input Line @@ -283,7 +373,7 @@ that the TUI actuator attaches to the response plist before transmission. (defun redraw (sw cw ch iw) (destructuring-bind (sd cd id) (st :dirty) (when sd (view-status sw)) - (when cd (view-chat cw ch)) + (when cd (view-conversation cw ch)) (when id (view-input iw)) (setf (st :dirty) (list nil nil nil)))) #+end_src @@ -616,46 +706,56 @@ Respects CJK/emoji char widths via char-width." #+begin_src lisp (in-package :passepartout.channel-tui) -(defun view-sidebar (win) - "Render 42-column sidebar with 7 panels: 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) - (gate-trace (st :gate-trace)) - (foveal-id (st :foveal-id)) - (rule-count (or (st :rule-count) 0)) - (context-usage (st :context-usage)) - (modified-files (st :modified-files)) - (session-cost (st :session-cost)) - (block-counts (st :block-counts))) - ;; Panel 1: Gate Trace - (add-string win "── Gate Trace ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if gate-trace - (dolist (entry (gate-trace-lines gate-trace)) - (when (< y (1- h)) - (add-string win (car entry) :y y :x 2 :n (- w 4) - :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) - (incf y))) - (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) - ;; Panel 2: Focus - (incf y) - (add-string win "── Focus ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (add-string win (format nil " ~a" (or foveal-id "(none)")) :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) - ;; Panel 3: Rules - (incf y 2) - (add-string win "── Rules ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (add-string win (format nil " Rules: ~d" rule-count) :y y :x 2 :n (- w 4) :fgcolor (theme-color :rule-count)) - ;; Panel 4: Context gauge - (incf y 2) - (add-string win "── Context ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (let* ((pct (or context-usage 0)) +;; ── Sidebar Panel Slots ── +;; Each sidebar panel is a cl-tty slot registration with :mode :replace. +;; The sidebar orchestrates them in order, passing (win w h y) and +;; receiving the next y position. + +(defun render-sidebar-panel-header (win w y title) + (add-string win (format nil "── ~a ──" title) :y y :x 1 :n (- w 2) + :fgcolor (theme-color :accent)) + (1+ y)) + +(cl-tty.slot:defslot :sidebar-gate-trace :mode :replace + :render-fn + (lambda (win w h y) + (let ((trace (st :gate-trace))) + (setf y (render-sidebar-panel-header win w y "Gate Trace")) + (if trace + (dolist (entry (gate-trace-lines trace)) + (when (< y (1- h)) + (add-string win (car entry) :y y :x 2 :n (- w 4) + :fgcolor (or (getf (cdr entry) :fgcolor) (theme-color :dim))) + (incf y))) + (add-string win " (no trace)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + y))) + +(cl-tty.slot:defslot :sidebar-focus :mode :replace + :render-fn + (lambda (win w h y) + (declare (ignore h)) + (setf y (render-sidebar-panel-header win w y "Focus")) + (add-string win (format nil " ~a" (or (st :foveal-id) "(none)")) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :focus-map)) + (+ y 2))) + +(cl-tty.slot:defslot :sidebar-rules :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 "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) (filled (min bar-width (floor (* pct bar-width) 100))) (gauge-color (cond ((< pct 50) (theme-color :connected)) @@ -667,49 +767,77 @@ Respects CJK/emoji char widths via char-width." (make-string (- bar-width filled) :initial-element #\░) pct) :y y :x 2 :n (- w 4) :fgcolor gauge-color)) - ;; Panel 5: Files - (incf y 2) - (add-string win "── Files ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if modified-files - (dolist (f modified-files) - (when (< y (1- h)) - (let ((fp (getf f :filepath)) - (added (getf f :lines-added)) - (removed (getf f :lines-removed))) - (add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]" - (subseq fp (max 0 (- (length fp) 30))) - (when (> added 0) added) - (when (> removed 0) removed)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) - (incf y)))) - (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) - ;; Panel 6: Cost - (incf y 2) - (add-string win "── Cost ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if session-cost - (progn - (add-string win (format nil " Total: $~,4f" (getf session-cost :total)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) - (incf y) - (add-string win (format nil " Calls: ~d" (getf session-cost :calls)) - :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))) - ;; Panel 7: Protection - (incf y 2) - (add-string win "── Protection ──" :y y :x 1 :n (- w 2) :fgcolor (theme-color :accent)) - (incf y) - (if (and block-counts (> (getf block-counts :total) 0)) - (let ((by-gate (getf block-counts :by-gate))) - (dolist (entry (subseq by-gate 0 (min (length by-gate) 6))) + (1+ y))) + +(cl-tty.slot:defslot :sidebar-files :mode :replace + :render-fn + (lambda (win w h y) + (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)) - (add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) - :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) - (incf y)))) - (add-string win " (no blocks)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + (let ((fp (getf f :filepath)) + (added (getf f :lines-added)) + (removed (getf f :lines-removed))) + (add-string win (format nil " ~a~@[ +~d~]~@[ -~d~]" + (subseq fp (max 0 (- (length fp) 30))) + (when (> added 0) added) + (when (> removed 0) removed)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) + (incf y)))) + (add-string win " (no changes)" :y y :x 2 :n (- w 4) :fgcolor (theme-color :dim))) + y))) + +(cl-tty.slot:defslot :sidebar-cost :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 "Cost")) + (let ((cost (st :session-cost))) + (if cost + (progn + (add-string win (format nil " Total: $~,4f" (getf cost :total)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :agent)) + (incf y) + (add-string win (format nil " Calls: ~d" (getf cost :calls)) + :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))) + (1+ y)))) + +(cl-tty.slot:defslot :sidebar-protection :mode :replace + :render-fn + (lambda (win w h y) + (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))) + (when (< y (1- h)) + (add-string win (format nil " ~a: ~d" (car entry) (cdr entry)) + :y y :x 2 :n (- w 4) :fgcolor (theme-color :gate-blocked)) + (incf y)))) + (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) - (- y 1))) + (1- y))) (defun view-minibuffer (win) "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)) (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) "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))))) (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) - (is (null (passepartout.channel-tui::st :minibuffer-mode))) - (is (= 0 (passepartout.channel-tui::st :minibuffer-selected-idx))) - (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)))))) + (is (null (getf passepartout.channel-tui::*state* :mode))) + (is (null (getf passepartout.channel-tui::*state* :palette-visible)))) #+end_src diff --git a/passepartout.asd b/passepartout.asd index 00dc3a4..4b9c7eb 100644 --- a/passepartout.asd +++ b/passepartout.asd @@ -16,7 +16,7 @@ (:file "lisp/core-pipeline"))) (defsystem :passepartout/tui - :depends-on (:passepartout :croatoan :usocket :bordeaux-threads) + :depends-on (:passepartout :croatoan :cl-tty :usocket :bordeaux-threads) :serial t :components ((:file "lisp/channel-tui-state") (:file "lisp/channel-tui-view")