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)
31 (defun widget-saved-state (widget)
32 (foreign-slot-value (pointer widget) '%gtk-widget :saved-state))
34 (export 'widget-saved-state)
36 (defmacro widget-p-fn (type)
37 (let ((name (intern (format nil "WIDGET-~A-P" (symbol-name type)) (find-package :gtk))))
38 `(progn (defun ,name (widget)
39 (member ,type (widget-flags widget)))
42 (widget-p-fn :toplevel)
43 (widget-p-fn :no-window)
44 (widget-p-fn :realized)
46 (widget-p-fn :visible)
47 (widget-p-fn :sensitive)
48 (widget-p-fn :parent-sensitive)
49 (widget-p-fn :can-focus)
50 (widget-p-fn :has-focus)
51 (widget-p-fn :can-default)
52 (widget-p-fn :has-default)
53 (widget-p-fn :has-grab)
54 (widget-p-fn :rc-style)
55 (widget-p-fn :composite-child)
56 (widget-p-fn :no-reparent)
57 (widget-p-fn :app-paintable)
58 (widget-p-fn :receives-default)
59 (widget-p-fn :double-buffered)
60 (widget-p-fn :no-show-all)
62 (defcfun (widget-unparent "gtk_widget_unparent") :void
65 (export 'widget-unparent)
67 (defcfun gtk-widget-show :void
70 (defcfun gtk-widget-show-all :void
73 (defun widget-show (widget &key (all t))
75 (gtk-widget-show-all widget)
76 (gtk-widget-show widget)))
80 (defcfun (widget-show-now "gtk_widget_show_now") :void
83 (export 'widget-show-now)
85 (defcfun gtk-widget-hide :void
88 (defcfun gtk-widget-hide-all :void
91 (defun widget-hide (widget &key (all t))
93 (gtk-widget-hide-all widget)
94 (gtk-widget-hide widget)))
96 (defcfun (widget-map "gtk_widget_map") :void
101 (defcfun (widget-unmap "gtk_widget_unmap") :void
104 (export 'widget-unmap)
106 (defcfun (widget-realize "gtk_widget_realize") :void
109 (export 'widget-realize)
111 (defcfun (widget-unrealize "gtk_widget_unrealize") :void
114 (export 'widget-unrealize)
116 (defcfun (widget-queue-draw "gtk_widget_queue_draw") :void
117 (widget (g-object widget)))
119 (export 'widget-queue-draw)
121 (defcfun (widget-queue-resize "gtk_widget_queue_resize") :void
122 (widget (g-object widget)))
124 (export 'widget-queue-resize)
126 (defcfun (widget-queue-resize-no-redraw "gtk_widget_queue_resize_no_redraw") :void
127 (widget (g-object widget)))
129 (export 'widget-queue-resize-no-redraw)
131 ; TODO: gtk_widget_get_child_requisition
133 ; TODO: gtk_widget_size_allocate
135 (defcfun (widget-add-accelerator "gtk_widget_add_accelerator") :void
137 (accel-signal :string)
138 (accel-group g-object)
140 (accel-mods modifier-type)
141 (accel-flags accel-flags))
143 (export 'widget-add-accelerator)
145 (defcfun (widget-remove-accelerator "gtk_widget_remove_accelerator") :void
147 (accel-group g-object)
149 (accel-mods modifier-type))
151 (export 'widget-remove-accelerator)
153 (defcfun (widget-set-accel-path "gtk_widget_set_accel_path") :void
156 (accel-group g-object))
158 (export 'widget-set-accel-path)
160 ; TODO: gtk_widget_list_accel_closures
162 (defcfun gtk-widget-can-activate-accel :boolean
166 (defun widget-can-activate-accel (widget signal)
167 (when (stringp signal) (setf signal (g-signal-lookup signal (g-type-from-object widget))))
168 (gtk-widget-can-activate-accel widget signal))
170 (export 'widget-can-activate-accel)
172 ; TODO: gtk_widget_event
174 (defcfun (widget-activate "gtk_widget_activate") :boolean
177 (export 'widget-activate)
179 (defcfun (widget-reparent "gtk_widget_reparent") :void
181 (new-parent g-object))
183 (export 'widget-reparent)
185 (defcfun gtk-widget-intersect :boolean
187 (area (g-boxed-foreign rectangle))
188 (intersection (g-boxed-foreign rectangle :in-out)))
190 (defun widget-intersect (widget rectangle)
191 (let ((result (make-rectangle :x 0 :y 0 :width 0 :height 0)))
192 (when (gtk-widget-intersect widget rectangle result)
195 (export 'widget-intersect)
197 (defcfun (widget-focus-p "gtk_widget_is_focus") :boolean
200 (export 'widget-focus-p)
202 (defcfun (widget-grab-focus "gtk_widget_grab_focus") :void
205 (export 'widget-grab-focus)
207 (defcfun (widget-grab-default "gtk_widget_grab_default") :void
210 (export 'widget-grab-default)
212 ; TODO: gtk_widget_set_state
214 ; TODO: gtk_widget_set_parent_window
216 ; TODO: gtk_widget_get_parent_window
218 ; TODO: gtk_widget_set_extension_events
220 ; TODO: gtk_widget_get_extension_events
223 ; fix ownership issues:
224 ; TODO: gtk_widget_get_toplevel
226 ; TODO: gtk_widget_get_ancestor
228 ; TODO: gtk_widget_get_colormap
230 ; TODO: gtk_widget_get_visual
232 (defcfun gtk-widget-get-pointer :void
237 (defun widget-pointer (widget)
238 (with-foreign-objects ((x :int) (y :int))
239 (gtk-widget-get-pointer widget x y)
240 (values (mem-ref x :int) (mem-ref y :int))))
242 (export 'widget-pointer)
244 (defcfun (widget-contained-p "gtk_widget_is_ancestor") :boolean
246 (container g-object))
248 (export 'widget-contained-p)
250 (defcfun gtk-widget-translate-coordinates :boolean
251 (src-widget g-object)
252 (dst-widget g-object)
255 (dst-x (:pointer :int))
256 (dst-y (:pointer :int)))
258 (defun widget-translate-coordinates (src-widget dst-widget src-x src-y)
259 (with-foreign-objects ((dst-x :int) (dst-y :int))
260 (gtk-widget-translate-coordinates src-widget dst-widget src-x src-y dst-x dst-y)
261 (values (mem-ref dst-x :int)
262 (mem-ref dst-y :int))))
264 (export 'widget-translate-coordinates)
266 (defcfun (widget-ensure-style "gtk_widget_ensure_style") :void
269 (export 'widget-ensure-style)
271 (defcfun (widget-reset-rc-styles "gtk_widget_reset_rc_styles") :void
274 (export 'widget-reset-rc-styles)
276 ; TODO: gtk_widget_push_colormap
278 ; TODO: gtk_widget_pop_colormap
280 ; TODO: gtk_widget_set_default_colormap
282 ; TODO: gtk_widget_get_default_colormap
284 ; TODO: gtk_widget_get_default_style (ownership)
286 ; TODO: gtk_widget_get_default_visual
288 (defcfun (widget-default-direction "gtk_widget_get_default_direction") text-direction)
290 (defcfun gtk-widget-set-default-direction :void
291 (direction text-direction))
293 (defun (setf widget-default-direction) (new-value)
294 (gtk-widget-set-default-direction new-value))
296 (export 'widget-default-direction)
298 ; TODO: gtk_widget_shape_combine_mask
300 ; TODO: gtk_widget_input_shape_combine_mask
302 (defcfun gtk-widget-path :void
304 (path-length (:pointer :uint))
305 (path (:pointer (:pointer :char)))
306 (path-reversed (:pointer (:pointer :char))))
308 (defcfun gtk-widget-class-path :void
310 (path-length (:pointer :uint))
311 (path (:pointer (:pointer :char)))
312 (path-reversed (:pointer (:pointer :char))))
314 (defun widget-path (widget &key (path-type :name))
315 (assert (typep path-type '(member :name :class)))
316 (with-foreign-object (path :pointer)
318 (:name (gtk-widget-path widget (null-pointer) path (null-pointer)))
319 (:class (gtk-widget-class-path widget (null-pointer) path (null-pointer))))
320 (mem-ref path '(g-string :free-from-foreign t))))
322 (export 'widget-path)
324 ; TODO: gtk_widget_modify_fg
326 ; TODO: gtk_widget_modify_bg
328 ; TODO: gtk_widget_modify_text
330 ; TODO: gtk_widget_modify_base
332 ; TODO: gtk_widget_modify_font
334 ; TODO: gtk_widget_modify_cursor
336 (defcfun (widget-create-pango-context "gtk_widget_create_pango_context") g-object
339 (export 'widget-create-pango-context)
341 (defcfun (widget-get-pango-context "gtk_widget_get_pango_context") g-object
344 (export 'widget-get-pango-context)
346 (defcfun (widget-create-pango-layout "gtk_widget_create_pango_layout") (g-object gdk::pango-layout :already-referenced)
347 (widget (g-object widget))
350 (export 'widget-create-pango-layout)
352 (defcfun (widget-render-icon "gtk_widget_render_icon") g-object
358 (export 'widget-render-icon)
360 (defcfun (widget-push-composite-child "gtk_widget_push_composite_child") :void
363 (export 'widget-push-composite-child)
365 (defcfun (widget-pop-composite-child "gtk_widget_pop_composite_child") :void
368 (export 'widget-pop-composite-child)
370 (defcfun (widget-queue-draw-area "gtk_widget_queue_draw_area") :void
377 (export 'widget-queue-draw-area)
379 (defcfun (widget-reset-shapes "gtk_widget_reset_shapes") :void
382 (export 'widget-reset-shapes)
384 (defcfun (widget-set-scroll-adjustments "gtk_widget_set_scroll_adjustments") :boolean
386 (hadjustment g-object)
387 (vadjustment g-object))
389 (export 'widget-set-scroll-adjustments)
391 ; TODO: gtk_widget_class_install_style_property
393 ; TOOD: gtk_widget_class_install_style_property_parser
395 ; TODO: gtk_widget_class_list_style_properties
397 ; TODO: gtk_widget_region_intersect
399 ; TODO: gtk_widget_send_expose
401 (defcfun gtk-widget-style-get-property :void
403 (property-name :string)
404 (value (:pointer g-value)))
406 (defcfun gtk-widget-class-find-style-property (:pointer g-param-spec)
408 (property-name :string))
410 (defcfun gtk-widget-class-list-style-properties (:pointer (:pointer g-param-spec))
412 (n-properties (:pointer :int)))
414 (defun widget-class-get-style-properties (type)
415 (setf type (ensure-g-type type))
416 (let ((class (g-type-class-ref type)))
418 (with-foreign-object (np :int)
419 (let ((specs (gtk-widget-class-list-style-properties class np)))
422 repeat (mem-ref np :int)
424 for spec = (mem-aref specs :pointer i)
425 collect (parse-g-param-spec spec))
427 (g-type-class-unref class))))
429 (export 'widget-class-get-style-properties)
431 (defun widget-child-property-type (widget property-name)
432 (let* ((type (g-type-from-object widget))
433 (class (g-type-class-ref type)))
435 (let ((g-param-spec (gtk-widget-class-find-style-property class property-name)))
436 (when (null-pointer-p g-param-spec) (error "Widget ~A has no style-property named '~A'" widget property-name))
437 (foreign-slot-value g-param-spec 'gobject:g-param-spec :value-type))
438 (g-type-class-unref class))))
440 (defun widget-child-property-value (widget property-name &optional property-type)
441 (unless property-type (setf property-type (widget-child-property-type widget property-name)))
442 (setf property-type (ensure-g-type property-type))
443 (with-foreign-object (gvalue 'g-value)
444 (g-value-zero gvalue)
445 (g-value-init gvalue property-type)
446 (prog1 (gtk-widget-style-get-property widget property-name gvalue)
447 (g-value-unset gvalue))))
449 (export 'widget-child-property-value)
451 (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean
453 (direction direction-type))
455 (export 'widget-child-focus)
457 (defcfun (widget-freeze-child-notify "gtk_widget_freeze_child_notify") :void
460 (export 'widget-freeze-child-notify)
462 (defcfun (widget-settings "gtk_widget_get_settings") g-object
465 (export 'widget-settings)
467 ; TODO: gtk_widget_get_clipboard
469 (defcfun (widget-display "gtk_widget_get_display") g-object
472 (export 'widget-display)
474 (defcfun (widget-root-window "gtk_widget_get_root_window") g-object
477 (export 'widget-root-window)
479 (defcfun (widget-screen "gtk_widget_get_screen") g-object
482 (export 'widget-screen)
484 (defcfun (widget-has-screen "gtk_widget_has_screen") :boolean
487 (export 'widget-has-screen)
489 ; TODO: gtk_widget_set_child_visible
491 (defcfun (widget-thaw-child-notify "gtk_widget_thaw_child_notify") :void
494 (export 'widget-thaw-child-notify)
496 ; TODO: gtk_widget_list_mnemonic_labels
498 (defcfun (widget-add-mnemonic-label "gtk_widget_add_mnemonic_label") :void
502 (export 'widget-add-mnemonic-label)
504 (defcfun (widget-remove-mnemonic-label "gtk_widget_remove_mnemonic_label") :void
508 (export 'widget-remove-mnemonic-label)
510 (defcfun (widget-action "gtk_widget_get_action") g-object
513 (export 'widget-action)
515 (defcfun (widget-composited-p "gtk_widget_is_composited") :boolean
518 (export 'widget-composited-p)
520 (defcfun (widget-error-bell "gtk_widget_error_bell") :void
523 (export 'widget-error-bell)
525 (defcfun (widget-trigger-tooltip-query "gtk_tooltip_trigger_tooltip_query") :void
528 (export 'widget-trigger-tooltip-query)
530 (defcfun gtk-widget-get-snapshot g-object
532 (clip-rectangle (g-boxed-foreign rectangle)))
534 (defun widget-snapshot (widget &optional clip-rectangle)
535 (gtk-widget-get-snapshot widget clip-rectangle))
537 (export 'widget-snapshot)