(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
(type-instance g-type-instance)
(defun ref-count (pointer)
(foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct 'ref-count))
+(defmethod initialize-instance :around ((obj g-object) &key)
+ (let ((*current-creating-object* obj))
+ (call-next-method)))
+
(defmethod initialize-instance :after ((obj g-object) &key &allow-other-keys)
(unless (slot-boundp obj 'pointer)
(error "Pointer slot is not initialized for ~A" obj))
(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
t))
(defun register-g-object (obj)
- (debugf "registered GObject ~A with ref-count ~A ~A~%" (pointer obj) (ref-count obj) (if (g-object-is-floating (pointer obj)) "(floating)" ""))
+ (debugf "registered GObject ~A with gobject ref-count ~A ~A~%" (pointer obj) (ref-count obj) (if (g-object-is-floating (pointer obj)) "(floating)" ""))
(when (should-ref-sink-at-creation obj)
(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)
(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