[gsharp-cvs] CVS update: gsharp/Flexichain/flexicursor.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp/Flexichain
In directory common-lisp.net:/tmp/cvs-serv16569

Modified Files:
	flexicursor.lisp 
Log Message:
Delete the entry entirely from the skiplist when number of cursors
at a particular position becomes zero.

Removed move> and move< functions. 

Replaced :around method for delete* by :before method that 
calls (incf cursor-pos) or (decf cursor-pos) (according to the type of
the cursor) before actual deletion takes place. 


Date: Mon Sep  6 13:25:52 2004
Author: rstrandh

Index: gsharp/Flexichain/flexicursor.lisp
diff -u gsharp/Flexichain/flexicursor.lisp:1.7 gsharp/Flexichain/flexicursor.lisp:1.8
--- gsharp/Flexichain/flexicursor.lisp:1.7	Thu Sep  2 08:23:50 2004
+++ gsharp/Flexichain/flexicursor.lisp	Mon Sep  6 13:25:52 2004
@@ -172,9 +172,11 @@
 	  'flexi-position-error :chain (chain cursor) :position position)
   (with-slots (chain index) cursor
      (with-slots (cursors) chain
-	(setf (skiplist-find cursors index)
-	      (delete cursor (skiplist-find cursors index)
-		      :key #'wp-value :test #'eq))
+	(let ((remaining (delete cursor (skiplist-find cursors index)
+				 :key #'wp-value :test #'eq)))
+	  (if (null remaining)
+	      (skiplist-delete cursors index)
+	      (setf (skiplist-find cursors index) remaining)))
 	(setf index (position-index chain (1- position)))
 	(push (make-wp cursor) (skiplist-find cursors index)))))
 
@@ -186,9 +188,11 @@
 	  'flexi-position-error :chain (chain cursor) :position position)
   (with-slots (chain index) cursor
      (with-slots (cursors) chain
-	(setf (skiplist-find cursors index)
-	      (delete cursor (skiplist-find cursors index)
-		      :key #'wp-value :test #'eq))
+	(let ((remaining (delete cursor (skiplist-find cursors index)
+				 :key #'wp-value :test #'eq)))
+	  (if (null remaining)
+	      (skiplist-delete cursors index)
+	      (setf (skiplist-find cursors index) remaining)))
 	(setf index (position-index chain position))
 	(push (make-wp cursor) (skiplist-find cursors index)))))
 
@@ -198,12 +202,6 @@
 (defmethod at-end-p ((cursor standard-flexicursor))
   (= (cursor-pos cursor) (nb-elements (chain cursor))))
 
-(defmethod move> ((cursor standard-flexicursor) &optional (n 1))
-  (incf (cursor-pos cursor) n))
-
-(defmethod move< ((cursor standard-flexicursor) &optional (n 1))
-  (decf (cursor-pos cursor) n))
-
 (defmethod insert ((cursor standard-flexicursor) object)
   (insert* (chain cursor) (cursor-pos cursor) object))
 
@@ -213,18 +211,16 @@
 	 (insert cursor object))
        sequence))
 
-(defmethod delete* :around ((chain standard-cursorchain) position)
+(defmethod delete* :before ((chain standard-cursorchain) position)
   (with-slots (cursors) chain
      (let* ((old-index (position-index chain position))
 	    (cursors-to-adjust (skiplist-find cursors old-index)))
-       (when cursors-to-adjust
-	 (skiplist-delete cursors old-index))
-       (call-next-method)
        (loop for cursor-wp in cursors-to-adjust
 	     as cursor = (wp-value cursor-wp)
 	     when cursor
-	       do (setf (cursor-pos cursor) position)
-	       and do  (push cursor-wp (skiplist-find cursors (flexicursor-index cursor)))))))
+	       do (typecase cursor
+		    (right-sticky-flexicursor (incf (cursor-pos cursor)))
+		    (left-sticky-flexicursor (decf (cursor-pos cursor))))))))
 
 (defmethod delete> ((cursor standard-flexicursor) &optional (n 1))
   (let ((chain (chain cursor))