[mcclim-cvs] CVS mcclim/Drei/Persistent

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Drei/Persistent
In directory clnet:/tmp/cvs-serv13736/Drei/Persistent

Modified Files:
	persistent-buffer.lisp 
Log Message:
Changed Drei to use a view-based paradigm, didn't make any significant
changes to ESA just yet.


--- /project/mcclim/cvsroot/mcclim/Drei/Persistent/persistent-buffer.lisp	2006/11/08 01:15:32	1.1
+++ /project/mcclim/cvsroot/mcclim/Drei/Persistent/persistent-buffer.lisp	2007/12/08 08:53:49	1.2
@@ -62,10 +62,7 @@
   (setf (slot-value cursor 'pos) position))
 
 (defclass persistent-buffer (buffer)
-  ((low-mark :reader low-mark)
-   (high-mark :reader high-mark)
-   (cursors :accessor cursors :initform nil)
-   (modified :initform nil :reader modified-p))
+  ((cursors :accessor cursors :initform nil))
   (:documentation "The Climacs persistent buffer base class
 \(non-instantiable)."))
 
@@ -196,31 +193,6 @@
 		       :buffer (buffer mark)
 		       :position offset)))
 
-(defmethod initialize-instance :after ((buffer binseq-buffer) &rest args)
-  "Create the low-mark and high-mark."
-  (declare (ignorable args))
-  (with-slots (low-mark high-mark) buffer
-    (setf low-mark (make-instance 'persistent-left-sticky-mark :buffer buffer))
-    (setf high-mark (make-instance 'persistent-right-sticky-mark
-				   :buffer buffer))))
-
-(defmethod initialize-instance :after ((buffer obinseq-buffer) &rest args)
-  "Create the low-mark and high-mark."
-  (declare (ignorable args))
-  (with-slots (low-mark high-mark) buffer
-    (setf low-mark (make-instance 'persistent-left-sticky-mark :buffer buffer))
-    (setf high-mark (make-instance 'persistent-right-sticky-mark
-				   :buffer buffer))))
-
-(defmethod initialize-instance :after ((buffer binseq2-buffer) &rest args)
-  "Create the low-mark and high-mark."
-  (declare (ignorable args))
-  (with-slots (low-mark high-mark) buffer
-    (setf low-mark
-	  (make-instance 'persistent-left-sticky-line-mark :buffer buffer))
-    (setf high-mark
-	  (make-instance 'persistent-right-sticky-line-mark :buffer buffer))))
-
 (defmethod clone-mark ((mark persistent-left-sticky-mark) &optional stick-to)
   (cond
     ((or (null stick-to) (eq stick-to :left))
@@ -436,7 +408,7 @@
   (assert (<= 0 offset) ()
 	  (make-condition 'offset-before-beginning :offset offset))
   (assert (<= offset (size buffer)) ()
-	  (make-condition 'offset-after-end :offset offset))
+          (make-condition 'offset-after-end :offset offset))
   (setf (slot-value buffer 'contents)
 	(binseq2-insert2 (slot-value buffer 'contents) offset object)))
 
@@ -478,6 +450,8 @@
 	  (make-condition 'offset-before-beginning :offset offset))
   (assert (<= offset (size buffer)) ()
 	  (make-condition 'offset-after-end :offset offset))
+  (assert (<= (+ offset n) (size buffer)) ()
+          (make-condition 'offset-after-end :offset (+ offset n)))
   (setf (slot-value buffer 'contents)
 	(binseq-remove* (slot-value buffer 'contents) offset n)))
 
@@ -486,6 +460,8 @@
 	  (make-condition 'offset-before-beginning :offset offset))
   (assert (<= offset (size buffer)) ()
 	  (make-condition 'offset-after-end :offset offset))
+  (assert (<= (+ offset n) (size buffer)) ()
+          (make-condition 'offset-after-end :offset (+ offset n)))
   (setf (slot-value buffer 'contents)
 	(obinseq-remove* (slot-value buffer 'contents) offset n)))
 
@@ -494,6 +470,8 @@
 	  (make-condition 'offset-before-beginning :offset offset))
   (assert (<= offset (size buffer)) ()
 	  (make-condition 'offset-after-end :offset offset))
+  (assert (<= (+ offset n) (size buffer)) ()
+          (make-condition 'offset-after-end :offset (+ offset n)))
   (setf (slot-value buffer 'contents)
 	(binseq2-remove*2 (slot-value buffer 'contents) offset n)))
 
@@ -639,48 +617,6 @@
       (rotatef offset1 offset2))
     (buffer-sequence (buffer mark1) offset1 offset2)))
 
-;;; Buffer modification protocol
-
-(defmethod (setf buffer-object)
-    :before (object (buffer persistent-buffer) offset)
-  (declare (ignore object))
-  (setf (offset (low-mark buffer))
-        (min (offset (low-mark buffer)) offset))
-  (setf (offset (high-mark buffer))
-        (max (offset (high-mark buffer)) offset))
-  (setf (slot-value buffer 'modified) t))
-
-(defmethod insert-buffer-object
-    :before ((buffer persistent-buffer) offset object)
-  (declare (ignore object))
-  (setf (offset (low-mark buffer))
-	(min (offset (low-mark buffer)) offset))
-  (setf (offset (high-mark buffer))
-	(max (offset (high-mark buffer)) offset))
-  (setf (slot-value buffer 'modified) t))
-
-(defmethod insert-buffer-sequence
-    :before ((buffer persistent-buffer) offset sequence)
-  (declare (ignore sequence))
-  (setf (offset (low-mark buffer))
-	(min (offset (low-mark buffer)) offset))
-  (setf (offset (high-mark buffer))
-	(max (offset (high-mark buffer)) offset))
-  (setf (slot-value buffer 'modified) t))
-
-(defmethod delete-buffer-range
-    :before ((buffer persistent-buffer) offset n)
-  (setf (offset (low-mark buffer))
-	(min (offset (low-mark buffer)) offset))
-  (setf (offset (high-mark buffer))
-	(max (offset (high-mark buffer)) (+ offset n)))
-  (setf (slot-value buffer 'modified) t))
-
-(defmethod clear-modify ((buffer persistent-buffer))
-  (beginning-of-buffer (high-mark buffer))
-  (end-of-buffer (low-mark buffer))
-  (setf (slot-value buffer 'modified) nil))
-
 (defmacro filter-and-update (l filter-fn update-fn)
   (let ((prev (gensym))
 	(curr (gensym))
@@ -731,3 +667,10 @@
 (defmethod delete-buffer-range
     :after ((buffer persistent-buffer) offset n)
   (adjust-cursors-on-delete buffer offset n))
+
+(defmethod make-buffer-mark ((buffer persistent-buffer)
+                             &optional (offset 0) (stick-to :left))
+  (make-instance (ecase stick-to
+                   (:left 'persistent-left-sticky-mark)
+                   (:right 'persistent-right-sticky-mark))
+   :offset offset :buffer buffer))