summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 22:21:53 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 22:21:53 +0100
commit42ab4123b1c1d0d2f4cf9c4b450caee39a798ad1 (patch)
tree4e6c34cab7f821f2f7588c1ce87c0555cb377f48
parent03239b38e120640e923f39eebd6c416147aebc19 (diff)
Properly convert foreign slot names into CLOS slot names.
darcs-hash:86d821bf8ce3432e3ca70dd6429f923d4283baa7
-rw-r--r--Lisp/class-definition.lisp3
-rw-r--r--Lisp/name-conversion.lisp24
2 files changed, 26 insertions, 1 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index c9e48c1..54af234 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -215,7 +215,8 @@
;; add them to our :DIRECT-SLOTS keyword argument.
(let ((key-args (copy-list args)))
(dolist (objc-slot (objcl-class-direct-slots/pointer pointer))
- (pushnew (list :name (intern (string-upcase (objcl-slot-name objc-slot))
+ (pushnew (list :name (intern (foreign-slot-name->slot-name
+ (objcl-slot-name objc-slot))
(find-package '#:objective-c-classes))
:foreign-name (objcl-slot-name objc-slot)
:foreign-type (parse-typespec (objcl-slot-type objc-slot)))
diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp
index 2386bfb..e51aa14 100644
--- a/Lisp/name-conversion.lisp
+++ b/Lisp/name-conversion.lisp
@@ -120,6 +120,17 @@
(name-hyphened->mixed-case (symbol-name slot-name) case-convention))
+(defun foreign-slot-name->slot-name (foreign-slot-name)
+ (let ((*package* (find-package '#:objective-c-classes)))
+ (export-and-return (read-from-string (name-underscored->hyphened
+ (name-camel-case->hyphened
+ foreign-slot-name))))))
+
+
+(defun name-underscored->hyphened (string)
+ (substitute #\- #\_ string))
+
+
(defun name-hyphened->underscored (string)
(substitute #\_ #\- string))
@@ -164,5 +175,18 @@
(subseq (string-capitalise-lower-case string) 1))))
+(defun name-camel-case->hyphened (string)
+ (with-output-to-string (out)
+ (loop for previous-position = 0 then word-start
+ for word-start = (position-if #'upper-case-p
+ string
+ :start (1+ previous-position))
+ do (format out "~(~A~)" (subseq string
+ previous-position
+ (or word-start (length string))))
+ while word-start
+ do (format out "-"))))
+
+
(defun name-hyphened->nerd-caps (string)
(remove #\- (string-capitalise-lower-case string)))