From 9dde84278b34334a0689cd3eee0d098007996f81 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Tue, 19 Feb 2008 15:48:16 +0100 Subject: Make FIND-OBJC-CLASS-BY-NAME able to find unregistered classes. darcs-hash:a92f0f0992d491f0f4f7172c94447ce90404dcb6 --- Lisp/libobjcl.lisp | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) (limited to 'Lisp') 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 -- cgit v1.2.3