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

v0.7.2: undo/redo — TDD

Browse Source 
Operation-level memory undo/redo built on existing Merkle snapshot
infrastructure. undo-snapshot captures state before destructive tool
execution. /undo and /redo TUI commands send structured events.

- core-memory: undo-snapshot, undo, redo functions + 3 tests
- core-perceive: :undo/:redo sensor handlers
- core-act: auto-snapshot before non-read-only tools
- core-package: undo/redo symbol exports
- channel-tui-main: /undo, /redo commands + 2 tests
- Core: 73/73  TUI Main: 74/74
This commit is contained in:
Amr Gharbeia
2026-05-08 16:39:00 -04:00
parent d2d61c5b44
commit 26fd756222
10 changed files with 276 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -97,7 +97,14 @@
(setf (st :input-hpos) 0)
(setf (st :scroll-offset) 0)
(cond
;; v0.7.2: HITL inline — structured approval/denial
;; v0.7.2: undo/redo
((string-equal text "/undo")
(send-daemon (list :type :event :payload (list :sensor :undo)))
(add-msg :system "Undo: restoring memory to previous state"))
((string-equal text "/redo")
(send-daemon (list :type :event :payload (list :sensor :redo)))
(add-msg :system "Redo: restoring memory"))
;; /help command
((and (>= (length text) 9)
(string-equal (subseq text 0 9) "/approve "))
(let ((token (string-trim '(#\Space) (subseq text 9))))
@@ -797,3 +804,25 @@
(let ((m (aref (st :messages) 0)))
(fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Denied" (getf m :content)))))
;; ── v0.7.2 Undo/Redo ──
(fiveam:test test-undo-command
"Contract v0.7.2: /undo sends undo event."
(init-state)
(dolist (ch (coerce "/undo" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((m (aref (st :messages) 0)))
(fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Undo" (getf m :content)))))
(fiveam:test test-redo-command
"Contract v0.7.2: /redo sends redo event."
(init-state)
(dolist (ch (coerce "/redo" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((m (aref (st :messages) 0)))
(fiveam:is (eq :system (getf m :role)))
(fiveam:is (search "Redo" (getf m :content)))))

3
lisp/core-act.lisp
View File

@@ -81,6 +81,9 @@
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
;; v0.7.2: snapshot before destructive tool execution
(when (and tool (not (cognitive-tool-read-only-p tool)))
(undo-snapshot))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))

91
lisp/core-memory.lisp
View File

@@ -151,6 +151,50 @@
(error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
t)
;; v0.7.2 — Undo/Redo
(defvar *undo-stack* nil
"Ring buffer of pre-operation memory snapshots. Newest first, max 20.")
(defvar *redo-stack* nil
"Stack of snapshots saved during undo for redo. Max 20.")
(defun undo-snapshot ()
"Save current memory state to the undo stack."
(let ((snap (list :timestamp (get-universal-time)
:data (memory-hash-table-copy *memory-store*))))
(push snap *undo-stack*)
(when (> (length *undo-stack*) 20)
(setf *undo-stack* (subseq *undo-stack* 0 20)))))
(defun undo (&optional source)
"Restore memory to the most recent undo snapshot. Returns T on success, NIL if stack empty."
(declare (ignore source))
(if *undo-stack*
(let ((snap (pop *undo-stack*)))
(push (list :timestamp (get-universal-time)
:data (memory-hash-table-copy *memory-store*))
*redo-stack*)
(when (> (length *redo-stack*) 20)
(setf *redo-stack* (subseq *redo-stack* 0 20)))
(setf *memory-store* (memory-hash-table-copy (getf snap :data)))
(log-message "UNDO: Memory restored to snapshot ~a" (getf snap :timestamp))
t)
(progn (log-message "UNDO: No snapshots to undo") nil)))
(defun redo (&optional source)
"Restore memory to the most recent redo snapshot. Returns T on success, NIL if stack empty."
(declare (ignore source))
(if *redo-stack*
(let ((snap (pop *redo-stack*)))
(push (list :timestamp (get-universal-time)
:data (memory-hash-table-copy *memory-store*))
*undo-stack*)
(when (> (length *undo-stack*) 20)
(setf *undo-stack* (subseq *undo-stack* 0 20)))
(setf *memory-store* (memory-hash-table-copy (getf snap :data)))
(log-message "REDO: Memory restored to snapshot ~a" (getf snap :timestamp))
t)
(progn (log-message "REDO: No snapshots to redo") nil)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
@@ -211,3 +255,50 @@
(rollback-memory 0)
(is (not (null (memory-object-get "snap-a"))))
(is (null (memory-object-get "snap-b"))))
(test test-undo-snapshot-restore
"Contract v0.7.2: undo-snapshot captures state, undo restores."
(let ((orig-store passepartout::*memory-store*)
(orig-undo passepartout::*undo-stack*)
(orig-redo passepartout::*redo-stack*))
(unwind-protect
(progn
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
passepartout::*undo-stack* nil
passepartout::*redo-stack* nil)
(passepartout::undo-snapshot)
(setf (gethash "x" passepartout::*memory-store*) "hello")
(is (string= "hello" (gethash "x" passepartout::*memory-store*)))
(is (passepartout::undo))
(is (null (gethash "x" passepartout::*memory-store*))))
(setf passepartout::*memory-store* orig-store
passepartout::*undo-stack* orig-undo
passepartout::*redo-stack* orig-redo))))
(test test-undo-redo-cycle
"Contract v0.7.2: redo restores undone state."
(let ((orig-store passepartout::*memory-store*)
(orig-undo passepartout::*undo-stack*)
(orig-redo passepartout::*redo-stack*))
(unwind-protect
(progn
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
passepartout::*undo-stack* nil
passepartout::*redo-stack* nil)
(passepartout::undo-snapshot)
(setf (gethash "y" passepartout::*memory-store*) "world")
(is (passepartout::undo))
(is (null (gethash "y" passepartout::*memory-store*)))
(is (passepartout::redo))
(is (string= "world" (gethash "y" passepartout::*memory-store*))))
(setf passepartout::*memory-store* orig-store
passepartout::*undo-stack* orig-undo
passepartout::*redo-stack* orig-redo))))
(test test-undo-empty-stack-nil
"Contract v0.7.2: undo returns nil on empty stack."
(let ((orig-undo passepartout::*undo-stack*))
(unwind-protect
(progn (setf passepartout::*undo-stack* nil)
(is (null (passepartout::undo))))
(setf passepartout::*undo-stack* orig-undo))))

5
lisp/core-package.lisp
View File

@@ -37,6 +37,11 @@
#:memory-object-scope
#:snapshot-memory
#:rollback-memory
#:undo-snapshot
#:undo
#:redo
#:*undo-stack*
#:*redo-stack*
#:context-get-system-logs
#:context-assemble-global-awareness
#:context-awareness-assemble

11
lisp/core-perceive.lisp
View File

@@ -89,8 +89,15 @@ FN receives (signal) and returns T if consumed, nil to continue."
(snapshot-memory)
(setf *loop-focus-id* (getf element :id))
(ingest-ast element :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
(:interrupt
(setf *loop-interrupt* t))
(:interrupt
(setf *loop-interrupt* t))
;; v0.7.2 undo/redo
(:undo
(log-message "GATE [Perceive]: undo requested")
(undo "perceive"))
(:redo
(log-message "GATE [Perceive]: redo requested")
(redo "perceive"))
;; HITL: re-injected approved action from dispatcher-approvals-process
(:approval-required
(when (getf payload :approved)