blob: 17c7cf3f99b74a795fc39de5f82b524cbb692ba7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
(in-package #:mulk.objective-cl)
;;; (@* "Method invocation")
(defun invoke (receiver message-start &rest message-components)
"Send a message to an Objective C instance.
## Arguments and Values:
*receiver* --- an Objective C wrapper object.
*message-start* --- a **symbol**.
*message-components* --- an alternating **list** of **object**s and
**symbol**s.
Returns: *result* --- the return value of the method invocation.
## Description:
All even-numbered *message components* are collected in order and the
resulting **list** used as if as additional **argument**s to
__invoke-by-name__.
All uneven-numbered *message components*, which must be **symbol**s, are
first split into parts separated by hyphens and each part converted into
a **string** according to the following rules:
1. The first part is fully converted to **lowercase**.
2. Any additional parts are also fully converted to **lowercase** except
for their first letters, which are left intact.
3. If the symbol is a **keyword**, the resulting **string** is suffixed
by a **colon** (`:').
After that, all parts are concatenated in order to form a
single *message name component*. The *message name components* are in
turn concatenated in order to form the *message name* which is used as
if as the second **argument** to __invoke-by-name__.
## Examples:
(invoke (find-objc-class 'ns-string)
:string-with-c-string \"Mulk.\")
;=> #<GSCBufferString `Mulk.' {5B36087}>
(invoke (find-objc-class 'ns-object)
'self)
;=> #<NSObject `NSObject' {16ECF598}>
(invoke (find-objc-class 'ns-object)
'name)
;=> \"NSObject\"
(invoke (find-objc-class 'ns-string)
:string-with-c-string \"Mulk.\"
:encoding 4)
;=> #<GSCBufferString `Mulk.' {5B36087}>
## See also:
__invoke-by-name__"
(check-type receiver (or id objc-class exception)
"an Objective C instance (ID, OBJC-CLASS or EXCEPTION)")
(do* ((components-left (cons message-start message-components)
(cddr components-left))
(message-list (list message-start)
(cons (first components-left) message-list))
(arglist (if (null (rest components-left))
nil
(list (second components-left)))
(if (null (rest components-left))
arglist
(cons (second components-left) arglist))))
((null (cddr components-left))
(apply #'invoke-by-name
receiver
(symbol-list->message-name (nreverse message-list))
(nreverse arglist)))))
(defun invoke-by-name (receiver method-name &rest args)
"Send a message to an Objective C object by the name of the method.
## Arguments and Values:
*receiver* --- an Objective C wrapper object.
*method-name* --- a **string**.
*args* --- a list of **object**s.
Returns: *result* --- the return value of the method invocation.
## Examples:
(invoke-by-name (find-objc-class 'ns-string)
\"stringWithCString:\" \"Mulk.\")
;=> #<GSCBufferString `Mulk.' {5B36087}>
(invoke-by-name (find-objc-class 'ns-object)
\"self\")
;=> #<NSObject `NSObject' {16ECF598}>
(invoke-by-name (find-objc-class 'ns-string)
\"stringWithCString:encoding:\"
\"Mulk.\"
4)
;=> #<GSCBufferString `Mulk.' {5B36087}>
## See also:
__invoke__"
(check-type receiver (or id objc-class exception)
"an Objective C instance (ID, OBJC-CLASS or EXCEPTION)")
(when *trace-method-calls*
(format t "~&Invoking [~A].~%" method-name))
(flet ((convert/signal (foreign-value)
;; Convert a foreign value into a Lisp value. If the value
;; to be converted represents an exception, signal it instead
;; of returning it as a value.
(let ((lisp-value (obj-data->lisp foreign-value)))
(if (typep lisp-value 'condition)
(cerror "Return NIL from OBJCL-INVOKE-METHOD." lisp-value)
lisp-value))))
(let ((objc-arglist (arglist->objc-arglist args))
(selector (selector method-name)))
(unwind-protect
(with-foreign-conversion ((objc-receiver receiver))
(with-foreign-objects ((return-value
(apply-macro '%objcl-invoke-method
objc-receiver
(pointer-to selector)
(length args)
objc-arglist)))
(let ((*skip-retaining* (or *skip-retaining*
(constructor-name-p method-name))))
(convert/signal return-value))))
(dealloc-objc-arglist objc-arglist)))))
;;; (@* "Helper functions")
(defun arglist->objc-arglist (arglist)
(arglist-intersperse-types (mapcar #'lisp->obj-data arglist)))
(defun dealloc-objc-arglist (objc-arglist)
(do ((objc-arglist objc-arglist (cddr objc-arglist)))
((null objc-arglist))
;; (first objc-arglist) is a CFFI type name.
(dealloc-obj-data (second objc-arglist))))
(defun arglist-intersperse-types (arglist)
(mapcan #'(lambda (arg)
(list :pointer arg))
arglist))
(defun constructor-name-p (method-name)
(flet ((method-name-starts-with (prefix)
(and (>= (length method-name) (length prefix))
(or (and (string= prefix
(subseq method-name 0 (length prefix)))
(or (= (length method-name)
(length prefix))
(not (lower-case-p (char method-name (length prefix))))))))))
(or (method-name-starts-with "alloc")
(method-name-starts-with "new"))))
|
