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