Add a SELECTOR function and use coerced selectors in Objective C code rather than strings.

darcs-hash:d10f9eafc3b21bfcfc027a263e8cee007155b89c

5 files changed, 77 insertions, 13 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))