Change weak reference to toggle references

[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 a68add0..e9c74f9 100644 (file)
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -5,11 +5,11 @@
 (defstruct object-type name class parent interfaces properties)
 
 (defun instance-init (instance class)
-  (debugf "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*)
+  (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*
               (gethash (pointer-address instance) *foreign-gobjects-strong*)
               (gethash (pointer-address instance) *foreign-gobjects-weak*))
-    (debugf "  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*))
@@ -68,7 +68,7 @@
     (iter (for property in (object-type-properties lisp-type-info))
           (for param-spec = (property->param-spec property))
           (for property-id from 123)
-          (debugf "installing property ~A~%" property)
+          (log-for :subclass "installing property ~A~%" property)
           (g-object-class-install-property class property-id param-spec))))
 
 (defun vtable-item->cstruct-item (item)
@@ -113,7 +113,7 @@
     (declare (ignorable class-name))
     (let* ((vtable (gethash interface-name *vtables*))
            (vtable-cstruct (vtable-description-cstruct-name vtable)))
-      (debugf "interface-init for class ~A and interface ~A~%" class-name interface-name)
+      (log-for :subclass "interface-init for class ~A and interface ~A~%" class-name interface-name)
       (iter (for method in (vtable-description-methods vtable))
             (setf (foreign-slot-value iface vtable-cstruct (vtable-method-info-name method)) (get-callback (vtable-method-info-callback-name method)))))))
 
@@ -136,7 +136,7 @@
 
 (defun class-init (class data)
   (declare (ignore data))
-  (debugf "class-init for ~A~%" (g-type-name (g-type-from-class class)))
+  (log-for :subclass "class-init for ~A~%" (g-type-name (g-type-from-class class)))
   (setf (foreign-slot-value class 'g-object-class :get-property)
         (callback c-object-property-get)
         (foreign-slot-value class 'g-object-class :set-property)
@@ -154,10 +154,10 @@
          (lisp-type-info (gethash type-name *registered-types*))
          (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first))
          (property-get-fn (fourth property-info)))
-    (debugf "get(~A,'~A')~%" lisp-object property-name)
+    (log-for :subclass "get(~A,'~A')~%" lisp-object property-name)
     (let ((value (restart-case
                      (funcall property-get-fn lisp-object)
-                   (return-from-property-getter (value) :interactive (lambda () (debugf "Enter new value: ") (list (eval (read)))) value))))
+                   (return-from-property-getter (value) :interactive (lambda () (format t "Enter new value: ") (list (eval (read)))) value))))
       (set-g-value g-value value property-type))))
 
 (defcallback c-object-property-get :void ((object :pointer) (property-id :uint) (value :pointer) (pspec :pointer))
@@ -173,7 +173,7 @@
          (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first))
          (property-set-fn (fifth property-info))
          (new-value (parse-g-value value)))
-    (debugf "set(~A,'~A',~A)~%" lisp-object property-name new-value)
+    (log-for :subclass "set(~A,'~A',~A)~%" lisp-object property-name new-value)
     (restart-case
         (funcall property-set-fn new-value lisp-object)
       (return-without-error-from-property-setter () nil))))
@@ -187,7 +187,7 @@
   `(progn
      (setf (gethash ,name *registered-types*) (make-object-type :name ,name :class ',class :parent ,parent :interfaces ',interfaces :properties ',properties))
      (at-init (',class)
-       (debugf "Registering GObject type implementation ~A for type ~A~%" ',class ,name)
+       (log-for :subclass "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)
          (g-type-register-static-simple (g-type-from-name ,parent)