Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv25601 Modified Files: flexichain.lisp flexicursor.lisp Log Message: Flexichain now compiles without errors and warnings, and the tester works properly. There are still cases where the cursors get assigned strange values, so it is not quite operational yet. Anyone wanting to run the tester should feel free to do so, though. I expect very little work is needed now to get it to run. But it is so boring that it is still going to take me some time to gather up the energy to actually do it. Date: Thu Aug 19 06:58:54 2004 Author: rstrandh Index: gsharp/Flexichain/flexichain.lisp diff -u gsharp/Flexichain/flexichain.lisp:1.2 gsharp/Flexichain/flexichain.lisp:1.3 --- gsharp/Flexichain/flexichain.lisp:1.2 Fri Aug 6 08:47:36 2004 +++ gsharp/Flexichain/flexichain.lisp Thu Aug 19 06:58:54 2004 @@ -196,7 +196,7 @@ (with-virtual-gap (bl ds gs ge) chain (- bl (- ge gs) 2))) -(defmethod empty-p ((chain standard-flexichain)) +(defmethod flexi-empty-p ((chain standard-flexichain)) (zerop (nb-elements chain))) (defgeneric insert-object (chain position object) Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.3 gsharp/Flexichain/flexicursor.lisp:1.4 --- gsharp/Flexichain/flexicursor.lisp:1.3 Mon Aug 16 01:12:45 2004 +++ gsharp/Flexichain/flexicursor.lisp Thu Aug 19 06:58:54 2004 @@ -54,6 +54,9 @@ (defgeneric cursor-pos (cursor) (:documentation "Returns the position of the cursor.")) +(defgeneric (setf cursor-pos) (posistion cursor) + (:documentation "Set the position of the cursor.")) + (defgeneric at-beginning-p (cursor) (:documentation "Returns true if the cursor is at the beginning of the chain.")) @@ -68,19 +71,12 @@ (defgeneric move< (cursor &optional n) (:documentation "Moves the cursor backward N positions.")) -(defgeneric insert< (cursor object) - (:documentation "Inserts an object before the cursor.")) - -(defgeneric insert> (cursor object) - (:documentation "Inserts an object after the cursor.")) +(defgeneric insert (cursor object) + (:documentation "Inserts an object at the cursor.")) -(defgeneric insert-sequence< (cursor sequence) +(defgeneric insert-sequence (cursor sequence) (:documentation "The effect is the same as if each element of the -sequence was inserted using INSERT<.")) - -(defgeneric insert-sequence> (cursor sequence) - (:documentation "The effect is the same as if each element of the -sequence was inserted using INSERT>.")) +sequence was inserted using INSERT.")) (defgeneric delete< (cursor &optional n) (:documentation "Deletes N objects before the cursor.")) @@ -105,12 +101,12 @@ (:documentation "The standard instantiable subclass of CURSORCHAIN")) (defun make-wp (value) - +sbcl (sb-ext:make-weak-pointer value) - +cmu (ext:make-wadk-pointer value)) + #+sbcl (sb-ext:make-weak-pointer value) + #+cmu (ext:make-weak-pointer value)) (defun wp-value (wp) - +sbcl (sb-ext:weak-pointer-value wp) - +cmu (ext:weak-pointer-value wp)) + #+sbcl (sb-ext:weak-pointer-value wp) + #+cmu (ext:weak-pointer-value wp)) (defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2) (declare (ignore to from)) @@ -125,12 +121,12 @@ (cond ((= start1 start2) nil) ((= gap-start gap-end) (skiplist-slide-keys cursors start2 (1- end2) addfun)) - ((< e s) + ((< gap-end gap-start) (cond ((and (= end2 gap-start) (> start1 start2)) (skiplist-slide-keys cursors start2 (1- end2) addfun)) ((= end2 gap-start) (skiplist-rotate-suffix cursors start2 addfun)) - (t skiplist-rotate-prefix cursors (1- end2) addfun))) + (t (skiplist-rotate-prefix cursors (1- end2) addfun)))) ((plusp gap-start) (skiplist-slide-keys cursors start2 (1- end2) addfun)) ((= start2 gap-end) @@ -161,7 +157,7 @@ (with-slots (index chain) cursor (setf index (position-index chain 0)) (with-slots (cursors) chain - (push (make-wp cursor) (skilist-find cursors index))))) + (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod clone-cursor ((cursor standard-flexicursor)) (with-slots (index) cursor @@ -236,10 +232,11 @@ (defmethod delete* :around ((chain standard-cursorchain) position) (with-slots (cursors) chain (let* ((old-index (position-index chain position)) - (cursors (skiplist-find cursors old-index))) - (skiplist-delete cursors index) + (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 save + (loop for cursor-wp in cursors-to-adjust as cursor = (wp-value cursor-wp) when cursor do (setf (cursor-pos cursor) position)