summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-09-26 00:40:55 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-09-26 00:40:55 +0200
commit6bda4966b9885c19dff28fe218a2923bc2ecd4db (patch)
treea4cef7a806236b1ac87d6df7e6155e060c1d4af5
parent3c913501dd064a8e8411a88f7c6992587e9033cb (diff)
Add FIND-OBJC-META-CLASS, fix some minor bugs.
darcs-hash:1ae0dd35e64b278b944bc797847ccfedb97ea471
-rw-r--r--Lisp/defpackage.lisp2
-rw-r--r--Lisp/libobjcl.lisp33
-rw-r--r--Objective-C/libobjcl.h3
-rw-r--r--Objective-C/libobjcl.m20
-rw-r--r--objective-cl.asd3
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"))