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)
