diff options
| -rw-r--r-- | Lisp/class-definition.lisp | 5 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 57 | ||||
| -rw-r--r-- | Lisp/name-conversion.lisp | 9 |
3 files changed, 39 insertions, 32 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 54af234..85f3eb6 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -215,9 +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 (foreign-slot-name->slot-name - (objcl-slot-name objc-slot)) - (find-package '#:objective-c-classes)) + (pushnew (list :name (foreign-slot-name->slot-name + (objcl-slot-name objc-slot)) :foreign-name (objcl-slot-name objc-slot) :foreign-type (parse-typespec (objcl-slot-type objc-slot))) (getf key-args :direct-slots) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 536938e..07f88ac 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -296,37 +296,36 @@ conventional case for namespace identifiers in Objective-C." (find-objc-meta-class (%objcl-class-name (pointer-to non-meta-superclass))) - (find-class 'objective-c-class)))) + (find-class 'objective-c-class))) + ;; If there is no superclass, we are the root metaclass. + ;; As we cannot assign ourselves as our own metaclass + ;; (which is a pity, because it would be the correct thing + ;; to do), we generate a fake metaclass for ourselves that + ;; is almost the same as ourselves except for its own + ;; metaclass, which is OBJECTIVE-C-META-CLASS. (As we are + ;; probably +NS-OBJECT, this fake metaclass will be called + ;; ++NS-OBJECT.) + ;; + ;; If the superclass is the root metaclass, we take it as + ;; our metaclass, because the root metaclass is the + ;; metaclass of all metaclasses. + ;; + ;; Otherwise, we use the metaclass of the superclass as + ;; our own, which will always get us the root metaclass. + (metaclass + (if non-meta-superclass + (if (typep (class-of superclass) + 'objective-c-meta-class) + superclass + (class-of superclass)) + (c2mop:ensure-class + (objc-fake-meta-class-name->symbol class-name-string) + :metaclass 'objective-c-meta-class + :pointer class-ptr + :direct-superclasses (list superclass))))) (or (find-class class-name nil) (c2mop:ensure-class class-name - ;; If there is no superclass, we are - ;; the root metaclass. As we cannot - ;; assign ourselves as our own - ;; metaclass (which is a pity, because - ;; it would be the correct thing to - ;; do), we use OBJECTIVE-C-META-CLASS - ;; as our metaclass and regrettably - ;; miss out on some features. (Sorry, - ;; you can't get at +NS-OBJECT's - ;; slots.) - ;; - ;; If the superclass is the root - ;; metaclass, we take it as our - ;; metaclass, because the root - ;; metaclass is the metaclass of all - ;; metaclasses. - ;; - ;; Otherwise, we use the metaclass of - ;; the superclass as our own, which - ;; will always get us the root - ;; metaclass. - :metaclass (if non-meta-superclass - (if (eq (class-name - (class-of superclass)) - 'objective-c-meta-class) - superclass - (class-of superclass)) - 'objective-c-meta-class) + :metaclass metaclass :pointer class-ptr :direct-superclasses (list superclass))))))) diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp index dcff468..84a0c82 100644 --- a/Lisp/name-conversion.lisp +++ b/Lisp/name-conversion.lisp @@ -106,6 +106,15 @@ (symbol-name (objc-class-name->symbol meta-class-name))))))) +(defun objc-fake-meta-class-name->symbol (meta-class-name) + (let ((*package* (find-package '#:objective-c-classes))) + (export-and-return + (intern + (concatenate 'string + "++" + (symbol-name (objc-class-name->symbol meta-class-name))))))) + + (defun name-hyphenated->mixed-case (string &optional (case-convention :nerd-caps)) (let ((lower-case-string (name->canonised-lower-case string))) (ecase case-convention |