Update of /project/flexichain/cvsroot/flexichain In directory clnet:/tmp/cvs-serv8302
Modified Files: flexichain-package.lisp flexichain.asd flexichain.lisp flexicursor.lisp Log Message: flexichain 0.3
* Troels Henriksen's changes for flexichain 0.3. ** Added delete-elements* ** minor indentation fixes ** clean up some of cursor-pos methods
Date: Fri Jan 25 18:59:21 2008 Author: charmon
Index: flexichain/flexichain-package.lisp diff -u flexichain/flexichain-package.lisp:1.1.1.1 flexichain/flexichain-package.lisp:1.2 --- flexichain/flexichain-package.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006 +++ flexichain/flexichain-package.lisp Fri Jan 25 18:59:21 2008 @@ -25,7 +25,7 @@ #:flexi-error #:flexi-initialization-error #:flexi-position-error #:flexi-incompatible-type-error #:nb-elements #:flexi-empty-p - #:insert* #:insert-vector* #:element* #:delete* + #:insert* #:insert-vector* #:element* #:delete* #:delete-elements* #:push-start #:pop-start #:push-end #:pop-end #:rotate #:cursorchain #:standard-cursorchain #:flexicursor #:standard-flexicursor
Index: flexichain/flexichain.asd diff -u flexichain/flexichain.asd:1.4 flexichain/flexichain.asd:1.5 --- flexichain/flexichain.asd:1.4 Tue Jan 30 11:37:42 2007 +++ flexichain/flexichain.asd Fri Jan 25 18:59:21 2008 @@ -23,7 +23,7 @@ ;; for testing. (asdf:defsystem :flexichain :name "flexichain" - :version "1.2" + :version "1.3" :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) (:file "flexichain" :depends-on ("utilities" "flexichain-package"))
Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.3 flexichain/flexichain.lisp:1.4 --- flexichain/flexichain.lisp:1.3 Fri Nov 3 18:24:09 2006 +++ flexichain/flexichain.lisp Fri Jan 25 18:59:21 2008 @@ -111,6 +111,13 @@ to the length of CHAIN, the FLEXI-POSITION-ERROR condition will be signaled."))
+(defgeneric delete-elements* (chain position n) + (:documentation "Delete N elements at POSITION of the chain. If +POSITION+N is out of range (less than 0 or greater than or equal +to the length of CHAIN, the FLEXI-POSITION-ERROR condition will +be signaled. N can be negative, in which case elements will be +deleted before POSITION.")) + (defgeneric element* (chain position) (:documentation "Returns the element at POSITION of the chain. If POSITION is out of range (less than 0 or greater than or equal @@ -288,6 +295,23 @@ (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor)))) (decrease-buffer-size chain))))
+(defmethod delete-elements* ((chain standard-flexichain) position n) + (unless (zerop n) + (with-slots (buffer expand-factor min-size fill-element gap-end gap-start) chain + (when (minusp n) + (incf position n) + (setf n (* -1 n))) + (assert (<= 0 (+ position n) (nb-elements chain)) () + 'flexi-position-error :chain chain :position position) + (ensure-gap-position chain position) + (fill-gap chain gap-end (+ gap-end n)) + (incf gap-end n) + (when (= gap-end (length buffer)) + (setf gap-end 0)) + (when (and (> (length buffer) (+ min-size 2)) + (< (+ (nb-elements chain) 2) (/ (length buffer) (square expand-factor)))) + (decrease-buffer-size chain))))) + (defmethod element* ((chain standard-flexichain) position) (with-slots (buffer) chain (assert (< -1 position (nb-elements chain)) ()
Index: flexichain/flexicursor.lisp diff -u flexichain/flexicursor.lisp:1.2 flexichain/flexicursor.lisp:1.3 --- flexichain/flexicursor.lisp:1.2 Tue Oct 17 12:02:02 2006 +++ flexichain/flexicursor.lisp Fri Jan 25 18:59:21 2008 @@ -148,7 +148,7 @@ (defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2) (declare (ignore to from)) (with-slots (cursors) cc - (setf cursors (adjust-cursors cursors start2 (1- end2) (- start1 start2))))) + (setf cursors (adjust-cursors cursors start2 (1- end2) (- start1 start2)))))
(defmethod clone-cursor ((cursor standard-flexicursor)) (make-instance (class-of cursor) @@ -161,9 +161,8 @@ (defmethod (setf cursor-pos) (position (cursor left-sticky-flexicursor)) (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) - (with-slots (chain index) cursor - (with-slots (cursors) chain - (setf index (position-index chain (1- position)))))) + (with-slots (chain) cursor + (setf (flexicursor-index cursor) (position-index chain (1- position)))))
(defmethod cursor-pos ((cursor right-sticky-flexicursor)) (index-position (chain cursor) (slot-value cursor 'index))) @@ -171,9 +170,8 @@ (defmethod (setf cursor-pos) (position (cursor right-sticky-flexicursor)) (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) - (with-slots (chain index) cursor - (with-slots (cursors) chain - (setf index (position-index chain position))))) + (with-slots (chain) cursor + (setf (flexicursor-index cursor) (position-index chain position))))
(defmethod at-beginning-p ((cursor standard-flexicursor)) (zerop (cursor-pos cursor))) @@ -200,6 +198,24 @@ (right-sticky-flexicursor (incf (cursor-pos cursor))) (left-sticky-flexicursor (decf (cursor-pos cursor))))))))
+(defmethod delete-elements* :before ((chain standard-cursorchain) position n) + (with-slots (cursors) chain + (when (minusp n) + (incf position n) + (setf n (* -1 n))) + (unless (zerop n) + (let* ((start-index (position-index chain position)) + (end-index (position-index chain (+ position n -1)))) + (loop for cursor-wp in cursors + as cursor = (weak-pointer-value cursor-wp) + when (and cursor (<= start-index (flexicursor-index cursor) + end-index)) + do (typecase cursor + (right-sticky-flexicursor (setf (cursor-pos cursor) + (+ position n))) + (left-sticky-flexicursor (setf (cursor-pos cursor) + position)))))))) + (defmethod delete> ((cursor standard-flexicursor) &optional (n 1)) (let ((chain (chain cursor)) (position (cursor-pos cursor)))