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

fix: resolve TUI compilation errors, replace ST calls with GETF

Browse Source 
- Remove dead croatoan-to-tty-event keymap dispatch clause from on-key
- Replace all (st :key) with (getf *state* :key) and all
  (setf (st :key) val) with (setf (getf *state* :key) val)
  to avoid SBCL cross-file SETF expander issues (239 replacements)
- Fix redraw arity: called with 4 args but defined with 3
- TUI now loads, initializes, and connects to daemon successfully
This commit is contained in:
Amr Gharbeia
2026-05-13 14:04:25 -04:00
parent 6e69c4a724
commit 885fc3f92e
6 changed files with 528 additions and 492 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -3,68 +3,68 @@
(defun on-key (ch) (defun on-key (ch)
(cond (cond
;; v0.7.1: Esc — interrupt streaming ;; v0.7.1: Esc — interrupt streaming
((and (eq ch :escape) (st :streaming-text)) ((and (eq ch :escape) (getf *state* :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0) (when (> (length (getf *state* :messages)) 0)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :content) (setf (getf (aref (getf *state* :messages) idx) :content)
(concatenate 'string (concatenate 'string
(getf (aref (st :messages) idx) :content) (getf (aref (getf *state* :messages) idx) :content)
" [interrupted]")) " [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (getf *state* :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now)))) (setf (getf (aref (getf *state* :messages) idx) :time) (now))))
(setf (st :streaming-text) nil) (setf (getf *state* :streaming-text) nil)
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
;; v0.7.2: Esc — exit search mode ;; v0.7.2: Esc — exit search mode
((and (eq ch :escape) (st :search-mode)) ((and (eq ch :escape) (getf *state* :search-mode))
(setf (st :search-mode) nil (setf (getf *state* :search-mode) nil
(st :search-matches) nil (getf *state* :search-matches) nil
(st :search-query) "") (getf *state* :search-query) "")
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(add-msg :system "Search exited")) (add-msg :system "Search exited"))
;; v0.7.2: search mode — Up/Down navigate matches ;; v0.7.2: search mode — Up/Down navigate matches
((and (st :search-mode) (eq ch :up)) ((and (getf *state* :search-mode) (eq ch :up))
(let* ((matches (st :search-matches)) (let* ((matches (getf *state* :search-matches))
(idx (st :search-match-idx)) (idx (getf *state* :search-match-idx))
(new-idx (max 0 (1- idx)))) (new-idx (max 0 (1- idx))))
(setf (st :search-match-idx) new-idx) (setf (getf *state* :search-match-idx) new-idx)
(when matches (when matches
(setf (st :scroll-offset) (nth new-idx matches)) (setf (getf *state* :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
((and (st :search-mode) (eq ch :down)) ((and (getf *state* :search-mode) (eq ch :down))
(let* ((matches (st :search-matches)) (let* ((matches (getf *state* :search-matches))
(idx (st :search-match-idx)) (idx (getf *state* :search-match-idx))
(new-idx (min (1- (length matches)) (1+ idx)))) (new-idx (min (1- (length matches)) (1+ idx))))
(setf (st :search-match-idx) new-idx) (setf (getf *state* :search-match-idx) new-idx)
(when matches (when matches
(setf (st :scroll-offset) (nth new-idx matches)) (setf (getf *state* :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
;; v0.7.2: search mode — Enter jumps to current match ;; v0.7.2: search mode — Enter jumps to current match
((and (st :search-mode) (eq ch :enter)) ((and (getf *state* :search-mode) (eq ch :enter))
(let ((matches (st :search-matches)) (let ((matches (getf *state* :search-matches))
(idx (st :search-match-idx))) (idx (getf *state* :search-match-idx)))
(when (and matches (>= (length matches) (1+ idx))) (when (and matches (>= (length matches) (1+ idx)))
(setf (st :scroll-offset) (nth idx matches)) (setf (getf *state* :scroll-offset) (nth idx matches))
(setf (st :search-mode) nil (setf (getf *state* :search-mode) nil
(st :search-matches) nil (getf *state* :search-matches) nil
(st :search-query) "") (getf *state* :search-query) "")
(add-msg :system (format nil "Jumped to match ~d" (1+ idx))) (add-msg :system (format nil "Jumped to match ~d" (1+ idx)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
;; v0.7.1: Tab on empty input — extract then open URL from agent message ;; v0.7.1: Tab on empty input — extract then open URL from agent message
((and (eq ch :tab) ((and (eq ch :tab)
(null (st :input-buffer))) (null (getf *state* :input-buffer)))
(if (st :url-buffer) (if (getf *state* :url-buffer)
;; Already extracted — now open it ;; Already extracted — now open it
(progn (progn
(add-msg :system (format nil "Opening ~a" (st :url-buffer))) (add-msg :system (format nil "Opening ~a" (getf *state* :url-buffer)))
(setf (st :url-buffer) nil)) (setf (getf *state* :url-buffer) nil))
;; Extract URL from last agent message ;; Extract URL from last agent message
(let ((url nil)) (let ((url nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for msg = (aref (st :messages) i) for msg = (aref (getf *state* :messages) i)
for content = (getf msg :content) for content = (getf msg :content)
for role = (getf msg :role) for role = (getf msg :role)
while (eq role :agent) while (eq role :agent)
@@ -78,69 +78,69 @@
(return))))) (return)))))
(if url (if url
(progn (progn
(setf (st :url-buffer) url) (setf (getf *state* :url-buffer) url)
(add-msg :system (format nil "Press Tab to open ~a" url)) (add-msg :system (format nil "Press Tab to open ~a" url))
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
nil)))) nil))))
;; v0.7.0: Ctrl key bindings ;; v0.7.0: Ctrl key bindings
((eq ch :ctrl-u) ((eq ch :ctrl-u)
(setf (st :input-buffer) nil) (setf (getf *state* :input-buffer) nil)
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
((eq ch :ctrl-w) ((eq ch :ctrl-w)
(let ((buf (st :input-buffer))) (let ((buf (getf *state* :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf)) (loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(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 (getf *state* :input-buffer) buf)
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
((eq ch :ctrl-a) ((eq ch :ctrl-a)
(setf (st :cursor-pos) 0)) (setf (getf *state* :cursor-pos) 0))
((eq ch :ctrl-e) ((eq ch :ctrl-e)
(setf (st :cursor-pos) (length (st :input-buffer)))) (setf (getf *state* :cursor-pos) (length (getf *state* :input-buffer))))
((eq ch :ctrl-l) ((eq ch :ctrl-l)
(setf (st :dirty) (list t t t))) (setf (getf *state* :dirty) (list t t t)))
((eq ch :ctrl-d) ((eq ch :ctrl-d)
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (getf *state* :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eq ch :ctrl-f) ((eq ch :ctrl-f)
(add-msg :system "Use /search <query> to find messages")) (add-msg :system "Use /search <query> to find messages"))
((eq ch :ctrl-g) ((eq ch :ctrl-g)
(let ((gate-idx nil)) (let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (getf *state* :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace))) when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish)) do (setf gate-idx i) (loop-finish))
(if gate-idx (if gate-idx
(let ((cg (st :collapsed-gates))) (let ((cg (getf *state* :collapsed-gates)))
(if (member gate-idx cg) (if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg)) (setf (getf *state* :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates))) (push gate-idx (getf *state* :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a" (add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown") (if (member gate-idx (getf *state* :collapsed-gates)) "hidden" "shown")
gate-idx)) gate-idx))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle")))) (add-msg :system "No gate trace to toggle"))))
((eq ch :ctrl-x) ((eq ch :ctrl-x)
(setf (st :pending-ctrl-x) t)) (setf (getf *state* :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eq ch :ctrl-e)) ; Ctrl+X+E — editor ((and (getf *state* :pending-ctrl-x) (eq ch :ctrl-e)) ; Ctrl+X+E — editor
(setf (st :pending-ctrl-x) nil) (setf (getf *state* :pending-ctrl-x) nil)
(add-msg :system "Opening $EDITOR... save and exit to return.") (add-msg :system "Opening $EDITOR... save and exit to return.")
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
((and (st :pending-ctrl-x) (not (eq ch :ctrl-e))) ; cancel Ctrl+X ((and (getf *state* :pending-ctrl-x) (not (eq ch :ctrl-e))) ; cancel Ctrl+X
(setf (st :pending-ctrl-x) nil) (setf (getf *state* :pending-ctrl-x) nil)
(on-key ch) (on-key ch)
(return-from on-key nil)) (return-from on-key nil))
;; Enter ;; Enter
((eq ch :enter) ((eq ch :enter)
;; Multi-line: if buffer ends with \, strip it and insert newline ;; Multi-line: if buffer ends with \, strip it and insert newline
(if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\)) (if (and (getf *state* :input-buffer) (eql (first (getf *state* :input-buffer)) #\\))
(progn (pop (st :input-buffer)) (progn (pop (getf *state* :input-buffer))
(push #\Newline (st :input-buffer)) (push #\Newline (getf *state* :input-buffer))
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
(let ((text (string-trim '(#\Space #\Tab) (input-string)))) (let ((text (string-trim '(#\Space #\Tab) (input-string))))
(when (> (length text) 0) (when (> (length text) 0)
(push text (st :input-history)) (push text (getf *state* :input-history))
(setf (st :input-hpos) 0) (setf (getf *state* :input-hpos) 0)
(setf (st :scroll-offset) 0) (setf (getf *state* :scroll-offset) 0)
(cond (cond
;; v0.7.2: undo/redo ;; v0.7.2: undo/redo
((string-equal text "/undo") ((string-equal text "/undo")
@@ -167,7 +167,7 @@
;; /help command ;; /help command
;; /why command — show last gate trace ;; /why command — show last gate trace
((string-equal text "/why") ((string-equal text "/why")
(let ((msgs (st :messages)) (let ((msgs (getf *state* :messages))
(found nil)) (found nil))
(loop for i from (1- (length msgs)) downto 0 (loop for i from (1- (length msgs)) downto 0
for m = (aref msgs i) for m = (aref msgs i)
@@ -220,9 +220,9 @@
(add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))) (add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
;; /context command — section breakdown with token estimates ;; /context command — section breakdown with token estimates
((string-equal text "/context") ((string-equal text "/context")
(let* ((msg-count (length (st :messages))) (let* ((msg-count (length (getf *state* :messages)))
(focus (or (st :foveal-id) "none")) (focus (or (getf *state* :foveal-id) "none"))
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4))) (id-tokens (min 200 (floor (+ 150 (length (or (getf *state* :focus-scope) ""))) 4)))
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*) (tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
(floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4) (floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4)
50)) 50))
@@ -269,7 +269,7 @@
(add-msg :system "Memory not available")))) (add-msg :system "Memory not available"))))
;; /context dropped — estimate pruned nodes from budget ;; /context dropped — estimate pruned nodes from budget
((string-equal text "/context dropped") ((string-equal text "/context dropped")
(let* ((msg-count (length (st :messages))) (let* ((msg-count (length (getf *state* :messages)))
(est-total (* msg-count 60)) (est-total (* msg-count 60))
(budget 8192) (budget 8192)
(dropped-msgs (if (> est-total budget) (dropped-msgs (if (> est-total budget)
@@ -284,7 +284,7 @@
;; /search command — message search ;; /search command — message search
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search ")) ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8)))) (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
(msgs (st :messages)) (msgs (getf *state* :messages))
(total (length msgs)) (total (length msgs))
(matches nil)) (matches nil))
(loop for i from 0 below total (loop for i from 0 below total
@@ -294,10 +294,10 @@
do (push i matches)) do (push i matches))
(setf matches (nreverse matches)) (setf matches (nreverse matches))
;; Enter search mode ;; Enter search mode
(setf (st :search-mode) t (setf (getf *state* :search-mode) t
(st :search-query) query (getf *state* :search-query) query
(st :search-matches) matches (getf *state* :search-matches) matches
(st :search-match-idx) 0) (getf *state* :search-match-idx) 0)
(if matches (if matches
(add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit" (add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit"
(length matches) query (length matches))) (length matches) query (length matches)))
@@ -445,11 +445,11 @@
(uiop:ensure-all-directories-exist (list hist-file)) (uiop:ensure-all-directories-exist (list hist-file))
(with-open-file (out hist-file :direction :output (with-open-file (out hist-file :direction :output
:if-exists :supersede :if-does-not-exist :create) :if-exists :supersede :if-does-not-exist :create)
(dolist (entry (reverse (st :input-history))) (dolist (entry (reverse (getf *state* :input-history)))
(write-line entry out)))) (write-line entry out))))
(add-msg :system "* Goodbye *") (add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit))) (send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil)) (setf (getf *state* :running) nil))
;; /reconnect — re-establish daemon connection ;; /reconnect — re-establish daemon connection
((string-equal text "/reconnect") ((string-equal text "/reconnect")
(disconnect-daemon) (disconnect-daemon)
@@ -457,12 +457,12 @@
;; Normal message ;; Normal message
(t (t
(add-msg :user text) (add-msg :user text)
(setf (st :busy) t) (setf (getf *state* :busy) t)
(send-daemon (list :type :event (send-daemon (list :type :event
:payload (list :sensor :user-input :text text))))) :payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil) (setf (getf *state* :input-buffer) nil)
(setf (st :cursor-pos) 0) (setf (getf *state* :cursor-pos) 0)
(setf (st :dirty) (list t t t)))))) (setf (getf *state* :dirty) (list t t t))))))
;; Tab — command completion (v0.7.0: extended with subcommand + file paths) ;; Tab — command completion (v0.7.0: extended with subcommand + file paths)
((eq ch :tab) ((eq ch :tab)
(let ((text (input-string))) (let ((text (input-string)))
@@ -481,8 +481,8 @@
(string-equal n partial :end2 (length partial)))) (string-equal n partial :end2 (length partial))))
names))) names)))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; /theme subcommand ;; /theme subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme ")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7))) (let* ((partial (string-trim '(#\Space) (subseq text 7)))
@@ -490,8 +490,8 @@
(match (if (string= partial "") (first names) (match (if (string= partial "") (first names)
(find partial names :test #'string-equal)))) (find partial names :test #'string-equal))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; /focus subcommand ;; /focus subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus ")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
(let* ((partial (string-trim '(#\Space) (subseq text 7))) (let* ((partial (string-trim '(#\Space) (subseq text 7)))
@@ -506,8 +506,8 @@
(string-equal d partial :end2 (length partial)))) (string-equal d partial :end2 (length partial))))
dirs)))) dirs))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; Command prefix / ;; Command prefix /
((and (> (length text) 1) (eql (char text 0) #\/)) ((and (> (length text) 1) (eql (char text 0) #\/))
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit")) (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
@@ -515,51 +515,51 @@
(lambda (in cmd) (and (>= (length cmd) (length in)) (lambda (in cmd) (and (>= (length cmd) (length in))
(string-equal cmd in :end1 (length in))))))) (string-equal cmd in :end1 (length in)))))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce match 'list))) (setf (getf *state* :input-buffer) (reverse (coerce match 'list)))
(when (member match '("/eval" "/focus" "/scope") :test #'string=) (when (member match '("/eval" "/focus" "/scope") :test #'string=)
(push #\Space (st :input-buffer))) (push #\Space (getf *state* :input-buffer)))
(setf (st :dirty) (list nil nil t)))))))) (setf (getf *state* :dirty) (list nil nil t)))))))
;; Backspace ;; Backspace
((eq ch :backspace) ((eq ch :backspace)
(input-delete-char) (input-delete-char)
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
;; Left arrow ;; Left arrow
((eq ch :left) ((eq ch :left)
(when (> (or (st :cursor-pos) 0) 0) (when (> (or (getf *state* :cursor-pos) 0) 0)
(decf (st :cursor-pos)) (decf (getf *state* :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
;; Right arrow ;; Right arrow
((eq ch :right) ((eq ch :right)
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer))) (when (< (or (getf *state* :cursor-pos) 0) (length (getf *state* :input-buffer)))
(incf (st :cursor-pos)) (incf (getf *state* :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
;; Up arrow ;; Up arrow
((eq ch :up) ((eq ch :up)
(let* ((h (st :input-history)) (p (st :input-hpos))) (let* ((h (getf *state* :input-history)) (p (getf *state* :input-hpos)))
(when (and h (< p (1- (length h)))) (when (and h (< p (1- (length h))))
(incf (st :input-hpos)) (incf (getf *state* :input-hpos))
(setf (st :input-buffer) (setf (getf *state* :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list))) (reverse (coerce (nth (getf *state* :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; Down arrow ;; Down arrow
((eq ch :down) ((eq ch :down)
(when (> (st :input-hpos) 0) (when (> (getf *state* :input-hpos) 0)
(decf (st :input-hpos)) (decf (getf *state* :input-hpos))
(let ((h (st :input-history))) (let ((h (getf *state* :input-history)))
(setf (st :input-buffer) (setf (getf *state* :input-buffer)
(if (and h (< (st :input-hpos) (length h))) (if (and h (< (getf *state* :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list)) (reverse (coerce (nth (getf *state* :input-hpos) h) 'list))
nil)) nil))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; PageUp — scroll back by page (10 lines) ;; PageUp — scroll back by page (10 lines)
((eq ch :ppage) ((eq ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1)))) (let ((max-offset (max 0 (- (length (getf *state* :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10)))) (setf (getf *state* :scroll-offset) (min max-offset (+ (getf *state* :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
;; PageDown — scroll forward by page ;; PageDown — scroll forward by page
((eq ch :npage) ((eq ch :npage)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))) (setf (getf *state* :scroll-offset) (max 0 (- (getf *state* :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
;; Printable ;; Printable
(t (t
(let ((chr (typecase ch (let ((chr (typecase ch
@@ -571,17 +571,17 @@
(t nil)))) (t nil))))
(when (and chr (graphic-char-p chr)) (when (and chr (graphic-char-p chr))
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t)))))))) (setf (getf *state* :dirty) (list nil nil t))))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
"Mark the most recent HITL panel message as resolved with DECISION." "Mark the most recent HITL panel message as resolved with DECISION."
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (getf *state* :messages) i)
when (and (getf m :panel) (not (getf m :panel-resolved))) when (and (getf m :panel) (not (getf m :panel-resolved)))
do (setf (getf m :panel-resolved) decision) do (setf (getf m :panel-resolved) decision)
(setf (aref (st :messages) i) m) (setf (aref (getf *state* :messages) i) m)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(loop-finish))) (loop-finish)))
;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections ;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections
@@ -646,50 +646,50 @@
(add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx" (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
hitl-msg explanation) hitl-msg explanation)
:panel t)) :panel t))
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
;; v0.7.1: streaming chunk ;; v0.7.1: streaming chunk
(when (eq msg-type :stream-chunk) (when (eq msg-type :stream-chunk)
(cond (cond
((string= text "") ((string= text "")
;; Final chunk: stamp time, clear streaming ;; Final chunk: stamp time, clear streaming
(when (> (length (st :messages)) 0) (when (> (length (getf *state* :messages)) 0)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (getf *state* :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now)))) (setf (getf (aref (getf *state* :messages) idx) :time) (now))))
(setf (st :streaming-text) nil) (setf (getf *state* :streaming-text) nil)
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
((null (st :streaming-text)) ((null (getf *state* :streaming-text))
;; First chunk: add new streaming message ;; First chunk: add new streaming message
(setf (st :streaming-text) "") (setf (getf *state* :streaming-text) "")
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(add-msg :agent text) (add-msg :agent text)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :streaming) t)) (setf (getf (aref (getf *state* :messages) idx) :streaming) t))
(setf (st :streaming-text) text) (setf (getf *state* :streaming-text) text)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
(t (t
;; Subsequent chunk: append ;; Subsequent chunk: append
(let* ((new-text (concatenate 'string (st :streaming-text) text)) (let* ((new-text (concatenate 'string (getf *state* :streaming-text) text))
(idx (1- (length (st :messages))))) (idx (1- (length (getf *state* :messages)))))
(setf (st :streaming-text) new-text) (setf (getf *state* :streaming-text) new-text)
(setf (getf (aref (st :messages) idx) :content) new-text) (setf (getf (aref (getf *state* :messages) idx) :content) new-text)
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
(return-from on-daemon-msg nil)))) (return-from on-daemon-msg nil))))
(when rule-count (setf (st :rule-count) rule-count)) (when rule-count (setf (getf *state* :rule-count) rule-count))
(when foveal-id (setf (st :foveal-id) foveal-id)) (when foveal-id (setf (getf *state* :foveal-id) foveal-id))
(cond (cond
(text (setf (st :busy) nil) (text (setf (getf *state* :busy) nil)
(add-msg :agent text :gate-trace gate-trace)) (add-msg :agent text :gate-trace gate-trace))
((eq action :handshake) ((eq action :handshake)
(add-msg :system (format nil "Connected v~a" (getf payload :version)))) (add-msg :system (format nil "Connected v~a" (getf payload :version))))
(t (add-msg :agent (format nil "~a" msg)))))) (t (add-msg :agent (format nil "~a" msg))))))
(defun send-daemon (msg) (defun send-daemon (msg)
(let ((s (st :stream))) (let ((s (getf *state* :stream)))
(when (and s (open-stream-p s)) (when (and s (open-stream-p s))
(handler-case (handler-case
(progn (progn
@@ -717,7 +717,7 @@
(defun reader-loop (s) (defun reader-loop (s)
(let ((consecutive-nils 0)) (let ((consecutive-nils 0))
(loop while (and (st :running) (open-stream-p s)) (loop while (and (getf *state* :running) (open-stream-p s))
do (let ((msg (recv-daemon s))) do (let ((msg (recv-daemon s)))
(if msg (if msg
(progn (queue-event (list :type :daemon :payload msg)) (progn (queue-event (list :type :daemon :payload msg))
@@ -736,8 +736,8 @@
(with-open-file (in hist-file :direction :input) (with-open-file (in hist-file :direction :input)
(loop for line = (read-line in nil nil) (loop for line = (read-line in nil nil)
while line while line
do (push line (st :input-history)))) do (push line (getf *state* :input-history))))
(setf (st :input-history) (nreverse (st :input-history)))))) (setf (getf *state* :input-history) (nreverse (getf *state* :input-history))))))
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105)) (defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(add-msg :system "* Connecting to daemon... *") (add-msg :system "* Connecting to daemon... *")
@@ -746,9 +746,9 @@
do (sleep backoff) do (sleep backoff)
(handler-case (handler-case
(let ((s (usocket:socket-connect host port :timeout 5))) (let ((s (usocket:socket-connect host port :timeout 5)))
(setf (st :stream) (usocket:socket-stream s) (setf (getf *state* :stream) (usocket:socket-stream s)
(st :connected) t) (getf *state* :connected) t)
(bt:make-thread (lambda () (reader-loop (st :stream))) (bt:make-thread (lambda () (reader-loop (getf *state* :stream)))
:name "tui-reader") :name "tui-reader")
(add-msg :system (format nil "* Connected v~a *" "0.5.0")) (add-msg :system (format nil "* Connected v~a *" "0.5.0"))
(return-from connect-daemon t)) (return-from connect-daemon t))
@@ -764,9 +764,9 @@
nil) nil)
(defun disconnect-daemon () (defun disconnect-daemon ()
(when (st :stream) (when (getf *state* :stream)
(ignore-errors (close (st :stream))) (ignore-errors (close (getf *state* :stream)))
(setf (st :stream) nil (st :connected) nil) (setf (getf *state* :stream) nil (getf *state* :connected) nil)
(add-msg :system "* Disconnected *"))) (add-msg :system "* Disconnected *")))
(defun tui-main () (defun tui-main ()
@@ -776,7 +776,7 @@
(let* ((swank-port (or (ignore-errors (let* ((swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT"))) (parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006))) 4006)))
(setf (st :dirty) (list t t t)) (setf (getf *state* :dirty) (list t t t))
(connect-daemon) (connect-daemon)
(when (> swank-port 0) (when (> swank-port 0)
(handler-case (handler-case
@@ -793,17 +793,17 @@
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h)) (let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h))) (curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render ;; Initial render
(redraw be curr-fb w h) (redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb) (rotatef prev-fb curr-fb)
(loop while (st :running) do (loop while (getf *state* :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
(cond (cond
((eq (getf ev :type) :daemon) ((eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload))) (on-daemon-msg (getf ev :payload)))
((eq (getf ev :type) :disconnected) ((eq (getf ev :type) :disconnected)
(setf (st :connected) nil (setf (getf *state* :connected) nil
(st :busy) nil) (getf *state* :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *")))) (add-msg :system "* Connection lost — type /reconnect to retry *"))))
(multiple-value-bind (type data) (multiple-value-bind (type data)
(cl-tty.input:read-event be :timeout 0) (cl-tty.input:read-event be :timeout 0)
@@ -812,7 +812,7 @@
(multiple-value-setq (w h) (cl-tty.backend:backend-size be)) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setf prev-fb (cl-tty.rendering:make-framebuffer w h) (setf prev-fb (cl-tty.rendering:make-framebuffer w h)
curr-fb (cl-tty.rendering:make-framebuffer w h)) curr-fb (cl-tty.rendering:make-framebuffer w h))
(setf (st :dirty) (list t t t))) (setf (getf *state* :dirty) (list t t t)))
(data (data
(let ((ch (typecase data (let ((ch (typecase data
(cl-tty.input:key-event (cl-tty.input:key-event
@@ -823,13 +823,13 @@
k))) k)))
(t data)))) (t data))))
(on-key ch))))))) (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (when (or (first (getf *state* :dirty)) (second (getf *state* :dirty)) (third (getf *state* :dirty)))
(cl-tty.backend:backend-clear curr-fb) (cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h) (redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)) (rotatef prev-fb curr-fb))
(sleep 0.1)))) (sleep 0.1)))
(disconnect-daemon)))) (disconnect-daemon)))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
@@ -846,19 +846,19 @@
(fiveam:test test-init-state (fiveam:test test-init-state
"Contract model.1: init-state returns fresh state plist with required keys." "Contract model.1: init-state returns fresh state plist with required keys."
(init-state) (init-state)
(fiveam:is (eq t (st :running))) (fiveam:is (eq t (getf *state* :running)))
(fiveam:is (eq :chat (st :mode))) (fiveam:is (eq :chat (getf *state* :mode)))
(fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (getf *state* :connected)))
(fiveam:is (eq nil (st :stream))) (fiveam:is (eq nil (getf *state* :stream)))
(fiveam:is (zerop (length (st :messages)))) (fiveam:is (zerop (length (getf *state* :messages))))
(fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq 0 (getf *state* :scroll-offset)))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (getf *state* :busy))))
(fiveam:test test-add-msg (fiveam:test test-add-msg
"Contract model.2: add-msg appends a message with role, content, and time." "Contract model.2: add-msg appends a message with role, content, and time."
(init-state) (init-state)
(add-msg :user "hello") (add-msg :user "hello")
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(msg (aref msgs 0))) (msg (aref msgs 0)))
(fiveam:is (eq :user (getf msg :role))) (fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (string= "hello" (getf msg :content)))
@@ -868,9 +868,9 @@
(fiveam:test test-add-msg-dirty-flag (fiveam:test test-add-msg-dirty-flag
"Contract model.2: add-msg sets dirty flags for status and chat." "Contract model.2: add-msg sets dirty flags for status and chat."
(init-state) (init-state)
(setf (st :dirty) (list nil nil nil)) (setf (getf *state* :dirty) (list nil nil nil))
(add-msg :system "boot") (add-msg :system "boot")
(let ((dirty (st :dirty))) (let ((dirty (getf *state* :dirty)))
(fiveam:is (eq t (first dirty))) (fiveam:is (eq t (first dirty)))
(fiveam:is (eq t (second dirty))) (fiveam:is (eq t (second dirty)))
(fiveam:is (eq nil (third dirty))))) (fiveam:is (eq nil (third dirty)))))
@@ -898,7 +898,7 @@
;; Input buffer should be cleared ;; Input buffer should be cleared
(fiveam:is (string= "" (input-string))) (fiveam:is (string= "" (input-string)))
;; A user message should be in the message list ;; A user message should be in the message list
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last (aref msgs 0))) (let ((last (aref msgs 0)))
(fiveam:is (eq :user (getf last :role))) (fiveam:is (eq :user (getf last :role)))
@@ -911,7 +911,7 @@
(dolist (ch (coerce "/eval (+ 1 2)" 'list)) (dolist (ch (coerce "/eval (+ 1 2)" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last-msg (aref msgs 0))) (let ((last-msg (aref msgs 0)))
(fiveam:is (eq :system (getf last-msg :role))) (fiveam:is (eq :system (getf last-msg :role)))
@@ -933,7 +933,7 @@
(dolist (ch (coerce "/focus myapp" 'list)) (dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command (fiveam:test test-on-key-scope-command
@@ -942,7 +942,7 @@
(dolist (ch (coerce "/scope memex" 'list)) (dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command (fiveam:test test-on-key-unfocus-command
@@ -951,7 +951,7 @@
(dolist (ch (coerce "/unfocus" 'list)) (dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-tab-completion (fiveam:test test-on-key-tab-completion
@@ -986,22 +986,22 @@
(dolist (ch (coerce "/help" 'list)) (dolist (ch (coerce "/help" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 3)) (fiveam:is (>= (length msgs) 3))
(fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))
(fiveam:test test-activity-indicator (fiveam:test test-activity-indicator
"Contract model: :busy flag is set on send and cleared on agent response." "Contract model: :busy flag is set on send and cleared on agent response."
(init-state) (init-state)
(fiveam:is (eq nil (st :busy))) (fiveam:is (eq nil (getf *state* :busy)))
;; Simulate sending a normal message (sets busy) ;; Simulate sending a normal message (sets busy)
(dolist (ch (coerce "hello" 'list)) (dolist (ch (coerce "hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(fiveam:is (eq t (st :busy))) (fiveam:is (eq t (getf *state* :busy)))
;; Simulate receiving an agent response (clears busy) ;; Simulate receiving an agent response (clears busy)
(on-daemon-msg '(:type :event :payload (:text "hi back"))) (on-daemon-msg '(:type :event :payload (:text "hi back")))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (getf *state* :busy))))
(fiveam:test test-theme (fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings." "Contract view: *tui-theme* provides color mappings."
@@ -1021,21 +1021,21 @@
(fiveam:test test-on-key-ctrl-l-redraws (fiveam:test test-on-key-ctrl-l-redraws
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags." "Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
(init-state) (init-state)
(setf (st :dirty) (list nil nil nil)) (setf (getf *state* :dirty) (list nil nil nil))
(on-key 12) ; Ctrl+L (on-key 12) ; Ctrl+L
(let ((d (st :dirty))) (let ((d (getf *state* :dirty)))
(fiveam:is (eq t (first d))) (fiveam:is (eq t (first d)))
(fiveam:is (eq t (second d))))) (fiveam:is (eq t (second d)))))
(fiveam:test test-scroll-notify (fiveam:test test-scroll-notify
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up." "Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
(init-state) (init-state)
(setf (st :scroll-at-bottom) nil) (setf (getf *state* :scroll-at-bottom) nil)
(add-msg :agent "hi") (add-msg :agent "hi")
(fiveam:is (eq t (st :scroll-notify))) (fiveam:is (eq t (getf *state* :scroll-notify)))
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil) (setf (getf *state* :scroll-at-bottom) t (getf *state* :scroll-notify) nil)
(add-msg :agent "hi2") (add-msg :agent "hi2")
(fiveam:is (eq nil (st :scroll-notify)))) (fiveam:is (eq nil (getf *state* :scroll-notify))))
(fiveam:test test-tab-subcommand (fiveam:test test-tab-subcommand
"Contract/v0.7.0: Tab completes subcommand for /theme." "Contract/v0.7.0: Tab completes subcommand for /theme."
@@ -1051,7 +1051,7 @@
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "Hello"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello")))
(on-daemon-msg '(:type :stream-chunk :payload (:text " world"))) (on-daemon-msg '(:type :stream-chunk :payload (:text " world")))
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (= 1 (length msgs))) (fiveam:is (= 1 (length msgs)))
(let ((msg (aref msgs 0))) (let ((msg (aref msgs 0)))
(fiveam:is (eq :agent (getf msg :role))) (fiveam:is (eq :agent (getf msg :role)))
@@ -1063,35 +1063,35 @@
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "Hi"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi")))
(on-daemon-msg '(:type :stream-chunk :payload (:text ""))) (on-daemon-msg '(:type :stream-chunk :payload (:text "")))
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (stringp (getf msg :time))) (fiveam:is (stringp (getf msg :time)))
(fiveam:is (string= "Hi" (getf msg :content))) (fiveam:is (string= "Hi" (getf msg :content)))
(fiveam:is (null (st :streaming-text))))) (fiveam:is (null (getf *state* :streaming-text)))))
(fiveam:test test-stream-interrupt (fiveam:test test-stream-interrupt
"Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes." "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes."
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "partial"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "partial")))
(on-key 27) (on-key 27)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (stringp (getf msg :time))) (fiveam:is (stringp (getf msg :time)))
(fiveam:is (search "[interrupted]" (getf msg :content))) (fiveam:is (search "[interrupted]" (getf msg :content)))
(fiveam:is (null (st :streaming-text))) (fiveam:is (null (getf *state* :streaming-text)))
(fiveam:is (null (st :busy))))) (fiveam:is (null (getf *state* :busy)))))
(fiveam:test test-stream-check-skip (fiveam:test test-stream-check-skip
"Contract/v0.7.1: Esc without active streaming does nothing." "Contract/v0.7.1: Esc without active streaming does nothing."
(init-state) (init-state)
(on-key 27) (on-key 27)
(fiveam:is (null (st :streaming-text))) (fiveam:is (null (getf *state* :streaming-text)))
(fiveam:is (= 0 (length (st :messages))))) (fiveam:is (= 0 (length (getf *state* :messages)))))
(fiveam:test test-tab-open-url (fiveam:test test-tab-open-url
"Contract/v0.7.1: Tab on empty input with URL message extracts URL." "Contract/v0.7.1: Tab on empty input with URL message extracts URL."
(init-state) (init-state)
(add-msg :agent "visit https://example.com for info") (add-msg :agent "visit https://example.com for info")
(on-key 9) (on-key 9)
(fiveam:is (string= "https://example.com" (st :url-buffer)))) (fiveam:is (string= "https://example.com" (getf *state* :url-buffer))))
;; ── v0.7.2 HITL Panels ── ;; ── v0.7.2 HITL Panels ──
@@ -1102,7 +1102,7 @@
:payload (:sensor :approval-required :payload (:sensor :approval-required
:action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell")) :action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell"))
:message "rm -rf blocked"))) :message "rm -rf blocked")))
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (search "rm -rf" (getf m :content))))) (fiveam:is (search "rm -rf" (getf m :content)))))
@@ -1116,11 +1116,11 @@
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
;; Panel message (index 0) should be marked resolved ;; Panel message (index 0) should be marked resolved
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (eq :approved (getf m :panel-resolved)))) (fiveam:is (eq :approved (getf m :panel-resolved))))
;; Last message should be the approval confirmation ;; Last message should be the approval confirmation
(let ((m (aref (st :messages) (1- (length (st :messages)))))) (let ((m (aref (getf *state* :messages) (1- (length (getf *state* :messages))))))
(fiveam:is (search "Approved" (getf m :content))))) (fiveam:is (search "Approved" (getf m :content)))))
(fiveam:test test-hitl-panel-after-deny (fiveam:test test-hitl-panel-after-deny
@@ -1131,7 +1131,7 @@
(dolist (ch (coerce "/deny HITL-deny" 'list)) (dolist (ch (coerce "/deny HITL-deny" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (eq :denied (getf m :panel-resolved))))) (fiveam:is (eq :denied (getf m :panel-resolved)))))
@@ -1142,7 +1142,7 @@
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
;; Should add a system message confirming approval, not a user message ;; Should add a system message confirming approval, not a user message
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((m (aref msgs 0))) (let ((m (aref msgs 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
@@ -1154,7 +1154,7 @@
(dolist (ch (coerce "/deny HITL-xyz" 'list)) (dolist (ch (coerce "/deny HITL-xyz" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Denied" (getf m :content))))) (fiveam:is (search "Denied" (getf m :content)))))
@@ -1166,7 +1166,7 @@
(dolist (ch (coerce "/undo" 'list)) (dolist (ch (coerce "/undo" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Undo" (getf m :content))))) (fiveam:is (search "Undo" (getf m :content)))))
@@ -1176,7 +1176,7 @@
(dolist (ch (coerce "/redo" 'list)) (dolist (ch (coerce "/redo" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Redo" (getf m :content))))) (fiveam:is (search "Redo" (getf m :content)))))
@@ -1189,7 +1189,7 @@
(dolist (ch (coerce "/why" 'list)) (dolist (ch (coerce "/why" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "[BLOCKED]" (getf m :content))) (fiveam:is (search "[BLOCKED]" (getf m :content)))
@@ -1201,7 +1201,7 @@
(dolist (ch (coerce "/why" 'list)) (dolist (ch (coerce "/why" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "No recent" (getf m :content))))) (fiveam:is (search "No recent" (getf m :content)))))
@@ -1212,11 +1212,11 @@
(init-state) (init-state)
(add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed))) (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(on-key 7) ;; Ctrl+G — first press hides (on-key 7) ;; Ctrl+G — first press hides
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "hidden" (getf m :content)))) (fiveam:is (search "hidden" (getf m :content))))
(on-key 7) ;; second press shows (on-key 7) ;; second press shows
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "shown" (getf m :content))))) (fiveam:is (search "shown" (getf m :content)))))
@@ -1224,7 +1224,7 @@
"Contract v0.7.2: Ctrl+G with no gate trace shows fallback." "Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
(init-state) (init-state)
(on-key 7) (on-key 7)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content))))) (fiveam:is (search "No gate trace" (getf m :content)))))
;; ── v0.7.2 Message Search Mode ── ;; ── v0.7.2 Message Search Mode ──
@@ -1237,9 +1237,9 @@
(dolist (ch (coerce "/search hello" 'list)) (dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (eq t (st :search-mode))) (fiveam:is (eq t (getf *state* :search-mode)))
(fiveam:is (string= "hello" (st :search-query))) (fiveam:is (string= "hello" (getf *state* :search-query)))
(fiveam:is (= 1 (length (st :search-matches))))) (fiveam:is (= 1 (length (getf *state* :search-matches)))))
(fiveam:test test-search-mode-escape-exits (fiveam:test test-search-mode-escape-exits
"Contract v0.7.2: Escape exits search mode." "Contract v0.7.2: Escape exits search mode."
@@ -1248,9 +1248,9 @@
(dolist (ch (coerce "/search test" 'list)) (dolist (ch (coerce "/search test" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (eq t (st :search-mode))) (fiveam:is (eq t (getf *state* :search-mode)))
(on-key 27) ;; Escape (on-key 27) ;; Escape
(fiveam:is (null (st :search-mode)))) (fiveam:is (null (getf *state* :search-mode))))
(fiveam:test test-search-mode-up-down-nav (fiveam:test test-search-mode-up-down-nav
"Contract v0.7.2: Up/Down navigates between search matches." "Contract v0.7.2: Up/Down navigates between search matches."
@@ -1261,13 +1261,13 @@
(dolist (ch (coerce "/search hello" 'list)) (dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (= 0 (st :search-match-idx))) (fiveam:is (= 0 (getf *state* :search-match-idx)))
(on-key 258) ;; Down (on-key 258) ;; Down
(fiveam:is (= 1 (st :search-match-idx))) (fiveam:is (= 1 (getf *state* :search-match-idx)))
(on-key 259) ;; Up (on-key 259) ;; Up
(fiveam:is (= 0 (st :search-match-idx))) (fiveam:is (= 0 (getf *state* :search-match-idx)))
(on-key 259) ;; Up (clamped) (on-key 259) ;; Up (clamped)
(fiveam:is (= 0 (st :search-match-idx)))) (fiveam:is (= 0 (getf *state* :search-match-idx))))
(fiveam:test test-context-sections (fiveam:test test-context-sections
"Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS." "Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS."
@@ -1276,7 +1276,7 @@
(dolist (ch (coerce "/context" 'list)) (dolist (ch (coerce "/context" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs)) (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 "LOGS" (getf m :content))) msgs))
(fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs))))
@@ -1287,21 +1287,21 @@
(dolist (ch (coerce "/help configuration" 'list)) (dolist (ch (coerce "/help configuration" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs))))
(fiveam:test test-pads-page-up (fiveam:test test-pads-page-up
"Contract v0.7.2: PageUp scrolls by page size (> 5 lines)." "Contract v0.7.2: PageUp scrolls by page size (> 5 lines)."
(init-state) (init-state)
(dotimes (i 30) (add-msg :system (format nil "msg ~d" i))) (dotimes (i 30) (add-msg :system (format nil "msg ~d" i)))
(setf (st :scroll-offset) 0) (setf (getf *state* :scroll-offset) 0)
(on-key :ppage) (on-key :ppage)
(fiveam:is (> (st :scroll-offset) 5) "Should scroll by more than 5 lines")) (fiveam:is (> (getf *state* :scroll-offset) 5) "Should scroll by more than 5 lines"))
(fiveam:test test-pads-page-down-clamp (fiveam:test test-pads-page-down-clamp
"Contract v0.7.2: PageDown clamps to 0." "Contract v0.7.2: PageDown clamps to 0."
(init-state) (init-state)
(dotimes (i 5) (add-msg :system (format nil "msg ~d" i))) (dotimes (i 5) (add-msg :system (format nil "msg ~d" i)))
(setf (st :scroll-offset) 3) (setf (getf *state* :scroll-offset) 3)
(on-key :npage) (on-key :npage)
(fiveam:is (= 0 (st :scroll-offset)))) (fiveam:is (= 0 (getf *state* :scroll-offset))))

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

@@ -126,6 +126,9 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:collapsed-gates nil ; v0.7.2 :collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2 :search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0 :search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
(defun now () (defun now ()

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

@@ -1,25 +1,40 @@
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defun view-status (fb w) (defun view-status (fb w)
(let ((line1 (format nil (let ((degraded (and (find-package :passepartout)
" Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(if (st :connected) "● Connected" "○ Disconnected") (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(string-upcase (string (st :mode))) '(:degraded :unhealthy))))
(length (st :messages)) (bg (if degraded :bright-yellow nil)))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(or (st :rule-count) 0) (cl-tty.backend:draw-text fb 1 1
(if (st :streaming-text) " [streaming]" (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :busy) " …thinking" ""))))) (if (st :connected) "● Connected" "○ Disconnected")
(cl-tty.backend:draw-text fb 1 1 line1 (string-upcase (string (st :mode)))
(theme-color (if (st :connected) :connected :disconnected)) (length (st :messages))
nil) (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.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) ""))) (let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0)) (when (and focus-info (> (length focus-info) 0))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info) (cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) nil))) (theme-color :timestamp) bg)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now)) (cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) nil))) (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)))))
(lsp-color (if (st :connected) :green :dim))
(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 lsp-color) 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))))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown ;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query) (defun search-highlight (content query)

462
org/channel-tui-main.org
View File

@@ -37,68 +37,68 @@ Event handlers + daemon I/O + main loop.
(defun on-key (ch) (defun on-key (ch)
(cond (cond
;; v0.7.1: Esc — interrupt streaming ;; v0.7.1: Esc — interrupt streaming
((and (eq ch :escape) (st :streaming-text)) ((and (eq ch :escape) (getf *state* :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream))) (send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0) (when (> (length (getf *state* :messages)) 0)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :content) (setf (getf (aref (getf *state* :messages) idx) :content)
(concatenate 'string (concatenate 'string
(getf (aref (st :messages) idx) :content) (getf (aref (getf *state* :messages) idx) :content)
" [interrupted]")) " [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (getf *state* :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now)))) (setf (getf (aref (getf *state* :messages) idx) :time) (now))))
(setf (st :streaming-text) nil) (setf (getf *state* :streaming-text) nil)
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
;; v0.7.2: Esc — exit search mode ;; v0.7.2: Esc — exit search mode
((and (eq ch :escape) (st :search-mode)) ((and (eq ch :escape) (getf *state* :search-mode))
(setf (st :search-mode) nil (setf (getf *state* :search-mode) nil
(st :search-matches) nil (getf *state* :search-matches) nil
(st :search-query) "") (getf *state* :search-query) "")
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(add-msg :system "Search exited")) (add-msg :system "Search exited"))
;; v0.7.2: search mode — Up/Down navigate matches ;; v0.7.2: search mode — Up/Down navigate matches
((and (st :search-mode) (eq ch :up)) ((and (getf *state* :search-mode) (eq ch :up))
(let* ((matches (st :search-matches)) (let* ((matches (getf *state* :search-matches))
(idx (st :search-match-idx)) (idx (getf *state* :search-match-idx))
(new-idx (max 0 (1- idx)))) (new-idx (max 0 (1- idx))))
(setf (st :search-match-idx) new-idx) (setf (getf *state* :search-match-idx) new-idx)
(when matches (when matches
(setf (st :scroll-offset) (nth new-idx matches)) (setf (getf *state* :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
((and (st :search-mode) (eq ch :down)) ((and (getf *state* :search-mode) (eq ch :down))
(let* ((matches (st :search-matches)) (let* ((matches (getf *state* :search-matches))
(idx (st :search-match-idx)) (idx (getf *state* :search-match-idx))
(new-idx (min (1- (length matches)) (1+ idx)))) (new-idx (min (1- (length matches)) (1+ idx))))
(setf (st :search-match-idx) new-idx) (setf (getf *state* :search-match-idx) new-idx)
(when matches (when matches
(setf (st :scroll-offset) (nth new-idx matches)) (setf (getf *state* :scroll-offset) (nth new-idx matches))
(add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches))) (add-msg :system (format nil "Match ~d/~d" (1+ new-idx) (length matches)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
;; v0.7.2: search mode — Enter jumps to current match ;; v0.7.2: search mode — Enter jumps to current match
((and (st :search-mode) (eq ch :enter)) ((and (getf *state* :search-mode) (eq ch :enter))
(let ((matches (st :search-matches)) (let ((matches (getf *state* :search-matches))
(idx (st :search-match-idx))) (idx (getf *state* :search-match-idx)))
(when (and matches (>= (length matches) (1+ idx))) (when (and matches (>= (length matches) (1+ idx)))
(setf (st :scroll-offset) (nth idx matches)) (setf (getf *state* :scroll-offset) (nth idx matches))
(setf (st :search-mode) nil (setf (getf *state* :search-mode) nil
(st :search-matches) nil (getf *state* :search-matches) nil
(st :search-query) "") (getf *state* :search-query) "")
(add-msg :system (format nil "Jumped to match ~d" (1+ idx))) (add-msg :system (format nil "Jumped to match ~d" (1+ idx)))
(setf (st :dirty) (list nil t nil))))) (setf (getf *state* :dirty) (list nil t nil)))))
;; v0.7.1: Tab on empty input — extract then open URL from agent message ;; v0.7.1: Tab on empty input — extract then open URL from agent message
((and (eq ch :tab) ((and (eq ch :tab)
(null (st :input-buffer))) (null (getf *state* :input-buffer)))
(if (st :url-buffer) (if (getf *state* :url-buffer)
;; Already extracted — now open it ;; Already extracted — now open it
(progn (progn
(add-msg :system (format nil "Opening ~a" (st :url-buffer))) (add-msg :system (format nil "Opening ~a" (getf *state* :url-buffer)))
(setf (st :url-buffer) nil)) (setf (getf *state* :url-buffer) nil))
;; Extract URL from last agent message ;; Extract URL from last agent message
(let ((url nil)) (let ((url nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for msg = (aref (st :messages) i) for msg = (aref (getf *state* :messages) i)
for content = (getf msg :content) for content = (getf msg :content)
for role = (getf msg :role) for role = (getf msg :role)
while (eq role :agent) while (eq role :agent)
@@ -112,69 +112,69 @@ Event handlers + daemon I/O + main loop.
(return))))) (return)))))
(if url (if url
(progn (progn
(setf (st :url-buffer) url) (setf (getf *state* :url-buffer) url)
(add-msg :system (format nil "Press Tab to open ~a" url)) (add-msg :system (format nil "Press Tab to open ~a" url))
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
nil)))) nil))))
;; v0.7.0: Ctrl key bindings ;; v0.7.0: Ctrl key bindings
((eq ch :ctrl-u) ((eq ch :ctrl-u)
(setf (st :input-buffer) nil) (setf (getf *state* :input-buffer) nil)
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
((eq ch :ctrl-w) ((eq ch :ctrl-w)
(let ((buf (st :input-buffer))) (let ((buf (getf *state* :input-buffer)))
(loop while (and buf (char= (first buf) #\Space)) do (pop buf)) (loop while (and buf (char= (first buf) #\Space)) do (pop buf))
(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 (getf *state* :input-buffer) buf)
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
((eq ch :ctrl-a) ((eq ch :ctrl-a)
(setf (st :cursor-pos) 0)) (setf (getf *state* :cursor-pos) 0))
((eq ch :ctrl-e) ((eq ch :ctrl-e)
(setf (st :cursor-pos) (length (st :input-buffer)))) (setf (getf *state* :cursor-pos) (length (getf *state* :input-buffer))))
((eq ch :ctrl-l) ((eq ch :ctrl-l)
(setf (st :dirty) (list t t t))) (setf (getf *state* :dirty) (list t t t)))
((eq ch :ctrl-d) ((eq ch :ctrl-d)
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (getf *state* :input-buffer)) (string= "" (input-string)))
(add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit."))) (add-msg :system "Goodbye. Run /quit or press Ctrl+D again to exit.")))
((eq ch :ctrl-f) ((eq ch :ctrl-f)
(add-msg :system "Use /search <query> to find messages")) (add-msg :system "Use /search <query> to find messages"))
((eq ch :ctrl-g) ((eq ch :ctrl-g)
(let ((gate-idx nil)) (let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (getf *state* :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace))) when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish)) do (setf gate-idx i) (loop-finish))
(if gate-idx (if gate-idx
(let ((cg (st :collapsed-gates))) (let ((cg (getf *state* :collapsed-gates)))
(if (member gate-idx cg) (if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg)) (setf (getf *state* :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates))) (push gate-idx (getf *state* :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a" (add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown") (if (member gate-idx (getf *state* :collapsed-gates)) "hidden" "shown")
gate-idx)) gate-idx))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle")))) (add-msg :system "No gate trace to toggle"))))
((eq ch :ctrl-x) ((eq ch :ctrl-x)
(setf (st :pending-ctrl-x) t)) (setf (getf *state* :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eq ch :ctrl-e)) ; Ctrl+X+E — editor ((and (getf *state* :pending-ctrl-x) (eq ch :ctrl-e)) ; Ctrl+X+E — editor
(setf (st :pending-ctrl-x) nil) (setf (getf *state* :pending-ctrl-x) nil)
(add-msg :system "Opening $EDITOR... save and exit to return.") (add-msg :system "Opening $EDITOR... save and exit to return.")
(setf (st :dirty) (list t t nil))) (setf (getf *state* :dirty) (list t t nil)))
((and (st :pending-ctrl-x) (not (eq ch :ctrl-e))) ; cancel Ctrl+X ((and (getf *state* :pending-ctrl-x) (not (eq ch :ctrl-e))) ; cancel Ctrl+X
(setf (st :pending-ctrl-x) nil) (setf (getf *state* :pending-ctrl-x) nil)
(on-key ch) (on-key ch)
(return-from on-key nil)) (return-from on-key nil))
;; Enter ;; Enter
((eq ch :enter) ((eq ch :enter)
;; Multi-line: if buffer ends with \, strip it and insert newline ;; Multi-line: if buffer ends with \, strip it and insert newline
(if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\)) (if (and (getf *state* :input-buffer) (eql (first (getf *state* :input-buffer)) #\\))
(progn (pop (st :input-buffer)) (progn (pop (getf *state* :input-buffer))
(push #\Newline (st :input-buffer)) (push #\Newline (getf *state* :input-buffer))
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
(let ((text (string-trim '(#\Space #\Tab) (input-string)))) (let ((text (string-trim '(#\Space #\Tab) (input-string))))
(when (> (length text) 0) (when (> (length text) 0)
(push text (st :input-history)) (push text (getf *state* :input-history))
(setf (st :input-hpos) 0) (setf (getf *state* :input-hpos) 0)
(setf (st :scroll-offset) 0) (setf (getf *state* :scroll-offset) 0)
(cond (cond
;; v0.7.2: undo/redo ;; v0.7.2: undo/redo
((string-equal text "/undo") ((string-equal text "/undo")
@@ -201,7 +201,7 @@ Event handlers + daemon I/O + main loop.
;; /help command ;; /help command
;; /why command — show last gate trace ;; /why command — show last gate trace
((string-equal text "/why") ((string-equal text "/why")
(let ((msgs (st :messages)) (let ((msgs (getf *state* :messages))
(found nil)) (found nil))
(loop for i from (1- (length msgs)) downto 0 (loop for i from (1- (length msgs)) downto 0
for m = (aref msgs i) for m = (aref msgs i)
@@ -254,9 +254,9 @@ Event handlers + daemon I/O + main loop.
(add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))) (add-msg :system "No tags configured. Set TAG_CATEGORIES env var."))))
;; /context command — section breakdown with token estimates ;; /context command — section breakdown with token estimates
((string-equal text "/context") ((string-equal text "/context")
(let* ((msg-count (length (st :messages))) (let* ((msg-count (length (getf *state* :messages)))
(focus (or (st :foveal-id) "none")) (focus (or (getf *state* :foveal-id) "none"))
(id-tokens (min 200 (floor (+ 150 (length (or (st :focus-scope) ""))) 4))) (id-tokens (min 200 (floor (+ 150 (length (or (getf *state* :focus-scope) ""))) 4)))
(tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*) (tool-tokens (if (boundp 'passepartout::*cognitive-tool-registry*)
(floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4) (floor (* (hash-table-count passepartout::*cognitive-tool-registry*) 40) 4)
50)) 50))
@@ -303,7 +303,7 @@ Event handlers + daemon I/O + main loop.
(add-msg :system "Memory not available")))) (add-msg :system "Memory not available"))))
;; /context dropped — estimate pruned nodes from budget ;; /context dropped — estimate pruned nodes from budget
((string-equal text "/context dropped") ((string-equal text "/context dropped")
(let* ((msg-count (length (st :messages))) (let* ((msg-count (length (getf *state* :messages)))
(est-total (* msg-count 60)) (est-total (* msg-count 60))
(budget 8192) (budget 8192)
(dropped-msgs (if (> est-total budget) (dropped-msgs (if (> est-total budget)
@@ -318,7 +318,7 @@ Event handlers + daemon I/O + main loop.
;; /search command — message search ;; /search command — message search
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search ")) ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8)))) (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
(msgs (st :messages)) (msgs (getf *state* :messages))
(total (length msgs)) (total (length msgs))
(matches nil)) (matches nil))
(loop for i from 0 below total (loop for i from 0 below total
@@ -328,10 +328,10 @@ Event handlers + daemon I/O + main loop.
do (push i matches)) do (push i matches))
(setf matches (nreverse matches)) (setf matches (nreverse matches))
;; Enter search mode ;; Enter search mode
(setf (st :search-mode) t (setf (getf *state* :search-mode) t
(st :search-query) query (getf *state* :search-query) query
(st :search-matches) matches (getf *state* :search-matches) matches
(st :search-match-idx) 0) (getf *state* :search-match-idx) 0)
(if matches (if matches
(add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit" (add-msg :system (format nil "Search: ~d matches for '~a' (1/~d) — Up/Down nav, Enter jump, Esc exit"
(length matches) query (length matches))) (length matches) query (length matches)))
@@ -479,11 +479,11 @@ Event handlers + daemon I/O + main loop.
(uiop:ensure-all-directories-exist (list hist-file)) (uiop:ensure-all-directories-exist (list hist-file))
(with-open-file (out hist-file :direction :output (with-open-file (out hist-file :direction :output
:if-exists :supersede :if-does-not-exist :create) :if-exists :supersede :if-does-not-exist :create)
(dolist (entry (reverse (st :input-history))) (dolist (entry (reverse (getf *state* :input-history)))
(write-line entry out)))) (write-line entry out))))
(add-msg :system "* Goodbye *") (add-msg :system "* Goodbye *")
(send-daemon (list :type :event :payload '(:action :quit))) (send-daemon (list :type :event :payload '(:action :quit)))
(setf (st :running) nil)) (setf (getf *state* :running) nil))
;; /reconnect — re-establish daemon connection ;; /reconnect — re-establish daemon connection
((string-equal text "/reconnect") ((string-equal text "/reconnect")
(disconnect-daemon) (disconnect-daemon)
@@ -491,12 +491,12 @@ Event handlers + daemon I/O + main loop.
;; Normal message ;; Normal message
(t (t
(add-msg :user text) (add-msg :user text)
(setf (st :busy) t) (setf (getf *state* :busy) t)
(send-daemon (list :type :event (send-daemon (list :type :event
:payload (list :sensor :user-input :text text))))) :payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil) (setf (getf *state* :input-buffer) nil)
(setf (st :cursor-pos) 0) (setf (getf *state* :cursor-pos) 0)
(setf (st :dirty) (list t t t)))))) (setf (getf *state* :dirty) (list t t t))))))
;; Tab — command completion (v0.7.0: extended with subcommand + file paths) ;; Tab — command completion (v0.7.0: extended with subcommand + file paths)
((eq ch :tab) ((eq ch :tab)
(let ((text (input-string))) (let ((text (input-string)))
@@ -515,8 +515,8 @@ Event handlers + daemon I/O + main loop.
(string-equal n partial :end2 (length partial)))) (string-equal n partial :end2 (length partial))))
names))) names)))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "@" match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; /theme subcommand ;; /theme subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme ")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/theme "))
(let* ((partial (string-trim '(#\Space) (subseq text 7))) (let* ((partial (string-trim '(#\Space) (subseq text 7)))
@@ -524,8 +524,8 @@ Event handlers + daemon I/O + main loop.
(match (if (string= partial "") (first names) (match (if (string= partial "") (first names)
(find partial names :test #'string-equal)))) (find partial names :test #'string-equal))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; /focus subcommand ;; /focus subcommand
((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus ")) ((and (>= (length text) 7) (string-equal (subseq text 0 7) "/focus "))
(let* ((partial (string-trim '(#\Space) (subseq text 7))) (let* ((partial (string-trim '(#\Space) (subseq text 7)))
@@ -540,8 +540,8 @@ Event handlers + daemon I/O + main loop.
(string-equal d partial :end2 (length partial)))) (string-equal d partial :end2 (length partial))))
dirs)))) dirs))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list))) (setf (getf *state* :input-buffer) (reverse (coerce (concatenate 'string "/focus " match) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; Command prefix / ;; Command prefix /
((and (> (length text) 1) (eql (char text 0) #\/)) ((and (> (length text) 1) (eql (char text 0) #\/))
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit")) (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
@@ -549,51 +549,51 @@ Event handlers + daemon I/O + main loop.
(lambda (in cmd) (and (>= (length cmd) (length in)) (lambda (in cmd) (and (>= (length cmd) (length in))
(string-equal cmd in :end1 (length in))))))) (string-equal cmd in :end1 (length in)))))))
(when match (when match
(setf (st :input-buffer) (reverse (coerce match 'list))) (setf (getf *state* :input-buffer) (reverse (coerce match 'list)))
(when (member match '("/eval" "/focus" "/scope") :test #'string=) (when (member match '("/eval" "/focus" "/scope") :test #'string=)
(push #\Space (st :input-buffer))) (push #\Space (getf *state* :input-buffer)))
(setf (st :dirty) (list nil nil t)))))))) (setf (getf *state* :dirty) (list nil nil t)))))))
;; Backspace ;; Backspace
((eq ch :backspace) ((eq ch :backspace)
(input-delete-char) (input-delete-char)
(setf (st :dirty) (list nil nil t))) (setf (getf *state* :dirty) (list nil nil t)))
;; Left arrow ;; Left arrow
((eq ch :left) ((eq ch :left)
(when (> (or (st :cursor-pos) 0) 0) (when (> (or (getf *state* :cursor-pos) 0) 0)
(decf (st :cursor-pos)) (decf (getf *state* :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
;; Right arrow ;; Right arrow
((eq ch :right) ((eq ch :right)
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer))) (when (< (or (getf *state* :cursor-pos) 0) (length (getf *state* :input-buffer)))
(incf (st :cursor-pos)) (incf (getf *state* :cursor-pos))
(setf (st :dirty) (list nil nil t)))) (setf (getf *state* :dirty) (list nil nil t))))
;; Up arrow ;; Up arrow
((eq ch :up) ((eq ch :up)
(let* ((h (st :input-history)) (p (st :input-hpos))) (let* ((h (getf *state* :input-history)) (p (getf *state* :input-hpos)))
(when (and h (< p (1- (length h)))) (when (and h (< p (1- (length h))))
(incf (st :input-hpos)) (incf (getf *state* :input-hpos))
(setf (st :input-buffer) (setf (getf *state* :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list))) (reverse (coerce (nth (getf *state* :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; Down arrow ;; Down arrow
((eq ch :down) ((eq ch :down)
(when (> (st :input-hpos) 0) (when (> (getf *state* :input-hpos) 0)
(decf (st :input-hpos)) (decf (getf *state* :input-hpos))
(let ((h (st :input-history))) (let ((h (getf *state* :input-history)))
(setf (st :input-buffer) (setf (getf *state* :input-buffer)
(if (and h (< (st :input-hpos) (length h))) (if (and h (< (getf *state* :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list)) (reverse (coerce (nth (getf *state* :input-hpos) h) 'list))
nil)) nil))
(setf (st :dirty) (list nil nil t))))) (setf (getf *state* :dirty) (list nil nil t)))))
;; PageUp — scroll back by page (10 lines) ;; PageUp — scroll back by page (10 lines)
((eq ch :ppage) ((eq ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1)))) (let ((max-offset (max 0 (- (length (getf *state* :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10)))) (setf (getf *state* :scroll-offset) (min max-offset (+ (getf *state* :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
;; PageDown — scroll forward by page ;; PageDown — scroll forward by page
((eq ch :npage) ((eq ch :npage)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10))) (setf (getf *state* :scroll-offset) (max 0 (- (getf *state* :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
;; Printable ;; Printable
(t (t
(let ((chr (typecase ch (let ((chr (typecase ch
@@ -605,17 +605,17 @@ Event handlers + daemon I/O + main loop.
(t nil)))) (t nil))))
(when (and chr (graphic-char-p chr)) (when (and chr (graphic-char-p chr))
(input-insert-char chr) (input-insert-char chr)
(setf (st :dirty) (list nil nil t)))))))) (setf (getf *state* :dirty) (list nil nil t))))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision) (defun resolve-hitl-panel (decision)
"Mark the most recent HITL panel message as resolved with DECISION." "Mark the most recent HITL panel message as resolved with DECISION."
(loop for i from (1- (length (st :messages))) downto 0 (loop for i from (1- (length (getf *state* :messages))) downto 0
for m = (aref (st :messages) i) for m = (aref (getf *state* :messages) i)
when (and (getf m :panel) (not (getf m :panel-resolved))) when (and (getf m :panel) (not (getf m :panel-resolved)))
do (setf (getf m :panel-resolved) decision) do (setf (getf m :panel-resolved) decision)
(setf (aref (st :messages) i) m) (setf (aref (getf *state* :messages) i) m)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(loop-finish))) (loop-finish)))
;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections ;; v0.7.2 — self-help-lookup: read USER_MANUAL.org and find matching sections
@@ -680,43 +680,43 @@ Event handlers + daemon I/O + main loop.
(add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx" (add-msg :system (format nil "┌─ Permission Required ─┐~%~a~%Action: ~a~%Respond: /approve HITL-xxxx or /deny HITL-xxxx"
hitl-msg explanation) hitl-msg explanation)
:panel t)) :panel t))
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
;; v0.7.1: streaming chunk ;; v0.7.1: streaming chunk
(when (eq msg-type :stream-chunk) (when (eq msg-type :stream-chunk)
(cond (cond
((string= text "") ((string= text "")
;; Final chunk: stamp time, clear streaming ;; Final chunk: stamp time, clear streaming
(when (> (length (st :messages)) 0) (when (> (length (getf *state* :messages)) 0)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :streaming) nil) (setf (getf (aref (getf *state* :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now)))) (setf (getf (aref (getf *state* :messages) idx) :time) (now))))
(setf (st :streaming-text) nil) (setf (getf *state* :streaming-text) nil)
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
((null (st :streaming-text)) ((null (getf *state* :streaming-text))
;; First chunk: add new streaming message ;; First chunk: add new streaming message
(setf (st :streaming-text) "") (setf (getf *state* :streaming-text) "")
(setf (st :busy) nil) (setf (getf *state* :busy) nil)
(add-msg :agent text) (add-msg :agent text)
(let ((idx (1- (length (st :messages))))) (let ((idx (1- (length (getf *state* :messages)))))
(setf (getf (aref (st :messages) idx) :streaming) t)) (setf (getf (aref (getf *state* :messages) idx) :streaming) t))
(setf (st :streaming-text) text) (setf (getf *state* :streaming-text) text)
(setf (st :dirty) (list nil t nil)) (setf (getf *state* :dirty) (list nil t nil))
(return-from on-daemon-msg nil)) (return-from on-daemon-msg nil))
(t (t
;; Subsequent chunk: append ;; Subsequent chunk: append
(let* ((new-text (concatenate 'string (st :streaming-text) text)) (let* ((new-text (concatenate 'string (getf *state* :streaming-text) text))
(idx (1- (length (st :messages))))) (idx (1- (length (getf *state* :messages)))))
(setf (st :streaming-text) new-text) (setf (getf *state* :streaming-text) new-text)
(setf (getf (aref (st :messages) idx) :content) new-text) (setf (getf (aref (getf *state* :messages) idx) :content) new-text)
(setf (st :dirty) (list nil t nil))) (setf (getf *state* :dirty) (list nil t nil)))
(return-from on-daemon-msg nil)))) (return-from on-daemon-msg nil))))
(when rule-count (setf (st :rule-count) rule-count)) (when rule-count (setf (getf *state* :rule-count) rule-count))
(when foveal-id (setf (st :foveal-id) foveal-id)) (when foveal-id (setf (getf *state* :foveal-id) foveal-id))
(cond (cond
(text (setf (st :busy) nil) (text (setf (getf *state* :busy) nil)
(add-msg :agent text :gate-trace gate-trace)) (add-msg :agent text :gate-trace gate-trace))
((eq action :handshake) ((eq action :handshake)
(add-msg :system (format nil "Connected v~a" (getf payload :version)))) (add-msg :system (format nil "Connected v~a" (getf payload :version))))
@@ -726,7 +726,7 @@ Event handlers + daemon I/O + main loop.
** Daemon Communication ** Daemon Communication
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp #+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(defun send-daemon (msg) (defun send-daemon (msg)
(let ((s (st :stream))) (let ((s (getf *state* :stream)))
(when (and s (open-stream-p s)) (when (and s (open-stream-p s))
(handler-case (handler-case
(progn (progn
@@ -754,7 +754,7 @@ Event handlers + daemon I/O + main loop.
(defun reader-loop (s) (defun reader-loop (s)
(let ((consecutive-nils 0)) (let ((consecutive-nils 0))
(loop while (and (st :running) (open-stream-p s)) (loop while (and (getf *state* :running) (open-stream-p s))
do (let ((msg (recv-daemon s))) do (let ((msg (recv-daemon s)))
(if msg (if msg
(progn (queue-event (list :type :daemon :payload msg)) (progn (queue-event (list :type :daemon :payload msg))
@@ -773,8 +773,8 @@ Event handlers + daemon I/O + main loop.
(with-open-file (in hist-file :direction :input) (with-open-file (in hist-file :direction :input)
(loop for line = (read-line in nil nil) (loop for line = (read-line in nil nil)
while line while line
do (push line (st :input-history)))) do (push line (getf *state* :input-history))))
(setf (st :input-history) (nreverse (st :input-history)))))) (setf (getf *state* :input-history) (nreverse (getf *state* :input-history))))))
#+END_SRC #+END_SRC
** Connection ** Connection
@@ -786,9 +786,9 @@ Event handlers + daemon I/O + main loop.
do (sleep backoff) do (sleep backoff)
(handler-case (handler-case
(let ((s (usocket:socket-connect host port :timeout 5))) (let ((s (usocket:socket-connect host port :timeout 5)))
(setf (st :stream) (usocket:socket-stream s) (setf (getf *state* :stream) (usocket:socket-stream s)
(st :connected) t) (getf *state* :connected) t)
(bt:make-thread (lambda () (reader-loop (st :stream))) (bt:make-thread (lambda () (reader-loop (getf *state* :stream)))
:name "tui-reader") :name "tui-reader")
(add-msg :system (format nil "* Connected v~a *" "0.5.0")) (add-msg :system (format nil "* Connected v~a *" "0.5.0"))
(return-from connect-daemon t)) (return-from connect-daemon t))
@@ -804,9 +804,9 @@ Event handlers + daemon I/O + main loop.
nil) nil)
(defun disconnect-daemon () (defun disconnect-daemon ()
(when (st :stream) (when (getf *state* :stream)
(ignore-errors (close (st :stream))) (ignore-errors (close (getf *state* :stream)))
(setf (st :stream) nil (st :connected) nil) (setf (getf *state* :stream) nil (getf *state* :connected) nil)
(add-msg :system "* Disconnected *"))) (add-msg :system "* Disconnected *")))
#+END_SRC #+END_SRC
@@ -819,7 +819,7 @@ Event handlers + daemon I/O + main loop.
(let* ((swank-port (or (ignore-errors (let* ((swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT"))) (parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006))) 4006)))
(setf (st :dirty) (list t t t)) (setf (getf *state* :dirty) (list t t t))
(connect-daemon) (connect-daemon)
(when (> swank-port 0) (when (> swank-port 0)
(handler-case (handler-case
@@ -836,17 +836,17 @@ Event handlers + daemon I/O + main loop.
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h)) (let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h))) (curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render ;; Initial render
(redraw be curr-fb w h) (redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb) (rotatef prev-fb curr-fb)
(loop while (st :running) do (loop while (getf *state* :running) do
(dolist (ev (drain-queue)) (dolist (ev (drain-queue))
(cond (cond
((eq (getf ev :type) :daemon) ((eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload))) (on-daemon-msg (getf ev :payload)))
((eq (getf ev :type) :disconnected) ((eq (getf ev :type) :disconnected)
(setf (st :connected) nil (setf (getf *state* :connected) nil
(st :busy) nil) (getf *state* :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *")))) (add-msg :system "* Connection lost — type /reconnect to retry *"))))
(multiple-value-bind (type data) (multiple-value-bind (type data)
(cl-tty.input:read-event be :timeout 0) (cl-tty.input:read-event be :timeout 0)
@@ -855,7 +855,7 @@ Event handlers + daemon I/O + main loop.
(multiple-value-setq (w h) (cl-tty.backend:backend-size be)) (multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setf prev-fb (cl-tty.rendering:make-framebuffer w h) (setf prev-fb (cl-tty.rendering:make-framebuffer w h)
curr-fb (cl-tty.rendering:make-framebuffer w h)) curr-fb (cl-tty.rendering:make-framebuffer w h))
(setf (st :dirty) (list t t t))) (setf (getf *state* :dirty) (list t t t)))
(data (data
(let ((ch (typecase data (let ((ch (typecase data
(cl-tty.input:key-event (cl-tty.input:key-event
@@ -866,13 +866,13 @@ Event handlers + daemon I/O + main loop.
k))) k)))
(t data)))) (t data))))
(on-key ch))))))) (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty))) (when (or (first (getf *state* :dirty)) (second (getf *state* :dirty)) (third (getf *state* :dirty)))
(cl-tty.backend:backend-clear curr-fb) (cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h) (redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be) (cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)) (rotatef prev-fb curr-fb))
(sleep 0.1)))) (sleep 0.1)))
(disconnect-daemon)))) (disconnect-daemon)))
#+END_SRC #+END_SRC
* Test Suite * Test Suite
@@ -892,19 +892,19 @@ Event handlers + daemon I/O + main loop.
(fiveam:test test-init-state (fiveam:test test-init-state
"Contract model.1: init-state returns fresh state plist with required keys." "Contract model.1: init-state returns fresh state plist with required keys."
(init-state) (init-state)
(fiveam:is (eq t (st :running))) (fiveam:is (eq t (getf *state* :running)))
(fiveam:is (eq :chat (st :mode))) (fiveam:is (eq :chat (getf *state* :mode)))
(fiveam:is (eq nil (st :connected))) (fiveam:is (eq nil (getf *state* :connected)))
(fiveam:is (eq nil (st :stream))) (fiveam:is (eq nil (getf *state* :stream)))
(fiveam:is (zerop (length (st :messages)))) (fiveam:is (zerop (length (getf *state* :messages))))
(fiveam:is (eq 0 (st :scroll-offset))) (fiveam:is (eq 0 (getf *state* :scroll-offset)))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (getf *state* :busy))))
(fiveam:test test-add-msg (fiveam:test test-add-msg
"Contract model.2: add-msg appends a message with role, content, and time." "Contract model.2: add-msg appends a message with role, content, and time."
(init-state) (init-state)
(add-msg :user "hello") (add-msg :user "hello")
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(msg (aref msgs 0))) (msg (aref msgs 0)))
(fiveam:is (eq :user (getf msg :role))) (fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content))) (fiveam:is (string= "hello" (getf msg :content)))
@@ -914,9 +914,9 @@ Event handlers + daemon I/O + main loop.
(fiveam:test test-add-msg-dirty-flag (fiveam:test test-add-msg-dirty-flag
"Contract model.2: add-msg sets dirty flags for status and chat." "Contract model.2: add-msg sets dirty flags for status and chat."
(init-state) (init-state)
(setf (st :dirty) (list nil nil nil)) (setf (getf *state* :dirty) (list nil nil nil))
(add-msg :system "boot") (add-msg :system "boot")
(let ((dirty (st :dirty))) (let ((dirty (getf *state* :dirty)))
(fiveam:is (eq t (first dirty))) (fiveam:is (eq t (first dirty)))
(fiveam:is (eq t (second dirty))) (fiveam:is (eq t (second dirty)))
(fiveam:is (eq nil (third dirty))))) (fiveam:is (eq nil (third dirty)))))
@@ -944,7 +944,7 @@ Event handlers + daemon I/O + main loop.
;; Input buffer should be cleared ;; Input buffer should be cleared
(fiveam:is (string= "" (input-string))) (fiveam:is (string= "" (input-string)))
;; A user message should be in the message list ;; A user message should be in the message list
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last (aref msgs 0))) (let ((last (aref msgs 0)))
(fiveam:is (eq :user (getf last :role))) (fiveam:is (eq :user (getf last :role)))
@@ -957,7 +957,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/eval (+ 1 2)" 'list)) (dolist (ch (coerce "/eval (+ 1 2)" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((last-msg (aref msgs 0))) (let ((last-msg (aref msgs 0)))
(fiveam:is (eq :system (getf last-msg :role))) (fiveam:is (eq :system (getf last-msg :role)))
@@ -979,7 +979,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/focus myapp" 'list)) (dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command (fiveam:test test-on-key-scope-command
@@ -988,7 +988,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/scope memex" 'list)) (dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command (fiveam:test test-on-key-unfocus-command
@@ -997,7 +997,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/unfocus" 'list)) (dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf msg :role))))) (fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-tab-completion (fiveam:test test-on-key-tab-completion
@@ -1032,22 +1032,22 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/help" 'list)) (dolist (ch (coerce "/help" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 3)) (fiveam:is (>= (length msgs) 3))
(fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))
(fiveam:test test-activity-indicator (fiveam:test test-activity-indicator
"Contract model: :busy flag is set on send and cleared on agent response." "Contract model: :busy flag is set on send and cleared on agent response."
(init-state) (init-state)
(fiveam:is (eq nil (st :busy))) (fiveam:is (eq nil (getf *state* :busy)))
;; Simulate sending a normal message (sets busy) ;; Simulate sending a normal message (sets busy)
(dolist (ch (coerce "hello" 'list)) (dolist (ch (coerce "hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(fiveam:is (eq t (st :busy))) (fiveam:is (eq t (getf *state* :busy)))
;; Simulate receiving an agent response (clears busy) ;; Simulate receiving an agent response (clears busy)
(on-daemon-msg '(:type :event :payload (:text "hi back"))) (on-daemon-msg '(:type :event :payload (:text "hi back")))
(fiveam:is (eq nil (st :busy)))) (fiveam:is (eq nil (getf *state* :busy))))
(fiveam:test test-theme (fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings." "Contract view: *tui-theme* provides color mappings."
@@ -1067,21 +1067,21 @@ Event handlers + daemon I/O + main loop.
(fiveam:test test-on-key-ctrl-l-redraws (fiveam:test test-on-key-ctrl-l-redraws
"Contract 1/v0.7.0: Ctrl+L sets all dirty flags." "Contract 1/v0.7.0: Ctrl+L sets all dirty flags."
(init-state) (init-state)
(setf (st :dirty) (list nil nil nil)) (setf (getf *state* :dirty) (list nil nil nil))
(on-key 12) ; Ctrl+L (on-key 12) ; Ctrl+L
(let ((d (st :dirty))) (let ((d (getf *state* :dirty)))
(fiveam:is (eq t (first d))) (fiveam:is (eq t (first d)))
(fiveam:is (eq t (second d))))) (fiveam:is (eq t (second d)))))
(fiveam:test test-scroll-notify (fiveam:test test-scroll-notify
"Contract/v0.7.0: add-msg sets scroll-notify when scrolled up." "Contract/v0.7.0: add-msg sets scroll-notify when scrolled up."
(init-state) (init-state)
(setf (st :scroll-at-bottom) nil) (setf (getf *state* :scroll-at-bottom) nil)
(add-msg :agent "hi") (add-msg :agent "hi")
(fiveam:is (eq t (st :scroll-notify))) (fiveam:is (eq t (getf *state* :scroll-notify)))
(setf (st :scroll-at-bottom) t (st :scroll-notify) nil) (setf (getf *state* :scroll-at-bottom) t (getf *state* :scroll-notify) nil)
(add-msg :agent "hi2") (add-msg :agent "hi2")
(fiveam:is (eq nil (st :scroll-notify)))) (fiveam:is (eq nil (getf *state* :scroll-notify))))
(fiveam:test test-tab-subcommand (fiveam:test test-tab-subcommand
"Contract/v0.7.0: Tab completes subcommand for /theme." "Contract/v0.7.0: Tab completes subcommand for /theme."
@@ -1097,7 +1097,7 @@ Event handlers + daemon I/O + main loop.
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "Hello"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hello")))
(on-daemon-msg '(:type :stream-chunk :payload (:text " world"))) (on-daemon-msg '(:type :stream-chunk :payload (:text " world")))
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (= 1 (length msgs))) (fiveam:is (= 1 (length msgs)))
(let ((msg (aref msgs 0))) (let ((msg (aref msgs 0)))
(fiveam:is (eq :agent (getf msg :role))) (fiveam:is (eq :agent (getf msg :role)))
@@ -1109,35 +1109,35 @@ Event handlers + daemon I/O + main loop.
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "Hi"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "Hi")))
(on-daemon-msg '(:type :stream-chunk :payload (:text ""))) (on-daemon-msg '(:type :stream-chunk :payload (:text "")))
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (stringp (getf msg :time))) (fiveam:is (stringp (getf msg :time)))
(fiveam:is (string= "Hi" (getf msg :content))) (fiveam:is (string= "Hi" (getf msg :content)))
(fiveam:is (null (st :streaming-text))))) (fiveam:is (null (getf *state* :streaming-text)))))
(fiveam:test test-stream-interrupt (fiveam:test test-stream-interrupt
"Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes." "Contract/v0.7.1: Esc during streaming appends [interrupted] and finalizes."
(init-state) (init-state)
(on-daemon-msg '(:type :stream-chunk :payload (:text "partial"))) (on-daemon-msg '(:type :stream-chunk :payload (:text "partial")))
(on-key 27) (on-key 27)
(let ((msg (aref (st :messages) 0))) (let ((msg (aref (getf *state* :messages) 0)))
(fiveam:is (stringp (getf msg :time))) (fiveam:is (stringp (getf msg :time)))
(fiveam:is (search "[interrupted]" (getf msg :content))) (fiveam:is (search "[interrupted]" (getf msg :content)))
(fiveam:is (null (st :streaming-text))) (fiveam:is (null (getf *state* :streaming-text)))
(fiveam:is (null (st :busy))))) (fiveam:is (null (getf *state* :busy)))))
(fiveam:test test-stream-check-skip (fiveam:test test-stream-check-skip
"Contract/v0.7.1: Esc without active streaming does nothing." "Contract/v0.7.1: Esc without active streaming does nothing."
(init-state) (init-state)
(on-key 27) (on-key 27)
(fiveam:is (null (st :streaming-text))) (fiveam:is (null (getf *state* :streaming-text)))
(fiveam:is (= 0 (length (st :messages))))) (fiveam:is (= 0 (length (getf *state* :messages)))))
(fiveam:test test-tab-open-url (fiveam:test test-tab-open-url
"Contract/v0.7.1: Tab on empty input with URL message extracts URL." "Contract/v0.7.1: Tab on empty input with URL message extracts URL."
(init-state) (init-state)
(add-msg :agent "visit https://example.com for info") (add-msg :agent "visit https://example.com for info")
(on-key 9) (on-key 9)
(fiveam:is (string= "https://example.com" (st :url-buffer)))) (fiveam:is (string= "https://example.com" (getf *state* :url-buffer))))
;; ── v0.7.2 HITL Panels ── ;; ── v0.7.2 HITL Panels ──
@@ -1148,7 +1148,7 @@ Event handlers + daemon I/O + main loop.
:payload (:sensor :approval-required :payload (:sensor :approval-required
:action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell")) :action (:TYPE :REQUEST :PAYLOAD (:TOOL "shell"))
:message "rm -rf blocked"))) :message "rm -rf blocked")))
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (search "rm -rf" (getf m :content))))) (fiveam:is (search "rm -rf" (getf m :content)))))
@@ -1162,11 +1162,11 @@ Event handlers + daemon I/O + main loop.
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
;; Panel message (index 0) should be marked resolved ;; Panel message (index 0) should be marked resolved
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (eq :approved (getf m :panel-resolved)))) (fiveam:is (eq :approved (getf m :panel-resolved))))
;; Last message should be the approval confirmation ;; Last message should be the approval confirmation
(let ((m (aref (st :messages) (1- (length (st :messages)))))) (let ((m (aref (getf *state* :messages) (1- (length (getf *state* :messages))))))
(fiveam:is (search "Approved" (getf m :content))))) (fiveam:is (search "Approved" (getf m :content)))))
(fiveam:test test-hitl-panel-after-deny (fiveam:test test-hitl-panel-after-deny
@@ -1177,7 +1177,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/deny HITL-deny" 'list)) (dolist (ch (coerce "/deny HITL-deny" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (getf m :panel)) (fiveam:is (getf m :panel))
(fiveam:is (eq :denied (getf m :panel-resolved))))) (fiveam:is (eq :denied (getf m :panel-resolved)))))
@@ -1188,7 +1188,7 @@ Event handlers + daemon I/O + main loop.
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
;; Should add a system message confirming approval, not a user message ;; Should add a system message confirming approval, not a user message
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (>= (length msgs) 1)) (fiveam:is (>= (length msgs) 1))
(let ((m (aref msgs 0))) (let ((m (aref msgs 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
@@ -1200,7 +1200,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/deny HITL-xyz" 'list)) (dolist (ch (coerce "/deny HITL-xyz" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Denied" (getf m :content))))) (fiveam:is (search "Denied" (getf m :content)))))
@@ -1212,7 +1212,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/undo" 'list)) (dolist (ch (coerce "/undo" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Undo" (getf m :content))))) (fiveam:is (search "Undo" (getf m :content)))))
@@ -1222,7 +1222,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/redo" 'list)) (dolist (ch (coerce "/redo" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 343) (on-key 343)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Redo" (getf m :content))))) (fiveam:is (search "Redo" (getf m :content)))))
@@ -1235,7 +1235,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/why" 'list)) (dolist (ch (coerce "/why" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (eq :system (getf m :role))) (fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "[BLOCKED]" (getf m :content))) (fiveam:is (search "[BLOCKED]" (getf m :content)))
@@ -1247,7 +1247,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/why" 'list)) (dolist (ch (coerce "/why" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "No recent" (getf m :content))))) (fiveam:is (search "No recent" (getf m :content)))))
@@ -1258,11 +1258,11 @@ Event handlers + daemon I/O + main loop.
(init-state) (init-state)
(add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed))) (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(on-key 7) ;; Ctrl+G — first press hides (on-key 7) ;; Ctrl+G — first press hides
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "hidden" (getf m :content)))) (fiveam:is (search "hidden" (getf m :content))))
(on-key 7) ;; second press shows (on-key 7) ;; second press shows
(let* ((msgs (st :messages)) (let* ((msgs (getf *state* :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "shown" (getf m :content))))) (fiveam:is (search "shown" (getf m :content)))))
@@ -1270,7 +1270,7 @@ Event handlers + daemon I/O + main loop.
"Contract v0.7.2: Ctrl+G with no gate trace shows fallback." "Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
(init-state) (init-state)
(on-key 7) (on-key 7)
(let ((m (aref (st :messages) 0))) (let ((m (aref (getf *state* :messages) 0)))
(fiveam:is (search "No gate trace" (getf m :content))))) (fiveam:is (search "No gate trace" (getf m :content)))))
;; ── v0.7.2 Message Search Mode ── ;; ── v0.7.2 Message Search Mode ──
@@ -1283,9 +1283,9 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/search hello" 'list)) (dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (eq t (st :search-mode))) (fiveam:is (eq t (getf *state* :search-mode)))
(fiveam:is (string= "hello" (st :search-query))) (fiveam:is (string= "hello" (getf *state* :search-query)))
(fiveam:is (= 1 (length (st :search-matches))))) (fiveam:is (= 1 (length (getf *state* :search-matches)))))
(fiveam:test test-search-mode-escape-exits (fiveam:test test-search-mode-escape-exits
"Contract v0.7.2: Escape exits search mode." "Contract v0.7.2: Escape exits search mode."
@@ -1294,9 +1294,9 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/search test" 'list)) (dolist (ch (coerce "/search test" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (eq t (st :search-mode))) (fiveam:is (eq t (getf *state* :search-mode)))
(on-key 27) ;; Escape (on-key 27) ;; Escape
(fiveam:is (null (st :search-mode)))) (fiveam:is (null (getf *state* :search-mode))))
(fiveam:test test-search-mode-up-down-nav (fiveam:test test-search-mode-up-down-nav
"Contract v0.7.2: Up/Down navigates between search matches." "Contract v0.7.2: Up/Down navigates between search matches."
@@ -1307,13 +1307,13 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/search hello" 'list)) (dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(fiveam:is (= 0 (st :search-match-idx))) (fiveam:is (= 0 (getf *state* :search-match-idx)))
(on-key 258) ;; Down (on-key 258) ;; Down
(fiveam:is (= 1 (st :search-match-idx))) (fiveam:is (= 1 (getf *state* :search-match-idx)))
(on-key 259) ;; Up (on-key 259) ;; Up
(fiveam:is (= 0 (st :search-match-idx))) (fiveam:is (= 0 (getf *state* :search-match-idx)))
(on-key 259) ;; Up (clamped) (on-key 259) ;; Up (clamped)
(fiveam:is (= 0 (st :search-match-idx)))) (fiveam:is (= 0 (getf *state* :search-match-idx))))
(fiveam:test test-context-sections (fiveam:test test-context-sections
"Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS." "Contract v0.7.2: /context shows section breakdown with IDENTITY, TOOLS, LOGS."
@@ -1322,7 +1322,7 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/context" 'list)) (dolist (ch (coerce "/context" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (some (lambda (m) (search "IDENTITY" (getf m :content))) msgs)) (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 "LOGS" (getf m :content))) msgs))
(fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search "TOOLS" (getf m :content))) msgs))))
@@ -1333,22 +1333,22 @@ Event handlers + daemon I/O + main loop.
(dolist (ch (coerce "/help configuration" 'list)) (dolist (ch (coerce "/help configuration" 'list))
(on-key (char-code ch))) (on-key (char-code ch)))
(on-key 13) (on-key 13)
(let ((msgs (st :messages))) (let ((msgs (getf *state* :messages)))
(fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs)))) (fiveam:is (some (lambda (m) (search ".env" (getf m :content))) msgs))))
(fiveam:test test-pads-page-up (fiveam:test test-pads-page-up
"Contract v0.7.2: PageUp scrolls by page size (> 5 lines)." "Contract v0.7.2: PageUp scrolls by page size (> 5 lines)."
(init-state) (init-state)
(dotimes (i 30) (add-msg :system (format nil "msg ~d" i))) (dotimes (i 30) (add-msg :system (format nil "msg ~d" i)))
(setf (st :scroll-offset) 0) (setf (getf *state* :scroll-offset) 0)
(on-key :ppage) (on-key :ppage)
(fiveam:is (> (st :scroll-offset) 5) "Should scroll by more than 5 lines")) (fiveam:is (> (getf *state* :scroll-offset) 5) "Should scroll by more than 5 lines"))
(fiveam:test test-pads-page-down-clamp (fiveam:test test-pads-page-down-clamp
"Contract v0.7.2: PageDown clamps to 0." "Contract v0.7.2: PageDown clamps to 0."
(init-state) (init-state)
(dotimes (i 5) (add-msg :system (format nil "msg ~d" i))) (dotimes (i 5) (add-msg :system (format nil "msg ~d" i)))
(setf (st :scroll-offset) 3) (setf (getf *state* :scroll-offset) 3)
(on-key :npage) (on-key :npage)
(fiveam:is (= 0 (st :scroll-offset)))) (fiveam:is (= 0 (getf *state* :scroll-offset))))
#+END_SRC #+END_SRC

3
org/channel-tui-state.org
View File

@@ -146,6 +146,9 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:collapsed-gates nil ; v0.7.2 :collapsed-gates nil ; v0.7.2
:search-mode nil :search-query "" ; v0.7.2 :search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0 :search-matches nil :search-match-idx 0
:sidebar-visible nil ; v0.8.0
:expand-tool-calls nil ; v0.8.0
:mcp-count 0 ; v0.8.0
:dirty (list nil nil nil)))) :dirty (list nil nil nil))))
#+END_SRC #+END_SRC

45
org/channel-tui-view.org
View File

@@ -46,25 +46,40 @@ that the TUI actuator attaches to the response plist before transmission.
(in-package :passepartout.channel-tui) (in-package :passepartout.channel-tui)
(defun view-status (fb w) (defun view-status (fb w)
(let ((line1 (format nil (let ((degraded (and (find-package :passepartout)
" Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a" (boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(if (st :connected) "● Connected" "○ Disconnected") (member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(string-upcase (string (st :mode))) '(:degraded :unhealthy))))
(length (st :messages)) (bg (if degraded :bright-yellow nil)))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0") ;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(or (st :rule-count) 0) (cl-tty.backend:draw-text fb 1 1
(if (st :streaming-text) " [streaming]" (format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :busy) " …thinking" ""))))) (if (st :connected) "● Connected" "○ Disconnected")
(cl-tty.backend:draw-text fb 1 1 line1 (string-upcase (string (st :mode)))
(theme-color (if (st :connected) :connected :disconnected)) (length (st :messages))
nil) (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.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) ""))) (let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0)) (when (and focus-info (> (length focus-info) 0))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info) (cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) nil))) (theme-color :timestamp) bg)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now)) (cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) nil))) (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)))))
(lsp-color (if (st :connected) :green :dim))
(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 lsp-color) 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))))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown ;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query) (defun search-highlight (content query)