diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-19 15:48:16 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-19 15:48:16 +0100 |
| commit | 9dde84278b34334a0689cd3eee0d098007996f81 (patch) | |
| tree | 4253aae41d4421037ee3f22c13d4eeb784547d5f /Lisp | |
| parent | 98a2664219df9f0bc7f8fdfb14dcc2e8972782ba (diff) | |
Make FIND-OBJC-CLASS-BY-NAME able to find unregistered classes.
darcs-hash:a92f0f0992d491f0f4f7172c94447ce90404dcb6
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/libobjcl.lisp | 32 |
1 files changed, 21 insertions, 11 deletions
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 0267f10..7c4137d 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -320,17 +320,27 @@ conventional case for namespace identifiers in Objective-C." (declaim (ftype (function (string) (or null objective-c-class)) find-objc-class-by-name)) (defun find-objc-class-by-name (class-name-string) - (let ((class-ptr (%objcl-find-class class-name-string))) - (if (objc-pointer-null class-ptr) - nil - (let ((class-name (objc-class-name->symbol class-name-string)) - (superclass (let ((potential-superclass - (objcl-class-superclass/pointer class-ptr))) - (if potential-superclass - (foreign-class-ensure-registered - potential-superclass) - (find-class 'id))))) - (or (find-class class-name nil) + ;; Note that this function is able to find classes that are not yet + ;; registered with the Objective-C runtime simply by looking for an + ;; extant CLOS class definition. + ;; + ;; This is important, as FIND-OBJC-CLASS-BY-NAME is called more often + ;; than you might think. For instance, doing a (PRIMITIVE-INVOKE + ;; class ...) will cause (OBJECT-GET-CLASS class) to be called at some + ;; point, which would otherwise fail. Of course, doing a method + ;; invocation on the class will cause the class to be registered along + ;; 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) + (if (objc-pointer-null class-ptr) + nil + (let ((superclass (let ((potential-superclass + (objcl-class-superclass/pointer class-ptr))) + (if potential-superclass + (foreign-class-ensure-registered + potential-superclass) + (find-class 'id))))) (c2mop:ensure-class class-name :metaclass (class-name (find-objc-meta-class |