X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign-gobject.lisp;h=e1b13e34ad9d10c1da2757f3ac311b2c71e78c03;hb=d993fa132ff1e0a1284b284598703d65ee9e6081;hp=f462721029f95ce5fa8d0f4ffd793df89aaefcaa;hpb=d698b1bf570296ce54a543fdae4233d731f42f72;p=cl-gtk2.git diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp index f462721..e1b13e3 100644 --- a/glib/gobject.foreign-gobject.lisp +++ b/glib/gobject.foreign-gobject.lisp @@ -13,6 +13,7 @@ (defvar *foreign-gobjects* (make-weak-hash-table :test 'equal :weakness :value)) (defvar *foreign-gobjects-ref-count* (make-hash-table :test 'equal)) +(defvar *lisp-objects-pointers* (make-hash-table :test 'equal)) (defvar *current-creating-object* nil) (defcstruct g-object-struct @@ -74,6 +75,13 @@ (declare (ignore data)) (debugf "g-object has finalized ~A ~A~%" (g-type-name (g-type-from-object object-pointer)) object-pointer)) +(defun erase-pointer (data object-pointer) + (declare (ignore data)) + (remhash (pointer-address object-pointer) *lisp-objects-pointers*)) + +(defcallback weak-notify-erase-pointer :void ((data :pointer) (object-pointer :pointer)) + (erase-pointer data object-pointer)) + (defun should-ref-sink-at-creation (object) ;;If object was not created from lisp-side, we should ref it ;;If an object is regular g-object, we should not ref-sink it @@ -91,6 +99,7 @@ (debugf "g_object_ref_sink(~A)~%" (pointer obj)) (g-object-ref-sink (pointer obj))) (g-object-weak-ref (pointer obj) (callback weak-notify-print) (null-pointer)) + (g-object-weak-ref (pointer obj) (callback weak-notify-erase-pointer) (null-pointer)) (setf (g-object-has-reference obj) t) (setf (gethash (pointer-address (pointer obj)) *foreign-gobjects*) obj) @@ -98,7 +107,7 @@ (defun g-object-dispose (pointer) (unless (gethash (pointer-address pointer) *foreign-gobjects-ref-count*) - (format t "GObject ~A is already disposed, signalling error~%" pointer) + (debugf "GObject ~A is already disposed, signalling error~%" pointer) (error "GObject ~A is already disposed" pointer)) (debugf "g_object_unref(~A) (of type ~A, lisp-value ~A) (lisp ref-count ~A, gobject ref-count ~A)~%" pointer