Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv20153/Persistent

Modified Files: persistent-buffer.lisp Log Message: Updated persistent buffers and tests to catch up with recent changes.

Date: Fri Feb 25 21:45:14 2005 Author: abakic

Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.6 climacs/Persistent/persistent-buffer.lisp:1.7 --- climacs/Persistent/persistent-buffer.lisp:1.6 Sun Feb 6 17:33:52 2005 +++ climacs/Persistent/persistent-buffer.lisp Fri Feb 25 21:45:11 2005 @@ -103,8 +103,10 @@ (cursor-pos (cursor mark)))

(defmethod (setf offset) (new-offset (mark p-mark-mixin)) - (assert (<= 0 new-offset (size (buffer mark))) () - (make-condition 'no-such-offset :offset new-offset)) + (assert (<= 0 new-offset) () + (make-condition 'motion-before-beginning :offset new-offset)) + (assert (<= new-offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset new-offset)) (setf (cursor-pos (cursor mark)) new-offset))

(defclass persistent-left-sticky-mark (left-sticky-mark p-mark-mixin) () @@ -119,8 +121,10 @@ &rest args &key (offset 0)) "Associates a created mark with the buffer for which it was created." (declare (ignorable args)) - (assert (<= 0 offset (size (buffer mark))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'motion-before-beginning :offset offset)) + (assert (<= offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset offset)) (setf (slot-value mark 'cursor) (make-instance 'left-sticky-persistent-cursor :buffer (buffer mark) @@ -130,8 +134,10 @@ &rest args &key (offset 0)) "Associates a created mark with the buffer for which it was created." (declare (ignorable args)) - (assert (<= 0 offset (size (buffer mark))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'motion-before-beginning :offset offset)) + (assert (<= offset (size (buffer mark))) () + (make-condition 'motion-after-end :offset offset)) (setf (slot-value mark 'cursor) (make-instance 'right-sticky-persistent-cursor :buffer (buffer mark) @@ -145,6 +151,26 @@ (setf high-mark (make-instance 'persistent-right-sticky-mark :buffer buffer))))

+(defmethod clone-mark ((mark persistent-left-sticky-mark) &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :left)) + (make-instance 'persistent-left-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :right) + (make-instance 'persistent-right-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + (t (error "invalid value for stick-to")))) + +(defmethod clone-mark ((mark persistent-right-sticky-mark) &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :right)) + (make-instance 'persistent-right-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :left) + (make-instance 'persistent-left-sticky-mark + :buffer (buffer mark) :offset (offset mark))) + (t (error "invalid value for stick-to")))) + (defmethod size ((buffer binseq-buffer)) (binseq-length (slot-value buffer 'contents)))

@@ -258,8 +284,10 @@ ;;; it can be saved for UNDO purposes in a history tree, by an UNDOABLE-BUFFER

(defmethod insert-buffer-object ((buffer binseq-buffer) offset object) - (assert (<= 0 offset (size buffer)) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-insert (slot-value buffer 'contents) offset object)))

@@ -286,8 +314,10 @@ (insert-buffer-sequence (buffer mark) (offset mark) sequence))

(defmethod delete-buffer-range ((buffer binseq-buffer) offset n) - (assert (<= 0 offset (size buffer)) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-remove* (slot-value buffer 'contents) offset n)))

@@ -324,32 +354,44 @@ (delete-buffer-range (buffer mark2) offset1 (- offset2 offset1))))

(defmethod buffer-object ((buffer binseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (binseq-get (slot-value buffer 'contents) offset))

(defmethod (setf buffer-object) (object (buffer binseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (binseq-set (slot-value buffer 'contents) offset object)))

(defmethod buffer-object ((buffer obinseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (obinseq-get (slot-value buffer 'contents) offset))

(defmethod (setf buffer-object) (object (buffer obinseq-buffer) offset) - (assert (<= 0 offset (1- (size buffer))) () - (make-condition 'no-such-offset :offset offset)) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) (setf (slot-value buffer 'contents) (obinseq-set (slot-value buffer 'contents) offset object)))

(defmethod buffer-sequence ((buffer binseq-buffer) offset1 offset2) - (assert (<= 0 offset1 (size buffer)) () - (make-condition 'no-such-offset :offset offset1)) - (assert (<= 0 offset2 (size buffer)) () - (make-condition 'no-such-offset :offset offset2)) + (assert (<= 0 offset1) () + (make-condition 'offset-before-beginning :offset offset1)) + (assert (<= offset1 (size buffer)) () + (make-condition 'offset-after-end :offset offset1)) + (assert (<= 0 offset2) () + (make-condition 'offset-before-beginning :offset offset2)) + (assert (<= offset2 (size buffer)) () + (make-condition 'offset-after-end :offset offset2)) (coerce (let ((len (- offset2 offset1))) (if (> len 0)