X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign-gobject-subclassing.lisp;h=da188c5d38180e6bc9a78901d9960371b0a1cd75;hb=2db6e819bb5ba103c7d961c06a49e8fe276d0146;hp=991413530a5e041fb12eebbd9869ab452570b380;hpb=10f80fc9d1404cd451160086301a8ff69bfec38a;p=cl-gtk2.git

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index 9914135..da188c5 100644
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -78,7 +78,7 @@
       (rest item)
       (list (first item) :pointer)))
 
-(defstruct vtable-method-info slot-name name return-type args callback-name)
+(defstruct vtable-method-info slot-name name return-type args callback-name impl-call)
 
 (defmethod make-load-form ((object vtable-method-info) &optional environment)
   (declare (ignore environment))
@@ -91,14 +91,15 @@
 (defun vtable-methods (iface-name items)
   (iter (for item in items)
         (when (eq :skip (first item)) (next-iteration))
-        (destructuring-bind (name return-type &rest args) item
+        (destructuring-bind (name (return-type &rest args) &key impl-call) item
           (for method-name = (intern (format nil "~A-~A-IMPL" (symbol-name iface-name) (symbol-name name))))
           (for callback-name = (intern (format nil "~A-~A-CALLBACK" (symbol-name iface-name) (symbol-name name))))
           (collect (make-vtable-method-info :slot-name name
                                             :name method-name
                                             :return-type return-type
                                             :args args
-                                            :callback-name callback-name)))))
+                                            :callback-name callback-name
+                                            :impl-call impl-call)))))
 
 (defvar *vtables* (make-hash-table :test 'equal))
 
@@ -114,13 +115,19 @@
                                       :cstruct-name ',cstruct-name
                                       :methods (list ,@(mapcar #'make-load-form methods))))
        ,@(iter (for method in methods)
-               (collect `(defgeneric ,(vtable-method-info-name method)
-                             (,@(mapcar #'first (vtable-method-info-args method)))))
+               (for args = 
+                    (if (vtable-method-info-impl-call method)
+                        (first (vtable-method-info-impl-call method))
+                        (mapcar #'first (vtable-method-info-args method))))
+               (collect `(defgeneric ,(vtable-method-info-name method) (,@args)))
                (collect `(glib-defcallback ,(vtable-method-info-callback-name method)
                              ,(vtable-method-info-return-type method)
                              (,@(vtable-method-info-args method))
-                           (restart-case 
-                               (,(vtable-method-info-name method) ,@(mapcar #'first (vtable-method-info-args method)))
+                           (restart-case
+                               ,(if (vtable-method-info-impl-call method)
+                                    `(progn ,@(rest (vtable-method-info-impl-call method)))
+                                    `(,(vtable-method-info-name method)
+                                       ,@(mapcar #'first (vtable-method-info-args method))))
                              (return-from-interface-method-implementation (v)
                                :interactive (lambda () (list (eval (read)))) v))))))))