-(defmacro define-vtable ((type-name cstruct-name) &body items)
- `(progn
- (defcstruct ,cstruct-name ,@(mapcar #'vtable-item->cstruct-item items))
- (setf (gethash ,type-name *vtables*)
- (make-vtable-description :type-name ,type-name :cstruct-name ',cstruct-name :methods (list ,@(mapcar #'make-load-form (vtable-methods items)))))
- ,@(iter (for method in (vtable-methods items))
- (collect `(defgeneric ,(vtable-method-info-name method) (,@(mapcar #'first (vtable-method-info-args method)))))
- (collect `(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)))
- (return-from-interface-method-implementation (v) :interactive (lambda () (list (eval (read)))) v)))))))
+(defmacro define-vtable ((type-name name) &body items)
+ (let ((cstruct-name (intern (format nil "~A-VTABLE" (symbol-name name))))
+ (methods (vtable-methods name items)))
+ `(progn
+ (defcstruct ,cstruct-name ,@(mapcar #'vtable-item->cstruct-item items))
+ (setf (gethash ,type-name *vtables*)
+ (make-vtable-description :type-name ,type-name
+ :cstruct-name ',cstruct-name
+ :methods (list ,@(mapcar #'make-load-form methods))))
+ ,@(iter (for method in methods)
+ (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
+ ,(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))))))))