Index: flexicursor.lisp
===================================================================
RCS file: /project/flexichain/cvsroot/flexichain/flexicursor.lisp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 flexicursor.lisp
--- flexicursor.lisp	9 Feb 2006 02:51:06 -0000	1.1.1.1
+++ flexicursor.lisp	26 Apr 2006 15:56:01 -0000
@@ -96,8 +96,7 @@
 (defgeneric (setf element>) (object cursor)
   (:documentation "Replaces the element immediately after the cursor."))
 
-(defclass standard-cursorchain
-    (weak-pointer-container-mixin cursorchain standard-flexichain)
+(defclass standard-cursorchain (cursorchain standard-flexichain)
   ((cursors :initform '()))
   (:documentation "The standard instantiable subclass of CURSORCHAIN"))
 
@@ -116,7 +115,7 @@
   (with-slots (index chain) cursor
      (setf index (position-index chain (1- position)))
      (with-slots (cursors) chain
-	(push (make-weak-pointer cursor chain) cursors))))
+	(push (make-weak-pointer cursor) cursors))))
 
 (defmethod initialize-instance :after ((cursor right-sticky-flexicursor)
 				       &rest initargs &key (position 0))
@@ -124,12 +123,12 @@
   (with-slots (index chain) cursor
      (setf index (position-index chain position))
      (with-slots (cursors) chain
-	(push (make-weak-pointer cursor chain) cursors))))
+	(push (make-weak-pointer cursor) cursors))))
 
-(defun adjust-cursors (chain cursors start end increment)
+(defun adjust-cursors (cursors start end increment)
   (let ((acc '()))
     (loop
-       for cursor = (and cursors (weak-pointer-value (car cursors) chain))
+       for cursor = (and cursors (weak-pointer-value (car cursors)))
        while cursors
        do (cond ((null cursor)
 		 (pop cursors))
@@ -149,7 +148,7 @@
 (defmethod move-elements :after ((cc standard-cursorchain) to from start1 start2 end2)
   (declare (ignore to from))
   (with-slots (cursors) cc
-     (setf cursors (adjust-cursors cc cursors start2 (1- end2) (- start1 start2)))))
+     (setf cursors (adjust-cursors cursors start2 (1- end2) (- start1 start2)))))
 
 (defmethod clone-cursor ((cursor standard-flexicursor))
   (make-instance (class-of cursor)
@@ -195,7 +194,7 @@
   (with-slots (cursors) chain
      (let* ((old-index (position-index chain position)))
        (loop for cursor-wp in cursors
-	     as cursor = (weak-pointer-value cursor-wp chain)
+	     as cursor = (weak-pointer-value cursor-wp)
 	     when (and cursor (= old-index (flexicursor-index cursor)))
 	       do (typecase cursor
 		    (right-sticky-flexicursor (incf (cursor-pos cursor)))
Index: utilities.lisp
===================================================================
RCS file: /project/flexichain/cvsroot/flexichain/utilities.lisp,v
retrieving revision 1.2
diff -u -r1.2 utilities.lisp
--- utilities.lisp	13 Mar 2006 18:13:33 -0000	1.2
+++ utilities.lisp	26 Apr 2006 15:56:01 -0000
@@ -34,60 +34,52 @@
         (values nil nil)
         (values (elt sequence position) t))))
 
-;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL and
-;;; Allegro weak references are only supported via weak hash tables. This class
-;;; provides the means for other classes to manage their weak references.
-;;; TODO: check other CL implementations behavior wrt. return values
-(defclass weak-pointer-container-mixin ()
-  (#+(or openmcl allegro)
-  (weak-hash :initform (make-hash-table :test #'eql
-					 ;; Get it together guys!
-					 #+openmcl :weak #+openmcl :value
-					 #+allegro :values #+allegro :weak))
-  (key-counter :initform 0))
-  (:documentation "Support for weak references, if needed"))
+;;;; Weak pointers
 
-(defgeneric make-weak-pointer (object container))
-
-#+(or sbcl cmu)
-(defmethod make-weak-pointer (object container)
-  (declare (ignore container))
-    #+cmu (extensions:make-weak-pointer object)
-    #+sbcl (sb-ext:make-weak-pointer object))
-
-#+(or openmcl allegro)
-(defmethod make-weak-pointer (object (container weak-pointer-container-mixin))
-  (let ((key (incf (slot-value container 'key-counter))))
-    (setf (gethash key (slot-value container 'weak-hash)) object)
-    key))
-
-(defgeneric weak-pointer-value (weak-pointer container))
-
-#+(or sbcl cmu)
-(defmethod weak-pointer-value (weak-pointer container)
-  (declare (ignore container))
-  #+cmu (extensions:weak-pointer-value weak-pointer)
-  #+sbcl (sb-ext:weak-pointer-value weak-pointer))
-
-#+(or openmcl allegro)
-(defmethod weak-pointer-value
-    (weak-pointer (container weak-pointer-container-mixin))
-  (let* ((table (slot-value container 'weak-hash))
-	 (val (gethash weak-pointer table)))
-    #+allegro
-    (unless val
-      (remhash weak-pointer table))
-    val))
-
-#-(or sbcl cmu openmcl)
-(progn
-  (eval-when (:evaluate :compile-toplevel :load-toplevel)
-    (warn "No support for weak pointers in this implementation. Things may
-get big and slow")
-    )
-  (defmethod make-weak-pointer (object container)
-    (declare (ignore container))
-    object)
-  (defmethod weak-pointer-value (weak-pointer container)
-    (declare (ignore container))
-    weak-pointer))
+#+:openmcl
+(defvar *weak-pointers* (make-hash-table :test 'eq :weak :value)
+  "Weak value hash-table mapping between pseudo weak pointers and its values.")
+
+#+:openmcl
+(defstruct (weak-pointer (:constructor %make-weak-pointer)))
+
+(defun make-weak-pointer (object)
+  "Creates a new weak pointer which points to OBJECT. For
+   portability reasons, OBJECT most not be NIL."
+  (assert (not (null object)))
+  #+:sbcl (sb-ext:make-weak-pointer object)
+  #+:cmu (ext:make-weak-pointer object)
+  #+:clisp (ext:make-weak-pointer object)
+  #+:allegro
+  (let ((wv (excl:weak-vector 1)))
+    (setf (svref wv 0) object)
+    wv)
+  #+:openmcl
+  (let ((wp (%make-weak-pointer)))
+    (setf (gethash wp *weak-pointers*) object)
+    wp)
+  #+:corman (ccl:make-weak-pointer object)
+  #+:lispworks
+  (let ((array (make-array 1)))
+    (hcl:set-array-weak array t)
+    (setf (svref array 0) object)
+    array)
+  #-(or :sbcl :cmu :clisp :allegro :openmcl :corman :lispworks)
+  object)
+
+(defun weak-pointer-value (weak-pointer)
+  "If WEAK-POINTER is valid, returns its value. Otherwise, returns NIL."
+  #+:sbcl (prog1 (sb-ext:weak-pointer-value weak-pointer))
+  #+:cmu (prog1 (ext:weak-pointer-value weak-pointer))
+  #+:clisp (prog1 (ext:weak-pointer-value weak-pointer))
+  #+:allegro (svref weak-pointer 0)
+  #+:openmcl (prog1 (gethash weak-pointer *weak-pointers*))
+  #+:corman (ccl:weak-pointer-obj weak-pointer)
+  #+:lispworks (svref weak-pointer 0)
+  #-(or :sbcl :cmu :clisp :allegro :openmcl :corman :lispworks)
+  weak-pointer)
+
+#-(or :sbcl :cmu :clisp :allegro :openmcl :corman :lispworks)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (warn "No support for weak pointers in this implementation. ~
+         Things may get big and slow."))
