From rstrandh at common-lisp.net  Sun May 31 07:28:20 2009
From: rstrandh at common-lisp.net (rstrandh)
Date: Sun, 31 May 2009 03:28:20 -0400
Subject: [mcclim-cvs] CVS mcclim/Drei
Message-ID: <E1MAfSu-0007KR-K7@common-lisp.net>

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory cl-net:/tmp/cvs-serv28006

Modified Files:
	views.lisp 
Log Message:
I added a new kind of undo record named CHANGE-RECORD, created by 
(setf buffer-object).

This fixes a problem that was reported by Nikodemus Siivola where
fill-paragraph did not record any undo information, because it was
using (setf buffer-object) as opposed to insert or delete.



--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2008/05/15 13:51:40	1.46
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2009/05/31 07:28:18	1.47
@@ -187,6 +187,16 @@
 `delete-record' containing a mark is created and added to the
 undo tree."))
 
+(defclass change-record (simple-undo-record)
+  ((objects :initarg :objects
+	    :documentation "The sequence of objects that are to 
+replace the records that are currently in the buffer at the 
+offset whenever flip-undo-record is called on an instance of 
+change-record"))
+  (:documentation "Whenever objects are modified, a 
+`change-record' containing a mark is created and added to the 
+undo tree."))
+
 (defclass compound-record (drei-undo-record)
   ((records :initform '()
             :initarg :records
@@ -201,7 +211,11 @@
 
 (defmethod print-object  ((object insert-record) stream)
   (with-slots (offset objects) object
-    (format stream "[offset: ~a objects: ~a]" offset objects)))
+    (format stream "[offset: ~a inserted objects: ~a]" offset objects)))
+
+(defmethod print-object  ((object change-record) stream)
+  (with-slots (offset objects) object
+    (format stream "[offset: ~a changed objects: ~a]" offset objects)))
 
 (defmethod print-object  ((object compound-record) stream)
   (with-slots (records) object
@@ -227,6 +241,14 @@
                          :objects (buffer-sequence buffer offset (+ offset n)))
 	  (undo-accumulate buffer))))
 
+(defmethod (setf buffer-object) :before (new-object (buffer undo-mixin) offset)
+  (unless (performing-undo buffer)
+    (push (make-instance 'change-record
+			 :buffer buffer
+			 :offset offset
+			 :objects (buffer-sequence buffer offset (1+ offset)))
+	  (undo-accumulate buffer))))
+
 (defmacro with-undo ((get-buffers-exp) &body body)
   "This macro executes the forms of `body', registering changes
 made to the list of buffers retrieved by evaluating
@@ -273,6 +295,11 @@
                   :objects (buffer-sequence buffer offset (+ offset length)))
     (delete-buffer-range buffer offset length)))
 
+(defmethod flip-undo-record ((record change-record))
+  (with-slots (buffer offset objects) record
+    (loop for i from 0 below (length objects)
+	  do (rotatef (aref objects i) (buffer-object buffer (+ i offset))))))
+
 (defmethod flip-undo-record ((record compound-record))
   (with-slots (records) record
     (mapc #'flip-undo-record records)