112ac1d3 |
1 | ;; Common Lisp bindings for GTK+ v2.x |
fa30048e |
2 | ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net> |
387230e8 |
3 | ;; |
112ac1d3 |
4 | ;; Permission is hereby granted, free of charge, to any person obtaining |
5 | ;; a copy of this software and associated documentation files (the |
6 | ;; "Software"), to deal in the Software without restriction, including |
7 | ;; without limitation the rights to use, copy, modify, merge, publish, |
8 | ;; distribute, sublicense, and/or sell copies of the Software, and to |
9 | ;; permit persons to whom the Software is furnished to do so, subject to |
10 | ;; the following conditions: |
387230e8 |
11 | ;; |
112ac1d3 |
12 | ;; The above copyright notice and this permission notice shall be |
13 | ;; included in all copies or substantial portions of the Software. |
387230e8 |
14 | ;; |
112ac1d3 |
15 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
16 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
17 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. |
18 | ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY |
19 | ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, |
20 | ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE |
21 | ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
387230e8 |
22 | |
be71e3c8 |
23 | ;; $Id: gparam.lisp,v 1.27 2008-11-04 03:22:23 espen Exp $ |
387230e8 |
24 | |
25 | (in-package "GLIB") |
26 | |
27 | (deftype gvalue () 'pointer) |
28 | |
dfa4f314 |
29 | (register-type 'gvalue '|g_value_get_type|) |
8532ba0a |
30 | |
4d83a8a6 |
31 | (eval-when (:compile-toplevel :load-toplevel :execute) |
32 | (defbinding (size-of-gvalue "size_of_gvalue") () unsigned-int)) |
33 | |
fa30048e |
34 | (defconstant +gvalue-size+ (size-of-gvalue)) |
60e767f4 |
35 | (defconstant +gvalue-value-offset+ |
110bd96c |
36 | (max (size-of 'type-number) (type-alignment '(unsigned-byte 64)))) |
be71e3c8 |
37 | (defconstant +gvalue-flags-offset+ |
38 | (+ +gvalue-value-offset+ (size-of '(unsigned-byte 64)))) |
39 | (defconstant +gvalue-nocopy-contents-flag+ 27) |
387230e8 |
40 | |
9adccb27 |
41 | (defbinding (%gvalue-init "g_value_init") () nil |
4d83a8a6 |
42 | (value gvalue) |
387230e8 |
43 | (type type-number)) |
44 | |
68093e26 |
45 | (defbinding (gvalue-unset "g_value_unset") () nil |
46 | (value gvalue)) |
47 | |
86e998ca |
48 | (defun gvalue-init (gvalue type &optional (value nil value-p) temp-p) |
9adccb27 |
49 | (%gvalue-init gvalue (find-type-number type)) |
50 | (when value-p |
86e998ca |
51 | (funcall (writer-function type :temp temp-p) value gvalue +gvalue-value-offset+))) |
68093e26 |
52 | |
3c44ba6c |
53 | (defun gvalue-new (&optional type (value nil value-p)) |
387230e8 |
54 | (let ((gvalue (allocate-memory +gvalue-size+))) |
3c44ba6c |
55 | (cond |
56 | (value-p (gvalue-init gvalue type value)) |
57 | (type (gvalue-init gvalue type))) |
387230e8 |
58 | gvalue)) |
59 | |
9adccb27 |
60 | (defun gvalue-free (gvalue &optional (unset-p t)) |
387230e8 |
61 | (unless (null-pointer-p gvalue) |
68093e26 |
62 | (when unset-p |
63 | (gvalue-unset gvalue)) |
387230e8 |
64 | (deallocate-memory gvalue))) |
65 | |
66 | (defun gvalue-type (gvalue) |
4f1fe141 |
67 | ;; We need to search for the for the most specific known type |
68 | ;; because internal types, unknown to Lisp, may be passed in GValues |
69 | (labels ((find-most-specific-known-type (type) |
70 | (or |
71 | (type-from-number type) |
72 | (let ((parent (type-parent type))) |
73 | (unless (zerop parent) |
74 | (find-most-specific-known-type parent)))))) |
ae462d0e |
75 | (let ((type-number (ref-type-number gvalue))) |
76 | (unless (zerop type-number) |
77 | (or |
78 | (find-most-specific-known-type type-number) |
79 | ;; This will signal an error if the type hierarchy is unknown |
80 | (type-from-number type-number t)))))) |
387230e8 |
81 | |
be71e3c8 |
82 | (let ((flags-reader nil)) |
83 | (defun gvalue-static-p (gvalue) |
84 | (unless flags-reader |
85 | (setf flags-reader (reader-function 'unsigned-int))) |
86 | (prog1 |
87 | (ldb-test (byte 1 +gvalue-nocopy-contents-flag+) |
88 | (funcall flags-reader gvalue +gvalue-flags-offset+)) |
89 | (force-output)))) |
90 | |
fa30048e |
91 | (defun gvalue-get (gvalue) |
9adccb27 |
92 | (funcall (reader-function (gvalue-type gvalue)) |
fa30048e |
93 | gvalue +gvalue-value-offset+)) |
94 | |
95 | (defun gvalue-peek (gvalue) |
96 | (funcall (reader-function (gvalue-type gvalue) :ref :peek) |
97 | gvalue +gvalue-value-offset+)) |
98 | |
99 | (defun gvalue-take (gvalue) |
be71e3c8 |
100 | (funcall (reader-function (gvalue-type gvalue) |
101 | :ref (if (gvalue-static-p gvalue) :peek :get)) |
fa30048e |
102 | gvalue +gvalue-value-offset+)) |
387230e8 |
103 | |
104 | (defun gvalue-set (gvalue value) |
9adccb27 |
105 | (funcall (writer-function (gvalue-type gvalue)) |
387230e8 |
106 | value gvalue +gvalue-value-offset+) |
107 | value) |
108 | |
8532ba0a |
109 | (defbinding (gvalue-p "g_type_check_value") () boolean |
110 | (location pointer)) |
111 | |
a54e8339 |
112 | (defmacro with-gvalue ((gvalue &optional type (value nil value-p)) &body body) |
fa30048e |
113 | `(with-memory (,gvalue +gvalue-size+) |
35850cce |
114 | ,(cond |
86e998ca |
115 | ((and type value-p) `(gvalue-init ,gvalue ,type ,value t)) |
35850cce |
116 | (type `(gvalue-init ,gvalue ,type))) |
117 | ,@body |
fa30048e |
118 | ,(unless value-p `(gvalue-take ,gvalue)))) |
df0b4e7d |
119 | |
4d83a8a6 |
120 | |
df0b4e7d |
121 | (deftype param-flag-type () |
122 | '(flags |
4eb73e10 |
123 | (:readable 1) |
124 | (:writable 2) |
125 | (:construct 4) |
126 | (:construct-only 8) |
127 | (:lax-validation 16) |
128 | (:private 32))) |
df0b4e7d |
129 | |
9adccb27 |
130 | (eval-when (:compile-toplevel :load-toplevel :execute) |
131 | (defclass param-spec-class (ginstance-class) |
132 | ()) |
133 | |
fa30048e |
134 | (defmethod shared-initialize ((class param-spec-class) names &rest initargs) |
135 | (declare (ignore names initargs)) |
136 | (call-next-method) |
137 | (unless (slot-boundp class 'ref) |
138 | (setf (slot-value class 'ref) '%param-spec-ref)) |
139 | (unless (slot-boundp class 'unref) |
140 | (setf (slot-value class 'unref) '%param-spec-unref))) |
141 | |
73572c12 |
142 | (defmethod validate-superclass ((class param-spec-class) (super standard-class)) |
9adccb27 |
143 | t ;(subtypep (class-name super) 'param) |
144 | )) |
145 | |
146 | |
147 | (defbinding %param-spec-ref () pointer |
148 | (location pointer)) |
149 | |
150 | (defbinding %param-spec-unref () nil |
151 | (location pointer)) |
152 | |
9adccb27 |
153 | |
4d83a8a6 |
154 | ;; TODO: rename to param-spec |
9adccb27 |
155 | (defclass param (ginstance) |
156 | ((name |
157 | :allocation :alien |
158 | :reader param-name |
159 | :type string) |
160 | (flags |
161 | :allocation :alien |
162 | :reader param-flags |
163 | :type param-flag-type) |
164 | (value-type |
165 | :allocation :alien |
166 | :reader param-value-type |
167 | :type type-number) |
168 | (owner-type |
169 | :allocation :alien |
170 | :reader param-owner-type |
171 | :type type-number) |
172 | (nickname |
173 | :allocation :virtual |
174 | :getter "g_param_spec_get_nick" |
175 | :reader param-nickname |
9ca5565a |
176 | :type (copy-of string)) |
9adccb27 |
177 | (documentation |
178 | :allocation :virtual |
179 | :getter "g_param_spec_get_blurb" |
180 | :reader param-documentation |
9ca5565a |
181 | :type (copy-of string))) |
dfa4f314 |
182 | (:metaclass param-spec-class) |
183 | (:gtype "GParam")) |
df0b4e7d |
184 | |
185 | |
186 | (defclass param-char (param) |
187 | ((minimum |
188 | :allocation :alien |
fa30048e |
189 | :reader param-minimum |
df0b4e7d |
190 | :type char) |
191 | (maximum |
192 | :allocation :alien |
fa30048e |
193 | :reader param-maximum |
df0b4e7d |
194 | :type char) |
195 | (default-value |
196 | :allocation :alien |
fa30048e |
197 | :reader param-default-value |
df0b4e7d |
198 | :type char)) |
dfa4f314 |
199 | (:metaclass param-spec-class) |
200 | (:gtype "GParamChar")) |
df0b4e7d |
201 | |
202 | (defclass param-unsigned-char (param) |
203 | ( |
204 | ; (minimum |
205 | ; :allocation :alien |
206 | ; :reader param-unsigned-char-minimum |
207 | ; :type unsigned-char) |
208 | ; (maximum |
209 | ; :allocation :alien |
210 | ; :reader param-unsigned-char-maximum |
211 | ; :type unsigned-char) |
212 | ; (default-value |
213 | ; :allocation :alien |
214 | ; :reader param-unsigned-char-default-value |
215 | ; :type unsigned-char) |
216 | ) |
9adccb27 |
217 | (:metaclass param-spec-class) |
dfa4f314 |
218 | (:gtype "GParamUChar")) |
df0b4e7d |
219 | |
220 | (defclass param-boolean (param) |
221 | ((default-value |
222 | :allocation :alien |
fa30048e |
223 | :reader param-default-value |
df0b4e7d |
224 | :type boolean)) |
dfa4f314 |
225 | (:metaclass param-spec-class) |
226 | (:gtype "GParamBoolean")) |
df0b4e7d |
227 | |
228 | (defclass param-int (param) |
229 | ((minimum |
230 | :allocation :alien |
fa30048e |
231 | :reader param-minimum |
df0b4e7d |
232 | :type int) |
233 | (maximum |
234 | :allocation :alien |
fa30048e |
235 | :reader param-maximum |
df0b4e7d |
236 | :type int) |
237 | (default-value |
238 | :allocation :alien |
fa30048e |
239 | :reader param-default-value |
df0b4e7d |
240 | :type int)) |
dfa4f314 |
241 | (:metaclass param-spec-class) |
242 | (:gtype "GParamInt")) |
df0b4e7d |
243 | |
244 | (defclass param-unsigned-int (param) |
245 | ((minimum |
246 | :allocation :alien |
fa30048e |
247 | :reader param-minimum |
df0b4e7d |
248 | :type unsigned-int) |
249 | (maximum |
250 | :allocation :alien |
fa30048e |
251 | :reader param-maximum |
df0b4e7d |
252 | :type unsigned-int) |
253 | (default-value |
254 | :allocation :alien |
fa30048e |
255 | :reader param-default-value |
df0b4e7d |
256 | :type unsigned-int)) |
9adccb27 |
257 | (:metaclass param-spec-class) |
dfa4f314 |
258 | (:gtype "GParamUInt")) |
df0b4e7d |
259 | |
260 | (defclass param-long (param) |
261 | ((minimum |
262 | :allocation :alien |
fa30048e |
263 | :reader param-minimum |
df0b4e7d |
264 | :type long) |
265 | (maximum |
266 | :allocation :alien |
fa30048e |
267 | :reader param-maximum |
df0b4e7d |
268 | :type long) |
269 | (default-value |
270 | :allocation :alien |
fa30048e |
271 | :reader param-default-value |
df0b4e7d |
272 | :type long)) |
dfa4f314 |
273 | (:metaclass param-spec-class) |
274 | (:gtype "GParam")) |
df0b4e7d |
275 | |
276 | (defclass param-unsigned-long (param) |
277 | ((minimum |
278 | :allocation :alien |
fa30048e |
279 | :reader param-minimum |
df0b4e7d |
280 | :type unsigned-long) |
281 | (maximum |
282 | :allocation :alien |
fa30048e |
283 | :reader param-maximum |
df0b4e7d |
284 | :type unsigned-long) |
285 | (default-value |
286 | :allocation :alien |
fa30048e |
287 | :reader param-default-value |
df0b4e7d |
288 | :type unsigned-long)) |
9adccb27 |
289 | (:metaclass param-spec-class) |
dfa4f314 |
290 | (:gtype "GParamULong")) |
df0b4e7d |
291 | |
292 | (defclass param-unichar (param) |
293 | () |
dfa4f314 |
294 | (:metaclass param-spec-class) |
295 | (:gtype "GParamUnichar")) |
df0b4e7d |
296 | |
297 | (defclass param-enum (param) |
298 | ((class |
299 | :allocation :alien |
300 | :reader param-enum-class |
301 | :type pointer) |
302 | (default-value |
303 | :allocation :alien |
fa30048e |
304 | :reader param-default-value |
df0b4e7d |
305 | :type long)) |
dfa4f314 |
306 | (:metaclass param-spec-class) |
307 | (:gtype "GParamEnum")) |
df0b4e7d |
308 | |
309 | (defclass param-flags (param) |
310 | ((class |
311 | :allocation :alien |
312 | :reader param-flags-class |
313 | :type pointer) |
314 | (default-value |
315 | :allocation :alien |
fa30048e |
316 | :reader param-default-value |
df0b4e7d |
317 | :type long)) |
dfa4f314 |
318 | (:metaclass param-spec-class) |
319 | (:gtype "GParamFlags")) |
df0b4e7d |
320 | |
321 | (defclass param-single-float (param) |
322 | ((minimum |
323 | :allocation :alien |
fa30048e |
324 | :reader param-minimum |
df0b4e7d |
325 | :type single-float) |
326 | (maximum |
327 | :allocation :alien |
fa30048e |
328 | :reader param-maximum |
df0b4e7d |
329 | :type single-float) |
330 | (default-value |
331 | :allocation :alien |
fa30048e |
332 | :reader param-default-value |
df0b4e7d |
333 | :type single-float) |
334 | (epsilon |
335 | :allocation :alien |
fa30048e |
336 | :reader param-float-epsilon |
df0b4e7d |
337 | :type single-float)) |
9adccb27 |
338 | (:metaclass param-spec-class) |
dfa4f314 |
339 | (:gtype "GParamFloat")) |
df0b4e7d |
340 | |
341 | (defclass param-double-float (param) |
342 | ((minimum |
343 | :allocation :alien |
fa30048e |
344 | :reader param-minimum |
df0b4e7d |
345 | :type double-float) |
346 | (maximum |
347 | :allocation :alien |
fa30048e |
348 | :reader param-maximum |
df0b4e7d |
349 | :type double-float) |
350 | (default-value |
351 | :allocation :alien |
fa30048e |
352 | :reader param-default-value |
df0b4e7d |
353 | :type double-float) |
354 | (epsilon |
355 | :allocation :alien |
fa30048e |
356 | :reader param-float-epsilon |
df0b4e7d |
357 | :type double-float)) |
9adccb27 |
358 | (:metaclass param-spec-class) |
dfa4f314 |
359 | (:gtype "GParamDouble")) |
df0b4e7d |
360 | |
361 | (defclass param-string (param) |
362 | ((default-value |
363 | :allocation :alien |
fa30048e |
364 | :reader param-default-value |
df0b4e7d |
365 | :type string)) |
dfa4f314 |
366 | (:metaclass param-spec-class) |
367 | (:gtype "GParamString")) |
df0b4e7d |
368 | |
369 | (defclass param-param (param) |
370 | () |
dfa4f314 |
371 | (:metaclass param-spec-class) |
372 | (:gtype "GParamParam")) |
df0b4e7d |
373 | |
374 | (defclass param-boxed (param) |
375 | () |
dfa4f314 |
376 | (:metaclass param-spec-class) |
377 | (:gtype "GParamBoxed")) |
df0b4e7d |
378 | |
379 | (defclass param-pointer (param) |
380 | () |
dfa4f314 |
381 | (:metaclass param-spec-class) |
382 | (:gtype "GParamPointer")) |
df0b4e7d |
383 | |
384 | (defclass param-value-array (param) |
385 | ((element-spec |
386 | :allocation :alien |
387 | :reader param-value-array-element-spec |
388 | :type param) |
389 | (length |
390 | :allocation :alien |
391 | :reader param-value-array-length |
392 | :type unsigned-int)) |
dfa4f314 |
393 | (:metaclass param-spec-class) |
394 | (:gtype "GParamValueArray")) |
df0b4e7d |
395 | |
396 | (defclass param-object (param) |
397 | () |
dfa4f314 |
398 | (:metaclass param-spec-class) |
399 | (:gtype "GParamObject")) |
400 | |
401 | (defclass param-overrride (param) |
402 | () |
403 | (:metaclass param-spec-class) |
404 | (:gtype "GParamOverride")) |