Correct reference counting of gobjects

diff --git a/glib/gobject.lisp b/glib/gobject.lisp
index 79ce7dc..1ecc1b4 100644 (file)
--- a/glib/gobject.lisp
+++ b/glib/gobject.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gobject.lisp,v 1.15 2004-10-31 00:56:29 espen Exp $
+;; $Id: gobject.lisp,v 1.16 2004-11-03 16:18:16 espen Exp $
 
 (in-package "GLIB")
 
@@ -58,9 +58,27 @@
 ;    (map 'nil #'gvalue-free values)
     )
   
+  (%object-weak-ref object)
   (apply #'call-next-method object initargs))
 
 
+(defmethod initialize-proxy ((object gobject) &rest initargs &key weak-ref)
+  (declare (ignore initargs))
+  (call-next-method)
+  (%object-weak-ref object)
+  (unless weak-ref
+    (object-ref object)))
+
+(def-callback weak-notify (void (data int) (location system-area-pointer))
+  (when (instance-cached-p location)
+    (warn "~A being finalized by the GObject system while still in existence in lisp" (find-cached-instance location))
+    (remove-cached-instance location)))
+
+(defbinding %object-weak-ref (object) nil
+  (object gobject)
+  ((callback weak-notify) pointer)
+  (0 unsigned-int))
+
 
 (defbinding (%gobject-new "g_object_new") () pointer
   (type type-number)
@@ -121,7 +139,7 @@
 (defun (setf object-data) (data object key &key (test #'eq))
   (%object-set-qdata-full
    object (quark-from-object key :test test)
-   (register-user-data data) *destroy-notify*)
+   (register-user-data data) (callback %destroy-user-data))
   data)
 
 (defbinding %object-get-qdata () unsigned-long

diff --git a/glib/proxy.lisp b/glib/proxy.lisp
index 7195f14..e9a0f13 100644 (file)
--- a/glib/proxy.lisp
+++ b/glib/proxy.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: proxy.lisp,v 1.9 2004-10-28 19:29:00 espen Exp $
+;; $Id: proxy.lisp,v 1.10 2004-11-03 16:18:16 espen Exp $
 
 (in-package "GLIB")
 
@@ -165,6 +165,9 @@
     (when ref
       (ext:weak-pointer-value ref))))
 
+(defun instance-cached-p (location)
+  (gethash (system:sap-int location) *instance-cache*))
+
 (defun remove-cached-instance (location)
   (remhash (system:sap-int location) *instance-cache*))
 
@@ -179,6 +182,10 @@
   (defgeneric initialize-proxy (object &rest initargs))
   (defgeneric instance-finalizer (object)))
 
+(defmethod print-object ((instance proxy) stream)
+  (print-unreadable-object (instance stream :type t :identity nil)
+    (format stream "at 0x~X" (sap-int (proxy-location instance)))))
+
 
 (defmethod initialize-instance :after ((instance proxy)
                                       &rest initargs &key)
@@ -206,8 +213,9 @@
     (declare (type symbol type) (type system-area-pointer location))
     (let ((free (proxy-class-free class)))
       #'(lambda ()
-         (funcall free type location)
-         (remove-cached-instance location)))))
+         (when (instance-cached-p location)
+            (remove-cached-instance location)
+            (funcall free type location))))))
 
 
 (deftype-method translate-type-spec proxy (type-spec)