Fix initialization of classes with multiple lisp classes in inheritance line

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index 5ec3dc1..58bfc07 100644 (file)
--- 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 (file)
--- 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)