diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-06 17:39:18 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-06 17:39:18 +0200 |
commit | c191d8f49e58bbc5b769780a0a17b5cec82174f1 (patch) | |
tree | 72bb1fb5c57b577bf17f055c6a37f6396e2e6d61 /Lisp/libobjcl.lisp | |
parent | 6ac284ebf50cc18f42115db05feecbccd659f8eb (diff) |
Make class and selector name retrieval more portable.
darcs-hash:f7a369dba0dda3e067547210ce7c008ae60cdc05
Diffstat (limited to 'Lisp/libobjcl.lisp')
-rw-r--r-- | Lisp/libobjcl.lisp | 41 |
1 files changed, 18 insertions, 23 deletions
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) |