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 +++++++++++++++++++++++++++++++++++++++++-
 Lisp/libobjcl.lisp   | 42 ++----------------------------------------
 2 files changed, 43 insertions(+), 41 deletions(-)

(limited to '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)
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index dd0b3b0..39b1e2d 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -525,46 +525,6 @@ If *name* is the name of an existing class:
   (%objcl-class-name (pointer-to class)))
 
 
-#? selector -> string
-(defun selector-name (selector)
-  "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__"
-  (declare (type selector selector))
-  (%objcl-selector-name (pointer-to selector)))
-
-
 #? (or id objective-c-class exception) selector -> t
 (defun get-method-implementation (object selector)
   (declare (type selector selector))
@@ -771,6 +731,8 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
   (%objcl-object-is-meta-class (pointer obj)))
 
 (defun object-get-class (obj)
+  ;; OPTIMISE: Both find-objc-class-by-name and %objcl-class-name are
+  ;; slow and mostly unneeded.
   (find-objc-class-by-name
    (%objcl-class-name (%objcl-object-get-class (pointer obj)))))
 
-- 
cgit v1.2.3