From e63bff30be008c4dfe1ee225c1879baecbeb0ab3 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 19 Mar 2008 03:07:42 +0100
Subject: Add a NAME slot to class SELECTOR.

darcs-hash:c51f1608afb05ec84f8f615114cb7f9f65abf8fe
---
 Lisp/data-types.lisp | 42 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 41 insertions(+), 1 deletion(-)

(limited to 'Lisp/data-types.lisp')

diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 67dcb70..e2a5358 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -81,8 +81,46 @@
   t)
 
 
+(defgeneric selector-name (selector)
+  (:documentation "Find the name of a selector.
+
+## Arguments and Values:
+
+*selector* --- an **object** of **type** __selector__.
+
+Returns: *name* --- a **string**.
+
+
+## Description:
+
+__selector-name__ returns the name of *selector*.
+
+
+## Examples:
+
+    (selector-name (selector '(:string-with-c-string :encoding)))
+     ;=> \"stringWithCString:encoding:\"
+
+
+## Note:
+
+If *x* is an **object** of **type** __selector__:
+
+    (objc-equal x (find-selector (selector-name x)))  ;=> T
+
+If *name* is the name of an existing selector:
+
+    (equal name (selector-name (find-selector name)))  ;=> T
+
+
+## See Also:
+
+  __find-selector__, __selector__"))
+
+
 (defclass selector (c2mop:funcallable-standard-object c-pointer-wrapper)
-     ()
+     ((name :accessor selector-name
+            :type string))
   (:metaclass c2mop:funcallable-standard-class)
   (:documentation "An Objective-C method selector.
 
@@ -134,6 +172,8 @@ The following calls are all equivalent:
   ;; Therefore, we handle this in a somewhat different manner for CMUCL.
   ;; See SELECTOR-FUNCTION below.
   (declare (ignore slot-names initargs))
+  (setf (slot-value selector 'name)
+        (%objcl-selector-name (pointer-to selector)))
   (c2mop:set-funcallable-instance-function
    selector
    #-cmu #'(lambda (receiver &rest args)
-- 
cgit v1.2.3