summaryrefslogtreecommitdiff
path: root/Lisp/name-conversion.lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 19:04:47 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 19:04:47 +0100
commite63b283318018aaa017ac98e7c501b3fd29387e8 (patch)
treeecf9cd3e8d2a256db8d201ccfc8560d40e999322 /Lisp/name-conversion.lisp
parentbd36266aa06dd6d12561a402eb2e1c936658bce5 (diff)
Fix some recently introduced name conversion bugs.
darcs-hash:d11edd57137604c9e8e5d2427d5a904de3f1df77
Diffstat (limited to 'Lisp/name-conversion.lisp')
-rw-r--r--Lisp/name-conversion.lisp24
1 files changed, 20 insertions, 4 deletions
diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp
index d6821b5..2386bfb 100644
--- a/Lisp/name-conversion.lisp
+++ b/Lisp/name-conversion.lisp
@@ -117,8 +117,7 @@
(defun slot-name->foreign-slot-name (slot-name
&key (case-convention :camel-case))
- (name-hyphened->mixed-case (symbol-name slot-name)
- :case-convention case-convention))
+ (name-hyphened->mixed-case (symbol-name slot-name) case-convention))
(defun name-hyphened->underscored (string)
@@ -142,11 +141,28 @@
(notany #'lower-case-p string))))
+(defun string-capitalise-lower-case (string)
+ "Like STRING-CAPITALIZE except that all upper-case characters are left alone."
+ (with-output-to-string (out)
+ (loop for previous-position = 0 then word-start
+ for delimiter-pos = (position-if-not #'alphanumericp
+ string
+ :start previous-position)
+ for word-start = (and delimiter-pos (1+ delimiter-pos))
+ do (format out
+ "~:(~C~)~A"
+ (char string previous-position)
+ (subseq string
+ (1+ previous-position)
+ (or word-start (length string))))
+ while word-start)))
+
+
(defun name-hyphened->camel-case (string)
(remove #\- (concatenate 'string
(string (char string 0))
- (subseq (string-capitalize string) 1))))
+ (subseq (string-capitalise-lower-case string) 1))))
(defun name-hyphened->nerd-caps (string)
- (remove #\- (string-capitalize string)))
+ (remove #\- (string-capitalise-lower-case string)))