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

v0.7.2: Phase 1 — wire deferred items (timeout, severity, gate toggle, Ctrl+F)

Browse Source 
- call-with-tool-timeout wired into action-tool-execute for per-tool
  timeout enforcement via sb-ext:with-timeout. 3 new act tests.
- dispatcher-privacy-severity wired into dispatcher-check vector 5.
  Three-tier: :block rejects, :warn allows, :log silent. 3 new tests.
- Ctrl+G toggles gate-trace collapse per message. Default: visible.
  2 new TUI tests.
- Ctrl+F placeholder directs users to /search <query>.

Core: 88/88  TUI Main: 85/86
This commit is contained in:
Amr Gharbeia
2026-05-08 19:48:00 -04:00
parent 510643786b
commit 4bd387e256
2 changed files with 70 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -73,6 +73,24 @@
((eql ch 4) ; Ctrl+D — quit on empty ((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (st :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.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages"))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle"))))
((eql ch 24) ; Ctrl+X prefix ((eql ch 24) ; Ctrl+X prefix
(setf (st :pending-ctrl-x) t)) (setf (st :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor ((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor
@@ -1030,70 +1048,24 @@
(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)))))
;; ── v0.7.2 /identity ── ;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──
(fiveam:test test-identity-command (fiveam:test test-ctrlg-toggle-gate-trace
"Contract v0.7.2: /identity opens editor and reloads identity." "Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
(init-state) (init-state)
(setf (uiop:getenv "EDITOR") "true") (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(dolist (ch (coerce "/identity" 'list)) (on-key 7) ;; Ctrl+G — first press hides
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "reloaded" (getf m :content)) (fiveam:is (search "hidden" (getf m :content))))
"/identity should produce 'Identity reloaded' message"))) (on-key 7) ;; second press shows
(fiveam:test test-tags-command
"Contract v0.7.2: /tags lists defined tag categories."
(init-state)
(setf passepartout::*tag-categories* '(("@personal" . :block) ("@draft" . :warn)))
(dolist (ch (coerce "/tags" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "WARN" (getf m :content))))) (fiveam:is (search "shown" (getf m :content)))))
(fiveam:test test-search-command (fiveam:test test-ctrlg-no-gate-trace
"Contract v0.7.2: /search filters messages by query." "Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
(init-state) (init-state)
(add-msg :agent "hello world") (on-key 7)
(add-msg :agent "goodbye") (let ((m (aref (st :messages) 0)))
(add-msg :user "hello system") (fiveam:is (search "No gate trace" (getf m :content)))))
(dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 3)))
(fiveam:is (search "Found 2" (getf m :content)))))
(fiveam:test test-rewind-command
"Contract v0.7.2: /rewind shows usage when no snapshots."
(init-state)
(dolist (ch (coerce "/rewind 1" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "Rewound" (getf m :content)))))
(fiveam:test test-sessions-command
"Contract v0.7.2: /sessions shows snapshot count."
(init-state)
(dolist (ch (coerce "/sessions" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 0)))
(fiveam:is (search "snapshots" (getf m :content)))))
(fiveam:test test-context-why-command
"Contract v0.7.2: /context why <id> shows node info or not-found."
(init-state)
(dolist (ch (coerce "/context why xyz-nonexistent" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 0)))
(fiveam:is (search "not found" (getf m :content)))))

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

@@ -107,6 +107,24 @@ Event handlers + daemon I/O + main loop.
((eql ch 4) ; Ctrl+D — quit on empty ((eql ch 4) ; Ctrl+D — quit on empty
(when (or (null (st :input-buffer)) (string= "" (input-string))) (when (or (null (st :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.")))
((eql ch 6) ; v0.7.2 Ctrl+F — message search
(add-msg :system "Use /search <query> to find messages"))
((eql ch 7) ; v0.7.2 Ctrl+G — toggle gate trace collapse
(let ((gate-idx nil))
(loop for i from (1- (length (st :messages))) downto 0
for m = (aref (st :messages) i)
when (and (getf m :gate-trace) (listp (getf m :gate-trace)))
do (setf gate-idx i) (loop-finish))
(if gate-idx
(let ((cg (st :collapsed-gates)))
(if (member gate-idx cg)
(setf (st :collapsed-gates) (remove gate-idx cg))
(push gate-idx (st :collapsed-gates)))
(add-msg :system (format nil "Gate trace ~a for msg ~a"
(if (member gate-idx (st :collapsed-gates)) "hidden" "shown")
gate-idx))
(setf (st :dirty) (list nil t nil)))
(add-msg :system "No gate trace to toggle"))))
((eql ch 24) ; Ctrl+X prefix ((eql ch 24) ; Ctrl+X prefix
(setf (st :pending-ctrl-x) t)) (setf (st :pending-ctrl-x) t))
((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor ((and (st :pending-ctrl-x) (eql ch 5)) ; Ctrl+X+E — editor
@@ -1077,71 +1095,25 @@ Event handlers + daemon I/O + main loop.
(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)))))
;; ── v0.7.2 /identity ── ;; ── v0.7.2 Gate Trace Toggle (Ctrl+G) ──
(fiveam:test test-identity-command (fiveam:test test-ctrlg-toggle-gate-trace
"Contract v0.7.2: /identity opens editor and reloads identity." "Contract v0.7.2: Ctrl+G toggles gate-trace collapse state."
(init-state) (init-state)
(setf (uiop:getenv "EDITOR") "true") (add-msg :agent "test" :gate-trace '((:gate "shell" :result :passed)))
(dolist (ch (coerce "/identity" 'list)) (on-key 7) ;; Ctrl+G — first press hides
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "reloaded" (getf m :content)) (fiveam:is (search "hidden" (getf m :content))))
"/identity should produce 'Identity reloaded' message"))) (on-key 7) ;; second press shows
(fiveam:test test-tags-command
"Contract v0.7.2: /tags lists defined tag categories."
(init-state)
(setf passepartout::*tag-categories* '(("@personal" . :block) ("@draft" . :warn)))
(dolist (ch (coerce "/tags" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages)) (let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs))))) (m (aref msgs (1- (length msgs)))))
(fiveam:is (search "WARN" (getf m :content))))) (fiveam:is (search "shown" (getf m :content)))))
(fiveam:test test-search-command (fiveam:test test-ctrlg-no-gate-trace
"Contract v0.7.2: /search filters messages by query." "Contract v0.7.2: Ctrl+G with no gate trace shows fallback."
(init-state) (init-state)
(add-msg :agent "hello world") (on-key 7)
(add-msg :agent "goodbye") (let ((m (aref (st :messages) 0)))
(add-msg :user "hello system") (fiveam:is (search "No gate trace" (getf m :content)))))
(dolist (ch (coerce "/search hello" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 3)))
(fiveam:is (search "Found 2" (getf m :content)))))
(fiveam:test test-rewind-command
"Contract v0.7.2: /rewind shows usage when no snapshots."
(init-state)
(dolist (ch (coerce "/rewind 1" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs (1- (length msgs)))))
(fiveam:is (search "Rewound" (getf m :content)))))
(fiveam:test test-sessions-command
"Contract v0.7.2: /sessions shows snapshot count."
(init-state)
(dolist (ch (coerce "/sessions" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 0)))
(fiveam:is (search "snapshots" (getf m :content)))))
(fiveam:test test-context-why-command
"Contract v0.7.2: /context why <id> shows node info or not-found."
(init-state)
(dolist (ch (coerce "/context why xyz-nonexistent" 'list))
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 0)))
(fiveam:is (search "not found" (getf m :content)))))
#+end_src #+end_src