use defmethod instead of defun for property accessor in generated classes
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Tue, 17 Mar 2009 07:52:31 +0000 (10:52 +0300)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Tue, 17 Mar 2009 07:52:31 +0000 (10:52 +0300)
glib/gobject.generating.lisp

index fe100a9..a7c9121 100644 (file)
                        :reader ',(cffi-property-reader object)
                        :writer ',(cffi-property-writer object)))
 
-(defun parse-accessor (spec)
-  (ecase (first spec)
-    (:cffi (destructuring-bind (&key reader writer) (rest spec)
-             (make-cffi-property-accessor :reader reader :writer writer)))
-    (:gobject (destructuring-bind (property-name) (rest spec)
-                (make-gobject-property-accessor :property-name property-name)))))
-
 (defun parse-gobject-property (spec)
   (destructuring-bind (name accessor-name gname type readable writable) spec
       (make-gobject-property :name name
                   (lispify-name property-name))
           *lisp-name-package*))
 
-(defgeneric property->reader (property))
-(defgeneric property->writer (property))
+(defgeneric property->reader (class property))
+(defgeneric property->writer (class property))
 
-(defmethod property->reader ((property gobject-property))
+(defmethod property->reader (class (property gobject-property))
   (with-slots (accessor-name type gname) property
-   `(defun ,accessor-name (object)
+   `(defmethod ,accessor-name ((object ,class))
       (g-object-call-get-property object ,gname ,type))))
 
-(defmethod property->reader ((property cffi-property))
+(defmethod property->reader (class (property cffi-property))
   (with-slots (accessor-name type reader) property
     (etypecase reader
-      (string `(defun ,accessor-name (object)
+      (string `(defmethod ,accessor-name ((object ,class))
                  (foreign-funcall ,reader g-object object ,type)))
-      (symbol `(defun ,accessor-name (object)
+      (symbol `(defmethod ,accessor-name ((object ,class))
                  (funcall ',reader object))))))
 
-(defmethod property->writer ((property gobject-property))
+(defmethod property->writer (class (property gobject-property))
   (with-slots (accessor-name type gname) property
-    `(defun (setf ,accessor-name) (new-value object)
+    `(defmethod (setf ,accessor-name) (new-value (object ,class))
        (g-object-call-set-property object ,gname new-value ,type)
        new-value)))
 
-(defmethod property->writer ((property cffi-property))
+(defmethod property->writer (class (property cffi-property))
   (with-slots (accessor-name type writer) property
     (etypecase writer
-      (string `(defun (setf ,accessor-name) (new-value object)
+      (string `(defmethod (setf ,accessor-name) (new-value (object ,class))
                  (foreign-funcall ,writer g-object object ,type new-value :void)
                  new-value))
-      (symbol `(defun (setf ,accessor-name) (new-value object)
+      (symbol `(defmethod (setf ,accessor-name) (new-value (object ,class))
                  (funcall ',writer object new-value)
                  new-value)))))
 
-(defun property->accessors (property export)
+(defun property->accessors (class property export)
   (append (when (property-readable property)
-            (list (property->reader property)))
+            (list (property->reader class property)))
           (when (property-writable property)
-            (list (property->writer property)))
+            (list (property->writer class property)))
           (when export
             (list `(export ',(property-accessor-name property)
                            (find-package ,(package-name (symbol-package (property-accessor-name property)))))))))
              ,@(mapcar #'cffi-property->initarg (remove-if-not #'cffi-property-p combined-properties)))))
        ,@(loop
             for property in properties
-            append (property->accessors property export))
+            append (property->accessors name property export))
        
        (eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (get ',name 'superclass) ',superclass
              (list (type-initializer-call type-initializer)))
      ,@(loop
           for property in properties
-          append (property->accessors property export))
+          append (property->accessors name property export))
      (eval-when (:compile-toplevel :load-toplevel :execute)
        (setf (get ',name 'properties) ',properties)
        (setf (gethash ,g-name *known-interfaces*) ',name))))