chiark / gitweb /
Hopefully allow (require :glib) again.
[clg] / gdk / gdktypes.lisp
1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net>
3 ;;
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:
11 ;;
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
14 ;;
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.
22
23 ;; $Id: gdktypes.lisp,v 1.29 2008-10-27 18:42:01 espen Exp $
24
25 (in-package "GDK")
26
27 (eval-when (:compile-toplevel :load-toplevel :execute)
28   (init-types-in-library gdk "libgdk-2.0" :prefix ("gdk_" "_gdk_"))
29   (init-types-in-library gdk "libgdk_pixbuf-2.0" :prefix "gdk_"))
30
31
32 (defclass color (boxed)
33   ((pixel
34     :allocation :alien
35     :type (unsigned 32))
36    (red
37     :allocation :alien
38     :accessor color-red
39     :type (unsigned 16))
40    (green
41     :allocation :alien
42     :accessor color-green
43     :type (unsigned 16))
44    (blue
45     :allocation :alien
46     :accessor color-blue
47     :type (unsigned 16)))
48   (:metaclass boxed-class)
49   (:packed t))
50
51
52 (deftype point () '(vector int 2))
53 (deftype segment () '(vector int 4))
54 (deftype trapezoid () '(vector double-float 6))
55 (deftype atom () 'unsigned-int)
56
57
58 ;; Could this just as well have been a vector?
59 (defclass rectangle (boxed)
60   ((x
61     :allocation :alien
62     :accessor rectangle-x
63     :initarg :x
64     :type int)
65    (y
66     :allocation :alien
67     :accessor rectangle-y
68     :initarg :y
69     :type int)
70    (width
71     :allocation :alien
72     :accessor rectangle-width
73     :initarg :width
74     :type int)
75    (height
76     :allocation :alien
77     :accessor rectangle-height
78     :initarg :height
79     :type int))
80   (:metaclass boxed-class))
81
82 (defclass region (struct)
83   ()
84   (:metaclass struct-class)
85   (:ref %region-copy)
86   (:unref %region-destroy))
87
88
89 (register-type 'event-mask '|gdk_event_mask_get_type|)
90 (define-flags-type event-mask
91   (:exposure 2)
92   :pointer-motion
93   :pointer-motion-hint
94   :button-motion
95   :button1-motion
96   :button2-motion
97   :button3-motion
98   :button-press
99   :button-release
100   :key-press
101   :key-release
102   :enter-notify
103   :leave-notify
104   :focus-change
105   :structure
106   :property-change
107   :visibility-notify
108   :proximity-in
109   :proximity-out
110   :substructure
111   :scroll
112   (:all-events #x3FFFFE))
113
114 (register-type 'modifier-type '|gdk_modifier_type_get_type|)
115 (define-flags-type modifier-type
116   :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5 
117   :button1 :button2 :button3 :button4 :button5
118   (:release #.(ash 1 30)))
119
120
121 (define-types-by-introspection "Gdk"
122   ("GdkFunction" :type gc-function)
123   ("GdkWMDecoration" :type wm-decoration)
124   ("GdkWMFunction" :type wm-function)
125   ("GdkGC" :type gc)
126   ("GdkGCX11" :type gc-x11)
127   ("GdkGCValuesMask" :type gc-values-mask)
128   ("GdkDrawableImplX11" :ignore t)
129   ("GdkWindowImplX11" :ignore t)
130   ("GdkPixmapImplX11" :ignore t)
131   ("GdkGCX11" :ignore t)
132   ("GdkColor" :ignore t)
133   ("GdkEvent" :ignore t)
134   ("GdkRectangle" :ignore t)
135   ("GdkCursor" :ignore t)
136   ("GdkFont" :ignore t) ; deprecated
137   ("GdkEventMask" :ignore t) ; manually defined
138   ("GdkModifierType" :ignore t) ; manually defined
139
140   ("GdkAppLaunchContext" :ignore t) ; needs GIO
141
142
143   ("GdkDisplay"
144    :slots
145    ((name
146      :allocation :virtual
147      :getter "gdk_display_get_name"
148      :reader display-name
149      :type (copy-of string))
150     (screens
151      :allocation :virtual
152      :getter display-screens)
153     (devices
154      :allocation :virtual
155      :getter "gdk_display_list_devices"
156      :reader display-devices
157      :type (copy-of (glist device)))))
158
159   ;; TODO: add unbound options
160   ("GdkDrawable"
161    :slots
162    ((display
163      :allocation :virtual
164      :getter "gdk_drawable_get_display"
165      :reader drawable-display
166      :type display)
167     (screen
168      :allocation :virtual
169      :getter "gdk_drawable_get_screen"
170      :reader drawable-screen
171      :type screen)
172     (visual
173      :allocation :virtual
174      :getter "gdk_drawable_get_visual"
175      :reader drawable-visual
176      :type visual)
177     (colormap
178      :allocation :virtual
179      :getter "gdk_drawable_get_colormap"
180      :setter "gdk_drawable_set_colormap"
181      :unbound nil
182      :accessor drawable-colormap
183      :initarg :colormap
184      :type colormap)
185     (depth
186      :allocation :virtual
187      :getter "gdk_drawable_get_depth"
188      :reader drawable-depth
189      :type int)
190     (with 
191      :allocation :virtual
192      :getter drawable-width)
193     (height
194      :allocation :virtual
195      :getter drawable-height)))
196   
197   ("GdkWindow"
198    :slots
199    ((state
200      :allocation :virtual
201      :getter "gdk_window_get_state"
202      :reader window-state
203      :type window-state)
204     (parent
205      :allocation :virtual
206      :getter "gdk_window_get_parent"
207      :reader window-parent
208      :type window)
209     (toplevel
210      :allocation :virtual
211      :getter "gdk_window_get_toplevel"
212      :reader window-toplevel
213      :type window)
214     (children
215      :allocation :virtual
216      :getter "gdk_window_get_children"
217      :reader window-children
218      :type (glist window))
219     (events
220      :allocation :virtual
221      :getter "gdk_window_get_events"
222      :setter "gdk_window_set_events"
223      :accessor window-events
224      :type event-mask)
225     (group
226      :allocation :virtual
227      :getter "gdk_window_get_group"
228      :setter "gdk_window_set_group"
229      :unbound nil
230      :accessor window-group
231      :type window)
232     #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
233     (type-hint
234      :allocation :virtual
235      :getter "gdk_window_get_type_hint"
236      :setter "gdk_window_set_type_hint"
237      :accessor window-type-hint
238      :type window-type-hint)
239     #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
240     (type-hint
241      :allocation :virtual
242      :getter "gdk_window_get_type_hint"
243      :accessor window-type-hint
244      :type window-type-hint)
245     (decorations
246      :allocation :virtual
247      :getter %window-decoration-getter
248      :setter "gdk_window_set_decoration"
249      :boundp %window-decoration-boundp
250      :accessor window-decorations
251      :type wm-decoration))))
252
253
254 (deftype bitmap () 'pixmap)
255
256 (defclass cursor (boxed)
257   ((type
258     :allocation :alien
259     :reader cursor-type
260     :type cursor-type)
261    (ref-count
262     :allocation :alien
263     :type unsigned-int)
264    (display
265     :allocation :virtual
266     :getter "gdk_cursor_get_display"
267     :reader cursor-display
268     :type display))
269   (:metaclass boxed-class)
270   (:ref %cursor-ref)
271   (:unref %cursor-unref))  
272
273
274 (defclass geometry (struct)
275   ((min-width 
276     :allocation :alien
277     :accessor geometry-min-width
278     :initarg :min-width
279     :type int)
280    (min-height 
281     :allocation :alien
282     :accessor geometry-min-height
283     :initarg :min-height
284     :type int)
285    (max-width 
286     :allocation :alien
287     :accessor geometry-max-width
288     :initarg :max-width
289     :type int)
290    (max-height 
291     :allocation :alien
292     :accessor geometry-max-height
293     :initarg :max-height
294     :type int)
295    (base-width 
296     :allocation :alien
297     :accessor geometry-base-width
298     :initarg :base-width
299     :type int)
300    (base-height 
301     :allocation :alien
302     :accessor geometry-base-height
303     :initarg :base-height
304     :type int)
305    (width-inc
306     :allocation :alien
307     :accessor geometry-width-inc
308     :initarg :width-inc
309     :type int)
310    (height-inc
311     :allocation :alien
312     :accessor geometry-height-inc
313     :initarg :height-inc
314     :type int)
315    (min-aspect
316     :allocation :alien
317     :accessor geometry-min-aspect
318     :initarg :min-aspect
319     :type double-float)
320    (max-aspect
321     :allocation :alien
322     :accessor geometry-max-aspect
323     :initarg :max-aspect
324     :type double-float)
325    (gravity
326     :allocation :alien
327     :accessor geometry-gravity
328     :initarg :gravity
329     :type gravity))
330   (:metaclass struct-class))
331
332 (deftype native-window () '(unsigned 32))