112ac1d3 |
1 | ;; Common Lisp bindings for GTK+ v2.x |
2 | ;; Copyright 2000-2005 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 | |
832df308 |
23 | ;; $Id: gparam.lisp,v 1.18 2006-02-06 11:56:22 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 | |
9adccb27 |
34 | ;(defconstant +gvalue-size+ (+ (size-of 'type-number) (* 2 (size-of 'double-float)))) |
4d83a8a6 |
35 | (defconstant +gvalue-size+ #.(size-of-gvalue)) |
36 | |
387230e8 |
37 | (defconstant +gvalue-value-offset+ (size-of 'type-number)) |
38 | |
9adccb27 |
39 | (defbinding (%gvalue-init "g_value_init") () nil |
4d83a8a6 |
40 | (value gvalue) |
387230e8 |
41 | (type type-number)) |
42 | |
68093e26 |
43 | (defbinding (gvalue-unset "g_value_unset") () nil |
44 | (value gvalue)) |
45 | |
9adccb27 |
46 | (defun gvalue-init (gvalue type &optional (value nil value-p)) |
47 | (%gvalue-init gvalue (find-type-number type)) |
48 | (when value-p |
49 | (funcall (writer-function type) value gvalue +gvalue-value-offset+))) |
68093e26 |
50 | |
3c44ba6c |
51 | (defun gvalue-new (&optional type (value nil value-p)) |
387230e8 |
52 | (let ((gvalue (allocate-memory +gvalue-size+))) |
3c44ba6c |
53 | (cond |
54 | (value-p (gvalue-init gvalue type value)) |
55 | (type (gvalue-init gvalue type))) |
387230e8 |
56 | gvalue)) |
57 | |
9adccb27 |
58 | (defun gvalue-free (gvalue &optional (unset-p t)) |
387230e8 |
59 | (unless (null-pointer-p gvalue) |
68093e26 |
60 | (when unset-p |
61 | (gvalue-unset gvalue)) |
387230e8 |
62 | (deallocate-memory gvalue))) |
63 | |
64 | (defun gvalue-type (gvalue) |
73572c12 |
65 | (type-from-number (sap-ref-32 gvalue 0))) |
387230e8 |
66 | |
832df308 |
67 | (defun gvalue-get (gvalue) |
9adccb27 |
68 | (funcall (reader-function (gvalue-type gvalue)) |
832df308 |
69 | gvalue +gvalue-value-offset+)) |
70 | |
71 | (defun gvalue-weak-get (gvalue) |
72 | (funcall (weak-reader-function (gvalue-type gvalue)) |
387230e8 |
73 | gvalue +gvalue-value-offset+)) |
74 | |
75 | (defun gvalue-set (gvalue value) |
9adccb27 |
76 | (funcall (writer-function (gvalue-type gvalue)) |
387230e8 |
77 | value gvalue +gvalue-value-offset+) |
78 | value) |
79 | |
8532ba0a |
80 | (defbinding (gvalue-p "g_type_check_value") () boolean |
81 | (location pointer)) |
82 | |
a54e8339 |
83 | (defmacro with-gvalue ((gvalue &optional type (value nil value-p)) &body body) |
84 | `(let ((,gvalue ,(cond |
85 | ((and type value-p) `(gvalue-new ,type ,value)) |
86 | (type `(gvalue-new ,type)) |
87 | (`(gvalue-new))))) |
6243c15e |
88 | (unwind-protect |
89 | (progn |
90 | ,@body |
a54e8339 |
91 | ,(unless value-p `(gvalue-get ,gvalue))) |
6243c15e |
92 | (gvalue-free ,gvalue)))) |
df0b4e7d |
93 | |
4d83a8a6 |
94 | |
df0b4e7d |
95 | (deftype param-flag-type () |
96 | '(flags |
4eb73e10 |
97 | (:readable 1) |
98 | (:writable 2) |
99 | (:construct 4) |
100 | (:construct-only 8) |
101 | (:lax-validation 16) |
102 | (:private 32))) |
df0b4e7d |
103 | |
9adccb27 |
104 | (eval-when (:compile-toplevel :load-toplevel :execute) |
105 | (defclass param-spec-class (ginstance-class) |
106 | ()) |
107 | |
73572c12 |
108 | (defmethod validate-superclass ((class param-spec-class) (super standard-class)) |
9adccb27 |
109 | t ;(subtypep (class-name super) 'param) |
110 | )) |
111 | |
112 | |
113 | (defbinding %param-spec-ref () pointer |
114 | (location pointer)) |
115 | |
116 | (defbinding %param-spec-unref () nil |
117 | (location pointer)) |
118 | |
119 | (defmethod reference-foreign ((class param-spec-class) location) |
120 | (declare (ignore class)) |
121 | (%param-spec-ref location)) |
122 | |
123 | (defmethod unreference-foreign ((class param-spec-class) location) |
124 | (declare (ignore class)) |
125 | (%param-spec-unref location)) |
126 | |
127 | |
128 | |
4d83a8a6 |
129 | ;; TODO: rename to param-spec |
9adccb27 |
130 | (defclass param (ginstance) |
131 | ((name |
132 | :allocation :alien |
133 | :reader param-name |
134 | :type string) |
135 | (flags |
136 | :allocation :alien |
137 | :reader param-flags |
138 | :type param-flag-type) |
139 | (value-type |
140 | :allocation :alien |
141 | :reader param-value-type |
142 | :type type-number) |
143 | (owner-type |
144 | :allocation :alien |
145 | :reader param-owner-type |
146 | :type type-number) |
147 | (nickname |
148 | :allocation :virtual |
149 | :getter "g_param_spec_get_nick" |
150 | :reader param-nickname |
9ca5565a |
151 | :type (copy-of string)) |
9adccb27 |
152 | (documentation |
153 | :allocation :virtual |
154 | :getter "g_param_spec_get_blurb" |
155 | :reader param-documentation |
9ca5565a |
156 | :type (copy-of string))) |
dfa4f314 |
157 | (:metaclass param-spec-class) |
158 | (:gtype "GParam")) |
df0b4e7d |
159 | |
160 | |
161 | (defclass param-char (param) |
162 | ((minimum |
163 | :allocation :alien |
164 | :reader param-char-minimum |
165 | :type char) |
166 | (maximum |
167 | :allocation :alien |
168 | :reader param-char-maximum |
169 | :type char) |
170 | (default-value |
171 | :allocation :alien |
172 | :reader param-char-default-value |
173 | :type char)) |
dfa4f314 |
174 | (:metaclass param-spec-class) |
175 | (:gtype "GParamChar")) |
df0b4e7d |
176 | |
177 | (defclass param-unsigned-char (param) |
178 | ( |
179 | ; (minimum |
180 | ; :allocation :alien |
181 | ; :reader param-unsigned-char-minimum |
182 | ; :type unsigned-char) |
183 | ; (maximum |
184 | ; :allocation :alien |
185 | ; :reader param-unsigned-char-maximum |
186 | ; :type unsigned-char) |
187 | ; (default-value |
188 | ; :allocation :alien |
189 | ; :reader param-unsigned-char-default-value |
190 | ; :type unsigned-char) |
191 | ) |
9adccb27 |
192 | (:metaclass param-spec-class) |
dfa4f314 |
193 | (:gtype "GParamUChar")) |
df0b4e7d |
194 | |
195 | (defclass param-boolean (param) |
196 | ((default-value |
197 | :allocation :alien |
198 | :reader param-boolean-default-value |
199 | :type boolean)) |
dfa4f314 |
200 | (:metaclass param-spec-class) |
201 | (:gtype "GParamBoolean")) |
df0b4e7d |
202 | |
203 | (defclass param-int (param) |
204 | ((minimum |
205 | :allocation :alien |
206 | :reader param-int-minimum |
207 | :type int) |
208 | (maximum |
209 | :allocation :alien |
210 | :reader param-int-maximum |
211 | :type int) |
212 | (default-value |
213 | :allocation :alien |
214 | :reader param-int-default-value |
215 | :type int)) |
dfa4f314 |
216 | (:metaclass param-spec-class) |
217 | (:gtype "GParamInt")) |
df0b4e7d |
218 | |
219 | (defclass param-unsigned-int (param) |
220 | ((minimum |
221 | :allocation :alien |
222 | :reader param-unsigned-int-minimum |
223 | :type unsigned-int) |
224 | (maximum |
225 | :allocation :alien |
226 | :reader param-unsigned-int-maximum |
227 | :type unsigned-int) |
228 | (default-value |
229 | :allocation :alien |
230 | :reader param-unsigned-int-default-value |
231 | :type unsigned-int)) |
9adccb27 |
232 | (:metaclass param-spec-class) |
dfa4f314 |
233 | (:gtype "GParamUInt")) |
df0b4e7d |
234 | |
235 | (defclass param-long (param) |
236 | ((minimum |
237 | :allocation :alien |
238 | :reader param-long-minimum |
239 | :type long) |
240 | (maximum |
241 | :allocation :alien |
242 | :reader param-long-maximum |
243 | :type long) |
244 | (default-value |
245 | :allocation :alien |
246 | :reader param-long-default-value |
247 | :type long)) |
dfa4f314 |
248 | (:metaclass param-spec-class) |
249 | (:gtype "GParam")) |
df0b4e7d |
250 | |
251 | (defclass param-unsigned-long (param) |
252 | ((minimum |
253 | :allocation :alien |
254 | :reader param-unsigned-long-minimum |
255 | :type unsigned-long) |
256 | (maximum |
257 | :allocation :alien |
258 | :reader param-unsigned-long-maximum |
259 | :type unsigned-long) |
260 | (default-value |
261 | :allocation :alien |
262 | :reader param-unsigned-long-default-value |
263 | :type unsigned-long)) |
9adccb27 |
264 | (:metaclass param-spec-class) |
dfa4f314 |
265 | (:gtype "GParamULong")) |
df0b4e7d |
266 | |
267 | (defclass param-unichar (param) |
268 | () |
dfa4f314 |
269 | (:metaclass param-spec-class) |
270 | (:gtype "GParamUnichar")) |
df0b4e7d |
271 | |
272 | (defclass param-enum (param) |
273 | ((class |
274 | :allocation :alien |
275 | :reader param-enum-class |
276 | :type pointer) |
277 | (default-value |
278 | :allocation :alien |
279 | :reader param-enum-default-value |
280 | :type long)) |
dfa4f314 |
281 | (:metaclass param-spec-class) |
282 | (:gtype "GParamEnum")) |
df0b4e7d |
283 | |
284 | (defclass param-flags (param) |
285 | ((class |
286 | :allocation :alien |
287 | :reader param-flags-class |
288 | :type pointer) |
289 | (default-value |
290 | :allocation :alien |
291 | :reader param-flags-default-value |
292 | :type long)) |
dfa4f314 |
293 | (:metaclass param-spec-class) |
294 | (:gtype "GParamFlags")) |
df0b4e7d |
295 | |
296 | (defclass param-single-float (param) |
297 | ((minimum |
298 | :allocation :alien |
299 | :reader param-single-float-minimum |
300 | :type single-float) |
301 | (maximum |
302 | :allocation :alien |
303 | :reader param-single-float-maximum |
304 | :type single-float) |
305 | (default-value |
306 | :allocation :alien |
307 | :reader param-single-float-default-value |
308 | :type single-float) |
309 | (epsilon |
310 | :allocation :alien |
311 | :reader param-single-float-epsilon |
312 | :type single-float)) |
9adccb27 |
313 | (:metaclass param-spec-class) |
dfa4f314 |
314 | (:gtype "GParamFloat")) |
df0b4e7d |
315 | |
316 | (defclass param-double-float (param) |
317 | ((minimum |
318 | :allocation :alien |
319 | :reader param-double-float-minimum |
320 | :type double-float) |
321 | (maximum |
322 | :allocation :alien |
323 | :reader param-double-float-maximum |
324 | :type double-float) |
325 | (default-value |
326 | :allocation :alien |
327 | :reader param-double-float-default-value |
328 | :type double-float) |
329 | (epsilon |
330 | :allocation :alien |
331 | :reader param-double-float-epsilon |
332 | :type double-float)) |
9adccb27 |
333 | (:metaclass param-spec-class) |
dfa4f314 |
334 | (:gtype "GParamDouble")) |
df0b4e7d |
335 | |
336 | (defclass param-string (param) |
337 | ((default-value |
338 | :allocation :alien |
339 | :reader param-string-default-value |
340 | :type string)) |
dfa4f314 |
341 | (:metaclass param-spec-class) |
342 | (:gtype "GParamString")) |
df0b4e7d |
343 | |
344 | (defclass param-param (param) |
345 | () |
dfa4f314 |
346 | (:metaclass param-spec-class) |
347 | (:gtype "GParamParam")) |
df0b4e7d |
348 | |
349 | (defclass param-boxed (param) |
350 | () |
dfa4f314 |
351 | (:metaclass param-spec-class) |
352 | (:gtype "GParamBoxed")) |
df0b4e7d |
353 | |
354 | (defclass param-pointer (param) |
355 | () |
dfa4f314 |
356 | (:metaclass param-spec-class) |
357 | (:gtype "GParamPointer")) |
df0b4e7d |
358 | |
359 | (defclass param-value-array (param) |
360 | ((element-spec |
361 | :allocation :alien |
362 | :reader param-value-array-element-spec |
363 | :type param) |
364 | (length |
365 | :allocation :alien |
366 | :reader param-value-array-length |
367 | :type unsigned-int)) |
dfa4f314 |
368 | (:metaclass param-spec-class) |
369 | (:gtype "GParamValueArray")) |
df0b4e7d |
370 | |
371 | (defclass param-object (param) |
372 | () |
dfa4f314 |
373 | (:metaclass param-spec-class) |
374 | (:gtype "GParamObject")) |
375 | |
376 | (defclass param-overrride (param) |
377 | () |
378 | (:metaclass param-spec-class) |
379 | (:gtype "GParamOverride")) |