summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 14:17:53 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 14:17:53 +0100
commit938a371de94ecbe2b4ccc72670dbfc8a68b50aa1 (patch)
treeef1da0dca61195ec46ecb7176ef78a040e9cbe6d
parent061a969f39f50c365369e28b5182d547f81ee11d (diff)
Fix ENSURE-OBJECTIVE-C-CLASS-PAIR.
darcs-hash:cd2b28bb4e252e25afb6807e32d092fcbd9c0977
-rw-r--r--Lisp/class-definition.lisp36
-rw-r--r--Lisp/libobjcl.lisp15
-rw-r--r--Objective-C/libobjcl.h3
-rw-r--r--Objective-C/libobjcl.m11
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)
{