From fc5fd1c843973bb080d5ab58038a116ad8d187b7 Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Tue, 17 Mar 2009 10:52:31 +0300
Subject: [PATCH] use defmethod instead of defun for property accessor in
 generated classes

---
 glib/gobject.generating.lisp |   41 +++++++++++++++++------------------------
 1 file changed, 17 insertions(+), 24 deletions(-)

diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp
index fe100a9..a7c9121 100644
--- a/glib/gobject.generating.lisp
+++ b/glib/gobject.generating.lisp
@@ -36,13 +36,6 @@
                        :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
@@ -94,43 +87,43 @@
                   (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)))))))))
@@ -179,7 +172,7 @@
              ,@(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
@@ -195,7 +188,7 @@
              (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))))
-- 
1.7.10.4