diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-03 00:18:51 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-03 00:18:51 +0100 |
| commit | 5cd4ba9e9cd3c64dffbbef3b154511eee704ceb0 (patch) | |
| tree | 2ab8ea0d8770d38a93cb6207adf2e6212664591e | |
| parent | bbf46f625cb69a3f99659222bd34f116e0c3ac76 (diff) | |
Use Objective-C metaclasses as CLOS metaclasses.
darcs-hash:dd0a1476e5412105a56b7c7de18f7d14f7af2696
| -rw-r--r-- | Lisp/class-definition.lisp | 7 | ||||
| -rw-r--r-- | Lisp/data-types.lisp | 2 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 7 |
3 files changed, 12 insertions, 4 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 049d521..45e6956 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -40,6 +40,11 @@ ()) +(defmethod c2mop:validate-superclass ((class objective-c-meta-class) + (superclass standard-class)) + t) + + (defmethod c2mop:direct-slot-definition-class ((class objective-c-class) &rest initargs) (if (some #'(lambda (symbol) (let ((nada '#:nada)) @@ -160,5 +165,5 @@ (nothing :accessor ns-string-nothing :initarg :ns-string :initform 100)) - (:metaclass objective-c-class) + (:metaclass objective-c-classes::%ns-string) (:wrapped-foreign-class "NSString")) diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 6c696f4..0b5865d 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -93,7 +93,7 @@ a suitable class method instead as you would in Objective-C. ()) -(defclass objective-c-meta-class (standard-class c-pointer-wrapper) +(defclass objective-c-meta-class (objective-c-class) ()) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 40c41ec..16a300f 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -233,7 +233,9 @@ conventional case for namespace identifiers in Objective-C." (let ((class-name (objc-class-name->symbol class-name-string))) (or (find-class class-name nil) (c2mop:ensure-class class-name - :metaclass 'objective-c-class + :metaclass (class-name + (find-objc-meta-class + class-name-string)) :pointer class-ptr :wrapped-foreign-class class-name-string)))))) @@ -258,7 +260,8 @@ conventional case for namespace identifiers in Objective-C." (or (find-class class-name nil) (c2mop:ensure-class class-name :metaclass 'objective-c-meta-class - :pointer class-ptr)))))) + :pointer class-ptr + :direct-superclasses '(objective-c-class))))))) (defun objc-pointer-null (pointer) |