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