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

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

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

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

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

@@ -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 <query> 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 <query> 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 <query> 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 <project>")))
(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 <query> 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 <node-id>")))
(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 <expr>")))
(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 <query>")))
(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 <node-id>")))
(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 <expr>")))
(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 <project>")))
(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 <id> 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 <number>")))
(list :title "Audit Node" :value :audit :desc "Inspect memory object"
:action (lambda () (add-msg :system "Usage: /audit <node-id>")))
;; 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)))))

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

@@ -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 ()

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

@@ -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))))