From bd36266aa06dd6d12561a402eb2e1c936658bce5 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 5 Feb 2008 18:45:04 +0100
Subject: Further simplify name conversion.

darcs-hash:ff2a7edafc4889cb2f1043e1113a1a7c3fa25afc
---
 Lisp/name-conversion.lisp | 65 ++++++++++++++++++++++-------------------------
 1 file changed, 30 insertions(+), 35 deletions(-)

diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp
index ee93067..d6821b5 100644
--- a/Lisp/name-conversion.lisp
+++ b/Lisp/name-conversion.lisp
@@ -20,25 +20,12 @@
 
 ;;; (@* "Message and selector names")
 (defun message-component->string (symbol)
-  (let* ((components (split-sequence #\- (symbol-name symbol)
-                                     :remove-empty-subseqs t))
-         (downcasep (notany #'lower-case-p (symbol-name symbol)))
-         (acc-string
-          (reduce #'(lambda (x y) (concatenate 'string x y))
-                  (mapcar #'(lambda (x)
-                              (if downcasep
-                                  (concatenate 'string
-                                               (string (char x 0))
-                                               (string-downcase (subseq x 1)))
-                                  x))
-                          (subseq components 1))
-                  :initial-value (if downcasep
-                                     (string-downcase (first components))
-                                     (first components)))))
+  (let ((case-converted-name
+         (name-hyphened->mixed-case (symbol-name symbol) :camel-case)))
     (if (eql (find-package '#:keyword)
              (symbol-package symbol))
-        (concatenate 'string acc-string ":")
-        acc-string)))
+        (concatenate 'string case-converted-name ":")
+        case-converted-name)))
 
 
 (defun symbol-list->message-name (symbol-list)
@@ -50,18 +37,21 @@
 
 ;;; (@* "Class names")
 (defun symbol->objc-class-name (symbol)
-  (let ((components (split-sequence #\- (symbol-name symbol)
-                                    :remove-empty-subseqs t)))
-    (reduce #'(lambda (x y) (concatenate 'string x y))
-            (mapcar #'(lambda (x)
-                        (concatenate 'string
-                                     (string (char x 0))
-                                     (string-downcase (subseq x 1))))
-                    (subseq components 1))
-            :initial-value (concatenate 'string
-                                        (string (char (first components) 0))
-                                        (string-upcase
-                                         (subseq (first components) 1))))))
+  (let* ((name (symbol-name symbol))
+         (hyphen-pos (position #\- name))
+         (head (if hyphen-pos
+                   (subseq name 0 hyphen-pos)
+                   nil))
+         (tail (if hyphen-pos
+                   (subseq name hyphen-pos)
+                   name))
+         (converted-tail
+          (name-hyphened->mixed-case tail :nerd-caps)))
+    (if head
+        (concatenate 'string
+                     (string-upcase head)
+                     converted-tail)
+        converted-tail)))
 
 
 (defun export-and-return (symbol)
@@ -116,14 +106,19 @@
                    (symbol-name (objc-class-name->symbol meta-class-name)))))))
 
 
+(defun name-hyphened->mixed-case (string &optional (case-convention :nerd-caps))
+  (let ((lower-case-string (name->canonised-lower-case string)))
+    (ecase case-convention
+      ((:camel-case) (name-hyphened->camel-case lower-case-string))
+      ((:nerd-caps) (name-hyphened->nerd-caps lower-case-string))
+      ((:underscored) (name-hyphened->underscored lower-case-string))
+      ((:hyphened) lower-case-string))))
+
+
 (defun slot-name->foreign-slot-name (slot-name
                                      &key (case-convention :camel-case))
-  (let ((string (name->canonised-lower-case (symbol-name slot-name))))
-    (ecase case-convention
-      ((:camel-case) (name-hyphened->camel-case string))
-      ((:nerd-caps) (name-hyphened->nerd-caps string))
-      ((:underscored) (name-hyphened->underscored string))
-      ((:hyphened) string))))
+  (name-hyphened->mixed-case (symbol-name slot-name)
+                             :case-convention case-convention))
 
 
 (defun name-hyphened->underscored (string)
-- 
cgit v1.2.3