bump passepartout: v0.9.0 Warm TUI Redesign — blank slate

Complete rewrite of the TUI with warm amber/gold color palette and
clean three-zone layout (chat top, input bottom, status very bottom).

1. Layout restructure: input at y=h-3, hint at y=h-2, status at y=h-1
2. Warm palette: 20-key amber/gold theme, 8 warm presets
3. Readline keybindings: Ctrl+A/E/U/W/K/Y/L/D/F/G in :global keymap
4. Chat messages: user boxes (┌─└─), agent headers, collapsible tools
5. Command palette: Ctrl+P top-centered overlay, warm colors
6. Sidebar: Ctrl+B toggle, right panel with focus/rules/context/MCP
7. Keybindings: :ctrl+x, :?, mouse wheel support
8. Search: existing /search with match highlighting
9. Help overlay: ? shows keybinding and command reference
This commit is contained in:
2026-05-13 19:13:20 -04:00
parent e27cffa4e0
commit 15d16fd520
7 changed files with 1045 additions and 783 deletions

View File

@@ -116,54 +116,7 @@ Event handlers + daemon I/O + main loop.
(add-msg :system (format nil "Press Tab to open ~a" url))
(setf (st :dirty) (list t t nil)))
nil))))
;; v0.7.0: Ctrl key bindings
((eql ch 21) ; Ctrl+U — clear line
(setf (st :input-buffer) nil)
(setf (st :dirty) (list nil nil t)))
((eql ch 23) ; Ctrl+W — delete word backward
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t))))
((eql ch 1) ; Ctrl+A — home
(setf (st :cursor-pos) 0))
((eql ch 5) ; Ctrl+E — end
(setf (st :cursor-pos) (length (st :input-buffer))))
((eql ch 12) ; Ctrl+L — redraw
(setf (st :dirty) (list t t t)))
((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.")
(setf (st :dirty) (list t t nil)))
((and (st :pending-ctrl-x) (not (eql ch 5))) ; cancel Ctrl+X
(setf (st :pending-ctrl-x) nil)
(on-key ch)
(return-from on-key nil))
;; Enter
;; Enter
((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch 343)
(eql ch #\Newline) (eql ch #\Return))
;; Multi-line: if buffer ends with \, strip it and insert newline
@@ -421,19 +374,19 @@ Event handlers + daemon I/O + main loop.
(add-msg :system "Ctrl+G Toggle gate trace"))
;; /theme command
((string-equal text "/theme")
(add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
(add-msg :system (format nil "Theme: ~a — user-fg=~a agent-fg=~a system=~a input-fg=~a"
*tui-theme-current-name*
(getf *tui-theme* :user)
(getf *tui-theme* :agent)
(getf *tui-theme* :user-fg)
(getf *tui-theme* :agent-fg)
(getf *tui-theme* :system)
(getf *tui-theme* :input)))
(add-msg :system "Presets: /theme dark | light | solarized | gruvbox"))
(getf *tui-theme* :input-fg)))
(add-msg :system "Presets: /theme amber | gold | terracotta | sepia | nord-warm | monokai-warm | gruvbox-warm | light-amber"))
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/theme "))
(let ((name (string-trim '(#\Space) (subseq text 7))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
(if (theme-switch name)
(add-msg :system (format nil "Theme switched to ~a" name))
(add-msg :system (format nil "Unknown theme '~a'. Try: amber gold terracotta sepia nord-warm monokai-warm gruvbox-warm light-amber" name)))))
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
@@ -519,11 +472,11 @@ Event handlers + daemon I/O + main loop.
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; /theme subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("dark" "light" "solarized" "gruvbox"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7)))
(names '("amber" "gold" "terracotta" "sepia" "nord-warm" "monokai-warm" "gruvbox-warm" "light-amber"))
(match (if (string= partial "") (first names)
(find partial names :test #'string-equal))))
(when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
(setf (st :dirty) (list nil nil t)))))
@@ -629,15 +582,15 @@ Event handlers + daemon I/O + main loop.
;; v0.8.0 — command palette for daemon commands (Ctrl+P)
(defun command-palette-show-commands ()
(let* ((on-select (lambda (opt)
(let ((cmd (getf opt :value)))
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(add-msg :system (format nil "Dispatching: ~s" cmd))
(send-daemon (list :type :event :payload cmd))
(setf (st :busy) t)
(setf (st :dirty) (list t t nil)))))
(sel (cl-tty.select:make-select :options *daemon-commands* :on-select on-select))
(let* ((on-select (lambda (cmd)
(pop (st :dialog-stack))
(setf (st :command-palette-active) nil)
(let ((action (getf cmd :value)))
(send-daemon (list :type :event :payload action))
(add-msg :system (format nil "Sent: ~a" action)))
(setf (st :dirty) (list t t nil))))
(sel (cl-tty.select:make-select :options *daemon-commands*
:on-select on-select))
(dlg (make-instance 'cl-tty.dialog:dialog
:title "Command Palette"
:content sel)))
@@ -863,8 +816,70 @@ Event handlers + daemon I/O + main loop.
(setf (st :dirty) (list nil t nil))))
(:npage (lambda (e) (declare (ignore e))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))))))
(setf (st :dirty) (list nil t nil))))
;; v0.9.0 — Readline keybindings
(:ctrl+a (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) 0)))
(:ctrl+e (lambda (e) (declare (ignore e))
(setf (st :cursor-pos) (length (st :input-buffer)))))
(:ctrl+u (lambda (e) (declare (ignore e))
(setf (st :input-buffer) nil)
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list nil nil t))))
(:ctrl+w (lambda (e) (declare (ignore e))
(let ((buf (st :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(loop while (and buf (char/= (first buf) #\Space)) do (pop buf))
(setf (st :input-buffer) buf)
(setf (st :dirty) (list nil nil t)))))
(:ctrl+k (lambda (e) (declare (ignore e))
(let* ((s (input-string))
(pos (or (st :cursor-pos) 0))
(killed (subseq s pos)))
(setf (st :kill-ring) killed)
(setf (st :input-buffer) (reverse (coerce (subseq s 0 pos) 'list)))
(setf (st :dirty) (list nil nil t)))))
(:ctrl+y (lambda (e) (declare (ignore e))
(let ((killed (st :kill-ring)))
(when killed
(dolist (ch (reverse (coerce killed 'list)))
(push ch (st :input-buffer)))
(setf (st :cursor-pos) (length (st :input-buffer)))
(setf (st :dirty) (list nil nil t))))))
(:ctrl+l (lambda (e) (declare (ignore e))
(setf (st :dirty) (list t t t))))
(:ctrl+d (lambda (e) (declare (ignore e))
(when (or (null (st :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))))
(:ctrl+f (lambda (e) (declare (ignore e))
(add-msg :system "Use /search <query> to find messages")))
(:ctrl+g (lambda (e) (declare (ignore e))
(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")))))
(:alt+enter (lambda (e) (declare (ignore e))
(push #\Newline (st :input-buffer))
(setf (st :dirty) (list nil nil t))))
;; v0.9.0 — Ctrl+X prefix + help
(:ctrl+x (lambda (e) (declare (ignore e))
(setf (st :pending-ctrl-x) t)))
(:? (lambda (e) (declare (ignore e))
(add-msg :system "Keybindings: Ctrl+P palette | Ctrl+B sidebar | Ctrl+F search | Ctrl+L redraw | Ctrl+D quit | Ctrl+Q quit | PageUp/Dn scroll | Esc interrupt | Tab complete | Up/Dn history")
(add-msg :system "Commands: /eval <expr> | /undo | /redo | /why | /identity | /tags | /audit | /search | /context | /focus | /scope | /unfocus | /theme | /reconnect | /help")
(setf (st :dirty) (list t t nil))))))
;; v0.8.0 — Prompt/local keymap (for when input is active)
(eval-when (:load-toplevel :execute)
(cl-tty.input:defkeymap :local
@@ -950,44 +965,59 @@ Event handlers + daemon I/O + main loop.
(let ((f (cl-tty.select:select-filter sel)))
(when (> (length f) 0)
(setf (cl-tty.select:select-filter sel) (subseq f 0 (1- f)))))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
;; v0.9.0 — Mouse wheel support
((cl-tty.input:mouse-event-p data)
(let ((btn (cl-tty.input:mouse-event-button data)))
(cond
((eql btn :scroll-up)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 3))))
(setf (st :dirty) (list nil t nil)))
((eql btn :scroll-down)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 3)))
(setf (st :dirty) (list nil t nil))))))
((cl-tty.input:dispatch-key-event data)
nil)
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear be)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
;; Draw separator line above input
(cl-tty.backend:draw-text be 0 (- h 4) (make-string w :initial-element #\─)
(theme-color :separator) nil)
(rotatef prev-fb curr-fb))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my (floor (- h dh) 2)))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg :bright-black))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :highlight))
(t (theme-color :agent)))
nil :bold sel-p)
(incf y-off)))))))
(let ((ds (st :dialog-stack)))
(when ds
(let* ((dlg (car ds))
(sel (cl-tty.dialog:dialog-content dlg))
(filtered (cl-tty.select:select-filtered-options sel))
(sel-idx (cl-tty.select:select-selected-index sel))
(cnt (length filtered))
(dw 60) (dh (min 20 (+ 4 cnt)))
(mx (floor (- w dw) 2))
(my 3))
(dotimes (row h)
(cl-tty.backend:draw-rect be 0 row w 1 :bg (theme-color :status-bg)))
(cl-tty.backend:draw-border be mx my dw dh :style :single
:title (cl-tty.dialog:dialog-title dlg)
:fg (theme-color :user-border))
(let ((y-off 1))
(dolist (item filtered)
(let* ((display-idx (first item))
(option (third item))
(title (getf option :title))
(cat (getf option :category))
(sel-p (eql display-idx sel-idx))
(text (if cat (format nil " ~a" title)
(format nil " ~:[ ~;▸~] ~a" sel-p title))))
(when (>= y-off (1- dh)) (return))
(cl-tty.backend:draw-text be (1+ mx) (+ my y-off) text
(cond (cat (theme-color :dim))
(sel-p (theme-color :accent))
(t (theme-color :agent-fg)))
nil :bold sel-p)
(incf y-off)))))))
(sleep 0.1))))
(disconnect-daemon))))
#+END_SRC
@@ -1167,25 +1197,27 @@ Event handlers + daemon I/O + main loop.
(fiveam:is (eq nil (st :busy))))
(fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings."
(fiveam:is (eq :green (getf *tui-theme* :user)))
(fiveam:is (eq :white (getf *tui-theme* :agent)))
(fiveam:is (eq :yellow (getf *tui-theme* :system)))
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
"Contract view: *tui-theme* provides warm color mappings."
(fiveam:is (string= "#FFB347" (getf *tui-theme* :user-fg)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :agent-fg)))
(fiveam:is (string= "#C8A87C" (getf *tui-theme* :system)))
(fiveam:is (string= "#E8D5B7" (getf *tui-theme* :input-fg)))
(fiveam:is (string= "#FFFFFF" (theme-color :unknown-role))))
(fiveam:test test-on-key-ctrl-u-clears
"Contract 1/v0.7.0: Ctrl+U clears the input buffer."
"Contract v0.9.0: Ctrl+U (via dispatch-key-event) clears the input buffer."
(init-state)
(dolist (ch '(#\h #\i)) (on-key (char-code ch)))
(on-key 21) ; Ctrl+U
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :u :ctrl t :code 21))
(fiveam:is (string= "" (input-string))))
(fiveam:test test-on-key-ctrl-l-redraws
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
"Contract v0.9.0: Ctrl+L (via dispatch-key-event) sets all dirty flags."
(init-state)
(setf (st :dirty) (list nil nil nil))
(on-key 12) ; Ctrl+L
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :l :ctrl t :code 12))
(let ((d (st :dirty)))
(fiveam:is (eq t (first d)))
(fiveam:is (eq t (second d)))))
@@ -1205,7 +1237,7 @@ Event handlers + daemon I/O + main loop.
(init-state)
(dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch)))
(on-key 9)
(fiveam:is (search "dark" (input-string) :test #'char-equal)))
(fiveam:is (search "amber" (input-string) :test #'char-equal)))
;; ── v0.7.1 Streaming ──
@@ -1371,22 +1403,25 @@ Event handlers + daemon I/O + main loop.
;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──
(fiveam:test test-ctrlg-toggle-gate-trace
"Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) toggles gate-trace collapse state."
(init-state)
(add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(on-key 7) ;; Ctrl+G — first press hides
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "hidden" (getf m :content))))
(on-key 7) ;; second press shows
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "shown" (getf m :content)))))
(fiveam:test test-ctrlg-no-gate-trace
"Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
"Contract v0.9.0: Ctrl+G (via dispatch-key-event) with no gate trace shows fallback."
(init-state)
(on-key 7)
(cl-tty.input:dispatch-key-event
(cl-tty.input:make-key-event :key :g :ctrl t :code 7))
(let ((m (aref (st :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content)))))