From 42ab4123b1c1d0d2f4cf9c4b450caee39a798ad1 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 5 Feb 2008 22:21:53 +0100
Subject: Properly convert foreign slot names into CLOS slot names.

darcs-hash:86d821bf8ce3432e3ca70dd6429f923d4283baa7
---
 Lisp/class-definition.lisp |  3 ++-
 Lisp/name-conversion.lisp  | 24 ++++++++++++++++++++++++
 2 files changed, 26 insertions(+), 1 deletion(-)

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)))
-- 
cgit v1.2.3