Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv22428/Persistent
Modified Files: binseq-package.lisp binseq.lisp obinseq.lisp persistent-buffer.lisp Added Files: binseq2.lisp Log Message: Line-oriented persistent buffer (binseq2). Warning: Need to fix minor bugs (related to number-of-lines-in-region, I believe).
base.lisp: Added faster methods on previous-line, next-line, buffer-number-of-lines-in-region.
pane.lisp, cl-syntax.lisp, html-syntax.lisp, text-syntax.lisp: Replaced some calls to make-instance to calls to clone-mark and (setf offset), in order to avoid passing climacs-buffer to marks. This also made possible to get rid of delegating methods on syntax.
climacs.asd: Added Persistent/binseq2.
packages.lisp: Added binseq2-related symbols.
Persistent/binseq.lisp, Persistent/obinseq.lisp: Cleanup.
Persistent/persistent-buffer.lisp: Added code for binseq2-buffer and related marks. Also some minor fixes.
Date: Sun Mar 13 21:51:54 2005 Author: abakic
Index: climacs/Persistent/binseq-package.lisp diff -u climacs/Persistent/binseq-package.lisp:1.2 climacs/Persistent/binseq-package.lisp:1.3 --- climacs/Persistent/binseq-package.lisp:1.2 Sun Mar 6 00:24:41 2005 +++ climacs/Persistent/binseq-package.lisp Sun Mar 13 21:51:52 2005 @@ -59,4 +59,36 @@ #:obinseq-insert #:obinseq-insert* #:obinseq-remove - #:obinseq-remove*)) \ No newline at end of file + #:obinseq-remove* + + #:binseq2-p + #:list-binseq2 + #:binseq2-list + #:vector-binseq2 + #:binseq2-vector + #:binseq2-empty + #:binseq2-length + #:binseq2-size + #:binseq2-front + #:binseq2-offset + #:binseq2-back + #:binseq2-front2 + #:binseq2-line2 + #:binseq2-back2 + #:binseq2-get + #:binseq2-set + #:binseq2-get2 + #:binseq2-set2 + #:binseq2-sub + #:binseq2-sub2 + #:binseq2-cons + #:binseq2-snoc + #:binseq2-append + #:binseq2-insert + #:binseq2-insert2 + #:binseq2-insert* + #:binseq2-insert*2 + #:binseq2-remove + #:binseq2-remove2 + #:binseq2-remove* + #:binseq2-remove*2)) \ No newline at end of file
Index: climacs/Persistent/binseq.lisp diff -u climacs/Persistent/binseq.lisp:1.2 climacs/Persistent/binseq.lisp:1.3 --- climacs/Persistent/binseq.lisp:1.2 Sun Mar 6 00:23:53 2005 +++ climacs/Persistent/binseq.lisp Sun Mar 13 21:51:53 2005 @@ -22,7 +22,7 @@
(in-package :binseq)
-(defun binseq-p (s) +(defun binseq-p (s) ; NOTE: should use a 3-vector instead of the 3-list... (or (eq s 'empty) (and (consp s) (or (eq (car s) 'leaf) @@ -160,21 +160,19 @@ (cond ((<= i 0) 'empty) ((<= (binseq-length s) i) s) - (t (cond - ((<= i (binseq-length (caddr s))) (binseq-front (caddr s) i)) - (t (binseq-append - (caddr s) - (binseq-front (cdddr s) (- i (binseq-length (caddr s)))))))))) + ((<= i (binseq-length (caddr s))) (binseq-front (caddr s) i)) + (t (binseq-append + (caddr s) + (binseq-front (cdddr s) (- i (binseq-length (caddr s))))))))
(defun binseq-back (s i) (cond ((<= i 0) 'empty) ((<= (binseq-length s) i) s) - (t (cond - ((<= i (binseq-length (cdddr s))) (binseq-back (cdddr s) i)) - (t (binseq-append - (binseq-back (caddr s) (- i (binseq-length (cdddr s)))) - (cdddr s))))))) + ((<= i (binseq-length (cdddr s))) (binseq-back (cdddr s) i)) + (t (binseq-append + (binseq-back (caddr s) (- i (binseq-length (cdddr s)))) + (cdddr s)))))
(defun %has-index (s i) (and (<= 0 i) (< i (binseq-length s))))
Index: climacs/Persistent/obinseq.lisp diff -u climacs/Persistent/obinseq.lisp:1.2 climacs/Persistent/obinseq.lisp:1.3 --- climacs/Persistent/obinseq.lisp:1.2 Sun Mar 6 00:23:54 2005 +++ climacs/Persistent/obinseq.lisp Sun Mar 13 21:51:53 2005 @@ -28,7 +28,7 @@ (or (null s) (atom s) (and (consp s) - (and (integerp (car s)) + (and (integerp (car s)) ; might wanna check the value (consp (cdr s)) (obinseq-p (cadr s)) (obinseq-p (cddr s)))))) @@ -167,21 +167,19 @@ (cond ((<= i 0) nil) ((<= (obinseq-length s) i) s) - (t (cond - ((<= i (obinseq-length (cadr s))) (obinseq-front (cadr s) i)) - (t (obinseq-append - (cadr s) - (obinseq-front (cddr s) (- i (obinseq-length (cadr s)))))))))) + ((<= i (obinseq-length (cadr s))) (obinseq-front (cadr s) i)) + (t (obinseq-append + (cadr s) + (obinseq-front (cddr s) (- i (obinseq-length (cadr s))))))))
(defun obinseq-back (s i) (cond ((<= i 0) nil) ((<= (obinseq-length s) i) s) - (t (cond - ((<= i (obinseq-length (cddr s))) (obinseq-back (cddr s) i)) - (t (obinseq-append - (obinseq-back (cadr s) (- i (obinseq-length (cddr s)))) - (cddr s))))))) + ((<= i (obinseq-length (cddr s))) (obinseq-back (cddr s) i)) + (t (obinseq-append + (obinseq-back (cadr s) (- i (obinseq-length (cddr s)))) + (cddr s)))))
(defun %ohas-index (s i) (and (<= 0 i) (< i (obinseq-length s))))
Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.9 climacs/Persistent/persistent-buffer.lisp:1.10 --- climacs/Persistent/persistent-buffer.lisp:1.9 Sun Mar 6 00:23:54 2005 +++ climacs/Persistent/persistent-buffer.lisp Sun Mar 13 21:51:53 2005 @@ -36,6 +36,15 @@
(defclass right-sticky-persistent-cursor (persistent-cursor) ())
+(defclass line-cursor-mixin () () + (:documentation "Support for line-oriented buffers.")) + +(defclass left-sticky-line-persistent-cursor + (left-sticky-persistent-cursor line-cursor-mixin) ()) + +(defclass right-sticky-line-persistent-cursor + (right-sticky-persistent-cursor line-cursor-mixin) ()) + (defmethod cursor-pos ((cursor left-sticky-persistent-cursor)) (1+ (slot-value cursor 'pos)))
@@ -79,13 +88,19 @@ (defclass binseq-buffer (persistent-buffer) ((contents :initform (list-binseq nil))) (:documentation "An instantiable subclass of PERSISTENT-BUFFER that -uses a binary sequence for the CONTENTS.")) +uses a binary sequence for the CONTENTS slot."))
(defclass obinseq-buffer (persistent-buffer) ((contents :initform (list-obinseq nil))) (:documentation "An instantiable subclass of PERSISTENT-BUFFER that uses an optimized binary sequence (only non-nil atoms are allowed as -elements) for the CONTENTS.")) +elements) for the CONTENTS slot.")) + +(defclass binseq2-buffer (persistent-buffer) + ((contents :initform (list-binseq2 nil))) + (:documentation "An instantiable subclass of PERSISTENT-BUFFER that +uses a binary sequence for lines and optimized binary sequences for +line contents, all kept in the CONTENTS slot."))
(defclass p-mark-mixin () ((buffer :initarg :buffer :reader buffer) @@ -93,6 +108,10 @@ (:documentation "A mixin class used in the initialization of a mark that is used in a PERSISTENT-BUFFER."))
+(defclass p-line-mark-mixin (p-mark-mixin) () + (:documentation "A persistent mark mixin class that works with +cursors that can efficiently work with lines.")) + (defmethod backward-object ((mark p-mark-mixin) &optional (count 1)) (decf (offset mark) count))
@@ -117,6 +136,14 @@ (:documentation "A RIGHT-STICKY-MARK subclass suitable for use in a PERSISTENT-BUFFER."))
+(defclass persistent-left-sticky-line-mark (left-sticky-mark p-line-mark-mixin) () + (:documentation "A LEFT-STICKY-MARK subclass with line support, +suitable for use in a PERSISTENT-BUFFER.")) + +(defclass persistent-right-sticky-line-mark (right-sticky-mark p-line-mark-mixin) () + (:documentation "A RIGHT-STICKY-MARK subclass with line support, +suitable for use in a PERSISTENT-BUFFER.")) + (defmethod initialize-instance :after ((mark persistent-left-sticky-mark) &rest args &key (offset 0)) "Associates a created mark with the buffer for which it was created." @@ -143,7 +170,33 @@ :buffer (buffer mark) :position offset)))
-(defmethod initialize-instance :after ((buffer persistent-buffer) &rest args) +(defmethod initialize-instance :after ((mark persistent-left-sticky-line-mark) + &rest args &key (offset 0)) + "Associates a created mark with the buffer for which it was created." + (declare (ignorable args)) + (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-line-persistent-cursor + :buffer (buffer mark) + :position offset))) + +(defmethod initialize-instance :after ((mark persistent-right-sticky-line-mark) + &rest args &key (offset 0)) + "Associates a created mark with the buffer for which it was created." + (declare (ignorable args)) + (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-line-persistent-cursor + :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 @@ -151,6 +204,23 @@ (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)) @@ -171,16 +241,49 @@ :buffer (buffer mark) :offset (offset mark))) (t (error "invalid value for stick-to"))))
+(defmethod clone-mark ((mark persistent-left-sticky-line-mark) + &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :left)) + (make-instance 'persistent-left-sticky-line-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :right) + (make-instance 'persistent-right-sticky-line-mark + :buffer (buffer mark) :offset (offset mark))) + (t (error "invalid value for stick-to")))) + +(defmethod clone-mark ((mark persistent-right-sticky-line-mark) + &optional stick-to) + (cond + ((or (null stick-to) (eq stick-to :right)) + (make-instance 'persistent-right-sticky-line-mark + :buffer (buffer mark) :offset (offset mark))) + ((eq stick-to :left) + (make-instance 'persistent-left-sticky-line-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)))
(defmethod size ((buffer obinseq-buffer)) (obinseq-length (slot-value buffer 'contents)))
+(defmethod size ((buffer binseq2-buffer)) + (binseq2-size (slot-value buffer 'contents))) + (defmethod number-of-lines ((buffer persistent-buffer)) (loop for offset from 0 below (size buffer) count (eql (buffer-object buffer offset) #\Newline)))
+(defmethod number-of-lines ((buffer binseq2-buffer)) + (let ((len (binseq2-length (slot-value buffer 'contents))) + (size (size buffer))) + (if (or (eql 0 size) + (eq (buffer-object buffer (1- size)) #\Newline)) + len + (max 0 (1- len))))) ; weird? + (defmethod mark< ((mark1 p-mark-mixin) (mark2 p-mark-mixin)) (assert (eq (buffer mark1) (buffer mark2))) (< (offset mark1) (offset mark2))) @@ -255,6 +358,11 @@ (loop until (beginning-of-line-p mark) do (decf (offset mark))))
+(defmethod beginning-of-line ((mark p-line-mark-mixin)) + (setf (offset mark) + (binseq2-offset + (slot-value (buffer mark) 'contents) (line-number mark)))) + (defmethod end-of-line ((mark p-mark-mixin)) (let* ((offset (offset mark)) (buffer (buffer mark)) @@ -264,19 +372,40 @@ do (incf offset)) (setf (offset mark) offset)))
+(defmethod end-of-line ((mark p-line-mark-mixin)) + (let* ((curr-offset (offset mark)) + (contents (slot-value (buffer mark) 'contents)) + (next-line-offset (binseq2-offset + contents + (1+ (binseq2-line2 contents curr-offset))))) + (if (> next-line-offset curr-offset) + (setf (offset mark) (1- next-line-offset)) + (setf (offset mark) (size (buffer mark)))))) + (defmethod buffer-line-number ((buffer persistent-buffer) (offset integer)) (loop for i from 0 below offset count (eql (buffer-object buffer i) #\Newline)))
+(defmethod buffer-line-number ((buffer binseq2-buffer) (offset integer)) + (binseq2-line2 (slot-value buffer 'contents) offset)) + (defmethod line-number ((mark p-mark-mixin)) (buffer-line-number (buffer mark) (offset mark)))
+(defmethod buffer-line-offset ((buffer binseq2-buffer) (line-no integer)) + (binseq2-offset (slot-value buffer 'contents) line-no)) + (defmethod buffer-column-number ((buffer persistent-buffer) (offset integer)) (loop for i downfrom offset while (> i 0) until (eql (buffer-object buffer (1- i)) #\Newline) count t))
+(defmethod buffer-column-number ((buffer binseq2-buffer) (offset integer)) + (- offset + (binseq2-offset + (slot-value buffer 'contents) (buffer-line-number buffer offset)))) + (defmethod column-number ((mark p-mark-mixin)) (buffer-column-number (buffer mark) (offset mark)))
@@ -292,24 +421,51 @@ (binseq-insert (slot-value buffer 'contents) offset object)))
(defmethod insert-buffer-object ((buffer obinseq-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) (obinseq-insert (slot-value buffer 'contents) offset object)))
+(defmethod insert-buffer-object ((buffer binseq2-buffer) offset object) + (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) + (binseq2-insert2 (slot-value buffer 'contents) offset object))) + (defmethod insert-object ((mark p-mark-mixin) object) (insert-buffer-object (buffer mark) (offset mark) object))
(defmethod insert-buffer-sequence ((buffer binseq-buffer) offset sequence) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (let ((binseq (vector-binseq sequence))) (setf (slot-value buffer 'contents) (binseq-insert* (slot-value buffer 'contents) offset binseq))))
(defmethod insert-buffer-sequence ((buffer obinseq-buffer) offset sequence) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) (let ((obinseq (vector-obinseq sequence))) (setf (slot-value buffer 'contents) (obinseq-insert* (slot-value buffer 'contents) offset obinseq))))
+(defmethod insert-buffer-sequence ((buffer binseq2-buffer) offset sequence) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (size buffer)) () + (make-condition 'offset-after-end :offset offset)) + (let ((binseq2 (vector-binseq2 sequence))) + (setf (slot-value buffer 'contents) + (binseq2-insert*2 (slot-value buffer 'contents) offset binseq2)))) + (defmethod insert-sequence ((mark p-mark-mixin) sequence) (insert-buffer-sequence (buffer mark) (offset mark) sequence))
@@ -322,11 +478,21 @@ (binseq-remove* (slot-value buffer 'contents) offset n)))
(defmethod delete-buffer-range ((buffer obinseq-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) (obinseq-remove* (slot-value buffer 'contents) offset n)))
+(defmethod delete-buffer-range ((buffer binseq2-buffer) offset n) + (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) + (binseq2-remove*2 (slot-value buffer 'contents) offset n))) + (defmethod delete-range ((mark p-mark-mixin) &optional (n 1)) (cond ((plusp n) (delete-buffer-range (buffer mark) (offset mark) n)) @@ -383,6 +549,21 @@ (setf (slot-value buffer 'contents) (obinseq-set (slot-value buffer 'contents) offset object)))
+(defmethod buffer-object ((buffer binseq2-buffer) offset) + (assert (<= 0 offset) () + (make-condition 'offset-before-beginning :offset offset)) + (assert (<= offset (1- (size buffer))) () + (make-condition 'offset-after-end :offset offset)) + (binseq2-get2 (slot-value buffer 'contents) offset)) + +(defmethod (setf buffer-object) (object (buffer binseq2-buffer) 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) + (binseq2-set2 (slot-value buffer 'contents) offset object))) + (defmethod buffer-sequence ((buffer binseq-buffer) offset1 offset2) (assert (<= 0 offset1) () (make-condition 'offset-before-beginning :offset offset1)) @@ -411,6 +592,21 @@ (if (> len 0) (obinseq-vector (obinseq-sub (slot-value buffer 'contents) offset1 len)) + (make-array 0)))) + +(defmethod buffer-sequence ((buffer binseq2-buffer) offset1 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)) + (let ((len (- offset2 offset1))) + (if (> len 0) + (binseq2-vector + (binseq2-sub2 (slot-value buffer 'contents) offset1 len)) (make-array 0))))
(defmethod object-before ((mark p-mark-mixin))