[flexichain-cvs] CVS update: flexichain/flexichain-package.lisp flexichain/flexichain.asd flexichain/flexichain.lisp flexichain/flexicursor.lisp
Cyrus Harmon
charmon at common-lisp.net
Fri Jan 25 23:59:23 UTC 2008
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)))
More information about the Flexichain-cvs
mailing list