5 (defun widget-flags (widget)
6 (convert-from-foreign (gtk-object-flags-as-integer widget) 'widget-flags))
8 (defun (setf widget-flags) (new-value widget)
9 (setf (gtk-object-flags-as-integer widget)
10 (convert-to-foreign new-value 'widget-flags))
13 (export 'widget-flags)
15 (defcstruct %gtk-widget
17 (:private-flags :uint16)
19 (:saved-state state-type)
20 (:name (:pointer :char))
22 (:requisition requisition-cstruct)
23 (:allocation allocation-cstruct)
27 (defun widget-state (widget)
28 (foreign-slot-value (pointer widget) '%gtk-widget :state))
30 (export 'widget-state)
32 (defun widget-saved-state (widget)
33 (foreign-slot-value (pointer widget) '%gtk-widget :saved-state))
35 (export 'widget-saved-state)
37 (defmacro widget-p-fn (type)
38 (let ((name (intern (format nil "WIDGET-~A-P" (symbol-name type)) (find-package :gtk))))
39 `(progn (defun ,name (widget)
40 (member ,type (widget-flags widget)))
43 (widget-p-fn :toplevel)
44 (widget-p-fn :no-window)
45 (widget-p-fn :realized)
47 (widget-p-fn :visible)
48 (widget-p-fn :sensitive)
49 (widget-p-fn :parent-sensitive)
50 (widget-p-fn :can-focus)
51 (widget-p-fn :has-focus)
52 (widget-p-fn :can-default)
53 (widget-p-fn :has-default)
54 (widget-p-fn :has-grab)
55 (widget-p-fn :rc-style)
56 (widget-p-fn :composite-child)
57 (widget-p-fn :no-reparent)
58 (widget-p-fn :app-paintable)
59 (widget-p-fn :receives-default)
60 (widget-p-fn :double-buffered)
61 (widget-p-fn :no-show-all)
63 (defcfun (widget-unparent "gtk_widget_unparent") :void
66 (export 'widget-unparent)
68 (defcfun gtk-widget-show :void
71 (defcfun gtk-widget-show-all :void
74 (defun widget-show (widget &key (all t))
76 (gtk-widget-show-all widget)
77 (gtk-widget-show widget)))
81 (defcfun (widget-show-now "gtk_widget_show_now") :void
84 (export 'widget-show-now)
86 (defcfun gtk-widget-hide :void
89 (defcfun gtk-widget-hide-all :void
92 (defun widget-hide (widget &key (all t))
94 (gtk-widget-hide-all widget)
95 (gtk-widget-hide widget)))
97 (defcfun (widget-map "gtk_widget_map") :void
102 (defcfun (widget-unmap "gtk_widget_unmap") :void
105 (export 'widget-unmap)
107 (defcfun (widget-realize "gtk_widget_realize") :void
110 (export 'widget-realize)
112 (defcfun (widget-unrealize "gtk_widget_unrealize") :void
115 (export 'widget-unrealize)
117 (defcfun (widget-queue-draw "gtk_widget_queue_draw") :void
118 (widget (g-object widget)))
120 (export 'widget-queue-draw)
122 (defcfun (widget-queue-resize "gtk_widget_queue_resize") :void
123 (widget (g-object widget)))
125 (export 'widget-queue-resize)
127 (defcfun (widget-queue-resize-no-redraw "gtk_widget_queue_resize_no_redraw") :void
128 (widget (g-object widget)))
130 (export 'widget-queue-resize-no-redraw)
132 ; TODO: gtk_widget_get_child_requisition
134 ; TODO: gtk_widget_size_allocate
136 (defcfun (widget-add-accelerator "gtk_widget_add_accelerator") :void
138 (accel-signal :string)
139 (accel-group g-object)
141 (accel-mods modifier-type)
142 (accel-flags accel-flags))
144 (export 'widget-add-accelerator)
146 (defcfun (widget-remove-accelerator "gtk_widget_remove_accelerator") :void
148 (accel-group g-object)
150 (accel-mods modifier-type))
152 (export 'widget-remove-accelerator)
154 (defcfun (widget-set-accel-path "gtk_widget_set_accel_path") :void
157 (accel-group g-object))
159 (export 'widget-set-accel-path)
161 ; TODO: gtk_widget_list_accel_closures
163 (defcfun gtk-widget-can-activate-accel :boolean
167 (defun widget-can-activate-accel (widget signal)
168 (when (stringp signal) (setf signal (g-signal-lookup signal (g-type-from-object widget))))
169 (gtk-widget-can-activate-accel widget signal))
171 (export 'widget-can-activate-accel)
173 (defcfun (widget-event "gtk_widget_event") :boolean
174 (widget (g-object widget))
175 (event (g-boxed-foreign event)))
177 (export 'widget-event)
179 (defcfun (widget-activate "gtk_widget_activate") :boolean
182 (export 'widget-activate)
184 (defcfun (widget-reparent "gtk_widget_reparent") :void
186 (new-parent g-object))
188 (export 'widget-reparent)
190 (defcfun gtk-widget-intersect :boolean
192 (area (g-boxed-foreign rectangle))
193 (intersection (g-boxed-foreign rectangle)))
195 (defun widget-intersect (widget rectangle)
196 (let ((result (make-rectangle)))
197 (when (gtk-widget-intersect widget rectangle result)
200 (export 'widget-intersect)
202 (defcfun (widget-focus-p "gtk_widget_is_focus") :boolean
205 (export 'widget-focus-p)
207 (defcfun (widget-grab-focus "gtk_widget_grab_focus") :void
210 (export 'widget-grab-focus)
212 (defcfun (widget-grab-default "gtk_widget_grab_default") :void
215 (export 'widget-grab-default)
217 (defcfun (widget-set-state "gtk_widget_set_state") :void
218 (widget (g-object widget))
221 (export 'widget-set-state)
223 (defcfun (widget-ancestor "gtk_widget_get_ancestor") (g-object widget)
224 (widget (g-object widget))
225 (type g-type-designator))
227 (export 'widget-ancestor)
229 (defcfun gtk-widget-get-pointer :void
234 (defun widget-pointer (widget)
235 (with-foreign-objects ((x :int) (y :int))
236 (gtk-widget-get-pointer widget x y)
237 (values (mem-ref x :int) (mem-ref y :int))))
239 (export 'widget-pointer)
241 (defcfun (widget-is-ancestor "gtk_widget_is_ancestor") :boolean
243 (container g-object))
245 (export 'widget-is-ancestor)
247 (defcfun gtk-widget-translate-coordinates :boolean
248 (src-widget g-object)
249 (dst-widget g-object)
252 (dst-x (:pointer :int))
253 (dst-y (:pointer :int)))
255 (defun widget-translate-coordinates (src-widget dst-widget src-x src-y)
256 (with-foreign-objects ((dst-x :int) (dst-y :int))
257 (gtk-widget-translate-coordinates src-widget dst-widget src-x src-y dst-x dst-y)
258 (values (mem-ref dst-x :int)
259 (mem-ref dst-y :int))))
261 (export 'widget-translate-coordinates)
263 (defcfun (widget-ensure-style "gtk_widget_ensure_style") :void
266 (export 'widget-ensure-style)
268 (defcfun (widget-reset-rc-styles "gtk_widget_reset_rc_styles") :void
271 (export 'widget-reset-rc-styles)
273 (defcfun (widget-push-colormap "gtk_widget_push_colormap") :void
274 (colormap (g-object gdk-colormap)))
276 (export 'widget-push-colormap)
278 (defcfun (widget-pop-colormap "gtk_widget_pop_colormap") :void)
280 (export 'widget-pop-colormap)
282 (defcfun (widget-default-colormap "gtk_widget_get_default_colormap") (g-object gdk-colormap))
284 (defcfun gtk-widget-set-default-colormap :void
285 (colormap (g-object gdk-colormap)))
287 (defun (setf widget-default-colormap) (colormap)
288 (gtk-widget-set-default-colormap colormap))
290 (export 'widget-default-colormap)
292 (defcfun (widget-default-style "gtk_widget_get_default_style") (g-object style))
294 (export 'widget-default-style)
296 (defcfun (widget-default-visual "gtk_widget_get_default_visual") (g-object visual))
298 (export 'widget-default-visual)
300 (defcfun (widget-default-direction "gtk_widget_get_default_direction") text-direction)
302 (defcfun gtk-widget-set-default-direction :void
303 (direction text-direction))
305 (defun (setf widget-default-direction) (new-value)
306 (gtk-widget-set-default-direction new-value))
308 (export 'widget-default-direction)
310 (defcfun (widget-shape-combine-mask "gtk_widget_shape_combine_mask") :void
311 (widget (g-object widget))
312 (shape-mask g-object)
316 (export 'widget-shape-combine-mask)
318 (defcfun (widget-input-shape-combine-mask "gtk_widget_input_shape_combine_mask") :void
319 (widget (g-object widget))
320 (shape-mask g-object)
324 (export 'widget-input-shape-combine-mask)
326 (defcfun gtk-widget-path :void
328 (path-length (:pointer :uint))
329 (path (:pointer (:pointer :char)))
330 (path-reversed (:pointer (:pointer :char))))
332 (defcfun gtk-widget-class-path :void
334 (path-length (:pointer :uint))
335 (path (:pointer (:pointer :char)))
336 (path-reversed (:pointer (:pointer :char))))
338 (defun widget-path (widget &key (path-type :name))
339 (assert (typep path-type '(member :name :class)))
340 (with-foreign-object (path :pointer)
342 (:name (gtk-widget-path widget (null-pointer) path (null-pointer)))
343 (:class (gtk-widget-class-path widget (null-pointer) path (null-pointer))))
344 (mem-ref path '(g-string :free-from-foreign t))))
346 (export 'widget-path)
348 (defcfun (widget-modify-fg "gtk_widget_modify_fg") :void
349 (widget (g-object widget))
351 (color (g-boxed-foreign color)))
353 (export 'widget-modify-fg)
355 (defcfun (widget-modify-bg "gtk_widget_modify_bg") :void
356 (widget (g-object widget))
358 (color (g-boxed-foreign color)))
360 (export 'widget-modify-bg)
362 (defcfun (widget-modify-text "gtk_widget_modify_text") :void
363 (widget (g-object widget))
365 (color (g-boxed-foreign color)))
367 (export 'widget-modify-text)
369 (defcfun (widget-modify-base "gtk_widget_modify_base") :void
370 (widget (g-object widget))
372 (color (g-boxed-foreign color)))
374 (export 'widget-modify-base)
376 ;void gtk_widget_modify_font (GtkWidget *widget,
377 ; PangoFontDescription *font_desc);
379 (defcfun (widget-modify-cursor "gtk_widget_modify_cursor") :void
380 (widget (g-object widget))
381 (primary (g-boxed-foreign color))
382 (secondary (g-boxed-foreign color)))
384 (export 'widget-modify-cursor)
386 (defcfun (widget-create-pango-context "gtk_widget_create_pango_context") (g-object :already-referenced)
389 (export 'widget-create-pango-context)
391 (defcfun (widget-get-pango-context "gtk_widget_get_pango_context") g-object
394 (export 'widget-get-pango-context)
396 (defcfun (widget-create-pango-layout "gtk_widget_create_pango_layout") (g-object gdk::pango-layout :already-referenced)
397 (widget (g-object widget))
400 (export 'widget-create-pango-layout)
402 (defcfun (widget-render-icon "gtk_widget_render_icon") g-object
408 (export 'widget-render-icon)
410 (defcfun (widget-push-composite-child "gtk_widget_push_composite_child") :void
413 (export 'widget-push-composite-child)
415 (defcfun (widget-pop-composite-child "gtk_widget_pop_composite_child") :void
418 (export 'widget-pop-composite-child)
420 (defcfun (widget-queue-clear "gtk_widget_queue_clear") :void
421 (widget (g-object widget)))
423 (export 'widget-queue-clear)
425 (defcfun (widget-queue-clear-area "gtk_widget_queue_clear_area") :void
426 (widget (g-object widget))
432 (export 'widget-queue-clear-area)
434 (defcfun (widget-queue-draw-area "gtk_widget_queue_draw_area") :void
441 (export 'widget-queue-draw-area)
443 (defcfun (widget-reset-shapes "gtk_widget_reset_shapes") :void
446 (export 'widget-reset-shapes)
448 (defcfun (widget-set-double-buffered "gtk_widget_set_double_buffered") :void
449 (widget (g-object widget))
450 (double-buffered :boolean))
452 (export 'widget-set-double-buffered)
454 (defcfun (widget-set-scroll-adjustments "gtk_widget_set_scroll_adjustments") :boolean
456 (hadjustment g-object)
457 (vadjustment g-object))
459 (export 'widget-set-scroll-adjustments)
461 (defcfun (widget-mnemonic-activate "gtk_widget_mnemonic_activate") :boolean
462 (widget (g-object widget))
463 (group-cycling :boolean))
465 (export 'widget-mnemonic-activate)
467 ; TODO: gtk_widget_class_install_style_property
469 ; TOOD: gtk_widget_class_install_style_property_parser
471 ; TODO: gtk_widget_class_list_style_properties
473 ; TODO: gtk_widget_region_intersect
475 ; TODO: gtk_widget_send_expose
477 (defcfun gtk-widget-style-get-property :void
479 (property-name :string)
480 (value (:pointer g-value)))
482 (defcfun gtk-widget-class-find-style-property (:pointer g-param-spec)
484 (property-name :string))
486 (defcfun gtk-widget-class-list-style-properties (:pointer (:pointer g-param-spec))
488 (n-properties (:pointer :int)))
490 (defun widget-get-style-properties (type)
491 (setf type (ensure-g-type type))
492 (let ((class (g-type-class-ref type)))
494 (with-foreign-object (np :int)
495 (let ((specs (gtk-widget-class-list-style-properties class np)))
498 repeat (mem-ref np :int)
500 for spec = (mem-aref specs :pointer i)
501 collect (parse-g-param-spec spec))
503 (g-type-class-unref class))))
505 (export 'widget-get-style-properties)
507 (defun widget-style-property-info (type property-name)
508 (let ((class (g-type-class-ref type)))
510 (let ((g-param-spec (gtk-widget-class-find-style-property class property-name)))
511 (parse-g-param-spec g-param-spec))
512 (g-type-class-unref class))))
514 (export 'widget-style-property-info)
516 (defun widget-style-property-type (widget property-name)
517 (let ((property-info (widget-style-property-info (g-type-from-object widget) property-name)))
518 (g-class-property-definition-type property-info)))
520 (defun widget-style-property-value (widget property-name &optional property-type)
521 (unless property-type (setf property-type (widget-style-property-type widget property-name)))
522 (setf property-type (ensure-g-type property-type))
523 (with-foreign-object (gvalue 'g-value)
524 (g-value-zero gvalue)
525 (g-value-init gvalue property-type)
526 (prog1 (gtk-widget-style-get-property widget property-name gvalue)
527 (g-value-unset gvalue))))
529 (export 'widget-style-property-value)
531 (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean
533 (direction direction-type))
535 (export 'widget-child-focus)
537 (defcfun (widget-child-notify "gtk_widget_child_notify") :void
538 (widget (g-object widget))
539 (property-name :string))
541 (export 'widget-child-notify)
543 (defcfun (widget-freeze-child-notify "gtk_widget_freeze_child_notify") :void
546 (export 'widget-freeze-child-notify)
548 (defcfun (widget-settings "gtk_widget_get_settings") g-object
551 (export 'widget-settings)
553 (defcfun (widget-clipboard "gtk_widget_get_clipboard") (g-object clipboard)
554 (widget (g-object widget))
555 (selection gdk-atom-as-string))
557 (export 'widget-clipboard)
559 (defcfun (widget-display "gtk_widget_get_display") g-object
562 (export 'widget-display)
564 (defcfun (widget-root-window "gtk_widget_get_root_window") g-object
567 (export 'widget-root-window)
569 (defcfun (widget-screen "gtk_widget_get_screen") g-object
572 (export 'widget-screen)
574 (defcfun (widget-has-screen "gtk_widget_has_screen") :boolean
577 (export 'widget-has-screen)
579 (defcfun (widget-thaw-child-notify "gtk_widget_thaw_child_notify") :void
582 (export 'widget-thaw-child-notify)
584 (defcfun (widget-mnemonic-labels "gtk_widget_list_mnemonic_labels") (glist (g-object widget) :free-from-foreign t)
585 (widget (g-object widget)))
587 (export 'widget-mnemonic-labels)
589 (defcfun (widget-add-mnemonic-label "gtk_widget_add_mnemonic_label") :void
593 (export 'widget-add-mnemonic-label)
595 (defcfun (widget-remove-mnemonic-label "gtk_widget_remove_mnemonic_label") :void
599 (export 'widget-remove-mnemonic-label)
601 (defcfun (widget-action "gtk_widget_get_action") g-object
604 (export 'widget-action)
606 (defcfun (widget-composited-p "gtk_widget_is_composited") :boolean
609 (export 'widget-composited-p)
611 (defcfun (widget-error-bell "gtk_widget_error_bell") :void
614 (export 'widget-error-bell)
616 (defcfun (widget-trigger-tooltip-query "gtk_tooltip_trigger_tooltip_query") :void
619 (export 'widget-trigger-tooltip-query)
621 (defcfun gtk-widget-get-snapshot g-object
623 (clip-rectangle (g-boxed-foreign rectangle)))
625 (defun widget-snapshot (widget &optional clip-rectangle)
626 (gtk-widget-get-snapshot widget clip-rectangle))
628 (export 'widget-snapshot)