Fixed re-initialization of gtk libraries on loading of dumped image (for now only...

[cl-gtk2.git] / glib / gobject.foreign-gobject-subclassing.lisp

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index b64f451..cb9fc94 100644 (file)
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -198,11 +198,13 @@
     (setf parent (g-type-name (ensure-g-type parent))))
   `(progn
      (setf (gethash ,name *registered-types*) (make-object-type :name ,name :class ',class :parent ,parent :interfaces ',interfaces :properties ',properties))
-     (with-foreign-object (query 'g-type-query)
-       (g-type-query (g-type-from-name ,parent) query)
-       (with-foreign-slots ((class-size instance-size) query g-type-query)
-         (g-type-register-static-simple (g-type-from-name ,parent) ,name class-size (callback c-class-init) instance-size (callback c-instance-init) nil)))
-     (add-interfaces ,name)
+     (at-init
+       (format t "Registering GObject type implementation ~A for type ~A~%" ',class ,name)
+       (with-foreign-object (query 'g-type-query)
+         (g-type-query (g-type-from-name ,parent) query)
+         (with-foreign-slots ((class-size instance-size) query g-type-query)
+           (g-type-register-static-simple (g-type-from-name ,parent) ,name class-size (callback c-class-init) instance-size (callback c-instance-init) nil)))
+       (add-interfaces ,name))
      (defmethod initialize-instance :before ((object ,class) &key pointer)
        (unless (or pointer (and (slot-boundp object 'gobject::pointer)
                                 (gobject::pointer object)))