(in-package :passepartout.channel-tui) (defun on-key (&rest args) ;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for ;; backspace). Croatoan's code-key + key-name convert them to keywords ;; so the cond below can use eq. (let* ((raw (car args)) (ch (if (and (integerp raw) (> raw 255)) (or (let* ((k (code-key raw)) (name (and k (key-name k)))) name) ;; Fallback for known ncurses codes when Croatoan ;; key tables aren't available (e.g. in tests) (case raw (343 :enter) (259 :up) (258 :down) (260 :left) (261 :right) (339 :ppage) (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 ((and (eql ch 27) (st :streaming-text)) (send-daemon (list :type :event :payload '(:action :cancel-stream))) (when (> (length (st :messages)) 0) (let ((idx (1- (length (st :messages))))) (setf (getf (aref (st :messages) idx) :content) (concatenate 'string (getf (aref (st :messages) idx) :content) " [interrupted]")) (setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (st :messages) idx) :time) (now)))) (setf (st :streaming-text) nil) (setf (st :busy) nil) (setf (st :dirty) (list t t nil))) ;; v0.7.2: Esc — exit search mode ((and (eql ch 27) (st :search-mode)) (setf (st :search-mode) nil (st :search-matches) nil (st :search-query) "") (setf (st :dirty) (list nil t nil)) (add-msg :system "Search exited")) ;; v0.7.2: search mode — Up/Down navigate matches ((and (st :search-mode) (or (eql ch 259) (eq ch :up))) (let* ((matches (st :search-matches)) (idx (st :search-match-idx)) (new-idx (max 0 (1- idx)))) (setf (st :search-match-idx) new-idx) (when matches (setf (st :scroll-offset) (nth new-idx matches)) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (setf (st :dirty) (list nil t nil))))) ((and (st :search-mode) (or (eql ch 258) (eq ch :down))) (let* ((matches (st :search-matches)) (idx (st :search-match-idx)) (new-idx (min (1- (length matches)) (1+ idx)))) (setf (st :search-match-idx) new-idx) (when matches (setf (st :scroll-offset) (nth new-idx matches)) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (setf (st :dirty) (list nil t nil))))) ;; v0.7.2: search mode — Enter jumps to current match ((and (st :search-mode) (or (eql ch 13) (eql ch 10) (eq ch :enter))) (let ((matches (st :search-matches)) (idx (st :search-match-idx))) (when (and matches (>= (length matches) (1+ idx))) (setf (st :scroll-offset) (nth idx matches)) (setf (st :search-mode) nil (st :search-matches) nil (st :search-query) "") (add-msg :system (format nil "Jumped to match ~d" (1+ idx))) (setf (st :dirty) (list nil t nil))))) ;; v0.7.1: Tab on empty input — extract then open URL from agent message ((and (or (eql ch 9) (eq ch :tab)) (null (st :input-buffer))) (if (st :url-buffer) ;; Already extracted — now open it (progn (add-msg :system (format nil "Opening ~a" (st :url-buffer))) (setf (st :url-buffer) nil)) ;; Extract URL from last agent message (let ((url nil)) (loop for i from (1- (length (st :messages))) downto 0 for msg = (aref (st :messages) i) for content = (getf msg :content) for role = (getf msg :role) while (eq role :agent) when content do (let ((pos (or (search "https://" content) (search "http://" content)))) (when pos (let ((end (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\)))) content :start pos) (length content)))) (setf url (subseq content pos end)) (return))))) (if url (progn (setf (st :url-buffer) url) (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 to find messages")) ((eql ch 28) ; v0.8.0 Ctrl+\ — open setup wizard (wizard-start) (setf (st :dirty) (list t t nil))) ((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 2)) ; Ctrl+X+B — toggle sidebar (setf (st :pending-ctrl-x) nil) (passepartout.channel-tui::sidebar-toggle) (add-msg :system (if (st :sidebar-visible) "Sidebar shown (Ctrl+X+B to hide)" "Sidebar hidden"))) ((eql ch 16) ; Ctrl+P — command palette (setf (st :palette-visible) t (st :palette-filter) "" (st :palette-selected-idx) 0 (st :palette-items) (passepartout.channel-tui::palette-items)) (setf (st :dirty) (list t t nil))) ((eql ch 4) ; Ctrl+D — quit on empty (when (or (null (st :input-buffer)) (string= "" (input-string))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) ((eql ch 6) ; v0.7.2 Ctrl+F — message search (add-msg :system "Use /search to find messages")) ((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse (let ((gate-idx nil)) (loop for i from (1- (length (st :messages))) downto 0 for m = (aref (st :messages) i) when (and (getf m :gate-trace) (listp (getf m :gate-trace))) do (setf gate-idx i) (loop-finish)) (if gate-idx (let ((cg (st :collapsed-gates))) (if (member gate-idx cg) (setf (st :collapsed-gates) (remove gate-idx cg)) (push gate-idx (st :collapsed-gates))) (add-msg :system (format nil "Gate trace ~a for msg ~a" (if (member gate-idx (st :collapsed-gates)) "hidden" "shown") gate-idx)) (setf (st :dirty) (list nil t nil))) (add-msg :system "No gate trace to toggle")))) ((eql ch 24) ; Ctrl+X prefix (setf (st :pending-ctrl-x) t)) ((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 ((or (eq ch :enter) (eql ch 13) (eql ch 10) (eql ch #\Newline) (eql ch #\Return)) ;; Multi-line: if buffer ends with \, strip it and insert newline (if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\)) (progn (pop (st :input-buffer)) (push #\Newline (st :input-buffer)) (setf (st :dirty) (list nil nil t))) (let ((text (string-trim '(#\Space #\Tab) (input-string)))) (when (> (length text) 0) (push text (st :input-history)) (setf (st :input-hpos) 0) (setf (st :scroll-offset) 0) (cond ;; v0.7.2: undo/redo ((string-equal text "/undo") (send-daemon (list :type :event :payload (list :sensor :undo))) (add-msg :system "Undo: restoring memory to previous state")) ((string-equal text "/redo") (send-daemon (list :type :event :payload (list :sensor :redo))) (add-msg :system "Redo: restoring memory")) ;; /help command ((and (>= (length text) 9) (string-equal (subseq text 0 9) "/approve ")) (let ((token (string-trim '(#\Space) (subseq text 9)))) (send-daemon (list :type :event :payload (list :action :hitl-respond :token token :decision :approved))) (add-msg :system (format nil "✓ Approved: ~a" token)) (resolve-hitl-panel :approved))) ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/deny ")) (let ((token (string-trim '(#\Space) (subseq text 6)))) (send-daemon (list :type :event :payload (list :action :hitl-respond :token token :decision :denied))) (add-msg :system (format nil "✗ Denied: ~a" token)) (resolve-hitl-panel :denied))) ;; /help command ;; /why command — show last gate trace ((string-equal text "/why") (let ((msgs (st :messages)) (found nil)) (loop for i from (1- (length msgs)) downto 0 for m = (aref msgs i) for gt = (getf m :gate-trace) when (and gt (listp gt) (> (length gt) 0)) do (setf found t) (dolist (entry gt) (let* ((gate (getf entry :gate)) (result (getf entry :result)) (reason (getf entry :reason)) (msg (format nil "~a ~a~@[ — ~a~]" (case result (:passed "[PASS]") (:blocked "[BLOCKED]") (:approval "[HITL]")) (or gate "unknown") reason))) (add-msg :system msg))) (loop-finish)) (unless found (add-msg :system "No recent gate trace. Run a tool to see gate decisions.")))) ;; /identity command — edit and reload identity file ((string-equal text "/identity") (let* ((editor (or (uiop:getenv "EDITOR") "emacs")) (path (merge-pathnames "memex/IDENTITY.org" (user-homedir-pathname)))) (add-msg :system (format nil "Opening ~a in ~a..." (namestring path) editor)) (uiop:run-program (list editor (namestring path)) :output t :error-output t) (when (fboundp 'load-identity-file) (funcall 'load-identity-file)) (add-msg :system "Identity reloaded"))) ;; /audit command — Merkle provenance ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/audit ")) (if (fboundp 'audit-node) (let* ((node-id (string-trim '(#\Space) (subseq text 7))) (info (funcall 'audit-node node-id))) (if info (add-msg :system (format nil "Node ~a: type=~a scope=~a hash=~a" (getf info :id) (getf info :type) (getf info :scope) (subseq (or (getf info :hash) "(none)") 0 16))) (add-msg :system (format nil "Node ~a not found" node-id)))) (add-msg :system "Memory audit not available"))) ;; /tags command — tag stack ;; /tags command — tag stack ((string-equal text "/tags") (let ((cats *tag-categories*)) (if cats (dolist (entry cats) (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry)))) (add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))) ;; /context command — context visibility ((string-equal text "/context") (let* ((msg-count (length (st :messages))) (focus (or (st :foveal-id) "none")) (id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4))) (tool-tokens (if (boundp '*cognitive-tool-registry*) (floor (* (hash-table-count *cognitive-tool-registry*) 40) 4) 50)) (log-tokens (min 4000 (floor (* msg-count 60) 4))) (overhead-tokens 200) (total-est (+ id-tokens tool-tokens log-tokens overhead-tokens)) (total-limit 8192) (pct-used (floor (* 100 total-est) total-limit))) (add-msg :system (format nil "Context: ~d msgs, focus=~a, ~d/~d tokens (~d%)" msg-count focus total-est total-limit pct-used)) (add-msg :system (format nil "IDENTITY ~5d tokens" id-tokens)) (add-msg :system (format nil "LOGS ~5d tokens" log-tokens)) (add-msg :system (format nil "TOOLS ~5d tokens" tool-tokens)) (add-msg :system (format nil "TIME+CONFIG ~5d tokens" overhead-tokens)))) ;; /context why — debug node ((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why ")) (let ((node-id (string-trim '(#\Space) (subseq text 13)))) (if (fboundp 'memory-object-get) (let ((obj (funcall 'memory-object-get node-id))) (if obj (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a" node-id (memory-object-type obj) (memory-object-scope obj) (memory-object-version obj))) (add-msg :system (format nil "Node ~a not found" node-id)))) (add-msg :system "Memory not available")))) ;; /context dropped — pruned nodes ((string-equal text "/context dropped") (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)")) ;; /search command — message search ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search ")) (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8)))) (msgs (st :messages)) (total (length msgs)) (matches nil)) (loop for i from 0 below total for m = (aref msgs i) for content = (getf m :content) when (search query (string-downcase content)) do (push i matches)) (setf matches (nreverse matches)) ;; Enter search mode (setf (st :search-mode) t (st :search-query) query (st :search-matches) matches (st :search-match-idx) 0) (if matches (add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit" (length matches) query (length matches))) (add-msg :system (format nil "0 matches for '~a'" query))))) ;; /rewind command — session rewind ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) (n (handler-case (parse-integer n-str) (error () nil)))) (if n (if (fboundp 'rollback-memory) (let* ((idx (1- n)) (snaps *memory-snapshots*) (ts (when (< idx (length snaps)) (getf (nth idx snaps) :timestamp)))) (funcall 'rollback-memory idx) (add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts))) (add-msg :system "Memory rollback not available")) (add-msg :system "Usage: /rewind ")))) ;; /sessions command — list snapshots ((string-equal text "/sessions") (let ((snaps *memory-snapshots*)) (if snaps (let ((shown (subseq snaps 0 (min 10 (length snaps))))) (add-msg :system (format nil "~d snapshots (showing ~d):" (length snaps) (length shown))) (loop for s in shown for i from 0 for ts = (getf s :timestamp) for data = (getf s :data) for size = (hash-table-size data) do (add-msg :system (format nil " #~d: ~a objects, timestamp ~d" (1+ i) size ts)))) (add-msg :system "No snapshots available")))) ;; /audit verify — memory integrity ((string-equal text "/audit verify") (let ((count 0) (hashed 0)) (maphash (lambda (k v) (declare (ignore k)) (when v (incf count) (when (memory-object-hash v) (incf hashed)))) *memory-store*) (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots" count hashed (length *memory-snapshots*))))) ;; /resume — resume from snapshot ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) (n (handler-case (parse-integer n-str) (error () nil)))) (if n (if (fboundp 'rollback-memory) (progn (funcall 'rollback-memory (1- n)) (add-msg :system (format nil "Resumed from snapshot ~d" n))) (add-msg :system "Memory rollback not available")) (add-msg :system "Usage: /resume ")))) ;; /help — search user manual ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/help ")) (let* ((topic (string-trim '(#\Space) (subseq text 6))) (results (self-help-lookup topic))) (dolist (entry results) (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry)))) (unless results (add-msg :system (format nil "Topic '~a' not found in USER_MANUAL.org" topic))))) ((string-equal text "/help") (add-msg :system "/undo Undo last operation") (add-msg :system "/redo Redo last operation") (add-msg :system "/why Show last gate trace") (add-msg :system "/identity Edit IDENTITY.org") (add-msg :system "/tags List tag severities") (add-msg :system "/audit Inspect memory object") (add-msg :system "/search Search messages") (add-msg :system "/context Show context summary") (add-msg :system "/eval Evaluate Lisp") (add-msg :system "/rewind Rewind to snapshot N") (add-msg :system "/sessions Show snapshots") (add-msg :system "/resume Resume from snapshot") (add-msg :system "/focus Set project context") (add-msg :system "/theme Show theme") (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))) ;; /theme command ((string-equal text "/theme") (add-msg :system (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a" *tui-theme-current-name* (getf *tui-theme* :user) (getf *tui-theme* :agent) (getf *tui-theme* :system) (getf *tui-theme* :input))) (add-msg :system "Presets: /theme dark | light | solarized | gruvbox")) ((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))))) ;; /eval command ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/eval ")) (handler-case (let* ((*read-eval* t) (*package* (find-package :passepartout.channel-tui)) (r (eval (read-from-string (subseq text 6))))) (add-msg :system (format nil "=> ~s" r))) (error (c) (add-msg :system (format nil "=> ✗ ~a" c))))) ;; /focus — set project context ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus ")) (let ((project (string-trim '(#\Space) (subseq text 7)))) (if (and (fboundp 'focus-project) (> (length project) 0)) (progn (funcall 'focus-project project nil) (add-msg :system (format nil "Focused on project: ~a" project))) (add-msg :system "Usage: /focus ")))) ;; /scope — change context scope ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/scope ")) (let ((scope-str (string-trim '(#\Space) (subseq text 7)))) (cond ((and (fboundp 'focus-session) (string-equal scope-str "session")) (funcall 'focus-session) (add-msg :system "Scope: session")) ((and (fboundp 'focus-project) (string-equal scope-str "project")) (funcall 'focus-project nil nil) (add-msg :system "Scope: project")) ((and (fboundp 'focus-memex) (string-equal scope-str "memex")) (funcall 'focus-memex) (add-msg :system "Scope: memex")) (t (add-msg :system "Usage: /scope memex|session|project"))))) ;; /unfocus — pop context ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/unfocus")) (if (fboundp 'unfocus) (progn (funcall 'unfocus) (add-msg :system "Popped context")) (add-msg :system "Context manager not loaded"))) ;; /quit — save history and exit ((or (string-equal text "/quit") (string-equal text "/q")) (let ((hist-file (merge-pathnames ".cache/passepartout/history" (user-homedir-pathname)))) (uiop:ensure-all-directories-exist (list hist-file)) (with-open-file (out hist-file :direction :output :if-exists :supersede :if-does-not-exist :create) (dolist (entry (reverse (st :input-history))) (write-line entry out)))) (add-msg :system "* Goodbye *") (send-daemon (list :type :event :payload '(:action :quit))) (setf (st :running) nil)) ;; /reconnect — re-establish daemon connection ((string-equal text "/reconnect") (disconnect-daemon) (connect-daemon)) ;; Normal message (t (add-msg :user text) (setf (st :busy) t) (send-daemon (list :type :event :payload (list :sensor :user-input :text text))))) (setf (st :input-buffer) nil) (setf (st :cursor-pos) 0) (setf (st :dirty) (list t t t)))))) ;; Tab — command completion (v0.7.0: extended with subcommand + file paths) ((or (eql ch 9) (eq ch :tab)) (let ((text (input-string))) (cond ;; @ prefix — file path completion ((and (>= (length text) 1) (eql (char text 0) #\@)) (let* ((partial (subseq text 1)) (memex (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))) (proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex)) (files (handler-case (append (uiop:directory-files proj "**/*.org") (uiop:directory-files proj "**/*.lisp")) (error () nil))) (names (mapcar (lambda (f) (subseq (namestring f) (1+ (length (namestring proj))))) files)) (match (find-if (lambda (n) (and (>= (length n) (length partial)) (string-equal n partial :end2 (length partial)))) names))) (when match (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)))) (when match (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list))) (setf (st :dirty) (list nil nil t))))) ;; /focus subcommand ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus ")) (let* ((partial (string-trim '(#\Space) (subseq text 7))) (memex (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))) (proj (merge-pathnames (make-pathname :directory '(:relative "projects")) memex)) (dirs (handler-case (mapcar (lambda (d) (car (last (pathname-directory d)))) (uiop:subdirectories proj)) (error () nil))) (match (if (string= partial "") (first dirs) (find-if (lambda (d) (and (>= (length d) (length partial)) (string-equal d partial :end2 (length partial)))) dirs)))) (when match (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list))) (setf (st :dirty) (list nil nil t))))) ;; Command prefix / ((and (> (length text) 1) (eql (char text 0) #\/)) (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit")) (match (find text cmds :test (lambda (in cmd) (and (>= (length cmd) (length in)) (string-equal cmd in :end1 (length in))))))) (when match (setf (st :input-buffer) (reverse (coerce match 'list))) (when (member match '("/eval" "/focus" "/scope") :test #'string=) (push #\Space (st :input-buffer))) (setf (st :dirty) (list nil nil t)))))))) ;; Backspace ((or (eq ch :backspace) (eql ch 127) (eql ch 8) (eql ch #\Backspace)) (input-delete-char) (setf (st :dirty) (list nil nil t))) ;; Left arrow ((or (eq ch :left) (eql ch 260)) (when (> (or (st :cursor-pos) 0) 0) (decf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Right arrow ((or (eq ch :right) (eql ch 261)) (when (< (or (st :cursor-pos) 0) (length (st :input-buffer))) (incf (st :cursor-pos)) (setf (st :dirty) (list nil nil t)))) ;; Up arrow ((or (eq ch :up) (eql ch 259)) (let* ((h (st :input-history)) (p (st :input-hpos))) (when (and h (< p (1- (length h)))) (incf (st :input-hpos)) (setf (st :input-buffer) (reverse (coerce (nth (st :input-hpos) h) 'list))) (setf (st :dirty) (list nil nil t))))) ;; Down arrow ((or (eq ch :down) (eql ch 258)) (when (> (st :input-hpos) 0) (decf (st :input-hpos)) (let ((h (st :input-history))) (setf (st :input-buffer) (if (and h (< (st :input-hpos) (length h))) (reverse (coerce (nth (st :input-hpos) h) 'list)) nil)) (setf (st :dirty) (list nil nil t))))) ;; PageUp ((or (eq ch :ppage) (eql ch 339)) (let ((page-size (max 10 (floor (length (st :messages)) 3)))) (setf (st :scroll-offset) (+ (st :scroll-offset) page-size))) (setf (st :dirty) (list nil t nil))) ;; PageDown ((or (eq ch :npage) (eql ch 338)) (let ((page-size (max 10 (floor (length (st :messages)) 3)))) (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)))))))) ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny (defun palette-items () "Returns categorized command list for the palette." (let ((items nil)) (push (list :category "Session" :items (list (list :name "/focus" :desc "Set project context" :shortcut "C-o" :action (lambda () (add-msg :system "/focus "))) (list :name "/scope" :desc "Change context scope" :action (lambda () (add-msg :system "/scope memex|session|project"))) (list :name "/unfocus" :desc "Pop context stack" :action (lambda () (send-daemon (list :type :event :payload (list :sensor :unfocus))))) (list :name "/search" :desc "Search messages" :shortcut "C-f" :action (lambda () (add-msg :system "Use /search to find messages"))))) items) (push (list :category "Agent" :items (list (list :name "/why" :desc "Show last gate trace" :shortcut "C-g" :action (lambda () (add-msg :system "Gate trace: use /why"))) (list :name "/audit" :desc "Inspect memory object" :action (lambda () (add-msg :system "/audit "))) (list :name "/context" :desc "Show context budget" :action (lambda () (add-msg :system "/context"))))) items) (push (list :category "View" :items (list (list :name "/theme" :desc "Switch color theme" :action (lambda () (add-msg :system "Presets: dark light solarized gruvbox nord tokyonight catppuccin monokai"))) (list :name "/sidebar" :desc "Toggle sidebar" :shortcut "C-x C-b" :action #'sidebar-toggle) (list :name "/help" :desc "Show all commands" :action (lambda () (add-msg :system "/focus /scope /unfocus /search /why /audit /context /help /theme /sidebar"))))) items) (push (list :category "System" :items (list (list :name "/setup" :desc "Run setup wizard" :shortcut "C-\\" :action (lambda () (wizard-start) (add-msg :system "Setup wizard opened") (setf (st :dirty) (list t t nil)))) (list :name "/eval" :desc "Evaluate Lisp expression" :action (lambda () (add-msg :system "/eval "))) (list :name "/reconnect" :desc "Reconnect to daemon" :action (lambda () (disconnect-daemon) (connect-daemon))) (list :name "/quit" :desc "Save history and exit" :shortcut "C-d" :action (lambda () (add-msg :system "* Goodbye *") (send-daemon (list :type :event :payload '(:action :quit))) (setf (st :running) nil))))) items) (nreverse items))) (defun palette-execute (selected-item) "Execute the selected palette item's action." (when (and selected-item (getf selected-item :action)) (funcall (getf selected-item :action)))) (defun wizard-steps () "Returns the ordered list of setup wizard steps." (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"))))))) (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 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 wizard-cancel () "Dismiss the wizard, preserving state for resumption." (setf (st :wizard-visible) nil (st :dirty) (list t t 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 resolve-hitl-panel (decision) "Mark the most recent HITL panel message as resolved with DECISION." (loop for i from (1- (length (st :messages))) downto 0 for m = (aref (st :messages) i) when (and (getf m :panel) (not (getf m :panel-resolved))) do (setf (getf m :panel-resolved) decision) (setf (aref (st :messages) i) m) (setf (st :dirty) (list nil t nil)) (loop-finish))) (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) (msg-type (getf msg :type)) (action (getf payload :action)) (level (getf msg :level)) (sensor (getf payload :sensor)) (gate-trace (getf msg :gate-trace)) (rule-count (getf payload :rule-count)) (foveal-id (getf payload :foveal-id))) ;; v0.7.2: HITL approval-required panel (when (eq level :approval-required) (let* ((hitl-msg (or (getf payload :message) (getf payload :text) "HITL approval required")) (hitl-action (getf (getf payload :action) :payload)) (tool-name (getf hitl-action :tool)) (explanation (or tool-name "unknown action"))) (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx" hitl-msg explanation) :panel t)) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) ;; v0.7.1: streaming chunk (when (eq msg-type :stream-chunk) (cond ((string= text "") ;; Final chunk: stamp time, clear streaming (when (> (length (st :messages)) 0) (let ((idx (1- (length (st :messages))))) (setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (st :messages) idx) :time) (now)))) (setf (st :streaming-text) nil) (setf (st :busy) nil) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) ((null (st :streaming-text)) ;; First chunk: add new streaming message (setf (st :streaming-text) "") (setf (st :busy) nil) (add-msg :agent text) (let ((idx (1- (length (st :messages))))) (setf (getf (aref (st :messages) idx) :streaming) t)) (setf (st :streaming-text) text) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) (t ;; Subsequent chunk: append (let* ((new-text (concatenate 'string (st :streaming-text) text)) (idx (1- (length (st :messages))))) (setf (st :streaming-text) new-text) (setf (getf (aref (st :messages) idx) :content) new-text) (setf (st :dirty) (list nil t nil))) (return-from on-daemon-msg nil)))) (when rule-count (setf (st :rule-count) rule-count)) (when foveal-id (setf (st :foveal-id) foveal-id)) (cond (text (setf (st :busy) nil) (add-msg :agent text :gate-trace gate-trace)) ((eq action :handshake) (add-msg :system (format nil "Connected v~a" (getf payload :version)))) (t (add-msg :agent (format nil "~a" msg)))))) ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny (defun resolve-hitl-panel (decision) "Mark the most recent HITL panel message as resolved with DECISION." (loop for i from (1- (length (st :messages))) downto 0 for m = (aref (st :messages) i) when (and (getf m :panel) (not (getf m :panel-resolved))) do (setf (getf m :panel-resolved) decision) (setf (aref (st :messages) i) m) (setf (st :dirty) (list nil t nil)) (loop-finish))) ;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections (defun self-help-lookup (topic) "Search USER_MANUAL.org for headlines matching TOPIC, return content previews." (let* ((manual-path (merge-pathnames "projects/passepartout/docs/USER_MANUAL.org" (merge-pathnames "memex/" (user-homedir-pathname)))) (results nil)) (handler-case (let* ((text (uiop:read-file-string manual-path)) (lines (uiop:split-string text :separator '(#\Newline))) (in-section nil) (section-content nil)) (dolist (line lines) (let ((trimmed (string-trim '(#\Space #\Tab) line))) (cond ;; New headline ((and (>= (length trimmed) 2) (eql (char trimmed 0) #\*)) ;; Flush previous section if in one (when (and in-section section-content) (push (cons in-section (string-trim '(#\Space #\Newline) (format nil "~{~a~^ ~}" (reverse section-content)))) results)) ;; Check if this headline matches topic (let ((title (string-trim '(#\Space #\*) trimmed))) (if (search topic title :test #'char-equal) (setf in-section title section-content nil) (setf in-section nil section-content nil)))) ;; Content line in matching section (in-section (when (and (> (length trimmed) 0) (not (eql (char trimmed 0) #\#))) (push trimmed section-content)))))) ;; Flush last section (when (and in-section section-content) (push (cons in-section (string-trim '(#\Space #\Newline) (format nil "~{~a~^ ~}" (reverse section-content)))) results)) (nreverse results)) (error (c) (list (cons "Error" (format nil "Cannot read manual: ~a" c))))))) (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) (msg-type (getf msg :type)) (action (getf payload :action)) (level (getf msg :level)) (sensor (getf payload :sensor)) (gate-trace (getf msg :gate-trace)) (rule-count (getf payload :rule-count)) (foveal-id (getf payload :foveal-id))) ;; v0.7.2: HITL approval-required panel (when (eq level :approval-required) (let* ((hitl-msg (or (getf payload :message) (getf payload :text) "HITL approval required")) (hitl-action (getf (getf payload :action) :payload)) (tool-name (getf hitl-action :tool)) (explanation (or tool-name "unknown action"))) (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx" hitl-msg explanation) :panel t)) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) ;; v0.7.1: streaming chunk (when (eq msg-type :stream-chunk) (cond ((string= text "") ;; Final chunk: stamp time, clear streaming (when (> (length (st :messages)) 0) (let ((idx (1- (length (st :messages))))) (setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (st :messages) idx) :time) (now)))) (setf (st :streaming-text) nil) (setf (st :busy) nil) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) ((null (st :streaming-text)) ;; First chunk: add new streaming message (setf (st :streaming-text) "") (setf (st :busy) nil) (add-msg :agent text) (let ((idx (1- (length (st :messages))))) (setf (getf (aref (st :messages) idx) :streaming) t)) (setf (st :streaming-text) text) (setf (st :dirty) (list nil t nil)) (return-from on-daemon-msg nil)) (t ;; Subsequent chunk: append (let* ((new-text (concatenate 'string (st :streaming-text) text)) (idx (1- (length (st :messages))))) (setf (st :streaming-text) new-text) (setf (getf (aref (st :messages) idx) :content) new-text) (setf (st :dirty) (list nil t nil))) (return-from on-daemon-msg nil)))) (when rule-count (setf (st :rule-count) rule-count)) (when foveal-id (setf (st :foveal-id) foveal-id)) ;; v0.8.0: sidebar enrichment fields (when (getf payload :block-counts) (setf (st :block-counts) (getf payload :block-counts))) (when (getf payload :context-usage) (setf (st :context-usage) (getf payload :context-usage))) (when (getf payload :modified-files) (setf (st :modified-files) (getf payload :modified-files))) (when (getf payload :session-cost) (setf (st :session-cost) (getf payload :session-cost))) (cond (text (setf (st :busy) nil) (add-msg :agent text :gate-trace gate-trace)) ((eq action :handshake) (add-msg :system (format nil "Connected v~a" (getf payload :version)))) (t (add-msg :agent (format nil "~a" msg)))))) (defun send-daemon (msg) (let ((s (st :stream))) (when (and s (open-stream-p s)) (handler-case (progn (format s "~a" (frame-message msg)) (finish-output s)) (error () nil))))) (defun recv-daemon (s) (handler-case (let* ((hdr (make-string 6)) (n 0)) (loop while (< n 6) do (let ((ch (read-char s nil))) (unless ch (return-from recv-daemon nil)) (setf (char hdr n) ch) (incf n))) (let* ((len (parse-integer hdr :radix 16 :junk-allowed t)) (buf (make-string (or len 0)))) (when (and len (> len 0)) (loop for i from 0 below len do (let ((ch (read-char s nil))) (unless ch (return-from recv-daemon nil)) (setf (char buf i) ch))) (let ((*read-eval* nil)) (read-from-string buf))))) (error () nil))) (defun reader-loop (s) (let ((consecutive-nils 0)) (loop while (and (st :running) (open-stream-p s)) do (let ((msg (recv-daemon s))) (if msg (progn (queue-event (list :type :daemon :payload msg)) (setf consecutive-nils 0)) (progn (sleep 0.5) (incf consecutive-nils) (when (> consecutive-nils 10) (queue-event (list :type :disconnected)) (return)))))))) (defun load-history () "Load input history from disk on TUI startup." (let ((hist-file (merge-pathnames ".cache/passepartout/history" (user-homedir-pathname)))) (when (uiop:file-exists-p hist-file) (with-open-file (in hist-file :direction :input) (loop for line = (read-line in nil nil) while line do (push line (st :input-history)))) (setf (st :input-history) (nreverse (st :input-history)))))) (defun connect-daemon (&optional (host "127.0.0.1") (port 9105)) (add-msg :system "* Connecting to daemon... *") (loop for attempt from 1 to 3 for backoff = 0 then 3 do (sleep backoff) (handler-case (let ((s (usocket:socket-connect host port :timeout 5))) (setf (st :stream) (usocket:socket-stream s) (st :connected) t) (bt:make-thread (lambda () (reader-loop (st :stream))) :name "tui-reader") (add-msg :system (format nil "* Connected v~a *" "0.5.0")) (return-from connect-daemon t)) (usocket:connection-refused-error (c) (when (= attempt 3) (add-msg :system (format nil "* No daemon on port ~a after ~a attempts *" port attempt)))) (error (c) (add-msg :system (format nil "* Connection attempt ~a failed: ~a *" attempt c)) (when (= attempt 3) (add-msg :system "* TIP: run 'passepartout daemon' first *"))))) nil) (defun disconnect-daemon () (when (st :stream) (ignore-errors (close (st :stream))) (setf (st :stream) nil (st :connected) nil) (add-msg :system "* Disconnected *"))) (defun tui-run-screen (scr) "The full TUI event loop. Called from tui-main inside with-screen." (let* ((h (or (height scr) 24)) (w (or (width scr) 80)) (sidebar-w (when (>= w 120) (make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44)))) (content-w (if sidebar-w (- w 44) (- w 2))) (ch (- h 5)) (sw (make-instance 'window :height 3 :width content-w :y 0 :x 1)) (cw (make-instance 'window :height ch :width content-w :y 3 :x 1)) (iw (make-instance 'window :height 1 :width content-w :y (- h 1) :x 1)) (swank-port (or (ignore-errors (parse-integer (uiop:getenv "TUI_SWANK_PORT"))) 4006))) (setf (function-keys-enabled-p iw) t (input-blocking iw) nil (st :dirty) (list t t t) (st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw) (connect-daemon) (when (> swank-port 0) (handler-case (progn (ql:quickload :swank :silent t) (funcall (find-symbol "CREATE-SERVER" "SWANK") :port swank-port :dont-close t) (add-msg :system (format nil "* Swank ~d M-x slime-connect *" swank-port))) (error () (add-msg :system "* Swank unavailable *")))) (flet ((recreate-windows (scr-width scr-height) (let* ((new-w scr-width) (new-h scr-height) (has-sidebar (and (>= new-w 120) (st :sidebar-visible))) (new-sidebar-w (when has-sidebar (make-instance 'window :height (- new-h 5) :width 42 :y 3 :x (- new-w 44)))) (new-content-w (if new-sidebar-w (- new-w 44) (- new-w 2))) (new-ch (- new-h 5))) (setq sw (make-instance 'window :height 3 :width new-content-w :y 0 :x 1) ch new-ch cw (make-instance 'window :height new-ch :width new-content-w :y 3 :x 1) iw (make-instance 'window :height 1 :width new-content-w :y (- new-h 1) :x 1) sidebar-w new-sidebar-w w new-w h new-h) (setf (function-keys-enabled-p iw) t (input-blocking iw) nil (st :dirty) (list t t t) (st :sw) sw (st :cw) cw (st :iw) iw)))) (let ((initial-sidebar (and (>= w 120) (st :sidebar-visible)))) (when initial-sidebar (view-sidebar (or sidebar-w (make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44)))) (refresh (or sidebar-w (make-instance 'window :height (- h 5) :width 42 :y 3 :x (- w 44)))))) (redraw sw cw ch iw) (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))) (refresh scr) (loop while (st :running) do (dolist (ev (drain-queue)) (cond ((eq (getf ev :type) :daemon) (on-daemon-msg (getf ev :payload))) ((eq (getf ev :type) :disconnected) (setf (st :connected) nil (st :busy) nil) (add-msg :system "* Connection lost — type /reconnect to retry *")))) (let ((ch (get-char iw))) (cond ((or (not ch) (equal ch -1)) nil) ((eql ch 410) (recreate-windows (or (width scr) 80) (or (height scr) 24)) (redraw sw cw ch iw) (refresh scr)) (t (ignore-errors (on-key ch))))) (redraw sw cw ch iw) (when sidebar-w (view-sidebar sidebar-w) (refresh sidebar-w)) ;; Recreate windows when sidebar visibility or terminal width changes (let ((sidebar-wanted (and (st :sidebar-visible) (>= w 120)))) (when (or (and sidebar-wanted (not sidebar-w)) (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))) (refresh scr) (sleep 0.03)) (disconnect-daemon)))) (defun tui-main () (init-state) (load-history) (theme-load) (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil) (tui-run-screen scr))) (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) (defpackage :passepartout-tui-tests (:use :cl :passepartout :passepartout.channel-tui) (:export #:tui-suite)) (in-package :passepartout-tui-tests) (fiveam:def-suite tui-suite :description "Verification of the TUI model and event handling") (fiveam:in-suite tui-suite) (fiveam:test test-init-state "Contract model.1: init-state returns fresh state plist with required keys." (init-state) (fiveam:is (eq t (st :running))) (fiveam:is (eq :chat (st :mode))) (fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (st :stream))) (fiveam:is (zerop (length (st :messages)))) (fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq nil (st :busy)))) (fiveam:test test-add-msg "Contract model.2: add-msg appends a message with role, content, and time." (init-state) (add-msg :user "hello") (let* ((msgs (st :messages)) (msg (aref msgs 0))) (fiveam:is (eq :user (getf msg :role))) (fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (stringp (getf msg :time))) (fiveam:is (= 5 (length (getf msg :time)))))) (fiveam:test test-add-msg-dirty-flag "Contract model.2: add-msg sets dirty flags for status and chat." (init-state) (setf (st :dirty) (list nil nil nil)) (add-msg :system "boot") (let ((dirty (st :dirty))) (fiveam:is (eq t (first dirty))) (fiveam:is (eq t (second dirty))) (fiveam:is (eq nil (third dirty))))) (fiveam:test test-queue-event-roundtrip "Contract model.3: queue-event + drain-queue preserves events in order." (init-state) (queue-event '(:type :key :payload (:ch 13))) (queue-event '(:type :daemon :payload (:text "hi"))) (let ((evs (drain-queue))) (fiveam:is (= 2 (length evs))) (fiveam:is (equal '(:type :key :payload (:ch 13)) (first evs))) (fiveam:is (equal '(:type :daemon :payload (:text "hi")) (second evs))) (fiveam:is (null (drain-queue))))) (fiveam:test test-on-key-enter-sends-user-message "Contract 1: on-key with Enter extracts input, adds user message, clears buffer." (init-state) ;; Simulate typing "test" (dolist (ch '(#\t #\e #\s #\t)) (on-key (char-code ch))) (fiveam:is (string= "test" (input-string))) ;; Simulate Enter key — ncurses returns 343 (KEY_ENTER) when keypad is enabled (on-key 343) ;; Input buffer should be cleared (fiveam:is (string= "" (input-string))) ;; A user message should be in the message list (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) (let ((last (aref msgs 0))) (fiveam:is (eq :user (getf last :role))) (fiveam:is (string= "test" (getf last :content)))))) (fiveam:test test-on-key-eval-command "Contract 1: on-key handles /eval command and displays result." (init-state) ;; Type "/eval (+ 1 2)" (dolist (ch (coerce "/eval (+ 1 2)" 'list)) (on-key (char-code ch))) (on-key 343) (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) (let ((last-msg (aref msgs 0))) (fiveam:is (eq :system (getf last-msg :role))) (fiveam:is (search "=> 3" (getf last-msg :content)))))) (fiveam:test test-on-key-backspace "Contract 1: on-key with Backspace removes last character from buffer." (init-state) (dolist (ch '(#\a #\b #\c)) (on-key (char-code ch))) (fiveam:is (string= "abc" (input-string))) ;; ncurses returns 263 (KEY_BACKSPACE) when keypad is enabled (on-key 263) (fiveam:is (string= "ab" (input-string)))) (fiveam:test test-on-key-focus-command "Contract 1: /focus command parses project name." (init-state) (dolist (ch (coerce "/focus myapp" 'list)) (on-key (char-code ch))) (on-key 343) (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-scope-command "Contract 1: /scope command with valid argument." (init-state) (dolist (ch (coerce "/scope memex" 'list)) (on-key (char-code ch))) (on-key 343) (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-unfocus-command "Contract 1: /unfocus command dispatches correctly." (init-state) (dolist (ch (coerce "/unfocus" 'list)) (on-key (char-code ch))) (on-key 343) (let ((msg (aref (st :messages) 0))) (fiveam:is (eq :system (getf msg :role))))) (fiveam:test test-on-key-tab-completion "Contract 1: Tab completes / commands when input starts with /." (init-state) (dolist (ch (coerce "/ev" 'list)) (on-key (char-code ch))) (on-key 9) (fiveam:is (string= "/eval " (input-string)))) (fiveam:test test-on-key-tab-no-slash "Contract 1: Tab does nothing when input doesn't start with /." (init-state) (dolist (ch (coerce "hello" 'list)) (on-key (char-code ch))) (on-key 9) (fiveam:is (string= "hello" (input-string)))) (fiveam:test test-on-key-multiline "Contract 1: \\ + Enter inserts newline instead of sending." (init-state) (dolist (ch (coerce "line1" 'list)) (on-key (char-code ch))) (on-key (char-code #\\)) (on-key 343) (fiveam:is (search "line1" (input-string))) (fiveam:is (search (string #\Newline) (input-string)))) (fiveam:test test-on-key-help "Contract 1: /help displays command list." (init-state) (dolist (ch (coerce "/help" 'list)) (on-key (char-code ch))) (on-key 343) (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 3)) (fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs)))) (fiveam:test test-activity-indicator "Contract model: :busy flag is set on send and cleared on agent response." (init-state) (fiveam:is (eq nil (st :busy))) ;; Simulate sending a normal message (sets busy) (dolist (ch (coerce "hello" 'list)) (on-key (char-code ch))) (on-key 343) (fiveam:is (eq t (st :busy))) ;; Simulate receiving an agent response (clears busy) (on-daemon-msg '(:type :event :payload (:text "hi back"))) (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))) (fiveam:is (eq :white (theme-color :unknown-role)))) (fiveam:test test-on-key-ctrl-u-clears "Contract 1/v0.7.0: Ctrl+U clears the input buffer." (init-state) (dolist (ch '(#\h #\i)) (on-key (char-code ch))) (on-key 21) ; Ctrl+U (fiveam:is (string= "" (input-string)))) (fiveam:test test-on-key-ctrl-l-redraws "Contract 1/v0.7.0: Ctrl+L sets all dirty flags." (init-state) (setf (st :dirty) (list nil nil nil)) (on-key 12) ; Ctrl+L (let ((d (st :dirty))) (fiveam:is (eq t (first d))) (fiveam:is (eq t (second d))))) (fiveam:test test-scroll-notify "Contract/v0.7.0: add-msg sets scroll-notify when scrolled up." (init-state) (setf (st :scroll-at-bottom) nil) (add-msg :agent "hi") (fiveam:is (eq t (st :scroll-notify))) (setf (st :scroll-at-bottom) t (st :scroll-notify) nil) (add-msg :agent "hi2") (fiveam:is (eq nil (st :scroll-notify)))) (fiveam:test test-tab-subcommand "Contract/v0.7.0: Tab completes subcommand for /theme." (init-state) (dolist (ch (coerce "/theme " 'list)) (on-key (char-code ch))) (on-key 9) (fiveam:is (search "dark" (input-string) :test #'char-equal))) ;; ── v0.7.1 Streaming ── (fiveam:test test-stream-chunk-appends "Contract/v0.7.1: stream-chunk frame appends to last message." (init-state) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello"))) (on-daemon-msg '(:type :stream-chunk :payload (:text " world"))) (let ((msgs (st :messages))) (fiveam:is (= 1 (length msgs))) (let ((msg (aref msgs 0))) (fiveam:is (eq :agent (getf msg :role))) (fiveam:is (string= "Hello world" (getf msg :content))) (fiveam:is (eq t (getf msg :streaming)))))) (fiveam:test test-stream-chunk-final "Contract/v0.7.1: final empty chunk stamps timestamp and clears streaming flag." (init-state) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi"))) (on-daemon-msg '(:type :stream-chunk :payload (:text ""))) (let ((msg (aref (st :messages) 0))) (fiveam:is (stringp (getf msg :time))) (fiveam:is (string= "Hi" (getf msg :content))) (fiveam:is (null (st :streaming-text))))) (fiveam:test test-stream-interrupt "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes." (init-state) (on-daemon-msg '(:type :stream-chunk :payload (:text "partial"))) (on-key 27) (let ((msg (aref (st :messages) 0))) (fiveam:is (stringp (getf msg :time))) (fiveam:is (search "[interrupted]" (getf msg :content))) (fiveam:is (null (st :streaming-text))) (fiveam:is (null (st :busy))))) (fiveam:test test-stream-check-skip "Contract/v0.7.1: Esc without active streaming does nothing." (init-state) (on-key 27) (fiveam:is (null (st :streaming-text))) (fiveam:is (= 0 (length (st :messages))))) (fiveam:test test-tab-open-url "Contract/v0.7.1: Tab on empty input with URL message extracts URL." (init-state) (add-msg :agent "visit https://example.com for info") (on-key 9) (fiveam:is (string= "https://example.com" (st :url-buffer)))) ;; ── v0.7.2 HITL Panels ── (fiveam:test test-hitl-panel-in-on-daemon-msg "Contract v0.7.2: approval-required messages render as HITL panels." (init-state) (on-daemon-msg '(:type :EVENT :level :approval-required :payload (:sensor :approval-required :action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell")) :message "rm -rf blocked"))) (let ((m (aref (st :messages) 0))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (getf m :panel)) (fiveam:is (search "rm -rf" (getf m :content))))) (fiveam:test test-hitl-panel-after-approve "Contract v0.7.2: /approve adds confirmation and marks panel resolved." (init-state) (on-daemon-msg '(:type :EVENT :level :approval-required :payload (:sensor :approval-required :message "test"))) (dolist (ch (coerce "/approve HITL-test" 'list)) (on-key (char-code ch))) (on-key 13) ;; Panel message (index 0) should be marked resolved (let ((m (aref (st :messages) 0))) (fiveam:is (getf m :panel)) (fiveam:is (eq :approved (getf m :panel-resolved)))) ;; Last message should be the approval confirmation (let ((m (aref (st :messages) (1- (length (st :messages)))))) (fiveam:is (search "Approved" (getf m :content))))) (fiveam:test test-hitl-panel-after-deny "Contract v0.7.2: /deny marks panel as denied." (init-state) (on-daemon-msg '(:type :EVENT :level :approval-required :payload (:sensor :approval-required :message "blocked"))) (dolist (ch (coerce "/deny HITL-deny" 'list)) (on-key (char-code ch))) (on-key 13) (let ((m (aref (st :messages) 0))) (fiveam:is (getf m :panel)) (fiveam:is (eq :denied (getf m :panel-resolved))))) (fiveam:test test-hitl-approve-parsed "Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text." (init-state) (dolist (ch (coerce "/approve HITL-abcd" 'list)) (on-key (char-code ch))) (on-key 343) ;; Should add a system message confirming approval, not a user message (let ((msgs (st :messages))) (fiveam:is (>= (length msgs) 1)) (let ((m (aref msgs 0))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (search "Approved" (getf m :content)))))) (fiveam:test test-hitl-deny-parsed "Contract v0.7.2: /deny HITL-xxxx sends structured denial." (init-state) (dolist (ch (coerce "/deny HITL-xyz" 'list)) (on-key (char-code ch))) (on-key 343) (let ((m (aref (st :messages) 0))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (search "Denied" (getf m :content))))) ;; ── v0.7.2 Undo/Redo ── (fiveam:test test-undo-command "Contract v0.7.2: /undo sends undo event." (init-state) (dolist (ch (coerce "/undo" 'list)) (on-key (char-code ch))) (on-key 343) (let ((m (aref (st :messages) 0))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (search "Undo" (getf m :content))))) (fiveam:test test-redo-command "Contract v0.7.2: /redo sends redo event." (init-state) (dolist (ch (coerce "/redo" 'list)) (on-key (char-code ch))) (on-key 343) (let ((m (aref (st :messages) 0))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (search "Redo" (getf m :content))))) ;; ── v0.7.2 Self-help ── (fiveam:test test-why-command "Contract v0.7.2: /why shows gate trace from last message." (init-state) (add-msg :agent "did something" :gate-trace '((:gate "shell" :result :blocked :reason "rm -rf"))) (dolist (ch (coerce "/why" 'list)) (on-key (char-code ch))) (on-key 13) (let* ((msgs (st :messages)) (m (aref msgs (1- (length msgs))))) (fiveam:is (eq :system (getf m :role))) (fiveam:is (search "[BLOCKED]" (getf m :content))) (fiveam:is (search "shell" (getf m :content))))) (fiveam:test test-why-no-trace "Contract v0.7.2: /why with no gate trace shows fallback message." (init-state) (dolist (ch (coerce "/why" 'list)) (on-key (char-code ch))) (on-key 13) (let* ((msgs (st :messages)) (m (aref msgs (1- (length msgs))))) (fiveam:is (search "No recent" (getf m :content))))) ;; ── 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." (init-state) (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed))) (on-key 7) ;; Ctrl+G — first press hides (let* ((msgs (st :messages)) (m (aref msgs (1- (length msgs))))) (fiveam:is (search "hidden" (getf m :content)))) (on-key 7) ;; second press shows (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." (init-state) (on-key 7) (let ((m (aref (st :messages) 0))) (fiveam:is (search "No gate trace" (getf m :content))))) ;; ── v0.7.2 Message Search Mode ── (fiveam:test test-search-mode-activate "Contract v0.7.2: /search enters search mode." (init-state) (add-msg :agent "hello world") (add-msg :agent "goodbye") (dolist (ch (coerce "/search hello" 'list)) (on-key (char-code ch))) (on-key 13) (fiveam:is (eq t (st :search-mode))) (fiveam:is (string= "hello" (st :search-query))) (fiveam:is (= 1 (length (st :search-matches))))) (fiveam:test test-search-mode-escape-exits "Contract v0.7.2: Escape exits search mode." (init-state) (add-msg :agent "test") (dolist (ch (coerce "/search test" 'list)) (on-key (char-code ch))) (on-key 13) (fiveam:is (eq t (st :search-mode))) (on-key 27) ;; Escape (fiveam:is (null (st :search-mode)))) (fiveam:test test-search-mode-up-down-nav "Contract v0.7.2: Up/Down navigates between search matches." (init-state) (add-msg :agent "aaa hello bbb") (add-msg :agent "ccc hello ddd") (add-msg :agent "no match here") (dolist (ch (coerce "/search hello" 'list)) (on-key (char-code ch))) (on-key 13) (fiveam:is (= 0 (st :search-match-idx))) (on-key 258) ;; Down (fiveam:is (= 1 (st :search-match-idx))) (on-key 259) ;; Up (fiveam:is (= 0 (st :search-match-idx))) (on-key 259) ;; Up (clamped) (fiveam:is (= 0 (st :search-match-idx)))) (fiveam:test test-context-sections "Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS." (init-state) (add-msg :agent "hello world") (dolist (ch (coerce "/context" 'list)) (on-key (char-code ch))) (on-key 13) (let ((msgs (st :messages))) (fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs)) (fiveam:is (some (lambda (m) (search "LOGS" (getf m :content))) msgs)) (fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs)))) (fiveam:test test-help-topic-lookup "Contract v0.7.2: /help reads and searches USER_MANUAL.org." (init-state) (dolist (ch (coerce "/help configuration" 'list)) (on-key (char-code ch))) (on-key 13) (let ((msgs (st :messages))) (fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs)))) (fiveam:test test-pads-page-up "Contract v0.7.2: PageUp scrolls by page size (> 5 lines)." (init-state) (dotimes (i 30) (add-msg :system (format nil "msg ~d" i))) (setf (st :scroll-offset) 0) (on-key :ppage) (fiveam:is (> (st :scroll-offset) 5) "Should scroll by more than 5 lines")) (fiveam:test test-pads-page-down-clamp "Contract v0.7.2: PageDown clamps to 0." (init-state) (dotimes (i 5) (add-msg :system (format nil "msg ~d" i))) (setf (st :scroll-offset) 3) (on-key :npage) (fiveam:is (= 0 (st :scroll-offset)))) (in-package :passepartout-tui-tests) (fiveam:test test-theme-hex-to-rgb "Contract 4: theme-hex-to-rgb parses #RRGGBB to integer triple." (multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "#5E81AC") (fiveam:is (= 94 r)) (fiveam:is (= 129 g)) (fiveam:is (= 172 b)))) (fiveam:test test-theme-hex-to-rgb-invalid "Contract 4: theme-hex-to-rgb returns white for invalid input." (multiple-value-bind (r g b) (passepartout.channel-tui::theme-hex-to-rgb "not-a-color") (fiveam:is (= 255 r)) (fiveam:is (= 255 g)) (fiveam:is (= 255 b)))) (fiveam:test test-sidebar-toggle "Contract 7: sidebar-toggle flips :sidebar-visible and sets dirty flags." (init-state) (setf (st :dirty) (list nil nil nil)) (passepartout.channel-tui::sidebar-toggle) (fiveam:is (eq t (st :sidebar-visible))) (fiveam:is (eq t (first (st :dirty)))) (fiveam:is (eq t (second (st :dirty))))) (fiveam:test test-ctrl-x-b-toggles-sidebar "Contract 5: Ctrl+X then Ctrl+B toggles sidebar." (init-state) (on-key 24) ; Ctrl+X (fiveam:is (eq t (st :pending-ctrl-x))) (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." (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: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-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-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=)))) ;; ── v0.8.0 Setup Wizard ── (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-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))))