blob: 8de77dd93e2f78ca5d273f380d26c7bcd82451d6 (
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
178
179
180
181
182
183
|
(in-package #:mulk.objective-cl)
;;; (@* "Method invocation")
(defun invoke (receiver message-start &rest message-components)
"Send a message to an Objective C instance.
*receiver* --- an Objective C wrapper object.
*message-start* --- a symbol.
*message-components* --- an alternating list of arguments and message
name component symbols.
Returns: *result* --- the return value of the method invocation.
Each message name component is first split into parts seperated by
hyphens and each part is converted into a string according to the
following rules:
1. The first part is fully converted to lower case.
2. Any additional parts are also fully converted to lower case except
for their first letters, which are left intact.
3. If the symbol is a keyword symbol, the resulting string is suffixed
by a colon (`:').
After that, all parts are concatenated in order to form a single message
component. The message components are in turn concatenated in order to
form the message name which is used as if the second argument to a call
to _invoke-by-name_.
The message components that are not message name components are
collected in order and the resulting list used as if as additional
arguments 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"
(flet ((message-component->string (symbol)
(let* ((components (split-sequence #\- (symbol-name symbol)
:remove-empty-subseqs t))
(acc-string
(reduce #'(lambda (x y) (concatenate 'string x y))
(mapcar #'(lambda (x)
(concatenate 'string
(string (char x 0))
(string-downcase (subseq x 1))))
(subseq components 1))
:initial-value (string-downcase (first components)))))
(if (eql (find-package '#:keyword)
(symbol-package symbol))
(concatenate 'string acc-string ":")
acc-string))))
(do* ((components-left (cons message-start message-components)
(cddr components-left))
(message-string (message-component->string message-start)
(concatenate 'string
message-string
(message-component->string (first components-left))))
(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 message-string (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.
RECEIVER: an Objective C wrapper object.
METHOD-NAME: a string.
ARGS: a list of objects.
Returns: 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"
(let* ((arglist (arglist-intersperse-types
(mapcar #'lisp->obj-data args)))
(return-value (apply-macro '%objcl-invoke-class-method
(lisp->obj-data receiver)
method-name
(length args)
arglist)))
(when *trace-method-calls*
(format t "~&Invoking [~A].~%" method-name))
(unwind-protect
(let ((value
(let ((*skip-retaining* (or *skip-retaining*
(constructor-name-p method-name))))
(obj-data->lisp return-value))))
(if (typep value 'condition)
(cerror "Return NIL from OBJCL-INVOKE-CLASS-METHOD" value)
value))
(dealloc-obj-data return-value))))
#+nil
(defun invoke-instance-method-by-name (receiver method-name &rest args)
(let* ((arglist (arglist-intersperse-types
(mapcar #'lisp->obj-data args)))
(return-value (apply-macro '%objcl-invoke-instance-method
(lisp->obj-data receiver)
method-name
(length args)
arglist)))
(format t "~&Invoking <~A>.~%" method-name)
(unwind-protect
(let ((value
(let ((*skip-retaining* (or *skip-retaining*
(constructor-name-p method-name))))
(obj-data->lisp return-value))))
(if (typep value 'condition)
(cerror "Return NIL from OBJCL-INVOKE-INSTANCE-METHOD" value)
value))
(dealloc-obj-data return-value))))
;;; (@* "Helper functions")
(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"))))
|
