summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Lisp/defpackage.lisp1
-rw-r--r--Lisp/libobjcl.lisp51
-rw-r--r--Lisp/method-invocation.lisp21
-rw-r--r--Lisp/tests.lisp16
-rw-r--r--Lisp/type-conversion.lisp1
-rw-r--r--Objective-C/libobjcl.h2
-rw-r--r--Objective-C/libobjcl.m14
7 files changed, 86 insertions, 20 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp
index c3008af..17ccf76 100644
--- a/Lisp/defpackage.lisp
+++ b/Lisp/defpackage.lisp
@@ -10,6 +10,7 @@
#:invoke
#:find-objc-class
#:find-selector
+ #:selector
;; Generic functions
#:objc-eql
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 00560fe..a713c8e 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -70,7 +70,7 @@ objects or classes, let alone send messages to them.
(defcfun ("objcl_invoke_method"
%objcl-invoke-method) obj-data
(receiver obj-data)
- (method-name :string)
+ (method-selector obj-data)
(argc :int)
&rest)
@@ -183,6 +183,55 @@ conventional case for namespace identifiers in Objective C."
(foreign-string-to-lisp/dealloc (%objcl-selector-name obj-data))))
+(defun selector (designator)
+ "Convert an object into a selector.
+
+## Arguments and Values:
+
+*designator* --- a *selector designator*.
+
+
+## Description:
+
+*selector-designator* must be a valid *selector designator*, that is:
+either a __selector__ object or one of a **symbol**, a **string**, or a
+**list** of **symbol**s representing a __selector__.
+
+If *selector-designator* is a **string** or a **list** of **symbol**s,
+__find-selector__ is called and the value returned, except that if
+__find-selector__ returns __nil__, an **error** is **signal**ed.
+
+If *selector-designator* is a single **symbol**, it is treated as if it
+were a **list** whose **car** is the **symbol** and whose **cdr** is
+__nil__.
+
+If *selector-designator* is a __selector__, it is simply returned.
+
+
+## Examples:
+
+ (selector \"self\") ;=> #<SELECTOR `self'>
+ (selector '(self)) ;=> #<SELECTOR `self'>
+ (selector 'self) ;=> #<SELECTOR `self'>
+ (selector *) ;=> #<SELECTOR `self'>
+
+ (selector 'selph) ; error
+
+ (selector \"stringWithCString:encoding:\")
+ ;=> #<SELECTOR `stringWithCString:encoding:'>
+
+ (selector '(:string-with-c-string :encoding))
+ ;=> #<SELECTOR `stringWithCString:encoding:'>"
+
+ (ctypecase designator
+ (selector designator)
+ (symbol (selector (list designator)))
+ ((or string list)
+ (or (find-selector designator)
+ (error "Could not find the selector designated by ~S."
+ designator)))))
+
+
(defun find-selector (selector-name)
"Retrieve a method selector by name.
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 95784fa..17c7cf3 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -131,23 +131,34 @@ Returns: *result* --- the return value of the method invocation.
(if (typep lisp-value 'condition)
(cerror "Return NIL from OBJCL-INVOKE-METHOD." lisp-value)
lisp-value))))
- (let* ((objc-args (mapcar #'lisp->obj-data args))
- (arglist (arglist-intersperse-types objc-args)))
+ (let ((objc-arglist (arglist->objc-arglist args))
+ (selector (selector method-name)))
(unwind-protect
(with-foreign-conversion ((objc-receiver receiver))
(with-foreign-objects ((return-value
(apply-macro '%objcl-invoke-method
objc-receiver
- method-name
+ (pointer-to selector)
(length args)
- arglist)))
+ objc-arglist)))
(let ((*skip-retaining* (or *skip-retaining*
(constructor-name-p method-name))))
(convert/signal return-value))))
- (mapc #'dealloc-obj-data objc-args)))))
+ (dealloc-objc-arglist objc-arglist)))))
;;; (@* "Helper functions")
+(defun arglist->objc-arglist (arglist)
+ (arglist-intersperse-types (mapcar #'lisp->obj-data arglist)))
+
+
+(defun dealloc-objc-arglist (objc-arglist)
+ (do ((objc-arglist objc-arglist (cddr objc-arglist)))
+ ((null objc-arglist))
+ ;; (first objc-arglist) is a CFFI type name.
+ (dealloc-obj-data (second objc-arglist))))
+
+
(defun arglist-intersperse-types (arglist)
(mapcan #'(lambda (arg)
(list :pointer arg))
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 28c4c9f..eec76ee 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -60,7 +60,7 @@
[NSString stringWithCString: "Klum."]))
((ensure [NSString isSubclassOfClass: [NSObject class]]))
((ensure [NSString performSelector:
- (find-selector "isSubclassOfClass:")
+ (selector "isSubclassOfClass:")
withObject: [NSObject class]]))))
@@ -70,9 +70,9 @@
(:tests
((ensure-same [NSString stringWithCString: "Mulk."]
[NSString stringWithCString: "Mulk." encoding: 4]))
- ((ensure-same [NSString respondsToSelector: (find-selector "new")]
+ ((ensure-same [NSString respondsToSelector: (selector "new")]
[NSString respondsToSelector: 'new]))
- ((ensure-same [NSString respondsToSelector: (find-selector "new")]
+ ((ensure-same [NSString respondsToSelector: (selector "new")]
[NSString respondsToSelector: "new"]))
((ensure (typep [NSString isEqual: [NSString self]] 'boolean)))
((ensure (typep [NSString isEqual: [NSObject self]] 'boolean)))))
@@ -113,8 +113,10 @@
(invoke (find-objc-class 'ns-string)
:string-with-c-string "Mulk." :encoding 4)))
((ensure-same [NSString performSelector:
- (find-selector "isSubclassOfClass:")
- withObject: [NSObject class]]
+ (selector "isSubclassOfClass:")
+ withObject: [NSObject self]]
(invoke (find-objc-class 'ns-string)
- :performSelector (find-selector "isSubclassOfClass")
- :with-object (find-objc-class 'ns-object))))))
+ :perform-selector (selector "isSubclassOfClass:")
+ :with-object (invoke
+ (find-objc-class 'ns-object)
+ 'self))))))
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
index bba40e7..42f3a98 100644
--- a/Lisp/type-conversion.lisp
+++ b/Lisp/type-conversion.lisp
@@ -10,6 +10,7 @@
'obj-data-union
(type-name->slot-name type-name))
(typecase value
+ (symbol (selector value))
((or id objc-class selector exception)
(pointer-to value))
(string (foreign-string-alloc value))
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 8ccafa7..270fa78 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -38,7 +38,7 @@ objcl_shutdown_runtime (void);
OBJCL_OBJ_DATA
objcl_invoke_method (OBJCL_OBJ_DATA receiver,
- const char *method_name,
+ SEL method_selector,
int argc,
...);
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index ee74944..cd79eb6 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -166,13 +166,12 @@ _objcl_invoke_method (id self_,
OBJCL_OBJ_DATA
objcl_invoke_method (OBJCL_OBJ_DATA receiver,
- const char *method_name,
+ SEL method_selector,
int argc,
...)
{
va_list arglist;
id self_ = NULL;
- SEL selector;
NSMethodSignature *signature;
OBJCL_OBJ_DATA result = malloc (sizeof (struct objcl_object));
@@ -188,13 +187,16 @@ objcl_invoke_method (OBJCL_OBJ_DATA receiver,
case 'E': self_ = receiver->data.exc_val;
}
- selector = NSSelectorFromString ([NSString
- stringWithUTF8String: method_name]);
- signature = [self_ methodSignatureForSelector: selector];
+ signature = [self_ methodSignatureForSelector: method_selector];
va_start (arglist, argc);
- _objcl_invoke_method (self_, result, signature, selector, argc, arglist);
+ _objcl_invoke_method (self_,
+ result,
+ signature,
+ method_selector,
+ argc,
+ arglist);
va_end (arglist);
}
NS_HANDLER
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-18 13:33:19 +0000