GtkWidget binding

diff --git a/api.ods b/api.ods
index 9fdf1b6..7fb2a4e 100644 (file)
Binary files a/api.ods and b/api.ods differ

diff --git a/bugs/issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml b/bugs/issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml
index 7571a0a..40c276a 100644 (file)
--- a/bugs/issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml
+++ b/bugs/issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml
@@ -5,8 +5,8 @@ type: :task
 component: cl-gtk2
 release: "0.1"
 reporter: Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
-status: :unstarted
-disposition: 
+status: :closed
+disposition: :fixed
 creation_time: 2009-10-03 01:23:31.425523 Z
 references: []
 
@@ -16,3 +16,7 @@ log_events:
   - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
   - created
   - ""
+- - 2009-10-10 10:57:36.611088 Z
+  - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
+  - closed with disposition fixed
+  - ""

diff --git a/generating.lisp b/generating.lisp
index 84835b5..9e58e08 100644 (file)
--- a/generating.lisp
+++ b/generating.lisp
@@ -277,7 +277,9 @@
         (:cffi gtk::accessible gtk::widget-accessible g-object
          "gtk_widget_get_accessible" nil)
         (:cffi gtk::tooltip-window gtk::widget-tooltip-window g-object
-        "gtk_widget_get_tooltip_window" "gtk_widget_set_tooltip_window"))
+        "gtk_widget_get_tooltip_window" "gtk_widget_set_tooltip_window")
+        (:cffi gtk::style gtk::widget-style (g-object gtk::style)
+         "gtk_widget_get_style" "gtk_widget_set_style"))
        ("GtkWindowGroup"
         (:cffi gtk::windows gtk::window-group-windows (glist (g-object gtk::gtk-window))
          "gtk_window_group_list_windows" nil))

diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp
index 25df5fb..a1f25c8 100644 (file)
--- a/gtk/gtk.widget.lisp
+++ b/gtk/gtk.widget.lisp
@@ -28,6 +28,7 @@
   (foreign-slot-value (pointer widget) '%gtk-widget :state))
 
 (export 'widget-state)
+
 (defun widget-saved-state (widget)
   (foreign-slot-value (pointer widget) '%gtk-widget :saved-state))
 
@@ -169,7 +170,11 @@
 
 (export 'widget-can-activate-accel)
 
-; TODO: gtk_widget_event
+(defcfun (widget-event "gtk_widget_event") :boolean
+  (widget (g-object widget))
+  (event (g-boxed-foreign event)))
+
+(export 'widget-event)
 
 (defcfun (widget-activate "gtk_widget_activate") :boolean
   (widget g-object))
@@ -185,10 +190,10 @@
 (defcfun gtk-widget-intersect :boolean
   (widget g-object)
   (area (g-boxed-foreign rectangle))
-  (intersection (g-boxed-foreign rectangle :in-out)))
+  (intersection (g-boxed-foreign rectangle)))
 
 (defun widget-intersect (widget rectangle)
-  (let ((result (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+  (let ((result (make-rectangle)))
     (when (gtk-widget-intersect widget rectangle result)
       result)))
 
@@ -209,25 +214,17 @@
 
 (export 'widget-grab-default)
 
-; TODO: gtk_widget_set_state
-
-; TODO: gtk_widget_set_parent_window
-
-; TODO: gtk_widget_get_parent_window
-
-; TODO: gtk_widget_set_extension_events
-
-; TODO: gtk_widget_get_extension_events
-
-
-; fix ownership issues:
-; TODO: gtk_widget_get_toplevel
+(defcfun (widget-set-state "gtk_widget_set_state") :void
+  (widget (g-object widget))
+  (state state-type))
 
-; TODO: gtk_widget_get_ancestor
+(export 'widget-set-state)
 
-; TODO: gtk_widget_get_colormap
+(defcfun (widget-ancestor "gtk_widget_get_ancestor") (g-object widget)
+  (widget (g-object widget))
+  (type g-type-designator))
 
-; TODO: gtk_widget_get_visual
+(export 'widget-ancestor)
 
 (defcfun gtk-widget-get-pointer :void
   (widget g-object)
@@ -241,11 +238,11 @@
 
 (export 'widget-pointer)
 
-(defcfun (widget-contained-p "gtk_widget_is_ancestor") :boolean
+(defcfun (widget-is-ancestor "gtk_widget_is_ancestor") :boolean
   (widget g-object)
   (container g-object))
 
-(export 'widget-contained-p)
+(export 'widget-is-ancestor)
 
 (defcfun gtk-widget-translate-coordinates :boolean
   (src-widget g-object)
@@ -273,17 +270,32 @@
 
 (export 'widget-reset-rc-styles)
 
-; TODO: gtk_widget_push_colormap
+(defcfun (widget-push-colormap "gtk_widget_push_colormap") :void
+  (colormap (g-object gdk-colormap)))
+
+(export 'widget-push-colormap)
+
+(defcfun (widget-pop-colormap "gtk_widget_pop_colormap") :void)
+
+(export 'widget-pop-colormap)
+
+(defcfun (widget-default-colormap "gtk_widget_get_default_colormap") (g-object gdk-colormap))
 
-; TODO: gtk_widget_pop_colormap
+(defcfun gtk-widget-set-default-colormap :void
+  (colormap (g-object gdk-colormap)))
 
-; TODO: gtk_widget_set_default_colormap
+(defun (setf widget-default-colormap) (colormap)
+  (gtk-widget-set-default-colormap colormap))
 
-; TODO: gtk_widget_get_default_colormap
+(export 'widget-default-colormap)
 
-; TODO: gtk_widget_get_default_style (ownership)
+(defcfun (widget-default-style "gtk_widget_get_default_style") (g-object style))
 
-; TODO: gtk_widget_get_default_visual
+(export 'widget-default-style)
+
+(defcfun (widget-default-visual "gtk_widget_get_default_visual") (g-object visual))
+
+(export 'widget-default-visual)
 
 (defcfun (widget-default-direction "gtk_widget_get_default_direction") text-direction)
 
@@ -295,9 +307,21 @@
 
 (export 'widget-default-direction)
 
-; TODO: gtk_widget_shape_combine_mask 
+(defcfun (widget-shape-combine-mask "gtk_widget_shape_combine_mask") :void
+  (widget (g-object widget))
+  (shape-mask g-object)
+  (offset-x :int)
+  (offset-y :int))
+
+(export 'widget-shape-combine-mask)
 
-; TODO: gtk_widget_input_shape_combine_mask
+(defcfun (widget-input-shape-combine-mask "gtk_widget_input_shape_combine_mask") :void
+  (widget (g-object widget))
+  (shape-mask g-object)
+  (offset-x :int)
+  (offset-y :int))
+
+(export 'widget-input-shape-combine-mask)
 
 (defcfun gtk-widget-path :void
   (widget g-object)
@@ -321,19 +345,45 @@
 
 (export 'widget-path)
 
-; TODO: gtk_widget_modify_fg
+(defcfun (widget-modify-fg "gtk_widget_modify_fg") :void
+  (widget (g-object widget))
+  (state state-type)
+  (color (g-boxed-foreign color)))
 
-; TODO: gtk_widget_modify_bg
+(export 'widget-modify-fg)
 
-; TODO: gtk_widget_modify_text
+(defcfun (widget-modify-bg "gtk_widget_modify_bg") :void
+  (widget (g-object widget))
+  (state state-type)
+  (color (g-boxed-foreign color)))
 
-; TODO: gtk_widget_modify_base
+(export 'widget-modify-bg)
 
-; TODO: gtk_widget_modify_font
+(defcfun (widget-modify-text "gtk_widget_modify_text") :void
+  (widget (g-object widget))
+  (state state-type)
+  (color (g-boxed-foreign color)))
+
+(export 'widget-modify-text)
+
+(defcfun (widget-modify-base "gtk_widget_modify_base") :void
+  (widget (g-object widget))
+  (state state-type)
+  (color (g-boxed-foreign color)))
 
-; TODO: gtk_widget_modify_cursor 
+(export 'widget-modify-base)
+
+;void                gtk_widget_modify_font              (GtkWidget *widget,
+;                                                         PangoFontDescription *font_desc);
+
+(defcfun (widget-modify-cursor "gtk_widget_modify_cursor") :void
+  (widget (g-object widget))
+  (primary (g-boxed-foreign color))
+  (secondary (g-boxed-foreign color)))
 
-(defcfun (widget-create-pango-context "gtk_widget_create_pango_context") g-object
+(export 'widget-modify-cursor)
+
+(defcfun (widget-create-pango-context "gtk_widget_create_pango_context") (g-object :already-referenced)
   (widget g-object))
 
 (export 'widget-create-pango-context)
@@ -367,6 +417,20 @@
 
 (export 'widget-pop-composite-child)
 
+(defcfun (widget-queue-clear "gtk_widget_queue_clear") :void
+  (widget (g-object widget)))
+
+(export 'widget-queue-clear)
+
+(defcfun (widget-queue-clear-area "gtk_widget_queue_clear_area") :void
+  (widget (g-object widget))
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int))
+
+(export 'widget-queue-clear-area)
+
 (defcfun (widget-queue-draw-area "gtk_widget_queue_draw_area") :void
   (widget g-object)
   (x :int)
@@ -381,6 +445,12 @@
 
 (export 'widget-reset-shapes)
 
+(defcfun (widget-set-double-buffered "gtk_widget_set_double_buffered") :void
+  (widget (g-object widget))
+  (double-buffered :boolean))
+
+(export 'widget-set-double-buffered)
+
 (defcfun (widget-set-scroll-adjustments "gtk_widget_set_scroll_adjustments") :boolean
   (widget g-object)
   (hadjustment g-object)
@@ -388,6 +458,12 @@
 
 (export 'widget-set-scroll-adjustments)
 
+(defcfun (widget-mnemonic-activate "gtk_widget_mnemonic_activate") :boolean
+  (widget (g-object widget))
+  (group-cycling :boolean))
+
+(export 'widget-mnemonic-activate)
+
 ; TODO: gtk_widget_class_install_style_property
 
 ; TOOD: gtk_widget_class_install_style_property_parser
@@ -411,7 +487,7 @@
   (class :pointer)
   (n-properties (:pointer :int)))
 
-(defun widget-class-get-style-properties (type)
+(defun widget-get-style-properties (type)
   (setf type (ensure-g-type type))
   (let ((class (g-type-class-ref type)))
     (unwind-protect
@@ -426,19 +502,23 @@
                (g-free specs))))
       (g-type-class-unref class))))
 
-(export 'widget-class-get-style-properties)
+(export 'widget-get-style-properties)
 
-(defun widget-child-property-type (widget property-name)
-  (let* ((type (g-type-from-object widget))
-         (class (g-type-class-ref type)))
+(defun widget-style-property-info (type property-name)
+  (let ((class (g-type-class-ref type)))
     (unwind-protect
          (let ((g-param-spec (gtk-widget-class-find-style-property class property-name)))
-           (when (null-pointer-p g-param-spec) (error "Widget ~A has no style-property named '~A'" widget property-name))
-           (foreign-slot-value g-param-spec 'gobject:g-param-spec :value-type))
+           (parse-g-param-spec g-param-spec))
       (g-type-class-unref class))))
 
-(defun widget-child-property-value (widget property-name &optional property-type)
-  (unless property-type (setf property-type (widget-child-property-type widget property-name)))
+(export 'widget-style-property-info)
+
+(defun widget-style-property-type (widget property-name)
+  (let ((property-info (widget-style-property-info (g-type-from-object widget) property-name)))
+    (g-class-property-definition-type property-info)))
+
+(defun widget-style-property-value (widget property-name &optional property-type)
+  (unless property-type (setf property-type (widget-style-property-type widget property-name)))
   (setf property-type (ensure-g-type property-type))
   (with-foreign-object (gvalue 'g-value)
     (g-value-zero gvalue)
@@ -446,7 +526,7 @@
     (prog1 (gtk-widget-style-get-property widget property-name gvalue)
       (g-value-unset gvalue))))
 
-(export 'widget-child-property-value)
+(export 'widget-style-property-value)
 
 (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean
   (widget g-object)
@@ -454,6 +534,12 @@
 
 (export 'widget-child-focus)
 
+(defcfun (widget-child-notify "gtk_widget_child_notify") :void
+  (widget (g-object widget))
+  (property-name :string))
+
+(export 'widget-child-notify)
+
 (defcfun (widget-freeze-child-notify "gtk_widget_freeze_child_notify") :void
   (widget g-object))
 
@@ -464,7 +550,11 @@
 
 (export 'widget-settings)
 
-; TODO: gtk_widget_get_clipboard
+(defcfun (widget-clipboard "gtk_widget_get_clipboard") (g-object clipboard)
+  (widget (g-object widget))
+  (selection gdk-atom-as-string))
+
+(export 'widget-clipboard)
 
 (defcfun (widget-display "gtk_widget_get_display") g-object
   (widget g-object))
@@ -486,14 +576,15 @@
 
 (export 'widget-has-screen)
 
-; TODO: gtk_widget_set_child_visible
-
 (defcfun (widget-thaw-child-notify "gtk_widget_thaw_child_notify") :void
   (widget g-object))
 
 (export 'widget-thaw-child-notify)
 
-; TODO: gtk_widget_list_mnemonic_labels
+(defcfun (widget-mnemonic-labels "gtk_widget_list_mnemonic_labels") (glist (g-object widget) :free-from-foreign t)
+  (widget (g-object widget)))
+
+(export 'widget-mnemonic-labels)
 
 (defcfun (widget-add-mnemonic-label "gtk_widget_add_mnemonic_label") :void
   (widget g-object)