diff options
| -rw-r--r-- | Lisp/defpackage.lisp | 2 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 33 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 20 | ||||
| -rw-r--r-- | objective-cl.asd | 3 |
5 files changed, 58 insertions, 3 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index a01ace0..34e7f1f 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -28,6 +28,8 @@ #:invoke #:find-objc-class #:find-selector + #:objc-class-name + #:selector-name #:selector ;; Generic functions diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index e5bff30..5f8d80f 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -52,6 +52,9 @@ (defcfun ("objcl_find_class" %objcl-find-class) :pointer (class-name :string)) +(defcfun ("objcl_find_meta_class" %objcl-find-meta-class) :pointer + (class-name :string)) + (defcfun ("objcl_class_name" %objcl-class-name) :string (class :pointer)) @@ -221,7 +224,7 @@ conventional case for namespace identifiers in Objective C." find-objc-class-by-name)) (defun find-objc-class-by-name (class-name) (let ((class-ptr (%objcl-find-class class-name))) - (if (cffi:null-pointer-p class-ptr) + (if (objc-pointer-null class-ptr) nil #-(or t openmcl) (make-pointer-wrapper 'objc-class :pointer class-ptr) #+(and nil openmcl) (change-class (make-pointer-wrapper 'c-pointer-wrapper @@ -229,6 +232,32 @@ conventional case for namespace identifiers in Objective C." 'objc-class)))) +(defun find-objc-meta-class (meta-class-name &optional errorp) + (let ((meta-class + (etypecase meta-class-name + (string (find-objc-meta-class-by-name meta-class-name)) + (symbol (find-objc-meta-class-by-name + (symbol->objc-class-name meta-class-name)))))) + (or meta-class (if errorp + (error "Found no Objective C metaclass named ~S." + meta-class-name) + nil)))) + + +(defun find-objc-meta-class-by-name (class-name) + (let ((class-ptr (%objcl-find-meta-class class-name))) + (if (objc-pointer-null class-ptr) + nil + #-(or t openmcl) (make-pointer-wrapper 'objc-meta-class :pointer class-ptr) + #+(and nil openmcl) (change-class (make-pointer-wrapper 'c-pointer-wrapper + :pointer value) + 'objc-meta-class)))) + +(defun objc-pointer-null (pointer) + (or (cffi:null-pointer-p pointer) + (cffi:pointer-eq pointer (objcl-get-nil)))) + + (declaim (ftype (function (string) (or null selector)) find-selector-by-name)) (defun find-selector-by-name (selector-name) @@ -251,7 +280,7 @@ conventional case for namespace identifiers in Objective C." (%objcl-selector-name (pointer-to selector))) -(declaim (ftype (function ((or id objc-class exception) selector) *) +(declaim (ftype (function ((or id objc-class exception) selector) t) get-method-implementation)) (defun get-method-implementation (object selector) (declare (type selector selector)) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index 35fd0c8..56ba2d7 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -43,6 +43,9 @@ objcl_invoke_with_types (int argc, Class objcl_find_class (const char *class_name); +Class +objcl_find_meta_class (const char *class_name); + SEL objcl_find_selector (const char *selector_name); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index c13f252..6f09cfe 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -128,7 +128,27 @@ objcl_invoke_with_types (int argc, Class objcl_find_class (const char *class_name) { +#ifdef __NEXT_RUNTIME__ + return objc_lookUpClass (class_name); +#else return NSClassFromString ([NSString stringWithUTF8String: class_name]); +#endif +} + + +Class +objcl_find_meta_class (const char *class_name) +{ +#ifdef __NEXT_RUNTIME__ + return objc_getMetaClass (class_name); +#else + /* FIXME: Is this correct? */ + Class class = objcl_find_class (class_name); + if (class == NULL || class == nil) + return NULL; + else + return class_get_meta_class (class); +#endif } diff --git a/objective-cl.asd b/objective-cl.asd index 0a347a0..b195e3c 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -25,7 +25,8 @@ ((:module "Lisp" :components ((:file "defpackage") (:file "constant-data" :depends-on ("defpackage")) - (:file "data-types" :depends-on ("defpackage")) + (:file "data-types" :depends-on ("defpackage" + "conditions")) (:file "parameters" :depends-on ("defpackage")) (:file "name-conversion" :depends-on ("defpackage")) (:file "internal-utilities" :depends-on ("defpackage")) |