diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-24 13:28:45 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-24 13:28:45 +0100 |
| commit | aa8645cdf28eb7b13d2813f5f0fe014df4d7b4b8 (patch) | |
| tree | 7ea1e014c0af0501938d0a377071460016078e19 /Lisp | |
| parent | 1deb19a20e934084cda4499e6930e35b0d2777c3 (diff) | |
When receiving a Lisp value wrapper from Objective-C, unwrap it automatically.
darcs-hash:f1b183f46c4d97c27121e0ada8614b9e9feb9955
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/data-types.lisp | 6 | ||||
| -rw-r--r-- | Lisp/lisp-value-wrapping.lisp | 12 | ||||
| -rw-r--r-- | Lisp/parameters.lisp | 2 | ||||
| -rw-r--r-- | Lisp/type-conversion.lisp | 14 |
4 files changed, 23 insertions, 11 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index d4e169e..2ab3fe4 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -582,6 +582,12 @@ seems like an acceptable trade-off. (trivial-garbage:finalize new-wrapper #'finaliser)))))) +(defclass lisp-value-wrapper-mixin () + ((lisp-value :initarg :value + :initform nil + :accessor lisp-value))) + + (defgeneric objcl-eql (obj1 obj2)) (with-compilation-unit () diff --git a/Lisp/lisp-value-wrapping.lisp b/Lisp/lisp-value-wrapping.lisp index dbc9c6e..1406a95 100644 --- a/Lisp/lisp-value-wrapping.lisp +++ b/Lisp/lisp-value-wrapping.lisp @@ -26,12 +26,6 @@ (find-objc-class "NSDictionary" t)) -(defclass lisp-value-wrapper-mixin () - ((lisp-value :initarg :value - :initform nil - :accessor lisp-value))) - - ;; May usefully override, among others: ;; - description (defclass ns::mlk-lisp-value (ns::ns-object lisp-value-wrapper-mixin) @@ -62,12 +56,14 @@ (defun make-lisp-value (value) ;; FIXME: The following won't work. Make MAKE-INSTANCE more useful... ;(make-instance 'ns::mlk-lisp-value :value value) - (let ((instance (invoke (typecase value + (let* ((*skip-value-wrapper-unwrapping* t) + (instance + (invoke-by-name (typecase value (string (find-class 'ns::mlk-lisp-string)) (vector (find-class 'ns::mlk-lisp-array)) (list (find-class 'ns::mlk-lisp-list)) (t (find-class 'ns::mlk-lisp-value))) - 'new))) + "new"))) (setf (lisp-value instance) value) instance)) diff --git a/Lisp/parameters.lisp b/Lisp/parameters.lisp index 14a3f16..f6fce2d 100644 --- a/Lisp/parameters.lisp +++ b/Lisp/parameters.lisp @@ -26,6 +26,8 @@ (defvar *skip-retaining* nil) +(defvar *skip-value-wrapper-unwrapping* nil) + (defvar *in-make-pointer-wrapper-p* nil "A debugging tool that helps identify direct MAKE-INSTANCE calls that ought not be there.") diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp index 9796104..5be0f12 100644 --- a/Lisp/type-conversion.lisp +++ b/Lisp/type-conversion.lisp @@ -25,9 +25,17 @@ (typespec-primary-type typespec)) ((id objective-c-class exception selector) (let ((*skip-retaining* skip-retaining-p)) - (intern-pointer-wrapper (typespec-primary-type typespec) - :pointer (cffi:mem-ref foreign-value-cell - c-type)))) + (let ((instance + (intern-pointer-wrapper (typespec-primary-type typespec) + :pointer (cffi:mem-ref + foreign-value-cell + c-type)))) + (typecase instance + (lisp-value-wrapper-mixin + (if *skip-value-wrapper-unwrapping* + instance + (lisp-value instance))) + (t instance))))) ((:char :unsigned-char) ;; FIXME? This is non-trivial. See policy.lisp for ;; details. |