diff options
-rw-r--r-- | libobjcl.h | 5 | ||||
-rw-r--r-- | libobjcl.m | 39 | ||||
-rw-r--r-- | objcl.lisp | 24 |
3 files changed, 59 insertions, 9 deletions
@@ -10,6 +10,7 @@ typedef struct objcl_object union { id id_val; + Class class_val; SEL sel_val; char char_val; short short_val; @@ -51,3 +52,7 @@ objcl_find_class (const char *class_name); char ** objcl_query_arglist_info (void *receiver, const char *method_name); + + +const char * +objcl_class_name (OBJCL_OBJ_DATA class); @@ -171,14 +171,19 @@ objcl_invoke_instance_method (OBJCL_OBJ_DATA receiver, ...) { va_list arglist; - id self_; + id self_ = NULL; SEL selector; NSMethodSignature *signature; void *result; assert (receiver->type[0] == '#' || receiver->type[0] == '@'); - self_ = receiver->data.id_val; + switch (receiver->type[0]) + { + case '#': self_ = receiver->data.class_val; + case '@': self_ = receiver->data.id_val; + } + selector = NSSelectorFromString ([NSString stringWithUTF8String: method_name]); @@ -199,14 +204,19 @@ objcl_invoke_class_method (OBJCL_OBJ_DATA class, ...) { va_list arglist; - id self_; + id self_ = NULL; SEL selector; NSMethodSignature *signature; void *result; assert (class->type[0] == '#' || class->type[0] == '@'); - self_ = class->data.id_val; + switch (class->type[0]) + { + case '#': self_ = class->data.class_val; + case '@': self_ = class->data.id_val; + } + selector = NSSelectorFromString ([NSString stringWithUTF8String: method_name]); @@ -223,14 +233,31 @@ objcl_invoke_class_method (OBJCL_OBJ_DATA class, void * objcl_find_class (const char *class_name) { - id class = + Class class = NSClassFromString ([NSString stringWithUTF8String: class_name]); OBJCL_OBJ_DATA result = malloc (sizeof (struct objcl_object)); const char *const typespec = "#8@0:4"; result->type = malloc (strlen (typespec) + 1); strcpy (result->type, typespec); - result->data.id_val = class; + result->data.class_val = class; return result; } + + +const char * +objcl_class_name (OBJCL_OBJ_DATA class) +{ + Class cls = NULL; + + assert (class->type[0] == '#' + || class->type[0] == '@'); + switch (class->type[0]) + { + case '#': cls = class->data.class_val; + case '@': cls = class->data.id_val; + } + + return class_get_class_name (cls); +} @@ -26,6 +26,7 @@ (defcunion obj-data-union (id-val :pointer) + (class-val :pointer) (sel-val :pointer) (char-val :char) (short-val :short) @@ -60,7 +61,8 @@ (argc :int) &rest) -(defcfun "objcl_invoke_class_method" obj-data +(defcfun ("objcl_invoke_class_method" + %objcl-invoke-class-method) obj-data (receiver obj-data) (method-name :string) (argc :int) @@ -69,6 +71,9 @@ (defcfun ("objcl_find_class" %objcl-find-class) :pointer (class-name :string)) +(defcfun ("objcl_class_name" %objcl-class-name) :string + (class obj-data)) + ;;; Copied from objc-api.h ;;; Probably ought to be generated by C code at initialisation time. @@ -107,7 +112,7 @@ (defparameter *objcl-data-map* '((id . id-val) - (class . id-val) + (class . class-val) (sel . sel-val) (chr . char-val) (uchr . char-val) @@ -215,6 +220,19 @@ (dealloc-obj-data return-value)))) +(defun objcl-invoke-class-method (class method-name &rest args) + (let* ((arglist (arglist-intersperse-types + (mapcar #'lisp->obj-data args))) + (return-value (apply-macro '%objcl-invoke-class-method + (lisp->obj-data class) + method-name + (length args) + arglist))) + (prog1 + (obj-data->lisp return-value) + (dealloc-obj-data return-value)))) + + (defun lisp->obj-data (value) (let ((obj-data (foreign-alloc 'obj-data)) (type-name (lisp-value->type-name value))) @@ -250,7 +268,7 @@ (if (null-pointer-p (foreign-slot-value (foreign-slot-value obj-data 'obj-data 'data) 'obj-data-union - 'id-val)) + 'class-val)) nil (obj-data->lisp obj-data)) (dealloc-obj-data obj-data)))) |