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