[lgtk-cvs] CVS update: lgtk/src/gtknexus.lisp lgtk/src/nexus.lisp

[Mario Mommer]

Update of /project/lgtk/cvsroot/lgtk/src
In directory common-lisp.net:/tmp/cvs-serv20234/src

Modified Files:
	gtknexus.lisp nexus.lisp 
Log Message:
Fixed another minor typo in lgtk.asd / changed the name of destroy-on-cg-p:
it is now destroy real-object.

Date: Sun Nov  9 12:32:46 2003
Author: mmommer

Index: lgtk/src/gtknexus.lisp
diff -u lgtk/src/gtknexus.lisp:1.3 lgtk/src/gtknexus.lisp:1.4
--- lgtk/src/gtknexus.lisp:1.3	Wed Nov  5 12:49:56 2003
+++ lgtk/src/gtknexus.lisp	Sun Nov  9 12:32:46 2003
@@ -11,9 +11,10 @@
 (defvar *gtkcallbacks* (make-instance 'idnexus))
 
 (defmethod destroy ((m gtk-objmeta))
-  (debugf t "Here we go destroying a gtk-objmeta~%")
+  (debugf t "Here we go destroying a gtk-objmeta. ID: ~X~%"
+	  (metacapsule-identify m))
   (let ((standing (destroyers m)))
-    (cond ((and standing (kill-on-gc-p m))
+    (cond ((and standing (destroy-real-object m) (contents m))
 	   (debugf t "It is still standing.~%")
 	   (mapcar #'destroy (callbacks m))
 	   (debugf t "Callbacks deallocated.~%")
@@ -32,7 +33,7 @@
 (defmethod destroy ((m g-objmeta))
   (debugf t "Here we go destroying a g-objmeta~%")
   (let ((standing (destroyers m)))
-    (cond ((and standing (kill-on-gc-p m))
+    (cond ((and standing (destroy-real-object m))
 	   (debugf t "It is still standing.~%")
 	   (mapcar #'destroy (callbacks m))
 	   (debugf t "Callbacks deallocated.~%")


Index: lgtk/src/nexus.lisp
diff -u lgtk/src/nexus.lisp:1.2 lgtk/src/nexus.lisp:1.3
--- lgtk/src/nexus.lisp:1.2	Fri Oct 31 05:52:53 2003
+++ lgtk/src/nexus.lisp	Sun Nov  9 12:32:46 2003
@@ -14,7 +14,7 @@
 	   :contents
 	   :metacapsule
 	   :metacapsule-identify
-	   :kill-on-gc-p
+	   :destroy-real-object
 	   :bag
 	   :meta
 	   :nexus
@@ -78,7 +78,7 @@
 	    :initform nil)
 
    ;; Do we destroy this on GC? Good question. On by default.
-   (kill-on-gc-p :accessor kill-on-gc-p
+   (destroy-real-object :accessor destroy-real-object
 		 :initform T)
 
    ;; The nexus keeps a reference to it. Needed for bookkeeping.
@@ -225,7 +225,8 @@
     (if n (remhash (metacapsule-identify meta)
 		   (table n)))
 
-    (debugf t "Removed ~a from nexus ~a.~%" meta n)))
+    (debugf t "Removed ~a from nexus ~a.~%" meta n))
+  (setf (destroy-real-object meta) nil))
 
 (defmethod destroy ((meta idmeta))
   (let ((id (id meta)))
@@ -233,4 +234,5 @@
 	      (remhash (id meta) (table (nexus meta)))
 	      (forget-id (id meta))
 	      (setf (id meta) nil))
-	  (t (debugf t "idmeta redestroyed.~%")))))
+	  (t (debugf t "idmeta redestroyed.~%"))))
+  (setf (destroy-real-object meta) nil))