Add the FIND-SELECTOR function.

darcs-hash:7d6f843c808b3d130201c85c6e806d68f5a9079c

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)
 {