From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sat, 5 Sep 2009 18:42:40 +0000 (+0400)
Subject: glib: more debugging logs for gobject creation; fixed instantiating lisp-implemented... 
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4779b2e12b19f4d3ea431b3784bbe0b8a463962d;p=cl-gtk2.git

glib: more debugging logs for gobject creation; fixed instantiating lisp-implemented classes
---

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index e9c74f9..618f870 100644
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -5,11 +5,13 @@
 (defstruct object-type name class parent interfaces properties)
 
 (defun instance-init (instance class)
+  (log-for :subclass "(instance-init ~A ~A)~%" instance class)
   (log-for :subclass "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*)
   (unless (or *current-creating-object*
+              *currently-making-object-p*
               (gethash (pointer-address instance) *foreign-gobjects-strong*)
               (gethash (pointer-address instance) *foreign-gobjects-weak*))
-    (log-for :subclass "  Proceeding with initialization...")
+    (log-for :subclass "Proceeding with initialization...~%")
     (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*))
@@ -198,8 +200,10 @@
                                         (callback c-instance-init) nil))
        (add-interfaces ,name))
      (defmethod initialize-instance :before ((object ,class) &key pointer)
+       (log-for :subclass "(initialize-instance ~A :pointer ~A) :before~%" object pointer)
        (unless (or pointer (and (slot-boundp object 'gobject::pointer)
                                 (gobject::pointer object)))
+         (log-for :subclass "calling g-object-constructor~%")
          (setf (gobject::pointer object) (gobject::g-object-call-constructor ,name nil nil)
                (gobject::g-object-has-reference object) t)))
      (progn
diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
index 2b67e7e..deac5b9 100644
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -205,15 +205,17 @@
     (apply #'call-next-method instance filtered-initargs)))
 
 (defmethod make-instance ((class gobject-class) &rest initargs &key pointer)
-  (if pointer
-      (progn
-        (assert (= (length initargs) 2) nil "POINTER can not be combined with other initargs (~A)" initargs)
-        (call-next-method))
-      (let* ((default-initargs (iter (for (arg value) in (class-default-initargs class))
-                                     (nconcing (list arg value))))
-             (effective-initargs (append initargs default-initargs))
-             (pointer (create-gobject-from-class-and-initargs class effective-initargs)))
-        (apply #'call-next-method class :pointer pointer effective-initargs))))
+  (log-for :subclass "(make-instance ~A ~{~A~^ ~})~%" class initargs)
+  (let ((*currently-making-object-p* t))
+    (if pointer
+        (progn
+          (assert (= (length initargs) 2) nil "POINTER can not be combined with other initargs (~A)" initargs)
+          (call-next-method))
+        (let* ((default-initargs (iter (for (arg value) in (class-default-initargs class))
+                                       (nconcing (list arg value))))
+               (effective-initargs (append initargs default-initargs))
+               (pointer (create-gobject-from-class-and-initargs class effective-initargs)))
+          (apply #'call-next-method class :pointer pointer effective-initargs)))))
 
 (defmethod slot-boundp-using-class ((class gobject-class) object (slot gobject-property-effective-slot-definition))
   (handler-case
diff --git a/glib/gobject.object.high.lisp b/glib/gobject.object.high.lisp
index 678fb2b..2a3c751 100644
--- a/glib/gobject.object.high.lisp
+++ b/glib/gobject.object.high.lisp
@@ -21,12 +21,16 @@
 (defvar *foreign-gobjects-strong* (make-hash-table :test 'equal))
 (defvar *current-creating-object* nil)
 (defvar *current-object-from-pointer* nil)
+(defvar *currently-making-object-p* nil)
 
 (defun ref-count (pointer)
   (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct :ref-count))
 
 (defmethod initialize-instance :around ((obj g-object) &key)
+  (when *currently-making-object-p*
+    (setf *currently-making-object-p* t))
   (let ((*current-creating-object* obj))
+    (log-for :subclass "initialize-instance :around; *current-creating-object* = ~A~%" obj)
     (call-next-method)))
 
 (defmethod initialize-instance :after ((obj g-object) &key &allow-other-keys)