From b450583841e5661383a2dff9408e23ea3e313b5a Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 4 Mar 2008 22:54:09 +0100
Subject: Introduce macro DEFINE-OBJECTIVE-C-GENERIC-FUNCTION.

darcs-hash:407ea76ee108cb03e819c6d5027b828a1232e24b
---
 Lisp/defpackage.lisp        |  1 +
 Lisp/method-definition.lisp | 12 ++++++++++++
 Lisp/tests.lisp             |  7 +++++--
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp
index eaeae3e..21bf284 100644
--- a/Lisp/defpackage.lisp
+++ b/Lisp/defpackage.lisp
@@ -46,6 +46,7 @@
            ;; Macros
            #+(or) #:define-objc-struct
            #+(or) #:define-objc-union
+           #:define-objective-c-generic-function
            #:define-objective-c-method
 
            ;; Special variables
diff --git a/Lisp/method-definition.lisp b/Lisp/method-definition.lisp
index 7e71f31..d97c2a8 100644
--- a/Lisp/method-definition.lisp
+++ b/Lisp/method-definition.lisp
@@ -75,6 +75,18 @@
                            ,@body)))))))
 
 
+(defmacro define-objective-c-generic-function (name lambda-list &body options)
+  `(defgeneric ,name ,lambda-list
+     ,@(unless (position :generic-function-class
+                         options
+                         :key #'car)
+         `((:generic-function-class objcl:objective-c-generic-function)))
+     ,@(unless (position :method-class
+                         options
+                         :key #'car)
+         `((:method-class objcl:objective-c-method)))))
+
+
 (defvar *callback-names* (make-hash-table :test #'eql))
 
 (defun intern-callback-name (method)
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 6783855..57da341 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -423,11 +423,13 @@
     (is (not (foreign-class-registered-p class)))
 
     ;; Method definition.
-    (is (eval `(defgeneric |foo:bar:stuff:do:| (a b c d e &rest f)
+    #.(enable-method-syntax)
+    (is (eval `(define-objective-c-generic-function #/foo:bar:stuff:do:
+                   (a b c d e &rest f)
                  (:generic-function-class objective-c-generic-function)
                  (:method-class objective-c-method))))
     (is (find-objc-class "NSNumber"))
-    (is (eval `(define-objective-c-method |foo:bar:stuff:do:| :int
+    (is (eval `(define-objective-c-method #/foo:bar:stuff:do: :int
                    ((x ,class-name)
                     (y :int)
                     z
@@ -436,6 +438,7 @@
                     &rest rest)
                  (declare (ignore z rest))
                  (+ y 20))))
+    #.(disable-method-syntax)
 
     ;; Sanity checks.
     (is (typep class 'objective-c-class))
-- 
cgit v1.2.3