X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.meta.lisp;h=36599d714549148152267c9ae5ea4f48824923b9;hb=bcc0750a3031ca5bfb5d1084f56e60e1ab991973;hp=5b0c3e6473a345c10ed3c79b57d666e789646db5;hpb=5953ac4d60cff5f1fbdc0229d2c5acc0876d8bbb;p=cl-gtk2.git

diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
old mode 100755
new mode 100644
index 5b0c3e6..36599d7
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -63,8 +63,8 @@
 (defmethod reinitialize-instance :around ((class gobject-class) &rest initargs &key (direct-superclasses nil d-s-p) &allow-other-keys)
   (declare (ignore direct-superclasses))
   (if d-s-p
-      (call-next-method)
-      (apply #'call-next-method class (compute-new-initargs-for-metaclass initargs 'g-object))))
+      (apply #'call-next-method class (compute-new-initargs-for-metaclass initargs 'g-object))
+      (call-next-method)))
 
 (defmethod initialize-instance :after ((object gobject-class) &key &allow-other-keys)
   (when (gobject-class-direct-g-type-name object)
@@ -72,6 +72,8 @@
     (at-init (object) (initialize-gobject-class-g-type object))))
 
 (defmethod finalize-inheritance :after ((class gobject-class))
+  (iter (for superclass in (class-direct-superclasses class))
+        (unless (class-finalized-p superclass) (finalize-inheritance superclass)))
   (setf (gobject-class-g-type-name class)
         (or (gobject-class-direct-g-type-name class)
             (let ((gobject-superclass (iter (for superclass in (class-direct-superclasses class))
@@ -122,22 +124,27 @@
 (defmethod validate-superclass ((class gobject-class) (superclass standard-class))
   t)
 
-(defmethod direct-slot-definition-class ((class gobject-class) &rest initargs &key allocation)
+(defmethod direct-slot-definition-class ((class gobject-class) &rest initargs &key allocation &allow-other-keys)
   (declare (ignore initargs))
   (case allocation
-    (:gobject-property 'gobject-property-direct-slot-definition)
-    (:gobject-fn 'gobject-fn-direct-slot-definition)
+    (:gobject-property (find-class 'gobject-property-direct-slot-definition))
+    (:gobject-fn (find-class 'gobject-fn-direct-slot-definition))
     (otherwise (call-next-method))))
 
-(defmethod effective-slot-definition-class ((class gobject-class) &rest initargs &key allocation)
+(defvar *e-s-d* nil)
+
+(defmethod effective-slot-definition-class ((class gobject-class) &rest initargs)
   (declare (ignore initargs))
-  (case allocation
-    (:gobject-property 'gobject-property-effective-slot-definition)
-    (:gobject-fn 'gobject-fn-effective-slot-definition)
-    (otherwise (call-next-method))))
+  (or *e-s-d* (call-next-method)))
 
 (defmethod compute-effective-slot-definition ((class gobject-class) name direct-slots)
-  (let ((effective-slot (call-next-method)))
+  (let ((effective-slot (let ((*e-s-d* (loop
+					  for slot in direct-slots
+					  when (typep slot 'gobject-direct-slot-definition)
+					  return (etypecase slot
+						   (gobject-property-direct-slot-definition (find-class 'gobject-property-effective-slot-definition))
+						   (gobject-fn-direct-slot-definition (find-class 'gobject-fn-effective-slot-definition))))))
+			  (call-next-method))))
     (when (typep effective-slot 'gobject-effective-slot-definition)
       (let ((allocation (loop
                               for direct-slot in direct-slots
@@ -176,31 +183,28 @@
                              (gobject-fn-effective-slot-definition-g-getter-fn effective-slot)
                              (and property-getter
                                   (if (stringp property-getter)
-                                      (if (foreign-symbol-pointer property-getter)
-                                          (compile nil `(lambda (object)
-                                                          (foreign-funcall ,property-getter
-                                                                           g-object object
-                                                                           ,property-type)))
-                                          (progn 
-                                            (warn "Property reader function '~A' has not been found" property-getter)
-                                            (lambda (object)
-                                              (declare (ignore object))
-                                              (error "Property reader function '~A' has not been found" property-getter))))
+                                      (compile nil (if (foreign-symbol-pointer property-getter)
+						       `(lambda (object)
+							  (foreign-funcall ,property-getter
+									   g-object object
+									   ,property-type))
+						       `(lambda (object)
+							  (declare (ignore object))
+							  (error "Property getter ~A is not available" ,property-getter))
+						       ))
                                       property-getter))
                              (gobject-fn-effective-slot-definition-g-setter-fn effective-slot)
                              (and property-setter
                                   (if (stringp property-setter)
-                                      (if (foreign-symbol-pointer property-setter)
-                                          (compile nil `(lambda (object new-value)
-                                                          (foreign-funcall ,property-setter
-                                                                           g-object object
-                                                                           ,property-type new-value
-                                                                           :void)))
-                                          (progn
-                                            (warn "Property writer function '~A' has not been found" property-setter)
-                                            (lambda (object)
-                                              (declare (ignore object))
-                                              (error "Property writer function '~A' has not been found" property-setter))))
+                                      (compile nil (if (foreign-symbol-pointer property-setter)
+						       `(lambda (object new-value)
+							  (foreign-funcall ,property-setter
+									   g-object object
+									   ,property-type new-value
+									   :void))
+						       `(lambda (object)
+							  (declare (ignore object))
+							  (error "Property setter ~A is not avaiable" ,property-setter))))
                                       property-setter)))))))
     effective-slot))