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