added GtkWidgetx
[cl-gtk2.git] / gtk / gtk.widget.lisp
1 (in-package :gtk)
2
3 ; TODO: GtkWidget
4
5 (defun widget-flags (widget)
6   (convert-from-foreign (gtk-object-flags-as-integer widget) 'widget-flags))
7
8 (defun (setf widget-flags) (new-value widget)
9   (setf (gtk-object-flags-as-integer widget)
10         (convert-to-foreign new-value 'widget-flags))
11   new-value)
12
13 (export 'widget-flags)
14
15 (defcstruct %gtk-requisition
16   (width :int)
17   (height :int))
18
19 (defcstruct %gtk-allocation
20   (x :int)
21   (y :int)
22   (width :int)
23   (height :int))
24
25 (defcstruct %gtk-widget
26   (object %gtk-object)
27   (private-flags :uint16)
28   (state state-type)
29   (saved-state state-type)
30   (name (:pointer :char))
31   (style :pointer)
32   (requisition %gtk-requisition)
33   (allocation %gtk-allocation)
34   (window :pointer)
35   (parent :pointer))
36
37 (defun widget-state (widget)
38   (foreign-slot-value (pointer widget) '%gtk-widget 'state))
39
40 (export 'widget-state)
41 (defun widget-saved-state (widget)
42   (foreign-slot-value (pointer widget) '%gtk-widget 'saved-state))
43
44 (export 'widget-saved-state)
45
46 (defmacro widget-p-fn (type)
47   (let ((name (intern (format nil "WIDGET-~A-P" (symbol-name type)) (find-package :gtk))))
48     `(progn (defun ,name (widget)
49               (member ,type (widget-flags widget)))
50             (export ',name))))
51
52 (widget-p-fn :toplevel)
53 (widget-p-fn :no-window)
54 (widget-p-fn :realized)
55 (widget-p-fn :mapped)
56 (widget-p-fn :visible)
57 (widget-p-fn :sensitive)
58 (widget-p-fn :parent-sensitive)
59 (widget-p-fn :can-focus)
60 (widget-p-fn :has-focus)
61 (widget-p-fn :can-default)
62 (widget-p-fn :has-default)
63 (widget-p-fn :has-grab)
64 (widget-p-fn :rc-style)
65 (widget-p-fn :composite-child)
66 (widget-p-fn :no-reparent)
67 (widget-p-fn :app-paintable)
68 (widget-p-fn :receives-default)
69 (widget-p-fn :double-buffered)
70 (widget-p-fn :no-show-all)
71
72 (defcfun (widget-unparent "gtk_widget_unparent") :void
73   (widget g-object))
74
75 (export 'widget-unparent)
76
77 (defcfun gtk-widget-show :void
78   (widget g-object))
79
80 (defcfun gtk-widget-show-all :void
81   (widget g-object))
82
83 (defun widget-show (widget &key (all t))
84   (if all
85       (gtk-widget-show-all widget)
86       (gtk-widget-show widget)))
87
88 (export 'widget-show)
89
90 (defcfun (widget-show-now "gtk_widget_show_now") :void
91   (widget g-object))
92
93 (export 'widget-show-now)
94
95 (defcfun gtk-widget-hide :void
96   (widget g-object))
97
98 (defcfun gtk-widget-hide-all :void
99   (widget g-object))
100
101 (defun widget-hide (widget &key (all t))
102   (if all
103       (gtk-widget-hide-all widget)
104       (gtk-widget-hide widget)))
105
106 (defcfun (widget-map "gtk_widget_map") :void
107   (widget g-object))
108
109 (export 'widget-map)
110
111 (defcfun (widget-unmap "gtk_widget_unmap") :void
112   (widget g-object))
113
114 (export 'widget-unmap)
115
116 (defcfun (widget-realize "gtk_widget_realize") :void
117   (width g-object))
118
119 (export 'widget-realize)
120
121 (defcfun (widget-unrealize "gtk_widget_unrealize") :void
122   (width g-object))
123
124 (export 'widget-unrealize)
125
126 (defcfun (widget-queue-draw "gtk_widget_queue_draw") :void
127   (widget (g-object widget)))
128
129 (export 'widget-queue-draw)
130
131 (defcfun (widget-queue-resize "gtk_widget_queue_resize") :void
132   (widget (g-object widget)))
133
134 (export 'widget-queue-resize)
135
136 (defcfun (widget-queue-resize-no-redraw "gtk_widget_queue_resize_no_redraw") :void
137   (widget (g-object widget)))
138
139 (export 'widget-queue-resize-no-redraw)
140
141 ; TODO: gtk_widget_get_child_requisition
142
143 ; TODO: gtk_widget_size_allocate
144
145 (defcfun (widget-add-accelerator "gtk_widget_add_accelerator") :void
146   (widget g-object)
147   (accel-signal :string)
148   (accel-group g-object)
149   (accel-key :uint)
150   (accel-mods gdk-modifier-type)
151   (accel-flags accel-flags))
152
153 (export 'widget-add-accelerator)
154
155 (defcfun (widget-remove-accelerator "gtk_widget_remove_accelerator") :void
156   (widget g-object)
157   (accel-group g-object)
158   (accel-key :uint)
159   (accel-mods gdk-modifier-type))
160
161 (export 'widget-remove-accelerator)
162
163 (defcfun (widget-set-accel-path "gtk_widget_set_accel_path") :void
164   (widget g-object)
165   (accel-path :string)
166   (accel-group g-object))
167
168 (export 'widget-set-accel-path)
169
170 ; TODO: gtk_widget_list_accel_closures
171
172 (defcfun gtk-widget-can-activate-accel :boolean
173   (widget g-object)
174   (signal-id :uint))
175
176 (defun widget-can-activate-accel (widget signal)
177   (when (stringp signal) (setf signal (g-signal-lookup signal (g-type-from-object widget))))
178   (gtk-widget-can-activate-accel widget signal))
179
180 (export 'widget-can-activate-accel)
181
182 ; TODO: gtk_widget_event
183
184 (defcfun (widget-activate "gtk_widget_activate") :boolean
185   (widget g-object))
186
187 (export 'widget-activate)
188
189 (defcfun (widget-reparent "gtk_widget_reparent") :void
190   (widget g-object)
191   (new-parent g-object))
192
193 (export 'widget-reparent)
194
195 (defcfun gtk-widget-intersect :boolean
196   (widget g-object)
197   (area (g-boxed-ptr rectangle))
198   (intersection (g-boxed-ptr rectangle :in-out)))
199
200 (defun widget-intersect (widget rectangle)
201   (let ((result (make-rectangle :x 0 :y 0 :width 0 :height 0)))
202     (when (gtk-widget-intersect widget rectangle result)
203       result)))
204
205 (export 'widget-intersect)
206
207 (defcfun (widget-focus-p "gtk_widget_is_focus") :boolean
208   (widget g-object))
209
210 (export 'widget-focus-p)
211
212 (defcfun (widget-grab-focus "gtk_widget_grab_focus") :void
213   (widget g-object))
214
215 (export 'widget-grab-focus)
216
217 (defcfun (widget-grab-default "gtk_widget_grab_default") :void
218   (widget g-object))
219
220 (export 'widget-grab-default)
221
222 ; TODO: gtk_widget_set_state
223
224 ; TODO: gtk_widget_set_parent_window
225
226 ; TODO: gtk_widget_get_parent_window
227
228 ; TODO: gtk_widget_set_extension_events
229
230 ; TODO: gtk_widget_get_extension_events
231
232
233 ; fix ownership issues:
234 ; TODO: gtk_widget_get_toplevel
235
236 ; TODO: gtk_widget_get_ancestor
237
238 ; TODO: gtk_widget_get_colormap
239
240 ; TODO: gtk_widget_get_visual
241
242 (defcfun gtk-widget-get-pointer :void
243   (widget g-object)
244   (x (:pointer :int))
245   (y (:pointer :int)))
246
247 (defun widget-pointer (widget)
248   (with-foreign-objects ((x :int) (y :int))
249     (gtk-widget-get-pointer widget x y)
250     (values (mem-ref x :int) (mem-ref y :int))))
251
252 (export 'widget-pointer)
253
254 (defcfun (widget-contained-p "gtk_widget_is_ancestor") :boolean
255   (widget g-object)
256   (container g-object))
257
258 (export 'widget-contained-p)
259
260 (defcfun gtk-widget-translate-coordinates :boolean
261   (src-widget g-object)
262   (dst-widget g-object)
263   (src-x :int)
264   (src-y :int)
265   (dst-x (:pointer :int))
266   (dst-y (:pointer :int)))
267
268 (defun widget-translate-coordinates (src-widget dst-widget src-x src-y)
269   (with-foreign-objects ((dst-x :int) (dst-y :int))
270     (gtk-widget-translate-coordinates src-widget dst-widget src-x src-y dst-x dst-y)
271     (values (mem-ref dst-x :int)
272             (mem-ref dst-y :int))))
273
274 (export 'widget-translate-coordinates)
275
276 (defcfun (widget-ensure-style "gtk_widget_ensure_style") :void
277   (widget g-object))
278
279 (export 'widget-ensure-style)
280
281 (defcfun (widget-reset-rc-styles "gtk_widget_reset_rc_styles") :void
282   (widget g-object))
283
284 (export 'widget-reset-rc-styles)
285
286 ; TODO: gtk_widget_push_colormap
287
288 ; TODO: gtk_widget_pop_colormap
289
290 ; TODO: gtk_widget_set_default_colormap
291
292 ; TODO: gtk_widget_get_default_colormap
293
294 ; TODO: gtk_widget_get_default_style (ownership)
295
296 ; TODO: gtk_widget_get_default_visual
297
298 (defcfun (widget-default-direction "gtk_widget_get_default_direction") text-direction)
299
300 (defcfun gtk-widget-set-default-direction :void
301   (direction text-direction))
302
303 (defun (setf widget-default-direction) (new-value)
304   (gtk-widget-set-default-direction new-value))
305
306 (export 'widget-default-direction)
307
308 ; TODO: gtk_widget_shape_combine_mask 
309
310 ; TODO: gtk_widget_input_shape_combine_mask
311
312 (defcfun gtk-widget-path :void
313   (widget g-object)
314   (path-length (:pointer :uint))
315   (path (:pointer (:pointer :char)))
316   (path-reversed (:pointer (:pointer :char))))
317
318 (defcfun gtk-widget-class-path :void
319   (widget g-object)
320   (path-length (:pointer :uint))
321   (path (:pointer (:pointer :char)))
322   (path-reversed (:pointer (:pointer :char))))
323
324 (defun widget-path (widget &key (path-type :name))
325   (assert (typep path-type '(member :name :class)))
326   (with-foreign-object (path :pointer)
327     (ecase path-type
328       (:name (gtk-widget-path widget (null-pointer) path (null-pointer)))
329       (:class (gtk-widget-class-path widget (null-pointer) path (null-pointer))))
330     (mem-ref path '(g-string :free-from-foreign t))))
331
332 (export 'widget-path)
333
334 ; TODO: gtk_widget_modify_style
335
336 ; TODO: gtk_widget_get_modifier_style
337
338 ; TODO: gtk_widget_modify_fg
339
340 ; TODO: gtk_widget_modify_bg
341
342 ; TODO: gtk_widget_modify_text
343
344 ; TODO: gtk_widget_modify_base
345
346 ; TODO: gtk_widget_modify_font
347
348 ; TODO: gtk_widget_modify_cursor 
349
350 (defcfun (widget-create-pango-context "gtk_widget_create_pango_context") g-object
351   (widget g-object))
352
353 (export 'widget-create-pango-context)
354
355 (defcfun (widget-get-pango-context "gtk_widget_get_pango_context") g-object
356   (widget g-object))
357
358 (export 'widget-get-pango-context)
359
360 (defcfun (widget-create-pango-layout "gtk_widget_create_pango_layout") (g-object gdk::pango-layout)
361   (widget (g-object widget))
362   (text :string))
363
364 (export 'widget-create-pango-layout)
365
366 (defcfun (widget-render-icon "gtk_widget_render_icon") g-object
367   (widget g-object)
368   (stock-id :string)
369   (size icon-size)
370   (detail :string))
371
372 (export 'widget-render-icon)
373
374 (defcfun (widget-push-composite-child "gtk_widget_push_composite_child") :void
375   (widget g-object))
376
377 (export 'widget-push-composite-child)
378
379 (defcfun (widget-pop-composite-child "gtk_widget_pop_composite_child") :void
380   (widget g-object))
381
382 (export 'widget-pop-composite-child)
383
384 (defcfun (widget-queue-draw-area "gtk_widget_queue_draw_area") :void
385   (widget g-object)
386   (x :int)
387   (y :int)
388   (width :int)
389   (height :int)
390
391 (export 'widget-queue-draw-area))
392
393 (defcfun (widget-reset-shapes "gtk_widget_reset_shapes") :void
394   (widget g-object))
395
396 (export 'widget-reset-shapes)
397
398 (defcfun (widget-set-scroll-adjustments "gtk_widget_set_scroll_adjustments") :boolean
399   (widget g-object)
400   (hadjustment g-object)
401   (vadjustment g-object))
402
403 (export 'widget-set-scroll-adjustments)
404
405 ; TODO: gtk_widget_class_install_style_property
406
407 ; TOOD: gtk_widget_class_install_style_property_parser
408
409 ; TODO: gtk_widget_class_find_style_property
410
411 ; TODO: gtk_widget_class_list_style_properties
412
413 ; TODO: gtk_widget_region_intersect
414
415 ; TODO: gtk_widget_send_expose
416
417 ; TODO: gtk_widget_style_get_property
418
419 (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean
420   (widget g-object)
421   (direction direction-type))
422
423 (export 'widget-child-focus)
424
425 (defcfun (widget-freeze-child-notify "gtk_widget_freeze_child_notify") :void
426   (widget g-object))
427
428 (export 'widget-freeze-child-notify)
429
430 (defcfun (widget-settings "gtk_widget_get_settings") g-object
431   (widget g-object))
432
433 (export 'widget-settings)
434
435 ; TODO: gtk_widget_get_clipboard
436
437 (defcfun (widget-display "gtk_widget_get_display") g-object
438   (widget g-object))
439
440 (export 'widget-display)
441
442 (defcfun (widget-root-window "gtk_widget_get_root_window") g-object
443   (widget g-object))
444
445 (export 'widget-root-window)
446
447 (defcfun (widget-screen "gtk_widget_get_screen") g-object
448   (widget g-object))
449
450 (export 'widget-screen)
451
452 (defcfun (widget-has-screen "gtk_widget_has_screen") :boolean
453   (widget g-object))
454
455 (export 'widget-has-screen)
456
457 ; TODO: gtk_widget_set_child_visible
458
459 (defcfun (widget-thaw-child-notify "gtk_widget_thaw_child_notify") :void
460   (widget g-object))
461
462 (export 'widget-thaw-child-notify)
463
464 ; TODO: gtk_widget_list_mnemonic_labels
465
466 (defcfun (widget-add-mnemonic-label "gtk_widget_add_mnemonic_label") :void
467   (widget g-object)
468   (label g-object))
469
470 (export 'widget-add-mnemonic-label)
471
472 (defcfun (widget-remove-mnemonic-label "gtk_widget_remove_mnemonic_label") :void
473   (widget g-object)
474   (label g-object))
475
476 (export 'widget-remove-mnemonic-label)
477
478 (defcfun (widget-action "gtk_widget_get_action") g-object
479   (widget g-object))
480
481 (export 'widget-action)
482
483 (defcfun (widget-composited-p "gtk_widget_is_composited") :boolean
484   (widget g-object))
485
486 (export 'widget-composited-p)
487
488 (defcfun (widget-error-bell "gtk_widget_error_bell") :void
489   (widget g-object))
490
491 (export 'widget-error-bell)
492
493 (defcfun (widget-trigger-tooltip-query "gtk_tooltip_trigger_tooltip_query") :void
494   (widget g-object))
495
496 (export 'widget-trigger-tooltip-query)
497
498 (defcfun (widget-snapshot "gtk_widget_get_snapshot") g-object
499   (widget g-object)
500   (clip-rectangle (g-boxed-ptr rectangle)))
501
502 (export 'widget-snapshot)