summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/defpackage.lisp1
-rw-r--r--Lisp/method-definition.lisp12
-rw-r--r--Lisp/tests.lisp7
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))