Commit c74c9e5a authored by Troels Henriksen's avatar Troels Henriksen
Browse files

Changed `with-undo' so undo works properly for commands that modify

buffers that were not the current buffer when the command loop
started. A single undo operation still cannot undo for multiple
buffers, however, so the user will have to manually invoke undo for
each buffer.
parent ee0998bd
......@@ -299,7 +299,7 @@
(handler-case
(progn
(if (buffer-pane-p current-window)
(with-undo ((buffer current-window))
(with-undo ((buffers frame))
(call-next-method))
(call-next-method))
(loop for buffer in (buffers frame)
......
......@@ -103,20 +103,28 @@
:objects (buffer-sequence buffer offset (+ offset n)))
(undo-accumulate buffer))))
(defmacro with-undo ((buffer) &body body)
(let ((buffer-var (gensym)))
`(let ((,buffer-var ,buffer))
(setf (undo-accumulate ,buffer-var) '())
(unwind-protect (progn ,@body)
(cond ((null (undo-accumulate ,buffer-var)) nil)
((null (cdr (undo-accumulate ,buffer-var)))
(add-undo (car (undo-accumulate ,buffer-var))
(undo-tree ,buffer-var)))
(t
(add-undo (make-instance 'compound-record
:buffer ,buffer-var
:records (undo-accumulate ,buffer-var))
(undo-tree ,buffer-var))))))))
(defmacro with-undo ((get-buffers-exp) &body body)
"Evaluate `body', registering any changes to buffer contents in
the undo memory for the respective buffer, permitting individual
undo for each buffer. `get-buffers-exp' should be a form, that
will be evaluated whenever a complete list of buffers is
needed (to set up all buffers to prepare for undo, and to check
them all for changes after `body' has run)."
(let ((buffer-sym (gensym)))
`(progn
(dolist (,buffer-sym ,get-buffers-exp)
(setf (undo-accumulate ,buffer-sym) '()))
(unwind-protect (progn ,@body)
(dolist (,buffer-sym ,get-buffers-exp)
(cond ((null (undo-accumulate ,buffer-sym)) nil)
((null (cdr (undo-accumulate ,buffer-sym)))
(add-undo (car (undo-accumulate ,buffer-sym))
(undo-tree ,buffer-sym)))
(t
(add-undo (make-instance 'compound-record
:buffer ,buffer-sym
:records (undo-accumulate ,buffer-sym))
(undo-tree ,buffer-sym)))))))))
(defmethod flip-undo-record :around ((record climacs-undo-record))
(with-slots (buffer) record
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment