diff options
| -rw-r--r-- | Lisp/data-types.lisp | 7 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 41 | ||||
| -rw-r--r-- | Lisp/type-conversion.lisp | 15 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 26 |
5 files changed, 65 insertions, 27 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 6181a3b..16d9147 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -98,6 +98,13 @@ (invoke-by-name class "hash")))) +(defmethod print-object ((selector selector) stream) + (print-unreadable-object (selector stream) + (format stream "~S `~A'" + 'selector + (selector-name selector)))) + + (defmethod print-object ((exception exception) stream) (print-unreadable-object (exception stream) (format stream "~S ~A {~X}" diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index ad13358..fff0963 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -90,6 +90,9 @@ objects or classes, let alone send messages to them. (defcfun ("objcl_find_selector" %objcl-find-selector) :pointer (selector-name :string)) +(defcfun ("objcl_selector_name" %objcl-selector-name) :string + (selector obj-data)) + (defun find-objc-class (class-name) "Retrieve an Objective C class by name. @@ -145,34 +148,26 @@ conventional case for namespace identifiers in Objective C." (defun find-objc-class-by-name (class-name) (let ((obj-data (%objcl-find-class class-name))) - (prog1 - (if (null-pointer-p (foreign-slot-value - (foreign-slot-value obj-data 'obj-data 'data) - 'obj-data-union - 'class-val)) - nil - (obj-data->lisp obj-data)) + (unwind-protect + (if (null-pointer-p (foreign-slot-value + (foreign-slot-value obj-data 'obj-data 'data) + 'obj-data-union + 'class-val)) + nil + (obj-data->lisp obj-data)) (dealloc-obj-data obj-data)))) (defun objcl-class-name (class) (declare (type (or objc-class id exception) class)) - (let ((obj-data (foreign-alloc 'obj-data))) - (with-foreign-slots ((type data) obj-data obj-data) - (setf (foreign-slot-value data - 'obj-data-union - (etypecase class - (objc-class 'class-val) - (id 'id-val) - (exception 'exc-val))) - (pointer-to class)) - (setf type (foreign-string-alloc (etypecase class - (objc-class "#") - (id "@") - (exception "E"))))) - (prog1 - (%objcl-class-name obj-data) - (dealloc-obj-data obj-data)))) + (with-foreign-objects ((obj-data class)) + (%objcl-class-name obj-data))) + + +(defun selector-name (selector) + (declare (type selector selector)) + (with-foreign-objects ((obj-data selector)) + (%objcl-selector-name obj-data))) (defun find-selector (selector-name) diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp index 8839b3b..3ac1ce6 100644 --- a/Lisp/type-conversion.lisp +++ b/Lisp/type-conversion.lisp @@ -32,4 +32,17 @@ ((id objc-class selector exception) (make-instance lisp-type :pointer value)) ((string) (foreign-string-to-lisp value)) - (otherwise value)))))
\ No newline at end of file + (otherwise value))))) + + +(defmacro with-foreign-objects (bindings &body body) + `(let ,(mapcar #'(lambda (name-value-pair) + (destructuring-bind (name value) + name-value-pair + `(,name (lisp->obj-data ,value)))) + bindings) + (unwind-protect + (progn ,@body) + ,@(mapcar #'(lambda (name-value-pair) + `(dealloc-obj-data ,(first name-value-pair))) + bindings)))) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index eefeb5e..e8bcfaf 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -63,3 +63,6 @@ objcl_query_arglist_info (void *receiver, const char * objcl_class_name (OBJCL_OBJ_DATA class); + +const char * +objcl_selector_name (OBJCL_OBJ_DATA class); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index 7208498..916ffa3 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -293,10 +293,10 @@ objcl_find_selector (const char *class_name) const char * objcl_class_name (OBJCL_OBJ_DATA class) { + const char *ns_name; + char *name; Class cls = NULL; - /* fprintf (stderr, "---------> %s <--------\n", class->type); */ - fflush (stderr); assert (class->type[0] == '#' || class->type[0] == '@' || class->type[0] == 'E'); @@ -307,5 +307,25 @@ objcl_class_name (OBJCL_OBJ_DATA class) case 'E': cls = (id) class->data.exc_val; } - return class_get_class_name (cls); + ns_name = [(NSStringFromClass (cls)) UTF8String]; + name = malloc (strlen (ns_name) + 1); + strcpy (name, ns_name); + + return name; +} + + +const char * +objcl_selector_name (OBJCL_OBJ_DATA selector) +{ + const char *ns_name; + char *name; + + assert (selector->type[0] == ':'); + ns_name = [(NSStringFromSelector (selector->data.sel_val)) + UTF8String]; + name = malloc (strlen (ns_name) + 1); + strcpy (name, ns_name); + + return name; } |