diff options
| -rw-r--r-- | Lisp/class-definition.lisp | 3 | ||||
| -rw-r--r-- | Lisp/name-conversion.lisp | 24 |
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))) |