From 5e99c88b6f22ff0ecbc6d07f78cb6b1568307c75 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Mon, 16 Feb 2009 14:36:28 +0300 Subject: [PATCH] Fix initialization of classes with multiple lisp classes in inheritance line --- glib/gobject.foreign-gobject-subclassing.lisp | 21 ++++++++++++--------- glib/gobject.foreign-gobject.lisp | 9 +++++++++ 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp index 5ec3dc1..58bfc07 100644 --- a/glib/gobject.foreign-gobject-subclassing.lisp +++ b/glib/gobject.foreign-gobject-subclassing.lisp @@ -15,15 +15,18 @@ (defun instance-init (instance class) (format t "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class 'type)) *current-creating-object*) - (setf (gethash (pointer-address instance) *lisp-objects-references*) - (or *current-creating-object* - (let* ((g-type (foreign-slot-value class 'g-type-class 'type)) - (type-name (g-type-name g-type)) - (lisp-type-info (gethash type-name *registered-types*)) - (lisp-class (object-type-class lisp-type-info))) - (make-instance lisp-class :pointer instance)))) - (g-object-add-toggle-ref instance (callback c-object-toggle-pointer) (null-pointer)) - (g-object-unref instance)) + (unless (gethash (pointer-address instance) *lisp-objects-pointers*) + (format t " Proceeding with initialization...") + (setf (gethash (pointer-address instance) *lisp-objects-pointers*) t + (gethash (pointer-address instance) *lisp-objects-references*) + (or *current-creating-object* + (let* ((g-type (foreign-slot-value class 'g-type-class 'type)) + (type-name (g-type-name g-type)) + (lisp-type-info (gethash type-name *registered-types*)) + (lisp-class (object-type-class lisp-type-info))) + (make-instance lisp-class :pointer instance)))) + (g-object-add-toggle-ref instance (callback c-object-toggle-pointer) (null-pointer)) + (g-object-unref instance))) (defcallback c-object-toggle-pointer :void ((data :pointer) (object :pointer) (is-last-ref :boolean)) (object-toggle-pointer data object is-last-ref)) diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp index f462721..291ef95 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) -- 1.7.10.4