[climacs-cvs] CVS climacs

thenriksen thenriksen at common-lisp.net
Thu Jul 6 17:31:50 UTC 2006


Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv5211

Modified Files:
	pane.lisp 
Log Message:
Protect the undo history, even if an error is signalled somewhere.


--- /project/climacs/cvsroot/climacs/pane.lisp	2006/05/14 20:35:44	1.43
+++ /project/climacs/cvsroot/climacs/pane.lisp	2006/07/06 17:31:50	1.44
@@ -107,16 +107,16 @@
   (let ((buffer-var (gensym)))
     `(let ((,buffer-var ,buffer))
        (setf (undo-accumulate ,buffer-var) '())
-       , at 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)))))))
+       (unwind-protect (progn , at 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))))))))
 
 (defmethod flip-undo-record :around ((record climacs-undo-record))
   (with-slots (buffer) record




More information about the Climacs-cvs mailing list