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

v0.7.2: session rewind + context debugging — TDD

Browse Source 
Session rewind: /rewind <n> restores memory to snapshot n-1 using
existing rollback-memory. /sessions lists up to 10 snapshots with
timestamps and object counts. Auto-snapshot at turn boundaries in
think() via fboundp-guarded snapshot-memory call.

Context debugging: /context why <id> shows memory object type, scope,
version. /context dropped placeholder (deferred to v0.8.0).

- core-reason: auto-snapshot in think() + 1 test
- channel-tui-main: /rewind, /sessions, /context why, /context dropped
  + 3 tests
- Core: 85/85  TUI Main: 88/89 (1 pre-existing flake)
This commit is contained in:
Amr Gharbeia
2026-05-08 19:05:47 -04:00
parent c959f93eb1
commit 029a32ef64
4 changed files with 186 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -220,6 +220,22 @@ Event handlers + daemon I/O + main loop.
do (add-msg :system (format nil " ~a: ~a"
(case role (:user "You") (:agent "Agent") (t "Sys"))
preview))))))
;; /context why <id> — debug node
((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why "))
(let ((node-id (string-trim '(#\Space) (subseq text 13))))
(if (fboundp 'passepartout::memory-object-get)
(let ((obj (funcall 'passepartout::memory-object-get node-id)))
(if obj
(add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a"
node-id
(passepartout::memory-object-type obj)
(passepartout::memory-object-scope obj)
(passepartout::memory-object-version obj)))
(add-msg :system (format nil "Node ~a not found" node-id))))
(add-msg :system "Memory not available"))))
;; /context dropped — pruned nodes
((string-equal text "/context dropped")
(add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
;; /search command — message search
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search "))
(let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))
@@ -247,6 +263,35 @@ Event handlers + daemon I/O + main loop.
content)))
(add-msg :system (format nil " #~d: ...~a..." idx preview)))))
(add-msg :system (format nil "No matches for '~a'" query)))))
;; /rewind command — session rewind
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
(n (handler-case (parse-integer n-str) (error () nil))))
(if n
(if (fboundp 'passepartout::rollback-memory)
(let* ((idx (1- n))
(snaps passepartout::*memory-snapshots*)
(ts (when (< idx (length snaps))
(getf (nth idx snaps) :timestamp))))
(funcall 'passepartout::rollback-memory idx)
(add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts)))
(add-msg :system "Memory rollback not available"))
(add-msg :system "Usage: /rewind <number>"))))
;; /sessions command — list snapshots
((string-equal text "/sessions")
(let ((snaps passepartout::*memory-snapshots*))
(if snaps
(let ((shown (subseq snaps 0 (min 10 (length snaps)))))
(add-msg :system (format nil "~d snapshots (showing ~d):"
(length snaps) (length shown)))
(loop for s in shown
for i from 0
for ts = (getf s :timestamp)
for data = (getf s :data)
for size = (hash-table-size data)
do (add-msg :system (format nil " #~d: ~a objects, timestamp ~d"
(1+ i) size ts))))
(add-msg :system "No snapshots available"))))
((string-equal text "/help")
(add-msg :system
"/focus <proj> Set project context")
@@ -1067,6 +1112,36 @@ Event handlers + daemon I/O + main loop.
(on-key (char-code ch)))
(on-key 13)
(let* ((msgs (st :messages))
(m (aref msgs 3))) ;; "Found 2" is 4th message (after 3 chat msgs)
(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