diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-12-04 21:12:35 +0100 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-12-04 21:12:35 +0100 |
commit | eb9a722a75c7315da50844444717e2dcf6f069e4 (patch) | |
tree | 5dc65476bd98298bca1ca14e96694381519089af | |
parent | 7d86d96c3aded01c04bc6b02d54c115a7555f1f8 (diff) |
Automatically register Objective-C classes used as superclasses.
darcs-hash:928ea318abd6914917d42d77c8581dd4c3ee67d7
-rw-r--r-- | Lisp/class-definition.lisp | 14 | ||||
-rw-r--r-- | Lisp/libobjcl.lisp | 5 |
2 files changed, 13 insertions, 6 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp index 7410847..1c01a7f 100644 --- a/Lisp/class-definition.lisp +++ b/Lisp/class-definition.lisp @@ -382,12 +382,18 @@ __define-objective-c-method__" direct-slots direct-default-initargs) (let* ((objective-c-superclasses - (remove-if-not #'(lambda (c) (typep c 'objective-c-class)) + (remove-if-not #'(lambda (c) (or (typep c 'objective-c-class) + (eq (symbol-package (class-name c)) + (find-package '#:ns)))) direct-superclasses)) (superclass (case (length objective-c-superclasses) (0 (find-objc-class "NSObject")) - (1 (first objective-c-superclasses)) + (1 (let ((class (first objective-c-superclasses))) + (if (typep class 'forward-referenced-class) + ;; Load the super class definition on demand. + (find-objc-class (symbol->objc-class-name (class-name class))) + class))) (otherwise (error "Tried to derive all of ~S at the same time. ~ (At most one Objective-C class may be derived at once.)" @@ -397,9 +403,7 @@ __define-objective-c-method__" direct-slots)) (new-class-pointer (objcl-create-class (symbol->objc-class-name name) - (find-if #'(lambda (c) - (typep c 'objective-c-class)) - direct-superclasses) + superclass nil (mapcar #'(lambda (x) (getf x :foreign-name diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 939f3b3..b5c6f27 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -346,7 +346,10 @@ conventional case for namespace identifiers in Objective-C." ;; the way as well. (let ((class-name (objc-class-name->symbol class-name-string)) (class-ptr (%objcl-find-class class-name-string))) - (or (find-class class-name nil) + (or (let ((lisp-class (find-class class-name nil))) + ;; FORWARD-REFERENCED-CLASSes aren't what we want! + (and (typep lisp-class 'objective-c-class) + lisp-class)) (if (objc-pointer-null class-ptr) nil (let ((superclass (let ((potential-superclass |