X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign-gobject-subclassing.lisp;h=d41d5bb41891d3b7c0a434aa132bdb2f1299fdc9;hb=ddaa0292b675c0336e20dfcca1ce3c7dcfc8ccee;hp=0ee4e9b70bfda11e4504e39cfb523841f63ef80c;hpb=16863d91ec98d17a3ec36c37f73e7859bf97841b;p=cl-gtk2.git

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index 0ee4e9b..d41d5bb 100644
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -14,13 +14,13 @@
       (setf (gethash (pointer-address object) *lisp-objects-references*) (gethash (pointer-address object) *foreign-gobjects*))))
 
 (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*)
+  (debugf "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*)
   (unless (gethash (pointer-address instance) *lisp-objects-pointers*)
     (debugf "  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))
+              (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)))
@@ -78,7 +78,7 @@
         (t (error "Unknown type: ~A (~A)" property-g-type (g-type-name property-g-type)))))))
 
 (defun install-properties (class)
-  (let* ((name (g-type-name (foreign-slot-value class 'g-type-class 'type)))
+  (let* ((name (g-type-name (foreign-slot-value class 'g-type-class :type)))
          (lisp-type-info (gethash name *registered-types*)))
     (iter (for property in (object-type-properties lisp-type-info))
           (for param-spec = (property->param-spec property))
@@ -138,8 +138,8 @@
   (let* ((interface-info (list name interface))
          (interface-info-ptr (allocate-stable-pointer interface-info)))
     (with-foreign-object (info 'g-interface-info)
-      (setf (foreign-slot-value info 'g-interface-info 'interface-init) (callback c-interface-init)
-            (foreign-slot-value info 'g-interface-info 'interface-data) interface-info-ptr)
+      (setf (foreign-slot-value info 'g-interface-info :interface-init) (callback c-interface-init)
+            (foreign-slot-value info 'g-interface-info :interface-data) interface-info-ptr)
       (g-type-add-interface-static (g-type-from-name name) (ensure-g-type interface) info))))
 
 (defun add-interfaces (name)
@@ -151,9 +151,9 @@
 (defun class-init (class data)
   (declare (ignore data))
   (debugf "class-init for ~A~%" (g-type-name (g-type-from-class class)))
-  (setf (foreign-slot-value class 'g-object-class 'get-property)
+  (setf (foreign-slot-value class 'g-object-class :get-property)
         (callback c-object-property-get)
-        (foreign-slot-value class 'g-object-class 'set-property)
+        (foreign-slot-value class 'g-object-class :set-property)
         (callback c-object-property-set))
   
   (install-properties class))
@@ -161,9 +161,9 @@
 (defun object-property-get (object property-id g-value pspec)
   (declare (ignore property-id))
   (let* ((lisp-object (gethash (pointer-address object) *lisp-objects-references*))
-         (property-name (foreign-slot-value pspec 'g-param-spec 'name))
-         (property-type (foreign-slot-value pspec 'g-param-spec 'value-type))
-         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec 'owner-type)))
+         (property-name (foreign-slot-value pspec 'g-param-spec :name))
+         (property-type (foreign-slot-value pspec 'g-param-spec :value-type))
+         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
          (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)))
@@ -179,8 +179,8 @@
 (defun object-property-set (object property-id value pspec)
   (declare (ignore property-id))
   (let* ((lisp-object (gethash (pointer-address object) *lisp-objects-references*))
-         (property-name (foreign-slot-value pspec 'g-param-spec 'name))
-         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec 'owner-type)))
+         (property-name (foreign-slot-value pspec 'g-param-spec :name))
+         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
          (lisp-type-info (gethash type-name *registered-types*))
          (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first))
          (property-set-fn (fifth property-info))
@@ -203,7 +203,12 @@
        (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)))
+           (g-type-register-static-simple (g-type-from-name ,parent)
+                                          ,name
+                                          (foreign-slot-value query 'g-type-query :class-size)
+                                          (callback c-class-init)
+                                          (foreign-slot-value query 'g-type-query :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)