diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 5fa0e64..4e063a9 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -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))))) diff --git a/lisp/core-act.lisp b/lisp/core-act.lisp index a224c9c..df03389 100644 --- a/lisp/core-act.lisp +++ b/lisp/core-act.lisp @@ -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)) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index 0a77f51..79a8b4c 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -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)))) diff --git a/lisp/core-package.lisp b/lisp/core-package.lisp index ca0c6fd..5124460 100644 --- a/lisp/core-package.lisp +++ b/lisp/core-package.lisp @@ -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 diff --git a/lisp/core-perceive.lisp b/lisp/core-perceive.lisp index e5e14a5..58218e3 100644 --- a/lisp/core-perceive.lisp +++ b/lisp/core-perceive.lisp @@ -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) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 10e201b..7c9de17 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -131,7 +131,14 @@ Event handlers + daemon I/O + main loop. (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)))) @@ -844,4 +851,26 @@ Event handlers + daemon I/O + main loop. (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))))) #+end_src diff --git a/org/core-act.org b/org/core-act.org index 183faf8..9f30784 100644 --- a/org/core-act.org +++ b/org/core-act.org @@ -180,6 +180,9 @@ The tool's return value is packed into a ~:tool-output~ event and fed back into (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)) diff --git a/org/core-memory.org b/org/core-memory.org index d400186..ddd50ac 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -359,6 +359,50 @@ Restores memory state from a previously saved snapshot file. Called during boot (log-message "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*)))))) (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))) #+end_src * Test Suite @@ -424,4 +468,51 @@ Verifies that the Merkle hash is deterministic and consistent across independent (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)))) #+end_src \ No newline at end of file diff --git a/org/core-package.org b/org/core-package.org index 2c0f054..8bb9ad8 100644 --- a/org/core-package.org +++ b/org/core-package.org @@ -62,6 +62,11 @@ The package definition. All public symbols are exported here. #: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 diff --git a/org/core-perceive.org b/org/core-perceive.org index 4aa73ef..7446eb2 100644 --- a/org/core-perceive.org +++ b/org/core-perceive.org @@ -214,8 +214,15 @@ The main perceive pipeline stage. (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)