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:
@@ -82,54 +82,7 @@
|
||||
(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
|
||||
@@ -387,19 +340,19 @@
|
||||
(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 "))
|
||||
@@ -485,11 +438,11 @@
|
||||
(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)))))
|
||||
@@ -595,15 +548,15 @@
|
||||
|
||||
;; 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)))
|
||||
@@ -819,8 +772,70 @@
|
||||
(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
|
||||
@@ -906,44 +921,59 @@
|
||||
(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))))
|
||||
|
||||
@@ -1120,25 +1150,27 @@
|
||||
(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)))))
|
||||
@@ -1158,7 +1190,7 @@
|
||||
(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 ──
|
||||
|
||||
@@ -1324,22 +1356,25 @@
|
||||
;; ── 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)))))
|
||||
|
||||
|
||||
@@ -13,68 +13,102 @@
|
||||
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
|
||||
|
||||
(defvar *tui-theme*
|
||||
;; Roles
|
||||
'(:user :green :agent :white :system :yellow
|
||||
;; Content
|
||||
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
|
||||
;; Status
|
||||
:connected :green :disconnected :red :busy :magenta :idle :white
|
||||
;; Gate trace
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
:hitl :magenta
|
||||
;; Tools (future use)
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
|
||||
;; Display
|
||||
:scroll-indicator :cyan :border :white :background :black
|
||||
;; Differentiator (v0.4.0)
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
;; UI
|
||||
:dim :white :highlight :cyan :accent :green
|
||||
;; Degraded
|
||||
:degraded :bright-yellow)
|
||||
"Color theme plist. 28 semantic keys → hex color strings.
|
||||
See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
'(:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
|
||||
:agent-header "#D4956A" :agent-fg "#E8D5B7"
|
||||
:system "#C8A87C"
|
||||
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
|
||||
:hint "#A08060"
|
||||
:status-bg "#2A1F1A" :status-fg "#D4A574"
|
||||
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
|
||||
:error "#E2584A"
|
||||
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
|
||||
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
|
||||
"Warm amber/gold color theme. 20 semantic keys → hex color strings.")
|
||||
|
||||
(defvar *tui-theme-presets*
|
||||
'(:dark (:user :green :agent :white :system :yellow
|
||||
:input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
|
||||
:connected :green :disconnected :red :busy :magenta :idle :white
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
|
||||
:scroll-indicator :cyan :border :white :background :black
|
||||
:rule-count :cyan :focus-map :yellow
|
||||
:dim :white :highlight :cyan :accent :green
|
||||
:degraded :bright-yellow)
|
||||
:light (:user :blue :agent :black :system :red
|
||||
:input :black :timestamp :yellow :help :blue :error :red :warning :yellow
|
||||
:connected :green :disconnected :red :busy :magenta :idle :black
|
||||
:gate-passed :green :gate-blocked :red :gate-approval :yellow
|
||||
:tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
|
||||
:scroll-indicator :blue :border :black :background :white
|
||||
:rule-count :blue :focus-map :red
|
||||
:dim :white :highlight :blue :accent :green
|
||||
:degraded :bright-yellow)
|
||||
:gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
|
||||
:input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
|
||||
:connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
|
||||
:gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f"
|
||||
:tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
|
||||
:scroll-indicator "#83a598" :border "#a89984" :background "#282828"
|
||||
:rule-count "#83a598" :focus-map "#fabd2f"
|
||||
:dim "#928374" :highlight "#83a598" :accent "#b8bb26"
|
||||
:degraded "#fabd2f")
|
||||
:solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
|
||||
:input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
|
||||
:connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
|
||||
:gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900"
|
||||
:tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
|
||||
:scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
|
||||
:rule-count "#2aa198" :focus-map "#b58900"
|
||||
:dim "#586e75" :highlight "#2aa198" :accent "#859900"
|
||||
:degraded "#b58900"))
|
||||
"Named theme presets. /theme <name> loads one into *tui-theme*.")
|
||||
'(:amber (:user-fg "#FFB347" :user-bg "#3A2A1A" :user-border "#CC8800"
|
||||
:agent-header "#D4956A" :agent-fg "#E8D5B7"
|
||||
:system "#C8A87C"
|
||||
:input-prompt "#FF8C42" :input-fg "#E8D5B7"
|
||||
:hint "#A08060"
|
||||
:status-bg "#2A1F1A" :status-fg "#D4A574"
|
||||
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
|
||||
:error "#E2584A"
|
||||
:tool-running "#FF8C42" :tool-done "#7CCC6C" :tool-error "#E2584A"
|
||||
:separator "#4A3A2A" :accent "#FFB347" :dim "#8B7355")
|
||||
:gold (:user-fg "#FFD700" :user-bg "#3A3020" :user-border "#DAA520"
|
||||
:agent-header "#D4A574" :agent-fg "#F0E6D0"
|
||||
:system "#C8A87C"
|
||||
:input-prompt "#FFA500" :input-fg "#F0E6D0"
|
||||
:hint "#A08060"
|
||||
:status-bg "#2A1F1A" :status-fg "#DAA520"
|
||||
:dot-connected "#7CCC6C" :dot-disconnected "#E2584A"
|
||||
:error "#E2584A"
|
||||
:tool-running "#FFA500" :tool-done "#7CCC6C" :tool-error "#E2584A"
|
||||
:separator "#4A3A2A" :accent "#FFD700" :dim "#8B7355")
|
||||
:terracotta (:user-fg "#E87A5D" :user-bg "#2D1C15" :user-border "#C0684A"
|
||||
:agent-header "#D4956A" :agent-fg "#E0C8B0"
|
||||
:system "#A08060"
|
||||
:input-prompt "#E87A5D" :input-fg "#E0C8B0"
|
||||
:hint "#8B6F5E"
|
||||
:status-bg "#1F1410" :status-fg "#D4956A"
|
||||
:dot-connected "#6CB85C" :dot-disconnected "#D94A3A"
|
||||
:error "#D94A3A"
|
||||
:tool-running "#E87A5D" :tool-done "#6CB85C" :tool-error "#D94A3A"
|
||||
:separator "#3A2820" :accent "#E87A5D" :dim "#7A6050")
|
||||
:sepia (:user-fg "#C4A882" :user-bg "#2A2218" :user-border "#A08860"
|
||||
:agent-header "#B89870" :agent-fg "#D4C4A8"
|
||||
:system "#9A8A6A"
|
||||
:input-prompt "#C4A882" :input-fg "#D4C4A8"
|
||||
:hint "#8A7A5E"
|
||||
:status-bg "#1E1810" :status-fg "#B89870"
|
||||
:dot-connected "#7AAC5C" :dot-disconnected "#C84A3A"
|
||||
:error "#C84A3A"
|
||||
:tool-running "#C4A882" :tool-done "#7AAC5C" :tool-error "#C84A3A"
|
||||
:separator "#3A3020" :accent "#C4A882" :dim "#7A6A50")
|
||||
:nord-warm (:user-fg "#D4A574" :user-bg "#2A2220" :user-border "#B8885A"
|
||||
:agent-header "#C49870" :agent-fg "#E0D0C0"
|
||||
:system "#A89080"
|
||||
:input-prompt "#D08770" :input-fg "#E0D0C0"
|
||||
:hint "#908070"
|
||||
:status-bg "#1E1A18" :status-fg "#C8A080"
|
||||
:dot-connected "#7CB860" :dot-disconnected "#D06050"
|
||||
:error "#D06050"
|
||||
:tool-running "#D08770" :tool-done "#7CB860" :tool-error "#D06050"
|
||||
:separator "#3A3030" :accent "#D4A574" :dim "#807060")
|
||||
:monokai-warm (:user-fg "#E6B87D" :user-bg "#1E1A16" :user-border "#CC9966"
|
||||
:agent-header "#D4A06A" :agent-fg "#D8C8B0"
|
||||
:system "#A89070"
|
||||
:input-prompt "#E6B87D" :input-fg "#D8C8B0"
|
||||
:hint "#8A7A5E"
|
||||
:status-bg "#141210" :status-fg "#CC9966"
|
||||
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
|
||||
:error "#D94A3A"
|
||||
:tool-running "#E6B87D" :tool-done "#7AB85C" :tool-error "#D94A3A"
|
||||
:separator "#2E2820" :accent "#E6B87D" :dim "#7A6A50")
|
||||
:gruvbox-warm (:user-fg "#D8A657" :user-bg "#1D1A16" :user-border "#B8884A"
|
||||
:agent-header "#C8A070" :agent-fg "#E0C8A8"
|
||||
:system "#A89070"
|
||||
:input-prompt "#D8A657" :input-fg "#E0C8A8"
|
||||
:hint "#8A7A5E"
|
||||
:status-bg "#141210" :status-fg "#C8A070"
|
||||
:dot-connected "#7AB85C" :dot-disconnected "#D94A3A"
|
||||
:error "#D94A3A"
|
||||
:tool-running "#D8A657" :tool-done "#7AB85C" :tool-error "#D94A3A"
|
||||
:separator "#2E2820" :accent "#D8A657" :dim "#7A6A50")
|
||||
:light-amber (:user-fg "#CC6600" :user-bg "#FFF5E6" :user-border "#CC8800"
|
||||
:agent-header "#8B6914" :agent-fg "#3A2A1A"
|
||||
:system "#6B5B3E"
|
||||
:input-prompt "#CC6600" :input-fg "#3A2A1A"
|
||||
:hint "#8B7355"
|
||||
:status-bg "#E8D5B7" :status-fg "#3A2A1A"
|
||||
:dot-connected "#2E8B57" :dot-disconnected "#CC3300"
|
||||
:error "#CC3300"
|
||||
:tool-running "#CC6600" :tool-done "#2E8B57" :tool-error "#CC3300"
|
||||
:separator "#C8B898" :accent "#CC6600" :dim "#8B7355"))
|
||||
"8 warm theme presets.")
|
||||
|
||||
(defvar *tui-theme-current-name* :dark
|
||||
(defvar *tui-theme-current-name* :amber
|
||||
"Name of the currently active theme preset.")
|
||||
|
||||
(defun theme-save ()
|
||||
@@ -115,7 +149,7 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
|
||||
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
|
||||
(:white "#FFFFFF") (:black "#000000")
|
||||
(:bright-yellow "#FFD700")
|
||||
(:bright-black "#666666") (:bright-yellow "#FFD700")
|
||||
(t "#FFFFFF"))))))
|
||||
|
||||
(defun st (key) (getf *state* key))
|
||||
@@ -137,11 +171,13 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
|
||||
:sidebar-width 30 ; v0.8.0
|
||||
:expand-tool-calls nil ; v0.8.0
|
||||
:mcp-count 0 ; v0.8.0
|
||||
:kill-ring nil ; v0.9.0
|
||||
:dialog-stack nil ; v0.8.0
|
||||
:minibuffer-active nil ; v0.8.0
|
||||
:command-palette-active nil ; v0.8.0
|
||||
:command-palette-dialog nil ; v0.8.0
|
||||
:dirty (list nil nil nil))))
|
||||
:command-palette-active nil ; v0.8.0
|
||||
:command-palette-dialog nil ; v0.8.0
|
||||
:session-cost 0.0 ; v0.9.0
|
||||
:dirty (list nil nil nil))))
|
||||
|
||||
(defvar *sidebar-panels*
|
||||
'((:id :gate-trace :title "Gate Trace" :width 28)
|
||||
|
||||
@@ -13,43 +13,17 @@ Returns a list of strings, one per line."
|
||||
(push text lines)
|
||||
(nreverse lines)))
|
||||
|
||||
(defun view-status (fb w)
|
||||
(let* ((degraded (and (find-package :passepartout)
|
||||
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
|
||||
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
|
||||
(bg (if degraded (theme-color :degraded) nil)))
|
||||
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
|
||||
(cl-tty.backend:draw-text fb 1 1
|
||||
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
|
||||
(if (st :connected) "● Connected" "○ Disconnected")
|
||||
(string-upcase (string (st :mode)))
|
||||
(length (st :messages))
|
||||
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
|
||||
(or (st :rule-count) 0)
|
||||
(if (st :streaming-text) " [streaming]"
|
||||
(if (st :busy) " …thinking" "")))
|
||||
(theme-color (if (st :connected) :connected :disconnected)) bg)
|
||||
;; Line 2: Focus + Timestamp
|
||||
(let ((focus-info (or (st :foveal-id) "")))
|
||||
(when (and focus-info (> (length focus-info) 0))
|
||||
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
|
||||
(theme-color :timestamp) bg)))
|
||||
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
|
||||
(theme-color :timestamp) bg)
|
||||
;; Line 3: Directory, LSP, MCP, commands hint (v0.8.0)
|
||||
(let* ((cwd (or (uiop:getenv "PWD") (uiop:getcwd)))
|
||||
(dir (subseq cwd (max 0 (- (length cwd) (- w 45)))))
|
||||
(mcp-count (or (st :mcp-count) 0))
|
||||
(hint " Ctrl+P: commands /help: help"))
|
||||
(cl-tty.backend:draw-text fb 1 3 (format nil " ~a" dir) (theme-color :dim) bg)
|
||||
(cl-tty.backend:draw-text fb (+ 2 (length dir)) 3 "●" (theme-color :accent) bg)
|
||||
(cl-tty.backend:draw-text fb (+ 5 (length dir)) 3 (format nil " MCP:~d" mcp-count)
|
||||
(theme-color :dim) bg)
|
||||
(cl-tty.backend:draw-text fb (- w (length hint) 2) 3 hint (theme-color :timestamp) bg))
|
||||
;; Line 4: Degraded mode warning (v0.8.0)
|
||||
(when degraded
|
||||
(cl-tty.backend:draw-text fb 1 4 " ⚠ Degraded mode — components unavailable"
|
||||
(theme-color :warning) (theme-color :degraded)))))
|
||||
(defun view-status (fb w h)
|
||||
(let* ((bg (theme-color :status-bg))
|
||||
(fg (theme-color :status-fg))
|
||||
(left (format nil " ~a ~a Rules:~a"
|
||||
(if (st :connected) "●" "○")
|
||||
(or (st :foveal-id) "passepartout") (or (st :rule-count) 0)))
|
||||
(right (format nil "$~,2f ~a" (or (st :session-cost) 0.0) (now))))
|
||||
(dotimes (col w)
|
||||
(cl-tty.backend:draw-rect fb col (- h 1) 1 1 :bg bg))
|
||||
(cl-tty.backend:draw-text fb 1 (- h 1) left fg nil)
|
||||
(cl-tty.backend:draw-text fb (- w (length right) 2) (- h 1) right fg nil)))
|
||||
|
||||
|
||||
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
|
||||
@@ -70,147 +44,176 @@ Returns a list of strings, one per line."
|
||||
(if (string= result "") content result))))
|
||||
|
||||
(defun view-chat (fb w h)
|
||||
(let* ((msgs (st :messages))
|
||||
(total (length msgs))
|
||||
(max-lines (- h 2))
|
||||
(is-search (st :search-mode))
|
||||
(y 1))
|
||||
;; v0.8.0: search mode header
|
||||
(let* ((msgs (st :messages)) (total (length msgs))
|
||||
(max-lines (- h 4)) (is-search (st :search-mode)) (y 0))
|
||||
(when is-search
|
||||
(let* ((matches (st :search-matches))
|
||||
(idx (st :search-match-idx))
|
||||
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
|
||||
(query (st :search-query))
|
||||
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
|
||||
(length matches) query (1+ idx) (length matches))))
|
||||
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
|
||||
(incf y)
|
||||
(decf max-lines)))
|
||||
;; Pre-compute display lines for each message
|
||||
(let ((msg-lines (make-array total)))
|
||||
(hdr (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
|
||||
(length matches) query (1+ idx) (length matches))))
|
||||
(cl-tty.backend:draw-text fb 1 y hdr (theme-color :accent) nil)
|
||||
(incf y) (decf max-lines)))
|
||||
(let ((msg-lines (make-array total)) (msg-heights (make-array total)))
|
||||
(dotimes (i total)
|
||||
(let* ((msg (aref msgs i))
|
||||
(role (getf msg :role))
|
||||
(content (getf msg :content))
|
||||
(time (or (getf msg :time) ""))
|
||||
(content-show (if is-search (search-highlight content (st :search-query)) content))
|
||||
(lines (case role
|
||||
(:user (cl-tty.box:word-wrap
|
||||
(format nil "│ [~a] ~a" time content-show) (- w 2)))
|
||||
(:agent (let* ((nodes (cl-tty.markdown:parse-blocks content-show))
|
||||
(md-lines (and nodes (cl-tty.markdown:render-md nodes))))
|
||||
(if md-lines
|
||||
(progn (setf (first md-lines)
|
||||
(format nil "[~a] ~a" time (first md-lines)))
|
||||
md-lines)
|
||||
(list (format nil "[~a] " time)))))
|
||||
(t (cl-tty.box:word-wrap
|
||||
(format nil " [~a] ~a" time content-show) (- w 2))))))
|
||||
;; v0.8.0: tool calls — collapsible
|
||||
(let* ((msg (aref msgs i)) (role (getf msg :role))
|
||||
(content (getf msg :content)) (time (or (getf msg :time) ""))
|
||||
(cs (if is-search (search-highlight content (st :search-query)) content))
|
||||
(pairs nil))
|
||||
(case role
|
||||
(:user
|
||||
(let* ((top (format nil "┌─ you ~a ─" time))
|
||||
(top-str (format nil "~a~a┐" top
|
||||
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
|
||||
(body (cl-tty.box:word-wrap cs (- w 4)))
|
||||
(pad (- w 3))
|
||||
(bot (format nil "└~a┘" (make-string (max 0 pad) :initial-element #\─)))
|
||||
(bdr (theme-color :user-border)))
|
||||
(push (list top-str bdr) pairs)
|
||||
(dolist (l body)
|
||||
(push (list (format nil "│ ~a~a│" l
|
||||
(make-string (max 0 (- pad (length l))) :initial-element #\Space))
|
||||
(theme-color :user-fg) (theme-color :user-bg)) pairs))
|
||||
(push (list bot bdr) pairs)))
|
||||
(:agent
|
||||
(let* ((hdr (format nil "── passepartout ~a " time))
|
||||
(hdr-str (format nil "~a~a" hdr
|
||||
(make-string (max 0 (- w (length hdr))) :initial-element #\─)))
|
||||
(nodes (cl-tty.markdown:parse-blocks cs))
|
||||
(body (or (and nodes (cl-tty.markdown:render-md nodes)) (list ""))))
|
||||
(push (list hdr-str (theme-color :agent-header)) pairs)
|
||||
(dolist (l body) (push (list l (theme-color :agent-fg)) pairs))))
|
||||
(t (dolist (l (cl-tty.box:word-wrap cs (- w 2)))
|
||||
(push (list l (theme-color :system)) pairs))))
|
||||
(let ((gt (getf msg :gate-trace)))
|
||||
(when (and gt (eq role :agent))
|
||||
(if (member i (st :collapsed-gates))
|
||||
(push (list (format nil "╎ Gate trace: ~a gates" (length gt))
|
||||
(theme-color :dim)) pairs)
|
||||
(dolist (entry (passepartout::gate-trace-lines gt))
|
||||
(push (list (concatenate 'string "╎ " (car entry))
|
||||
(theme-color (getf (cdr entry) :fgcolor))) pairs)))))
|
||||
(let ((tc (getf msg :tool-calls)))
|
||||
(when tc
|
||||
(if (st :expand-tool-calls)
|
||||
(if (member i (st :collapsed-tools))
|
||||
(let* ((n (or (getf (first tc) :name) "tool"))
|
||||
(d (or (getf (first tc) :duration) 0.0))
|
||||
(extra (reduce #'+ tc :key
|
||||
(lambda (c) (length (cl-tty.box:word-wrap
|
||||
(or (getf c :output) "") (- w 6)))))))
|
||||
(push (list (format nil "┌─ ~a ──── ~,1fs ── [+~d more] ────────┐" n d extra)
|
||||
(theme-color :tool-done)) pairs))
|
||||
(dolist (call tc)
|
||||
(setf lines (append lines
|
||||
(list (format nil " ╎ Tool: ~a" (or (getf call :name) "unknown"))))))
|
||||
(setf lines (append lines
|
||||
(list (format nil " ╎ ~a tool call(s)" (length tc))))))))
|
||||
;; v0.8.0: gate trace — collapsible with left border
|
||||
(let ((gt (getf msg :gate-trace)))
|
||||
(when gt
|
||||
(if (member i (st :collapsed-gates))
|
||||
(setf lines (append lines
|
||||
(list (format nil "╎ Gate trace: ~a gates — Ctrl+G toggle"
|
||||
(length gt)))))
|
||||
(dolist (entry (passepartout::gate-trace-lines gt))
|
||||
(setf lines (append lines
|
||||
(list (concatenate 'string "╎ " (car entry)))))))))
|
||||
(setf (aref msg-lines i) lines)))
|
||||
;; Count visible messages from end
|
||||
(let* ((name (or (getf call :name) "tool"))
|
||||
(dur (or (getf call :duration) 0.0))
|
||||
(st (getf call :status))
|
||||
(out (getf call :output))
|
||||
(bc (theme-color
|
||||
(cond ((eq st :running) :tool-running)
|
||||
((eq st :error) :tool-error)
|
||||
(t :tool-done))))
|
||||
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
|
||||
(ol (when out (cl-tty.box:word-wrap out (- w 6))))
|
||||
(top (format nil "┌─ ~a ──── ~,1fs ─" name dur))
|
||||
(top-str (format nil "~a~a┐" top
|
||||
(make-string (max 0 (- w (length top) 1)) :initial-element #\─)))
|
||||
(bot (format nil "└~a┘" (make-string (max 0 (- w 2)) :initial-element #\─))))
|
||||
(push (list top-str bc) pairs)
|
||||
(dolist (l ol)
|
||||
(push (list (format nil "│ ~a ~a~a│" pfx l
|
||||
(make-string (max 0 (- w (length pfx) (length l) 4))
|
||||
:initial-element #\Space)) bc) pairs))
|
||||
(push (list bot bc) pairs))))))
|
||||
(when (> i 0)
|
||||
(let ((pt (or (getf (aref msgs (1- i)) :time) "")))
|
||||
(flet ((h (s) (if (> (length s) 0) (subseq s 0 (or (position #\: s) 0)) "")))
|
||||
(let ((ph (h pt)) (ch (h time)))
|
||||
(when (and (> (length ch) 0) (string/= ch ph))
|
||||
(let* ((pad (max 0 (floor (- w (length time) 2) 2)))
|
||||
(rpad (- w (length time) 2 pad)))
|
||||
(push (list (format nil "~a ~a ~a"
|
||||
(make-string pad :initial-element #\─)
|
||||
time
|
||||
(make-string rpad :initial-element #\─))
|
||||
(theme-color :separator)) pairs)))))))
|
||||
(setf (aref msg-lines i) (nreverse pairs))
|
||||
(setf (aref msg-heights i) (length pairs))))
|
||||
(let ((msg-count 0) (lines-remaining max-lines))
|
||||
(loop for i from (1- total) downto 0
|
||||
while (> lines-remaining 0)
|
||||
do (let ((nlines (length (aref msg-lines i))))
|
||||
(if (<= nlines lines-remaining)
|
||||
(progn (decf lines-remaining nlines) (incf msg-count))
|
||||
do (let ((h (aref msg-heights i)))
|
||||
(if (<= h lines-remaining)
|
||||
(progn (decf lines-remaining h) (incf msg-count))
|
||||
(setf lines-remaining 0))))
|
||||
;; Render from the correct starting message
|
||||
(let* ((scroll-skip (st :scroll-offset))
|
||||
(start (max 0 (- total msg-count scroll-skip))))
|
||||
(loop for i from start below total
|
||||
while (< y (1- h))
|
||||
do (let* ((msg (aref msgs i))
|
||||
(role (getf msg :role))
|
||||
(lines (aref msg-lines i))
|
||||
(color (theme-color
|
||||
(case role
|
||||
(:user :user) (:agent :agent) (:system :system) (t :agent))))
|
||||
(is-panel (getf msg :panel))
|
||||
(is-resolved (getf msg :panel-resolved)))
|
||||
;; HITL panel coloring
|
||||
(when is-panel
|
||||
(setf color (if is-resolved (theme-color :dim) (theme-color :hitl))))
|
||||
(dolist (line lines)
|
||||
(when (< y (1- h))
|
||||
(cl-tty.backend:draw-text fb 1 y line color nil)
|
||||
(incf y))))))))))
|
||||
(loop for i from start below total while (< y (- h 4))
|
||||
do (let ((pairs (aref msg-lines i)))
|
||||
(dolist (pair pairs)
|
||||
(when (>= y (- h 4)) (return))
|
||||
(destructuring-bind (text color &optional bg) pair
|
||||
(when bg (cl-tty.backend:draw-rect fb 0 y w 1 :bg bg))
|
||||
(cl-tty.backend:draw-text fb 0 y text color nil))
|
||||
(incf y)))))))))
|
||||
|
||||
(defun view-input (fb w)
|
||||
(defun view-input (fb w h)
|
||||
(let* ((text (input-string))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(display-start (max 0 (- pos (1- w))))
|
||||
(visible (subseq text display-start (min (length text) (+ display-start w)))))
|
||||
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
|
||||
(cl-tty.backend:draw-text fb 0 (- h 3) (format nil "> ~a" visible) (theme-color :input-fg) nil)
|
||||
(cl-tty.backend:draw-text fb 0 (- h 2) (format nil " Ctrl+P palette | Up/Dn history | Tab complete")
|
||||
(theme-color :hint) nil)))
|
||||
|
||||
(defun view-sidebar (fb w h)
|
||||
(let ((x (- w (st :sidebar-width))))
|
||||
"Render the right-side sidebar panel with warm colors."
|
||||
(let* ((x (- w (or (st :sidebar-width) 30)))
|
||||
(y 0))
|
||||
;; Vertical separator
|
||||
(dotimes (row h)
|
||||
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg :dim))
|
||||
;; Render panels
|
||||
(let ((y 1))
|
||||
;; Focus panel
|
||||
(when (st :foveal-id)
|
||||
(cl-tty.backend:draw-text fb (1+ x) y " Focus" (theme-color :highlight) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~a" (st :foveal-id)) (theme-color :agent) nil)
|
||||
(incf y 2))
|
||||
;; Rules panel
|
||||
(let ((rules (or (st :rule-count) 0)))
|
||||
(cl-tty.backend:draw-text fb (1+ x) y " Rules" (theme-color :highlight) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d active" rules) (theme-color :agent) nil)
|
||||
(incf y 2))
|
||||
;; Context panel — token gauge
|
||||
(cl-tty.backend:draw-text fb (1+ x) y " Context" (theme-color :highlight) nil)
|
||||
(cl-tty.backend:draw-rect fb (1- x) row 1 1 :bg (theme-color :separator)))
|
||||
;; Focus panel
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) " FOCUS" (theme-color :accent) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~a" (or (st :foveal-id) "none"))
|
||||
(theme-color :agent-fg) nil)
|
||||
(incf y 2)
|
||||
;; Rules panel
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) " RULES" (theme-color :accent) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d active" (or (st :rule-count) 0))
|
||||
(theme-color :agent-fg) nil)
|
||||
(incf y 2)
|
||||
;; Context panel — token gauge
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) " CONTEXT" (theme-color :accent) nil)
|
||||
(incf y)
|
||||
(let* ((msg-count (max 1 (length (st :messages))))
|
||||
(est (* msg-count 60))
|
||||
(limit 8192)
|
||||
(pct (min 100 (floor (* 100 est) limit)))
|
||||
(bar-len (floor pct 10))
|
||||
(bar (make-string bar-len :initial-element #\#)))
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y)
|
||||
(format nil " [~a~a]" bar
|
||||
(make-string (- 10 bar-len) :initial-element #\Space))
|
||||
(theme-color :dim) nil)
|
||||
(incf y)
|
||||
(let* ((msg-count (length (st :messages)))
|
||||
(est (* msg-count 60))
|
||||
(limit 8192)
|
||||
(pct (min 100 (floor (* 100 est) limit)))
|
||||
(bar-len (floor pct 10))
|
||||
(bar (make-string bar-len :initial-element #\#)))
|
||||
(cl-tty.backend:draw-text fb (1+ x) y (format nil " [~a~a]" bar (make-string (- 10 bar-len) :initial-element #\Space)) (theme-color :dim) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d%" pct) (theme-color :timestamp) nil)
|
||||
(incf y 2))
|
||||
;; MCP count
|
||||
(let ((mcp (or (st :mcp-count) 0)))
|
||||
(cl-tty.backend:draw-text fb (1+ x) y " MCP" (theme-color :highlight) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) y (format nil " ~d server~:p" mcp) (theme-color :agent) nil)))))
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d%" pct)
|
||||
(theme-color :status-fg) nil)
|
||||
(incf y 2))
|
||||
;; MCP panel
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) " MCP" (theme-color :accent) nil)
|
||||
(incf y)
|
||||
(cl-tty.backend:draw-text fb (1+ x) (incf y) (format nil " ~d server~:p" (or (st :mcp-count) 0))
|
||||
(theme-color :agent-fg) nil)))
|
||||
|
||||
(defun redraw (fb w h)
|
||||
(destructuring-bind (sd cd id) (st :dirty)
|
||||
(let* ((degraded (and (find-package :passepartout)
|
||||
(boundp (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))
|
||||
(symbol-value (find-symbol "*DEGRADED-COMPONENTS*" :passepartout))))
|
||||
(chat-h (- h (if degraded 6 5))))
|
||||
(when sd (view-status fb w))
|
||||
(when cd (view-chat fb w chat-h))
|
||||
(when id (view-input fb w))
|
||||
(when (and (st :sidebar-visible) (>= w 120))
|
||||
(view-sidebar fb w h))
|
||||
(setf (st :dirty) (list nil nil nil)))))
|
||||
(when sd (view-status fb w h))
|
||||
(when cd (view-chat fb w h))
|
||||
(when id (view-input fb w h))
|
||||
(when (and (st :sidebar-visible) (>= w 120))
|
||||
(view-sidebar fb w h))
|
||||
(setf (st :dirty) (list nil nil nil))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
@@ -286,8 +289,8 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(url (getf attrs :url)))
|
||||
(declare (ignore code))
|
||||
(cl-tty.backend:draw-text fb x y text
|
||||
(cond (url (theme-color :highlight))
|
||||
(t (theme-color (or (getf attrs :role) :agent))))
|
||||
(cond (url (theme-color :accent))
|
||||
(t (theme-color (or (getf attrs :role) :agent-fg))))
|
||||
nil
|
||||
:bold bold)
|
||||
(incf x (length text))))
|
||||
@@ -366,10 +369,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(reason (getf entry :reason))
|
||||
(name (or gate "unknown"))
|
||||
(color (case result
|
||||
(:passed :gate-passed)
|
||||
(:blocked :gate-blocked)
|
||||
(:approval :gate-approval)
|
||||
(t :dim)))
|
||||
(:passed :tool-done)
|
||||
(:blocked :error)
|
||||
(:approval :accent)
|
||||
(t :dim)))
|
||||
(prefix (case result
|
||||
(:passed " \u2713 ")
|
||||
(:blocked " \u2717 ")
|
||||
@@ -468,7 +471,7 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(let ((lines (passepartout::gate-trace-lines
|
||||
'((:gate "path" :result :passed)))))
|
||||
(is (= 1 (length lines)))
|
||||
(is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
|
||||
(is (eq :tool-done (getf (cdar lines) :fgcolor)))))
|
||||
|
||||
(test test-gate-trace-lines-blocked
|
||||
"Contract 9: gate-trace-lines for blocked gate."
|
||||
@@ -507,6 +510,6 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
|
||||
(is (not (and (passepartout.channel-tui::st :sidebar-visible) (>= w 120))))))
|
||||
|
||||
(test test-status-bar-tokens
|
||||
"v0.8.0: status bar uses :degraded and :warning theme tokens."
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :degraded))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :warning)))
|
||||
"v0.9.0: status bar uses :status-fg and :status-bg theme tokens."
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :status-fg))
|
||||
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))
|
||||
|
||||
Reference in New Issue
Block a user