Amr Gharbeia
b9a4318ef8
- Changed all 50 org file :tangle targets from ../lisp/ to ~/.local/share/passepartout/lisp/ (XDG data dir) - Removed 49 generated .lisp files from project lisp/ directory - Removed tests/system-integration-tests.lisp (generated) - Removed lisp/*.fasl (compiled, stale) - Updated core-manifest.org to tangle .asd to XDG root - Remapped quicklisp symlink: local-projects/passepartout → XDG TUI fixes in channel-tui-main.org: - Removed with-raw-terminal (stty raw breaks fd 0 reads in this SBCL) - Use cat subprocess + pipe for keyboard input (via :input :interactive) - Blocking read-char on pipe with with-timeout 0.1s for daemon processing - Key events queued via drain-queue alongside daemon messages - Full dialog key routing (Escape, Up/Down, Enter, filters, Backspace) - SIGWINCH resize handling - Post-handshake backend-size re-query - Daemon version in status bar (was v0.5.0 hardcoded) - Handshake version stored in state, no add-msg - :daemon-version and :size-queried in state plist - view-status uses draw-rect for background - Test section gated with #+passepartout-tests
16 KiB
16 KiB
Passepartout TUI — Model
Model
The TUI state is a single plist accessed via st / (setf st).
All state mutation flows through event handlers in the controller.
Contract
- (init-state): returns a fresh state plist with
:msgslist,:inputbuffer,:dirtyflag,:busyflag, and:connectionstatus. - (add-msg role content &key gate-trace): appends a message object
to the
:messagesvector (v0.3.3), tagged with timestamp, role, and optional gate-trace from the daemon (v0.4.0). - (queue-event ev): thread-safely enqueues an event for the reader loop. (drain-queue) returns and clears the queue.
Package + State
(defpackage :passepartout.channel-tui
(:use :cl :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw
:on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon
:*tui-theme* :theme-color))
(in-package :passepartout.channel-tui)
(defvar *state* nil)
(defvar *event-queue* nil)
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defvar *tui-theme*
'(: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*
'(: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* :amber
"Name of the currently active theme preset.")
(defun theme-save ()
"Persist current theme to disk."
(let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
(user-homedir-pathname))))
(uiop:ensure-all-directories-exist (list path))
(with-open-file (out path :direction :output :if-exists :supersede :if-does-not-exist :create)
(format out ";; Passepartout TUI theme — auto-generated~%")
(format out "(setf passepartout.channel-tui::*tui-theme* '~s)~%" *tui-theme*)
(format out "(setf passepartout.channel-tui::*tui-theme-current-name* ~s)~%" *tui-theme-current-name*))
t))
(defun theme-load ()
"Load persisted theme from disk. Called at startup."
(let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
(user-homedir-pathname))))
(when (uiop:file-exists-p path)
(ignore-errors (load path)))))
(defun theme-switch (name)
"Switch to a named theme preset. Returns the preset name or nil if not found."
(let* ((key (intern (string-upcase (string name)) :keyword))
(preset (getf *tui-theme-presets* key)))
(when preset
(setf *tui-theme* (copy-list preset)
*tui-theme-current-name* key)
(theme-save)
(setf (st :dirty) (list t t t))
key)))
(defun theme-color (role)
"Returns a hex color string for a semantic role, suitable for cl-tty."
(let ((val (or (getf *tui-theme* role) :white)))
(cond
((stringp val) val)
(t (case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(:bright-black "#666666") (:bright-yellow "#FFD700")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
(defun init-state ()
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages (make-array 16 :adjustable t :fill-pointer 0)
:scroll-offset 0 :busy nil :cursor-pos 0
:pending-ctrl-x nil
:scroll-at-bottom t :scroll-notify nil
:streaming-text nil :url-buffer nil ; v0.7.1
:collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0
: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
:session-cost 0.0 ; v0.9.0
:daemon-version nil ; filled by handshake
:dirty (list nil nil nil))))Sidebar panel definitions
(defvar *sidebar-panels*
'((:id :gate-trace :title "Gate Trace" :width 28)
(:id :focus :title "Focus" :width 28)
(:id :rules :title "Rules" :width 28)
(:id :context :title "Context" :width 28)
(:id :cost :title "Cost" :width 28)
(:id :files :title "Files" :width 28))
"Sidebar panel definitions for cl-tty slot registrations.")Helpers
(defun now ()
(multiple-value-bind (s m h) (get-decoded-time)
(declare (ignore s))
(format nil "~2,'0d:~2,'0d" h m)))
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun input-insert-char (ch)
"Insert character at cursor position into the input buffer."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0))
(s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1+ pos))))
(defun input-delete-char ()
"Delete character before cursor position (standard backspace)."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0)))
(when (and buf (> pos 0))
(let* ((s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1- pos))))))
(defun add-msg (role content &key gate-trace panel)
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages))
;; v0.7.0: notify when scrolled up and new msg arrives
(unless (st :scroll-at-bottom)
(setf (st :scroll-notify) t))
(setf (st :dirty) (list t t nil)))Slash Commands
(defvar *slash-commands*
'((:title "/eval <expr> — Evaluate Lisp" :value "/eval" :category :session)
(:title "/undo — Undo last operation" :value "/undo" :category :session)
(:title "/redo — Redo last operation" :value "/redo" :category :session)
(:title "/reconnect — Re-establish daemon" :value "/reconnect" :category :session)
(:title "/quit — Save history and exit" :value "/quit" :category :session)
(:title "/q — Quick quit" :value "/q" :category :session)
(:title "/why — Show last gate trace" :value "/why" :category :memory)
(:title "/identity — Edit IDENTITY.org" :value "/identity" :category :memory)
(:title "/tags — List tag severities" :value "/tags" :category :memory)
(:title "/audit <id> — Inspect memory" :value "/audit" :category :memory)
(:title "/audit verify — Memory integrity" :value "/audit verify" :category :memory)
(:title "/rewind <n> — Rewind to snapshot" :value "/rewind" :category :memory)
(:title "/sessions — Show memory snapshots" :value "/sessions" :category :memory)
(:title "/resume <n> — Resume from snapshot" :value "/resume" :category :memory)
(:title "/focus <project> — Set context" :value "/focus" :category :system)
(:title "/scope <scope> — Change scope" :value "/scope" :category :system)
(:title "/unfocus — Pop context" :value "/unfocus" :category :system)
(:title "/theme [name] — Show/switch theme" :value "/theme" :category :system)
(:title "/context — Show context summary" :value "/context" :category :system)
(:title "/context why <id> — Debug memory" :value "/context why" :category :system)
(:title "/context dropped — Estimate pruned" :value "/context dropped" :category :system)
(:title "/search <query> — Search messages" :value "/search" :category :navigation)
(:title "/help — Show commands" :value "/help" :category :help)
(:title "/help <topic> — Search manual" :value "/help <topic>" :category :help))
"Slash commands for minibuffer select-dialog.")Daemon Commands
(defvar *daemon-commands*
'((:title "Status — Daemon health info" :value (:action :status) :category :session)
(:title "Stats — Daemon statistics" :value (:action :stats) :category :session)
(:title "Ping — Daemon reachability" :value (:action :ping) :category :session)
(:title "Memory Snapshot — Capture state" :value (:action :memory-snapshot) :category :memory)
(:title "Memory Rebuild — Rebuild indices" :value (:action :memory-rebuild) :category :memory)
(:title "Memory Compact — Optimize storage" :value (:action :memory-compact) :category :memory)
(:title "Reload Config — Reload configuration" :value (:action :reload-config) :category :system)
(:title "Reload Identity — Reload identity file" :value (:action :reload-identity) :category :system)
(:title "List Skills — Available skills" :value (:action :list-skills) :category :system)
(:title "Help — Show daemon help" :value (:action :help) :category :help))
"Daemon commands for the command palette (Ctrl+P).")Event Queue
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
(defun drain-queue ()
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))