55212af1 |
1 | ;; Common Lisp bindings for GTK+ v2.x |
20b02512 |
2 | ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net> |
2ca6ee06 |
3 | ;; |
55212af1 |
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: |
2ca6ee06 |
11 | ;; |
55212af1 |
12 | ;; The above copyright notice and this permission notice shall be |
13 | ;; included in all copies or substantial portions of the Software. |
2ca6ee06 |
14 | ;; |
55212af1 |
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. |
2ca6ee06 |
22 | |
efc1c549 |
23 | ;; $Id: gparam.lisp,v 1.24 2007/06/01 06:18:59 espen Exp $ |
2ca6ee06 |
24 | |
25 | (in-package "GLIB") |
26 | |
27 | (deftype gvalue () 'pointer) |
28 | |
dcb31db6 |
29 | (register-type 'gvalue '|g_value_get_type|) |
d84a536c |
30 | |
935a783c |
31 | (eval-when (:compile-toplevel :load-toplevel :execute) |
32 | (defbinding (size-of-gvalue "size_of_gvalue") () unsigned-int)) |
33 | |
20b02512 |
34 | (defconstant +gvalue-size+ (size-of-gvalue)) |
933a3dfb |
35 | (defconstant +gvalue-value-offset+ |
efc1c549 |
36 | (max (size-of 'type-number) (type-alignment '(unsigned-byte 64)))) |
2ca6ee06 |
37 | |
6baf860c |
38 | (defbinding (%gvalue-init "g_value_init") () nil |
935a783c |
39 | (value gvalue) |
2ca6ee06 |
40 | (type type-number)) |
41 | |
83f129a7 |
42 | (defbinding (gvalue-unset "g_value_unset") () nil |
43 | (value gvalue)) |
44 | |
6baf860c |
45 | (defun gvalue-init (gvalue type &optional (value nil value-p)) |
46 | (%gvalue-init gvalue (find-type-number type)) |
47 | (when value-p |
48 | (funcall (writer-function type) value gvalue +gvalue-value-offset+))) |
83f129a7 |
49 | |
13c1e78f |
50 | (defun gvalue-new (&optional type (value nil value-p)) |
2ca6ee06 |
51 | (let ((gvalue (allocate-memory +gvalue-size+))) |
13c1e78f |
52 | (cond |
53 | (value-p (gvalue-init gvalue type value)) |
54 | (type (gvalue-init gvalue type))) |
2ca6ee06 |
55 | gvalue)) |
56 | |
6baf860c |
57 | (defun gvalue-free (gvalue &optional (unset-p t)) |
2ca6ee06 |
58 | (unless (null-pointer-p gvalue) |
83f129a7 |
59 | (when unset-p |
60 | (gvalue-unset gvalue)) |
2ca6ee06 |
61 | (deallocate-memory gvalue))) |
62 | |
63 | (defun gvalue-type (gvalue) |
111ae625 |
64 | ;; We need to search for the for the most specific known type |
65 | ;; because internal types, unknown to Lisp, may be passed in GValues |
66 | (labels ((find-most-specific-known-type (type) |
67 | (or |
68 | (type-from-number type) |
69 | (let ((parent (type-parent type))) |
70 | (unless (zerop parent) |
71 | (find-most-specific-known-type parent)))))) |
72 | (or |
73 | (find-most-specific-known-type (ref-type-number gvalue)) |
74 | ;; This will signal an error if the type hierarchy is unknown |
75 | (type-from-number (ref-type-number gvalue) t)))) |
2ca6ee06 |
76 | |
20b02512 |
77 | (defun gvalue-get (gvalue) |
6baf860c |
78 | (funcall (reader-function (gvalue-type gvalue)) |
20b02512 |
79 | gvalue +gvalue-value-offset+)) |
80 | |
81 | (defun gvalue-peek (gvalue) |
82 | (funcall (reader-function (gvalue-type gvalue) :ref :peek) |
83 | gvalue +gvalue-value-offset+)) |
84 | |
85 | (defun gvalue-take (gvalue) |
86 | (funcall (reader-function (gvalue-type gvalue) :ref :get) |
87 | gvalue +gvalue-value-offset+)) |
2ca6ee06 |
88 | |
89 | (defun gvalue-set (gvalue value) |
6baf860c |
90 | (funcall (writer-function (gvalue-type gvalue)) |
2ca6ee06 |
91 | value gvalue +gvalue-value-offset+) |
92 | value) |
93 | |
d84a536c |
94 | (defbinding (gvalue-p "g_type_check_value") () boolean |
95 | (location pointer)) |
96 | |
87837a66 |
97 | (defmacro with-gvalue ((gvalue &optional type (value nil value-p)) &body body) |
20b02512 |
98 | `(with-memory (,gvalue +gvalue-size+) |
6bd80ff0 |
99 | ,(cond |
100 | ((and type value-p) `(gvalue-init ,gvalue ,type ,value)) |
101 | (type `(gvalue-init ,gvalue ,type))) |
102 | ,@body |
20b02512 |
103 | ,(unless value-p `(gvalue-take ,gvalue)))) |
42ff94e7 |
104 | |
935a783c |
105 | |
42ff94e7 |
106 | (deftype param-flag-type () |
107 | '(flags |
aebc385c |
108 | (:readable 1) |
109 | (:writable 2) |
110 | (:construct 4) |
111 | (:construct-only 8) |
112 | (:lax-validation 16) |
113 | (:private 32))) |
42ff94e7 |
114 | |
6baf860c |
115 | (eval-when (:compile-toplevel :load-toplevel :execute) |
116 | (defclass param-spec-class (ginstance-class) |
117 | ()) |
118 | |
20b02512 |
119 | (defmethod shared-initialize ((class param-spec-class) names &rest initargs) |
120 | (declare (ignore names initargs)) |
121 | (call-next-method) |
122 | (unless (slot-boundp class 'ref) |
123 | (setf (slot-value class 'ref) '%param-spec-ref)) |
124 | (unless (slot-boundp class 'unref) |
125 | (setf (slot-value class 'unref) '%param-spec-unref))) |
126 | |
3d36c5d6 |
127 | (defmethod validate-superclass ((class param-spec-class) (super standard-class)) |
6baf860c |
128 | t ;(subtypep (class-name super) 'param) |
129 | )) |
130 | |
131 | |
132 | (defbinding %param-spec-ref () pointer |
133 | (location pointer)) |
134 | |
135 | (defbinding %param-spec-unref () nil |
136 | (location pointer)) |
137 | |
6baf860c |
138 | |
935a783c |
139 | ;; TODO: rename to param-spec |
6baf860c |
140 | (defclass param (ginstance) |
141 | ((name |
142 | :allocation :alien |
143 | :reader param-name |
144 | :type string) |
145 | (flags |
146 | :allocation :alien |
147 | :reader param-flags |
148 | :type param-flag-type) |
149 | (value-type |
150 | :allocation :alien |
151 | :reader param-value-type |
152 | :type type-number) |
153 | (owner-type |
154 | :allocation :alien |
155 | :reader param-owner-type |
156 | :type type-number) |
157 | (nickname |
158 | :allocation :virtual |
159 | :getter "g_param_spec_get_nick" |
160 | :reader param-nickname |
508d13a7 |
161 | :type (copy-of string)) |
6baf860c |
162 | (documentation |
163 | :allocation :virtual |
164 | :getter "g_param_spec_get_blurb" |
165 | :reader param-documentation |
508d13a7 |
166 | :type (copy-of string))) |
dcb31db6 |
167 | (:metaclass param-spec-class) |
168 | (:gtype "GParam")) |
42ff94e7 |
169 | |
170 | |
171 | (defclass param-char (param) |
172 | ((minimum |
173 | :allocation :alien |
20b02512 |
174 | :reader param-minimum |
42ff94e7 |
175 | :type char) |
176 | (maximum |
177 | :allocation :alien |
20b02512 |
178 | :reader param-maximum |
42ff94e7 |
179 | :type char) |
180 | (default-value |
181 | :allocation :alien |
20b02512 |
182 | :reader param-default-value |
42ff94e7 |
183 | :type char)) |
dcb31db6 |
184 | (:metaclass param-spec-class) |
185 | (:gtype "GParamChar")) |
42ff94e7 |
186 | |
187 | (defclass param-unsigned-char (param) |
188 | ( |
189 | ; (minimum |
190 | ; :allocation :alien |
191 | ; :reader param-unsigned-char-minimum |
192 | ; :type unsigned-char) |
193 | ; (maximum |
194 | ; :allocation :alien |
195 | ; :reader param-unsigned-char-maximum |
196 | ; :type unsigned-char) |
197 | ; (default-value |
198 | ; :allocation :alien |
199 | ; :reader param-unsigned-char-default-value |
200 | ; :type unsigned-char) |
201 | ) |
6baf860c |
202 | (:metaclass param-spec-class) |
dcb31db6 |
203 | (:gtype "GParamUChar")) |
42ff94e7 |
204 | |
205 | (defclass param-boolean (param) |
206 | ((default-value |
207 | :allocation :alien |
20b02512 |
208 | :reader param-default-value |
42ff94e7 |
209 | :type boolean)) |
dcb31db6 |
210 | (:metaclass param-spec-class) |
211 | (:gtype "GParamBoolean")) |
42ff94e7 |
212 | |
213 | (defclass param-int (param) |
214 | ((minimum |
215 | :allocation :alien |
20b02512 |
216 | :reader param-minimum |
42ff94e7 |
217 | :type int) |
218 | (maximum |
219 | :allocation :alien |
20b02512 |
220 | :reader param-maximum |
42ff94e7 |
221 | :type int) |
222 | (default-value |
223 | :allocation :alien |
20b02512 |
224 | :reader param-default-value |
42ff94e7 |
225 | :type int)) |
dcb31db6 |
226 | (:metaclass param-spec-class) |
227 | (:gtype "GParamInt")) |
42ff94e7 |
228 | |
229 | (defclass param-unsigned-int (param) |
230 | ((minimum |
231 | :allocation :alien |
20b02512 |
232 | :reader param-minimum |
42ff94e7 |
233 | :type unsigned-int) |
234 | (maximum |
235 | :allocation :alien |
20b02512 |
236 | :reader param-maximum |
42ff94e7 |
237 | :type unsigned-int) |
238 | (default-value |
239 | :allocation :alien |
20b02512 |
240 | :reader param-default-value |
42ff94e7 |
241 | :type unsigned-int)) |
6baf860c |
242 | (:metaclass param-spec-class) |
dcb31db6 |
243 | (:gtype "GParamUInt")) |
42ff94e7 |
244 | |
245 | (defclass param-long (param) |
246 | ((minimum |
247 | :allocation :alien |
20b02512 |
248 | :reader param-minimum |
42ff94e7 |
249 | :type long) |
250 | (maximum |
251 | :allocation :alien |
20b02512 |
252 | :reader param-maximum |
42ff94e7 |
253 | :type long) |
254 | (default-value |
255 | :allocation :alien |
20b02512 |
256 | :reader param-default-value |
42ff94e7 |
257 | :type long)) |
dcb31db6 |
258 | (:metaclass param-spec-class) |
259 | (:gtype "GParam")) |
42ff94e7 |
260 | |
261 | (defclass param-unsigned-long (param) |
262 | ((minimum |
263 | :allocation :alien |
20b02512 |
264 | :reader param-minimum |
42ff94e7 |
265 | :type unsigned-long) |
266 | (maximum |
267 | :allocation :alien |
20b02512 |
268 | :reader param-maximum |
42ff94e7 |
269 | :type unsigned-long) |
270 | (default-value |
271 | :allocation :alien |
20b02512 |
272 | :reader param-default-value |
42ff94e7 |
273 | :type unsigned-long)) |
6baf860c |
274 | (:metaclass param-spec-class) |
dcb31db6 |
275 | (:gtype "GParamULong")) |
42ff94e7 |
276 | |
277 | (defclass param-unichar (param) |
278 | () |
dcb31db6 |
279 | (:metaclass param-spec-class) |
280 | (:gtype "GParamUnichar")) |
42ff94e7 |
281 | |
282 | (defclass param-enum (param) |
283 | ((class |
284 | :allocation :alien |
285 | :reader param-enum-class |
286 | :type pointer) |
287 | (default-value |
288 | :allocation :alien |
20b02512 |
289 | :reader param-default-value |
42ff94e7 |
290 | :type long)) |
dcb31db6 |
291 | (:metaclass param-spec-class) |
292 | (:gtype "GParamEnum")) |
42ff94e7 |
293 | |
294 | (defclass param-flags (param) |
295 | ((class |
296 | :allocation :alien |
297 | :reader param-flags-class |
298 | :type pointer) |
299 | (default-value |
300 | :allocation :alien |
20b02512 |
301 | :reader param-default-value |
42ff94e7 |
302 | :type long)) |
dcb31db6 |
303 | (:metaclass param-spec-class) |
304 | (:gtype "GParamFlags")) |
42ff94e7 |
305 | |
306 | (defclass param-single-float (param) |
307 | ((minimum |
308 | :allocation :alien |
20b02512 |
309 | :reader param-minimum |
42ff94e7 |
310 | :type single-float) |
311 | (maximum |
312 | :allocation :alien |
20b02512 |
313 | :reader param-maximum |
42ff94e7 |
314 | :type single-float) |
315 | (default-value |
316 | :allocation :alien |
20b02512 |
317 | :reader param-default-value |
42ff94e7 |
318 | :type single-float) |
319 | (epsilon |
320 | :allocation :alien |
20b02512 |
321 | :reader param-float-epsilon |
42ff94e7 |
322 | :type single-float)) |
6baf860c |
323 | (:metaclass param-spec-class) |
dcb31db6 |
324 | (:gtype "GParamFloat")) |
42ff94e7 |
325 | |
326 | (defclass param-double-float (param) |
327 | ((minimum |
328 | :allocation :alien |
20b02512 |
329 | :reader param-minimum |
42ff94e7 |
330 | :type double-float) |
331 | (maximum |
332 | :allocation :alien |
20b02512 |
333 | :reader param-maximum |
42ff94e7 |
334 | :type double-float) |
335 | (default-value |
336 | :allocation :alien |
20b02512 |
337 | :reader param-default-value |
42ff94e7 |
338 | :type double-float) |
339 | (epsilon |
340 | :allocation :alien |
20b02512 |
341 | :reader param-float-epsilon |
42ff94e7 |
342 | :type double-float)) |
6baf860c |
343 | (:metaclass param-spec-class) |
dcb31db6 |
344 | (:gtype "GParamDouble")) |
42ff94e7 |
345 | |
346 | (defclass param-string (param) |
347 | ((default-value |
348 | :allocation :alien |
20b02512 |
349 | :reader param-default-value |
42ff94e7 |
350 | :type string)) |
dcb31db6 |
351 | (:metaclass param-spec-class) |
352 | (:gtype "GParamString")) |
42ff94e7 |
353 | |
354 | (defclass param-param (param) |
355 | () |
dcb31db6 |
356 | (:metaclass param-spec-class) |
357 | (:gtype "GParamParam")) |
42ff94e7 |
358 | |
359 | (defclass param-boxed (param) |
360 | () |
dcb31db6 |
361 | (:metaclass param-spec-class) |
362 | (:gtype "GParamBoxed")) |
42ff94e7 |
363 | |
364 | (defclass param-pointer (param) |
365 | () |
dcb31db6 |
366 | (:metaclass param-spec-class) |
367 | (:gtype "GParamPointer")) |
42ff94e7 |
368 | |
369 | (defclass param-value-array (param) |
370 | ((element-spec |
371 | :allocation :alien |
372 | :reader param-value-array-element-spec |
373 | :type param) |
374 | (length |
375 | :allocation :alien |
376 | :reader param-value-array-length |
377 | :type unsigned-int)) |
dcb31db6 |
378 | (:metaclass param-spec-class) |
379 | (:gtype "GParamValueArray")) |
42ff94e7 |
380 | |
381 | (defclass param-object (param) |
382 | () |
dcb31db6 |
383 | (:metaclass param-spec-class) |
384 | (:gtype "GParamObject")) |
385 | |
386 | (defclass param-overrride (param) |
387 | () |
388 | (:metaclass param-spec-class) |
389 | (:gtype "GParamOverride")) |