- (if (g-object-has-reference object)
- (let ((object-type (g-type-from-object (pointer object)))
- (initially-unowned-type (g-type-from-name "GInitiallyUnowned")))
- (g-type-is-a object-type initially-unowned-type))
- t))
+ (let ((r (cond
+ ((eq object *current-creating-object*) ;; g_object_new returns objects with ref = 1, we should save _this_ ref
+ (g-object-is-floating (pointer object))) ;; but floating objects should be ref_sunk
+ (t t))))
+ (debugf "(should-ref-sink-at-creation ~A) => ~A~%" object r)
+ r))
+
+(defcallback gobject-toggle-ref-toggled :void
+ ((data :pointer) (pointer :pointer) (is-last-ref :boolean))
+ (declare (ignore data))
+ (debugf "~A is now ~A with ~A refs~%" pointer (if is-last-ref "weak pointer" "strong pointer") (ref-count pointer))
+ (debugf "obj: ~A~%" (or (gethash (pointer-address pointer) *foreign-gobjects-strong*)
+ (gethash (pointer-address pointer) *foreign-gobjects-weak*)))
+ (if is-last-ref
+ (let ((obj (gethash (pointer-address pointer) *foreign-gobjects-strong*)))
+ (if obj
+ (progn
+ (remhash (pointer-address pointer) *foreign-gobjects-strong*)
+ (setf (gethash (pointer-address pointer) *foreign-gobjects-weak*) obj))
+ (warn "GObject at ~A has no lisp-side (strong) reference" pointer)))
+ (let ((obj (gethash (pointer-address pointer) *foreign-gobjects-weak*)))
+ (unless obj (warn "GObject at ~A has no lisp-side (weak) reference" pointer))
+ (remhash (pointer-address pointer) *foreign-gobjects-weak*)
+ (setf (gethash (pointer-address pointer) *foreign-gobjects-strong*) obj))))
+
+(defcallback gobject-weak-ref-finalized :void
+ ((data :pointer) (pointer :pointer))
+ (declare (ignore data))
+ (debugf "~A is weak-ref-finalized with ~A refs~%" pointer (ref-count pointer))
+ (remhash (pointer-address pointer) *foreign-gobjects-weak*)
+ (when (gethash (pointer-address pointer) *foreign-gobjects-strong*)
+ (warn "GObject at ~A was weak-ref-finalized while still holding lisp-side strong reference to it" pointer))
+ (remhash (pointer-address pointer) *foreign-gobjects-strong*))