From 6ac284ebf50cc18f42115db05feecbccd659f8eb Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Mon, 6 Aug 2007 17:02:02 +0200
Subject: Add the FIND-SELECTOR function.
darcs-hash:7d6f843c808b3d130201c85c6e806d68f5a9079c
---
Lisp/defpackage.lisp | 1 +
Lisp/libobjcl.lisp | 78 ++++++++++++++++++++++++++++++++++++++++++++++----
Objective-C/libobjcl.h | 9 ++++--
Objective-C/libobjcl.m | 22 ++++++++++++--
4 files changed, 99 insertions(+), 11 deletions(-)
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp
index 3047087..af51e52 100644
--- a/Lisp/defpackage.lisp
+++ b/Lisp/defpackage.lisp
@@ -7,4 +7,5 @@
#:invoke-by-name
#:invoke
#:find-objc-class
+ #:find-selector
#:*trace-method-calls*))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 4f420b9..ad13358 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -18,7 +18,6 @@
(use-foreign-library libobjcl)
-;; FIXME: docs
(defcfun ("objcl_initialise_runtime" initialise-runtime) :void)
(setf (documentation #'initialise-runtime 'function)
"Initialise the Objective C runtime.
@@ -45,7 +44,6 @@ before making any other Objective C calls.
__shutdown-runtime__")
-;; FIXME: docs
(defcfun ("objcl_shutdown_runtime" shutdown-runtime) :void)
(setf (documentation #'shutdown-runtime 'function)
"Shut the Objective C runtime down.
@@ -89,6 +87,9 @@ objects or classes, let alone send messages to them.
(defcfun ("objcl_class_name" %objcl-class-name) :string
(class obj-data))
+(defcfun ("objcl_find_selector" %objcl-find-selector) :pointer
+ (selector-name :string))
+
(defun find-objc-class (class-name)
"Retrieve an Objective C class by name.
@@ -166,9 +167,76 @@ conventional case for namespace identifiers in Objective C."
(exception 'exc-val)))
(pointer-to class))
(setf type (foreign-string-alloc (etypecase class
- (objc-class "#")
- (id "@")
- (exception "E")))))
+ (objc-class "#")
+ (id "@")
+ (exception "E")))))
(prog1
(%objcl-class-name obj-data)
(dealloc-obj-data obj-data))))
+
+
+(defun find-selector (selector-name)
+ "Retrieve a method selector by name.
+
+## Arguments and Values:
+
+*selector-name* --- a **string** or a **list** of **symbol**s.
+
+Returns: *selector* --- a __selector__ object, or __nil__.
+
+
+## Description:
+
+If *selector-name* is a **string**, the __selector__ named by that
+string is returned. If no __selector__ with the given name exists,
+__nil__ is returned.
+
+If *selector-name* is a **list** of **symbol**s, all **symbol**s are
+first split into parts separated by hyphens and each part converted into
+a **string** according to the following rules:
+
+1. The first part is fully converted to **lowercase**.
+
+2. Any additional parts are also fully converted to **lowercase** except
+ for their first letters, which are left intact.
+
+3. If the symbol is a **keyword**, the resulting **string** is suffixed
+ by a **colon** (`:').
+
+After that, all parts are concatenated in order to form a
+single *selector name component*. The *selector name components* are in
+turn concatenated in order to form the **string** that identifies the
+selector, which is used as if given directly as an argument to a call to
+__find-selector__.
+
+Note that the conversion rules for selector names are identical to those
+by which __invoke__ converts its arguments into a *message name*.
+
+
+## Examples:
+
+ (find-selector \"self\") ;=> #<SELECTOR `self'>
+ (find-selector '(self)) ;=> #<SELECTOR `self'>
+
+ (find-selector \"stringWithCString:encoding:\")
+ ;=> #<SELECTOR `stringWithCString:encoding:'>
+
+ (find-selector '(:string-with-c-string :encoding))
+ ;=> #<SELECTOR `stringWithCString:encoding:'>"
+
+ (typecase selector-name
+ (string (find-selector-by-name selector-name))
+ (list (find-selector-by-name (symbol-list->message-name
+ selector-name)))))
+
+
+(defun find-selector-by-name (selector-name)
+ (let ((obj-data (%objcl-find-selector selector-name)))
+ (prog1
+ (if (null-pointer-p (foreign-slot-value
+ (foreign-slot-value obj-data 'obj-data 'data)
+ 'obj-data-union
+ 'sel-val))
+ nil
+ (obj-data->lisp obj-data))
+ (dealloc-obj-data obj-data))))
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 4d6d092..eefeb5e 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -36,21 +36,24 @@ objcl_initialise_runtime (void);
void
objcl_shutdown_runtime (void);
-void *
+OBJCL_OBJ_DATA
objcl_invoke_instance_method (OBJCL_OBJ_DATA receiver,
const char *method_name,
int argc,
...);
-void *
+OBJCL_OBJ_DATA
objcl_invoke_class_method (OBJCL_OBJ_DATA class,
const char *method_name,
int argc,
...);
-void *
+OBJCL_OBJ_DATA
objcl_find_class (const char *class_name);
+OBJCL_OBJ_DATA
+objcl_find_selector (const char *selector_name);
+
/* Return a null-terminated list of type information strings.
The first entry describes the type of the method's return value. */
char **
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index 41d165c..7208498 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -164,7 +164,7 @@ _objcl_invoke_method (id self_,
}
-void *
+OBJCL_OBJ_DATA
objcl_invoke_instance_method (OBJCL_OBJ_DATA receiver,
const char *method_name,
int argc,
@@ -211,7 +211,7 @@ objcl_invoke_instance_method (OBJCL_OBJ_DATA receiver,
}
-void *
+OBJCL_OBJ_DATA
objcl_invoke_class_method (OBJCL_OBJ_DATA class,
const char *method_name,
int argc,
@@ -258,7 +258,7 @@ objcl_invoke_class_method (OBJCL_OBJ_DATA class,
}
-void *
+OBJCL_OBJ_DATA
objcl_find_class (const char *class_name)
{
Class class =
@@ -274,6 +274,22 @@ objcl_find_class (const char *class_name)
}
+OBJCL_OBJ_DATA
+objcl_find_selector (const char *class_name)
+{
+ SEL selector =
+ NSSelectorFromString ([NSString stringWithUTF8String: class_name]);
+ OBJCL_OBJ_DATA result = malloc (sizeof (struct objcl_object));
+ const char *const typespec = ":";
+
+ result->type = malloc (strlen (typespec) + 1);
+ strcpy (result->type, typespec);
+ result->data.sel_val = selector;
+
+ return result;
+}
+
+
const char *
objcl_class_name (OBJCL_OBJ_DATA class)
{
--
cgit v1.2.3