diff options
| -rw-r--r-- | Lisp/class-definition.lisp | 36 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 15 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 11 |
4 files changed, 48 insertions, 17 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 11d3767..3eb10ee 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -220,9 +220,11 @@ (0 (find-objc-class "NSObject")) (1 (first objective-c-superclasses)) (otherwise - (error "At most one Objective-C class may be derived at once.")))) - (ivars (remove-if-not #'(lambda (c) - (typep c 'foreign-direct-slot-definition)) + (error "Tried to derive all of ~S at the same time. ~ + (At most one Objective-C class may be derived at once.)" + objective-c-superclasses)))) + (ivars (remove-if-not #'(lambda (x) + (getf x :foreign-type nil)) direct-slots)) (new-class-pointer (objcl-create-class (symbol->objc-class-name name) @@ -230,23 +232,29 @@ (typep c 'objective-c-class)) direct-superclasses) nil - (mapcar #'slot-definition-foreign-name + (mapcar #'(lambda (x) + (getf x :foreign-name + (slot-name->foreign-slot-name + (getf x :name)))) ivars) (mapcar #'(lambda (x) - (slot-definition-foreign-type x)) + (getf x :foreign-type)) ivars))) (metaclass - (ensure-class name + (ensure-class (objc-meta-class-name->symbol + (symbol->objc-class-name name)) :metaclass (class-of (class-of superclass)) - :pointer new-class-pointer - :direct-superclasses (list (class-of superclass)))) + :pointer (%objcl-class-metaclass new-class-pointer) + :direct-superclasses (list (class-of superclass)) + :new-foreign-class-p t)) (class (ensure-class name :metaclass metaclass :pointer new-class-pointer :direct-slots direct-slots :direct-superclasses direct-superclasses - :direct-default-initargs direct-default-initargs))) + :direct-default-initargs direct-default-initargs + :new-foreign-class-p t))) class)) @@ -281,6 +289,11 @@ (t (call-next-method)))) +(defmethod reinitialize-instance ((class objective-c-class) + &key &allow-other-keys) + (call-next-method)) + + (defmethod initialize-instance :around ((class objective-c-class) &rest args &key pointer @@ -305,7 +318,8 @@ (defmethod make-instance :before ((class objective-c-class) &key &allow-other-keys) - (foreign-class-ensure-registered class)) + (unless (typep class 'objective-c-meta-class) + (foreign-class-ensure-registered class))) (defun foreign-class-ensure-registered (class) @@ -339,6 +353,6 @@ :initform nil :initarg :foos :accessor mlk-string-foos) - (foo-count :foreign-type '(:integer ()))) + (foo-count :foreign-type (:int ()))) (:metaclass #+(or) objective-c-class ns:+ns-object)) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 1364c58..47c39a9 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -57,6 +57,9 @@ (defcfun ("objcl_class_superclass" %objcl-class-superclass) :pointer (obj :pointer)) +(defcfun ("objcl_class_metaclass" %objcl-class-metaclass) :pointer + (obj :pointer)) + (defcfun ("objcl_find_selector" %objcl-find-selector) :pointer (selector-name :string)) @@ -768,12 +771,12 @@ separating parts by hyphens works nicely in all of the `:INVERT`, list) :pointer))) (%objcl-create-class class-name - (pointer-to superclass) - (length protocol-names) - %protocol-names - (length ivar-names) - %ivar-names - %ivar-typestrings))))) + (pointer-to superclass) + (length protocol-names) + %protocol-names + (length ivar-names) + %ivar-names + %ivar-typestrings))))) ;;; (@* "Low-level Data Conversion") (eval-when (:compile-toplevel :load-toplevel) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index 758c831..89292f4 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -90,6 +90,9 @@ objcl_class_name (Class class); Class objcl_class_superclass (Class class); +MetaClass +objcl_class_metaclass (Class class); + const char * objcl_selector_name (SEL selector); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index dc44c2d..c933e49 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -284,6 +284,17 @@ objcl_class_superclass (Class class) } +MetaClass +objcl_class_metaclass (Class class) +{ +#ifdef __NEXT_RUNTIME__ + return objc_getMetaClass (class); +#else + return class_get_meta_class (class); +#endif +} + + const char * objcl_selector_name (SEL selector) { |