Refactored SYMBOL-NAME-TO-JS-STRING.

diff --git a/src/utils.lisp b/src/utils.lisp
index 9047abb..6c4a8c6 100644 (file)
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -20,74 +20,46 @@
       (when keep-separators (push (string (char string i)) res))
       (setf last (1+ i)))))
 
-(defparameter *special-chars*
-  '((#\! . "Bang")
-    (#\? . "What")
-    (#\# . "Hash")
-    (#\@ . "At")
-    (#\% . "Percent")
-    (#\+ . "Plus")
-    (#\* . "Star")
-    (#\/ . "Slash")
-    (#\= . "Equals")
-    (#\: . "Colon")))
-
-;;; Parenscript-style symbol -> Javascript-style symbol
-
-(defun special-symbol-delimiter? (char)
-  (or (eql char #\+) (eql char #\*)))
-
-(defun special-symbol-name? (string)
-  (nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.*)[\\*|\\+](.*)" string)))
-
-(defun first-uppercase-p (string)
-  (and (> (length string) 1)
-       (special-symbol-delimiter? (char string 0))))
-
-(defun untouchable-string-p (string)
-  (and (> (length string) 1)
-       (char= #\: (char string 0))))
-
 (defun symbol-name-to-js-string (symbol)
   "Given a Lisp symbol or string, produces to a valid JavaScript
 identifier by following transformation heuristics case conversion. For
 example, paren-script becomes parenScript, *some-global* becomes
 SOMEGLOBAL."
-  (let ((sym-name (string symbol))
-        res
-        (do-not-touch nil)
+  (let ((sym-name (symbol-name symbol))
+        (no-case-conversion nil)
         (lowercase t)
         (all-uppercase nil))
-    (when (and (not (eq symbol '[]))
-               (find-if (lambda (x) (member x '(#\. #\[ #\]))) sym-name))
+    (when (and (not (eq symbol '[])) ;; HACK
+               (find-if (lambda (x) (find x '(#\. #\[ #\]))) sym-name))
       (warn "Symbol ~A contains one of '.[]' - this compound naming convention is no longer supported by Parenscript!"
             symbol))
-    (cond ((special-symbol-name? sym-name)
-           (setf all-uppercase t
-                 sym-name (let ((parts (special-symbol-name? sym-name)))
-                            (concatenate 'string (aref parts 0) (aref parts 1)))))
-          ((first-uppercase-p sym-name)
-           (setf lowercase nil
-                 sym-name (subseq sym-name 1)))
-          ((untouchable-string-p sym-name)
-           (setf do-not-touch t
-                 sym-name (subseq sym-name 1))))
-    (flet ((reschar (c)
-             (push (cond (do-not-touch c)
-                         ((and lowercase (not all-uppercase)) (char-downcase c))
-                         (t (char-upcase c)))
-                   res)
-             (setf lowercase t)))
-      (dotimes (i (length sym-name))
-        (let ((c (char sym-name i)))
-          (cond ((eql c #\-)
-                 (setf lowercase (not lowercase)))
-                ((assoc c *special-chars*)
-                 (dolist (i (coerce (cdr (assoc c *special-chars*)) 'list))
-                   (reschar i)))
-                (t (reschar c))))))
-    (coerce (nreverse res) 'string)))
-
+    (acond ((nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.*)[\\*|\\+](.*)" sym-name :sharedp t))
+            (setf all-uppercase t
+                  sym-name (concatenate 'string (aref it 0) (aref it 1))))
+           ((and (> (length sym-name) 1)
+                 (or (eql (char sym-name 0) #\+)
+                     (eql (char sym-name 0) #\*)))
+            (setf lowercase nil
+                  sym-name (subseq sym-name 1)))
+           ((and (> (length sym-name) 1)
+                 (char= #\: (char sym-name 0)))
+            (setf no-case-conversion t
+                  sym-name (subseq sym-name 1))))
+    (with-output-to-string (acc)
+      (loop for c across sym-name
+         do (acond ((eql c #\-)
+                    (setf lowercase (not lowercase)))
+                   ((position c "!?#@%+*/=:")
+                    (write-sequence (aref #("bang" "what" "hash" "at" "percent"
+                                            "plus" "star" "slash" "equals" "colon")
+                                          it)
+                                    acc))
+                   (t (write-char (cond (no-case-conversion c)
+                                        ((and lowercase (not all-uppercase)) (char-downcase c))
+                                        (t (char-upcase c)))
+                                  acc)
+                      (setf lowercase t)))))))
+  
 (defun ordered-set-difference (list1 list2 &key (test #'eql)) ; because the CL set-difference may not preserve order
   (reduce (lambda (list el) (remove el list :test test))
           (cons list1 list2)))