From 97f8ec14fe0d01415b8037aadf2658e52c6c0f63 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 13 Sep 2009 04:40:58 +0400 Subject: [PATCH] Support for gobject:release method for GObjects --- glib/gobject.meta.lisp | 6 ++++-- glib/gobject.object.high.lisp | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp index 79ab9d0..d7cb8c7 100644 --- a/glib/gobject.meta.lisp +++ b/glib/gobject.meta.lisp @@ -219,7 +219,8 @@ (defmethod slot-boundp-using-class ((class gobject-class) object (slot gobject-property-effective-slot-definition)) (handler-case - (progn (g-object-property-type (pointer object) (gobject-property-effective-slot-definition-g-property-name slot) :assert-readable t) t) + (and (pointer object) + (progn (g-object-property-type (pointer object) (gobject-property-effective-slot-definition-g-property-name slot) :assert-readable t) t)) (property-unreadable-error () nil))) (defmethod slot-value-using-class ((class gobject-class) object (slot gobject-property-effective-slot-definition)) @@ -235,7 +236,8 @@ new-value) (defmethod slot-boundp-using-class ((class gobject-class) object (slot gobject-fn-effective-slot-definition)) - (not (null (gobject-fn-effective-slot-definition-g-getter-fn slot)))) + (and (pointer object) + (not (null (gobject-fn-effective-slot-definition-g-getter-fn slot))))) (defmethod slot-value-using-class ((class gobject-class) object (slot gobject-fn-effective-slot-definition)) (let ((fn (gobject-fn-effective-slot-definition-g-getter-fn slot))) diff --git a/glib/gobject.object.high.lisp b/glib/gobject.object.high.lisp index 66a0b63..887ea2d 100644 --- a/glib/gobject.object.high.lisp +++ b/glib/gobject.object.high.lisp @@ -33,6 +33,12 @@ (defun ref-count (pointer) (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct :ref-count)) +(defmethod release ((obj g-object)) + (cancel-finalization obj) + (let ((p (pointer obj))) + (setf (pointer obj) nil) + (g-object-dispose-carefully p))) + (defmethod initialize-instance :around ((obj g-object) &key) (when *currently-making-object-p* (setf *currently-making-object-p* t)) -- 1.7.10.4