Update of /project/flexichain/cvsroot/flexichain In directory clnet:/tmp/cvs-serv9793
Modified Files: flexichain.lisp flexicursor.lisp Log Message: Patch from Troels Henriksen.
Date: Sat Jan 26 06:23:09 2008 Author: rstrandh
Index: flexichain/flexichain.lisp diff -u flexichain/flexichain.lisp:1.4 flexichain/flexichain.lisp:1.5 --- flexichain/flexichain.lisp:1.4 Fri Jan 25 18:59:21 2008 +++ flexichain/flexichain.lisp Sat Jan 26 06:23:09 2008 @@ -297,15 +297,24 @@
(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 + (with-slots (buffer expand-factor min-size gap-end data-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) + ;; Two cases to consider - one where position+n is wholly on + ;; this side of the gap in buffer, and one where part of it is + ;; "wrapped around" to the beginning of buffer. + (cond ((>= (length buffer) (+ gap-end n)) + (fill-gap chain gap-end (+ gap-end n)) + (incf gap-end n)) + (t (let ((surplus-elements (- n (- (length buffer) gap-end)))) + (fill-gap chain gap-end (length buffer)) + (fill-gap chain 0 surplus-elements) + (setf gap-end surplus-elements + data-start (1+ gap-end))))) (when (= gap-end (length buffer)) (setf gap-end 0)) (when (and (> (length buffer) (+ min-size 2))
Index: flexichain/flexicursor.lisp diff -u flexichain/flexicursor.lisp:1.3 flexichain/flexicursor.lisp:1.4 --- flexichain/flexicursor.lisp:1.3 Fri Jan 25 18:59:21 2008 +++ flexichain/flexicursor.lisp Sat Jan 26 06:23:09 2008 @@ -204,17 +204,15 @@ (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)))))))) + (loop for cursor-wp in cursors + as cursor = (weak-pointer-value cursor-wp) + when (and cursor (<= position (cursor-pos cursor) + (+ position n))) + 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))