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

[Robert Strandh]

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)