2ca6ee06 |
1 | ;; Common Lisp bindings for GTK+ v2.0 |
dcb31db6 |
2 | ;; Copyright (C) 2000-2005 Espen S. Johnsen <espen@users.sf.net> |
2ca6ee06 |
3 | ;; |
4 | ;; This library is free software; you can redistribute it and/or |
5 | ;; modify it under the terms of the GNU Lesser General Public |
6 | ;; License as published by the Free Software Foundation; either |
7 | ;; version 2 of the License, or (at your option) any later version. |
8 | ;; |
9 | ;; This library is distributed in the hope that it will be useful, |
10 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;; Lesser General Public License for more details. |
13 | ;; |
14 | ;; You should have received a copy of the GNU Lesser General Public |
15 | ;; License along with this library; if not, write to the Free Software |
16 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
17 | |
dcb31db6 |
18 | ;; $Id: gparam.lisp,v 1.16 2005/03/06 17:26:23 espen Exp $ |
2ca6ee06 |
19 | |
20 | (in-package "GLIB") |
21 | |
22 | (deftype gvalue () 'pointer) |
23 | |
dcb31db6 |
24 | (register-type 'gvalue '|g_value_get_type|) |
d84a536c |
25 | |
935a783c |
26 | (eval-when (:compile-toplevel :load-toplevel :execute) |
27 | (defbinding (size-of-gvalue "size_of_gvalue") () unsigned-int)) |
28 | |
6baf860c |
29 | ;(defconstant +gvalue-size+ (+ (size-of 'type-number) (* 2 (size-of 'double-float)))) |
935a783c |
30 | (defconstant +gvalue-size+ #.(size-of-gvalue)) |
31 | |
2ca6ee06 |
32 | (defconstant +gvalue-value-offset+ (size-of 'type-number)) |
33 | |
6baf860c |
34 | (defbinding (%gvalue-init "g_value_init") () nil |
935a783c |
35 | (value gvalue) |
2ca6ee06 |
36 | (type type-number)) |
37 | |
83f129a7 |
38 | (defbinding (gvalue-unset "g_value_unset") () nil |
39 | (value gvalue)) |
40 | |
6baf860c |
41 | (defun gvalue-init (gvalue type &optional (value nil value-p)) |
42 | (%gvalue-init gvalue (find-type-number type)) |
43 | (when value-p |
44 | (funcall (writer-function type) value gvalue +gvalue-value-offset+))) |
83f129a7 |
45 | |
13c1e78f |
46 | (defun gvalue-new (&optional type (value nil value-p)) |
2ca6ee06 |
47 | (let ((gvalue (allocate-memory +gvalue-size+))) |
13c1e78f |
48 | (cond |
49 | (value-p (gvalue-init gvalue type value)) |
50 | (type (gvalue-init gvalue type))) |
2ca6ee06 |
51 | gvalue)) |
52 | |
6baf860c |
53 | (defun gvalue-free (gvalue &optional (unset-p t)) |
2ca6ee06 |
54 | (unless (null-pointer-p gvalue) |
83f129a7 |
55 | (when unset-p |
56 | (gvalue-unset gvalue)) |
2ca6ee06 |
57 | (deallocate-memory gvalue))) |
58 | |
59 | (defun gvalue-type (gvalue) |
3d36c5d6 |
60 | (type-from-number (sap-ref-32 gvalue 0))) |
2ca6ee06 |
61 | |
62 | (defun gvalue-get (gvalue) |
6baf860c |
63 | (funcall (reader-function (gvalue-type gvalue)) |
2ca6ee06 |
64 | gvalue +gvalue-value-offset+)) |
65 | |
66 | (defun gvalue-set (gvalue value) |
6baf860c |
67 | (funcall (writer-function (gvalue-type gvalue)) |
2ca6ee06 |
68 | value gvalue +gvalue-value-offset+) |
69 | value) |
70 | |
d84a536c |
71 | (defbinding (gvalue-p "g_type_check_value") () boolean |
72 | (location pointer)) |
73 | |
87837a66 |
74 | (defmacro with-gvalue ((gvalue &optional type (value nil value-p)) &body body) |
75 | `(let ((,gvalue ,(cond |
76 | ((and type value-p) `(gvalue-new ,type ,value)) |
77 | (type `(gvalue-new ,type)) |
78 | (`(gvalue-new))))) |
7c6da969 |
79 | (unwind-protect |
80 | (progn |
81 | ,@body |
87837a66 |
82 | ,(unless value-p `(gvalue-get ,gvalue))) |
7c6da969 |
83 | (gvalue-free ,gvalue)))) |
42ff94e7 |
84 | |
935a783c |
85 | |
42ff94e7 |
86 | (deftype param-flag-type () |
87 | '(flags |
aebc385c |
88 | (:readable 1) |
89 | (:writable 2) |
90 | (:construct 4) |
91 | (:construct-only 8) |
92 | (:lax-validation 16) |
93 | (:private 32))) |
42ff94e7 |
94 | |
6baf860c |
95 | (eval-when (:compile-toplevel :load-toplevel :execute) |
96 | (defclass param-spec-class (ginstance-class) |
97 | ()) |
98 | |
3d36c5d6 |
99 | (defmethod validate-superclass ((class param-spec-class) (super standard-class)) |
6baf860c |
100 | t ;(subtypep (class-name super) 'param) |
101 | )) |
102 | |
103 | |
104 | (defbinding %param-spec-ref () pointer |
105 | (location pointer)) |
106 | |
107 | (defbinding %param-spec-unref () nil |
108 | (location pointer)) |
109 | |
110 | (defmethod reference-foreign ((class param-spec-class) location) |
111 | (declare (ignore class)) |
112 | (%param-spec-ref location)) |
113 | |
114 | (defmethod unreference-foreign ((class param-spec-class) location) |
115 | (declare (ignore class)) |
116 | (%param-spec-unref location)) |
117 | |
118 | |
119 | |
935a783c |
120 | ;; TODO: rename to param-spec |
6baf860c |
121 | (defclass param (ginstance) |
122 | ((name |
123 | :allocation :alien |
124 | :reader param-name |
125 | :type string) |
126 | (flags |
127 | :allocation :alien |
128 | :reader param-flags |
129 | :type param-flag-type) |
130 | (value-type |
131 | :allocation :alien |
132 | :reader param-value-type |
133 | :type type-number) |
134 | (owner-type |
135 | :allocation :alien |
136 | :reader param-owner-type |
137 | :type type-number) |
138 | (nickname |
139 | :allocation :virtual |
140 | :getter "g_param_spec_get_nick" |
141 | :reader param-nickname |
508d13a7 |
142 | :type (copy-of string)) |
6baf860c |
143 | (documentation |
144 | :allocation :virtual |
145 | :getter "g_param_spec_get_blurb" |
146 | :reader param-documentation |
508d13a7 |
147 | :type (copy-of string))) |
dcb31db6 |
148 | (:metaclass param-spec-class) |
149 | (:gtype "GParam")) |
42ff94e7 |
150 | |
151 | |
152 | (defclass param-char (param) |
153 | ((minimum |
154 | :allocation :alien |
155 | :reader param-char-minimum |
156 | :type char) |
157 | (maximum |
158 | :allocation :alien |
159 | :reader param-char-maximum |
160 | :type char) |
161 | (default-value |
162 | :allocation :alien |
163 | :reader param-char-default-value |
164 | :type char)) |
dcb31db6 |
165 | (:metaclass param-spec-class) |
166 | (:gtype "GParamChar")) |
42ff94e7 |
167 | |
168 | (defclass param-unsigned-char (param) |
169 | ( |
170 | ; (minimum |
171 | ; :allocation :alien |
172 | ; :reader param-unsigned-char-minimum |
173 | ; :type unsigned-char) |
174 | ; (maximum |
175 | ; :allocation :alien |
176 | ; :reader param-unsigned-char-maximum |
177 | ; :type unsigned-char) |
178 | ; (default-value |
179 | ; :allocation :alien |
180 | ; :reader param-unsigned-char-default-value |
181 | ; :type unsigned-char) |
182 | ) |
6baf860c |
183 | (:metaclass param-spec-class) |
dcb31db6 |
184 | (:gtype "GParamUChar")) |
42ff94e7 |
185 | |
186 | (defclass param-boolean (param) |
187 | ((default-value |
188 | :allocation :alien |
189 | :reader param-boolean-default-value |
190 | :type boolean)) |
dcb31db6 |
191 | (:metaclass param-spec-class) |
192 | (:gtype "GParamBoolean")) |
42ff94e7 |
193 | |
194 | (defclass param-int (param) |
195 | ((minimum |
196 | :allocation :alien |
197 | :reader param-int-minimum |
198 | :type int) |
199 | (maximum |
200 | :allocation :alien |
201 | :reader param-int-maximum |
202 | :type int) |
203 | (default-value |
204 | :allocation :alien |
205 | :reader param-int-default-value |
206 | :type int)) |
dcb31db6 |
207 | (:metaclass param-spec-class) |
208 | (:gtype "GParamInt")) |
42ff94e7 |
209 | |
210 | (defclass param-unsigned-int (param) |
211 | ((minimum |
212 | :allocation :alien |
213 | :reader param-unsigned-int-minimum |
214 | :type unsigned-int) |
215 | (maximum |
216 | :allocation :alien |
217 | :reader param-unsigned-int-maximum |
218 | :type unsigned-int) |
219 | (default-value |
220 | :allocation :alien |
221 | :reader param-unsigned-int-default-value |
222 | :type unsigned-int)) |
6baf860c |
223 | (:metaclass param-spec-class) |
dcb31db6 |
224 | (:gtype "GParamUInt")) |
42ff94e7 |
225 | |
226 | (defclass param-long (param) |
227 | ((minimum |
228 | :allocation :alien |
229 | :reader param-long-minimum |
230 | :type long) |
231 | (maximum |
232 | :allocation :alien |
233 | :reader param-long-maximum |
234 | :type long) |
235 | (default-value |
236 | :allocation :alien |
237 | :reader param-long-default-value |
238 | :type long)) |
dcb31db6 |
239 | (:metaclass param-spec-class) |
240 | (:gtype "GParam")) |
42ff94e7 |
241 | |
242 | (defclass param-unsigned-long (param) |
243 | ((minimum |
244 | :allocation :alien |
245 | :reader param-unsigned-long-minimum |
246 | :type unsigned-long) |
247 | (maximum |
248 | :allocation :alien |
249 | :reader param-unsigned-long-maximum |
250 | :type unsigned-long) |
251 | (default-value |
252 | :allocation :alien |
253 | :reader param-unsigned-long-default-value |
254 | :type unsigned-long)) |
6baf860c |
255 | (:metaclass param-spec-class) |
dcb31db6 |
256 | (:gtype "GParamULong")) |
42ff94e7 |
257 | |
258 | (defclass param-unichar (param) |
259 | () |
dcb31db6 |
260 | (:metaclass param-spec-class) |
261 | (:gtype "GParamUnichar")) |
42ff94e7 |
262 | |
263 | (defclass param-enum (param) |
264 | ((class |
265 | :allocation :alien |
266 | :reader param-enum-class |
267 | :type pointer) |
268 | (default-value |
269 | :allocation :alien |
270 | :reader param-enum-default-value |
271 | :type long)) |
dcb31db6 |
272 | (:metaclass param-spec-class) |
273 | (:gtype "GParamEnum")) |
42ff94e7 |
274 | |
275 | (defclass param-flags (param) |
276 | ((class |
277 | :allocation :alien |
278 | :reader param-flags-class |
279 | :type pointer) |
280 | (default-value |
281 | :allocation :alien |
282 | :reader param-flags-default-value |
283 | :type long)) |
dcb31db6 |
284 | (:metaclass param-spec-class) |
285 | (:gtype "GParamFlags")) |
42ff94e7 |
286 | |
287 | (defclass param-single-float (param) |
288 | ((minimum |
289 | :allocation :alien |
290 | :reader param-single-float-minimum |
291 | :type single-float) |
292 | (maximum |
293 | :allocation :alien |
294 | :reader param-single-float-maximum |
295 | :type single-float) |
296 | (default-value |
297 | :allocation :alien |
298 | :reader param-single-float-default-value |
299 | :type single-float) |
300 | (epsilon |
301 | :allocation :alien |
302 | :reader param-single-float-epsilon |
303 | :type single-float)) |
6baf860c |
304 | (:metaclass param-spec-class) |
dcb31db6 |
305 | (:gtype "GParamFloat")) |
42ff94e7 |
306 | |
307 | (defclass param-double-float (param) |
308 | ((minimum |
309 | :allocation :alien |
310 | :reader param-double-float-minimum |
311 | :type double-float) |
312 | (maximum |
313 | :allocation :alien |
314 | :reader param-double-float-maximum |
315 | :type double-float) |
316 | (default-value |
317 | :allocation :alien |
318 | :reader param-double-float-default-value |
319 | :type double-float) |
320 | (epsilon |
321 | :allocation :alien |
322 | :reader param-double-float-epsilon |
323 | :type double-float)) |
6baf860c |
324 | (:metaclass param-spec-class) |
dcb31db6 |
325 | (:gtype "GParamDouble")) |
42ff94e7 |
326 | |
327 | (defclass param-string (param) |
328 | ((default-value |
329 | :allocation :alien |
330 | :reader param-string-default-value |
331 | :type string)) |
dcb31db6 |
332 | (:metaclass param-spec-class) |
333 | (:gtype "GParamString")) |
42ff94e7 |
334 | |
335 | (defclass param-param (param) |
336 | () |
dcb31db6 |
337 | (:metaclass param-spec-class) |
338 | (:gtype "GParamParam")) |
42ff94e7 |
339 | |
340 | (defclass param-boxed (param) |
341 | () |
dcb31db6 |
342 | (:metaclass param-spec-class) |
343 | (:gtype "GParamBoxed")) |
42ff94e7 |
344 | |
345 | (defclass param-pointer (param) |
346 | () |
dcb31db6 |
347 | (:metaclass param-spec-class) |
348 | (:gtype "GParamPointer")) |
42ff94e7 |
349 | |
350 | (defclass param-value-array (param) |
351 | ((element-spec |
352 | :allocation :alien |
353 | :reader param-value-array-element-spec |
354 | :type param) |
355 | (length |
356 | :allocation :alien |
357 | :reader param-value-array-length |
358 | :type unsigned-int)) |
dcb31db6 |
359 | (:metaclass param-spec-class) |
360 | (:gtype "GParamValueArray")) |
42ff94e7 |
361 | |
362 | (defclass param-object (param) |
363 | () |
dcb31db6 |
364 | (:metaclass param-spec-class) |
365 | (:gtype "GParamObject")) |
366 | |
367 | (defclass param-overrride (param) |
368 | () |
369 | (:metaclass param-spec-class) |
370 | (:gtype "GParamOverride")) |