[flexichain-cvs] CVS update: flexichain/flexichain.lisp flexichain/flexicursor.lisp

[Robert Strandh]

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))