8 module ListItem = struct
9 let cast w : list_item obj = Object.try_cast w "GtkListItem"
10 external create : unit -> list_item obj = "ml_gtk_list_item_new"
11 external create_with_label : string -> list_item obj
12 = "ml_gtk_list_item_new_with_label"
13 let create ?label () =
14 match label with None -> create ()
15 | Some label -> create_with_label label
19 let cast w : liste obj = Object.try_cast w "GtkList"
20 external create : unit -> liste obj = "ml_gtk_list_new"
21 external insert_item :
22 [>`list] obj -> [>`listitem] obj -> pos:int -> unit
23 = "ml_gtk_list_insert_item"
24 let insert_items l wl ~pos =
25 let wl = if pos < 0 then wl else List.rev wl in
26 List.iter wl ~f:(insert_item l ~pos)
27 let append_items l = insert_items l ~pos:(-1)
28 let prepend_items l = insert_items l ~pos:0
29 external clear_items : [>`list] obj -> start:int -> stop:int -> unit =
30 "ml_gtk_list_clear_items"
31 external select_item : [>`list] obj -> pos:int -> unit
32 = "ml_gtk_list_select_item"
33 external unselect_item : [>`list] obj -> pos:int -> unit
34 = "ml_gtk_list_unselect_item"
35 external select_child : [>`list] obj -> [>`listitem] obj -> unit
36 = "ml_gtk_list_select_child"
37 external unselect_child : [>`list] obj -> [>`listitem] obj -> unit
38 = "ml_gtk_list_unselect_child"
39 external child_position : [>`list] obj -> [>`listitem] obj -> int
40 = "ml_gtk_list_child_position"
41 external set_selection_mode : [>`list] obj -> selection_mode -> unit
42 = "ml_gtk_list_set_selection_mode"
43 module Signals = struct
45 let selection_changed : ([>`list],_) t =
46 { name = "selection_changed"; marshaller = marshal_unit }
47 let select_child : ([>`list],_) t =
48 { name = "select_child"; marshaller = Widget.Signals.marshal }
49 let unselect_child : ([>`list],_) t =
50 { name = "unselect_child"; marshaller = Widget.Signals.marshal }
55 let cast w : clist obj = Object.try_cast w "GtkCList"
56 external create : cols:int -> clist obj = "ml_gtk_clist_new"
57 external create_with_titles : string array -> clist obj
58 = "ml_gtk_clist_new_with_titles"
59 external get_rows : [>`clist] obj -> int = "ml_gtk_clist_get_rows"
60 external get_columns : [>`clist] obj -> int = "ml_gtk_clist_get_columns"
61 external get_focus_row : [>`clist] obj -> int
62 = "ml_gtk_clist_get_focus_row"
63 external set_hadjustment : [>`clist] obj -> [>`adjustment] obj -> unit
64 = "ml_gtk_clist_set_hadjustment"
65 external set_vadjustment : [>`clist] obj -> [>`adjustment] obj -> unit
66 = "ml_gtk_clist_set_vadjustment"
67 external get_hadjustment : [>`clist] obj -> adjustment obj
68 = "ml_gtk_clist_get_hadjustment"
69 external get_vadjustment : [>`clist] obj -> adjustment obj
70 = "ml_gtk_clist_get_vadjustment"
71 external set_shadow_type : [>`clist] obj -> shadow_type -> unit
72 = "ml_gtk_clist_set_shadow_type"
73 external set_selection_mode : [>`clist] obj -> selection_mode -> unit
74 = "ml_gtk_clist_set_selection_mode"
75 external set_reorderable : [>`clist] obj -> bool -> unit
76 = "ml_gtk_clist_set_reorderable"
77 external set_use_drag_icons : [>`clist] obj -> bool -> unit
78 = "ml_gtk_clist_set_use_drag_icons"
79 external set_button_actions :
80 [>`clist] obj -> int -> button_action list -> unit
81 = "ml_gtk_clist_set_button_actions"
82 external freeze : [>`clist] obj -> unit = "ml_gtk_clist_freeze"
83 external thaw : [>`clist] obj -> unit = "ml_gtk_clist_thaw"
84 external column_titles_show : [>`clist] obj -> unit
85 = "ml_gtk_clist_column_titles_show"
86 external column_titles_hide : [>`clist] obj -> unit
87 = "ml_gtk_clist_column_titles_hide"
88 external column_title_active : [>`clist] obj -> int -> unit
89 = "ml_gtk_clist_column_title_active"
90 external column_title_passive : [>`clist] obj -> int -> unit
91 = "ml_gtk_clist_column_title_passive"
92 external column_titles_active : [>`clist] obj -> unit
93 = "ml_gtk_clist_column_titles_active"
94 external column_titles_passive : [>`clist] obj -> unit
95 = "ml_gtk_clist_column_titles_passive"
96 external set_column_title : [>`clist] obj -> int -> string -> unit
97 = "ml_gtk_clist_set_column_title"
98 external get_column_title : [>`clist] obj -> int -> string
99 = "ml_gtk_clist_get_column_title"
100 external set_column_widget : [>`clist] obj -> int -> [>`widget] obj -> unit
101 = "ml_gtk_clist_set_column_widget"
102 external get_column_widget : [>`clist] obj -> int -> widget obj
103 = "ml_gtk_clist_get_column_widget"
104 external set_column_justification :
105 [>`clist] obj -> int -> justification -> unit
106 = "ml_gtk_clist_set_column_justification"
107 external set_column_visibility : [>`clist] obj -> int -> bool -> unit
108 = "ml_gtk_clist_set_column_visibility"
109 external set_column_resizeable : [>`clist] obj -> int -> bool -> unit
110 = "ml_gtk_clist_set_column_resizeable"
111 external set_column_auto_resize : [>`clist] obj -> int -> bool -> unit
112 = "ml_gtk_clist_set_column_auto_resize"
113 external columns_autosize : [>`clist] obj -> unit
114 = "ml_gtk_clist_columns_autosize"
115 external optimal_column_width : [>`clist] obj -> int -> int
116 = "ml_gtk_clist_optimal_column_width"
117 external set_column_width : [>`clist] obj -> int -> int -> unit
118 = "ml_gtk_clist_set_column_width"
119 external set_column_min_width : [>`clist] obj -> int -> int -> unit
120 = "ml_gtk_clist_set_column_min_width"
121 external set_column_max_width : [>`clist] obj -> int -> int -> unit
122 = "ml_gtk_clist_set_column_max_width"
123 external set_row_height : [>`clist] obj -> int -> unit
124 = "ml_gtk_clist_set_row_height"
127 int -> int -> row_align:clampf -> col_align:clampf -> unit
128 = "ml_gtk_clist_moveto"
129 external row_is_visible : [>`clist] obj -> int -> visibility
130 = "ml_gtk_clist_row_is_visible"
131 external get_cell_type : [>`clist] obj -> int -> int -> cell_type
132 = "ml_gtk_clist_get_cell_type"
133 external set_text : [>`clist] obj -> int -> int -> string -> unit
134 = "ml_gtk_clist_set_text"
135 external get_text : [>`clist] obj -> int -> int -> string
136 = "ml_gtk_clist_get_text"
137 external set_pixmap :
139 int -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit
140 = "ml_gtk_clist_set_pixmap"
141 external get_pixmap :
142 [>`clist] obj -> int -> int -> Gdk.pixmap option * Gdk.bitmap option
143 = "ml_gtk_clist_get_pixmap"
144 external set_pixtext :
145 [>`clist] obj -> int -> int ->
146 string -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit
147 = "ml_gtk_clist_set_pixtext_bc" "ml_gtk_clist_set_pixtext"
148 external set_foreground :
149 [>`clist] obj -> row:int -> Gdk.Color.t Gpointer.optboxed -> unit
150 = "ml_gtk_clist_set_foreground"
151 external set_background :
152 [>`clist] obj -> row:int -> Gdk.Color.t Gpointer.optboxed -> unit
153 = "ml_gtk_clist_set_background"
154 external get_cell_style : [>`clist] obj -> int -> int -> Gtk.style
155 = "ml_gtk_clist_get_cell_style"
156 external set_cell_style : [>`clist] obj -> int -> int -> Gtk.style -> unit
157 = "ml_gtk_clist_set_cell_style"
158 external get_row_style : [>`clist] obj -> row:int -> Gtk.style
159 = "ml_gtk_clist_get_row_style"
160 external set_row_style : [>`clist] obj -> row:int -> Gtk.style -> unit
161 = "ml_gtk_clist_set_row_style"
162 external set_selectable : [>`clist] obj -> row:int -> bool -> unit
163 = "ml_gtk_clist_set_selectable"
164 external get_selectable : [>`clist] obj -> row:int -> bool
165 = "ml_gtk_clist_get_selectable"
167 [>`clist] obj -> int -> int -> vertical:int -> horizontal:int -> unit
168 = "ml_gtk_clist_set_shift"
169 external insert : [>`clist] obj -> row:int -> Gpointer.optstring array -> int
170 = "ml_gtk_clist_insert"
171 let insert w ~row texts =
172 let len = get_columns w in
173 if List.length texts > len then invalid_arg "CList.insert";
174 let arr = Array.create (get_columns w) None in
175 List.fold_left texts ~init:0
176 ~f:(fun pos text -> arr.(pos) <- text; pos+1);
177 let r = insert w ~row (Array.map ~f:Gpointer.optstring arr) in
178 if r = -1 then invalid_arg "GtkCList::insert";
180 external remove : [>`clist] obj -> row:int -> unit
181 = "ml_gtk_clist_remove"
182 external set_row_data : [>`clist] obj -> row:int -> Obj.t -> unit
183 = "ml_gtk_clist_set_row_data"
184 external get_row_data : [>`clist] obj -> row:int -> Obj.t
185 = "ml_gtk_clist_get_row_data"
186 external select : [>`clist] obj -> int -> int -> unit
187 = "ml_gtk_clist_select_row"
188 external unselect : [>`clist] obj -> int -> int -> unit
189 = "ml_gtk_clist_unselect_row"
190 external clear : [>`clist] obj -> unit = "ml_gtk_clist_clear"
191 external get_row_column : [>`clist] obj -> x:int -> y:int -> int * int
192 = "ml_gtk_clist_get_selection_info"
193 external select_all : [>`clist] obj -> unit = "ml_gtk_clist_select_all"
194 external unselect_all : [>`clist] obj -> unit = "ml_gtk_clist_unselect_all"
195 external swap_rows : [>`clist] obj -> int -> int -> unit
196 = "ml_gtk_clist_swap_rows"
197 external row_move : [>`clist] obj -> int -> dst:int -> unit
198 = "ml_gtk_clist_row_move"
199 external set_sort_column : [>`clist] obj -> int -> unit
200 = "ml_gtk_clist_set_sort_column"
201 external set_sort_type : [>`clist] obj -> sort_type -> unit
202 = "ml_gtk_clist_set_sort_type"
203 external sort : [>`clist] obj -> unit
204 = "ml_gtk_clist_sort"
205 external set_auto_sort : [>`clist] obj -> bool -> unit
206 = "ml_gtk_clist_set_auto_sort"
207 let set_titles_show w = function
208 true -> column_titles_show w
209 | false -> column_titles_hide w
210 let set_titles_active w = function
211 true -> column_titles_active w
212 | false -> column_titles_passive w
213 let set ?hadjustment ?vadjustment ?shadow_type
214 ?(button_actions=[]) ?selection_mode ?reorderable
215 ?use_drag_icons ?row_height ?titles_show ?titles_active w =
216 let may_set f param = may param ~f:(f w) in
217 may_set set_hadjustment hadjustment;
218 may_set set_vadjustment vadjustment;
219 may_set set_shadow_type shadow_type;
220 List.iter button_actions ~f:(fun (n,act) -> set_button_actions w n act);
221 may_set set_selection_mode selection_mode;
222 may_set set_reorderable reorderable;
223 may_set set_use_drag_icons use_drag_icons;
224 may_set set_row_height row_height;
225 may_set set_titles_show titles_show;
226 may_set set_titles_active titles_active
227 let set_sort w ?auto ?column ?dir:sort_type () =
228 may auto ~f:(set_auto_sort w);
229 may column ~f:(set_sort_column w);
230 may sort_type ~f:(set_sort_type w)
231 let set_cell w ?text ?pixmap ?mask ?(spacing=0) ?style row col =
232 begin match text, pixmap with
234 set_text w row col text
236 set_pixmap w row col pm (Gpointer.optboxed mask)
237 | Some text, Some pm ->
238 set_pixtext w row col text spacing pm (Gpointer.optboxed mask)
241 may style ~f:(set_cell_style w row col)
242 let set_column w ?widget ?title ?title_active ?justification
243 ?visibility ?resizeable ?auto_resize ?width ?min_width ?max_width
245 let may_set f param = may param ~f:(f w col) in
246 may_set set_column_widget widget;
247 may_set set_column_title title;
249 ~f:(fun active -> if active then column_title_active w col
250 else column_title_passive w col);
251 may_set set_column_justification justification;
252 may_set set_column_visibility visibility;
253 may_set set_column_resizeable resizeable;
254 may_set set_column_auto_resize auto_resize;
255 may_set set_column_width width;
256 may_set set_column_min_width min_width;
257 may_set set_column_max_width max_width
258 let set_row w ?foreground ?background ?selectable ?style row =
259 let may_set f = may ~f:(f w ~row) in
260 may_set set_foreground foreground;
261 may_set set_background background;
262 may_set set_selectable selectable;
263 may_set set_row_style style
264 module Signals = struct
267 let marshal_select f argv = function
268 | INT row :: INT column :: POINTER p :: _ ->
269 let event : GdkEvent.Button.t option =
270 may_map ~f:GdkEvent.unsafe_copy p
272 f ~row ~column ~event
273 | _ -> invalid_arg "GtkList.CList.Signals.marshal_select"
274 let select_row : ([>`clist],_) t =
275 { name = "select_row"; marshaller = marshal_select }
276 let unselect_row : ([>`clist],_) t =
277 { name = "unselect_row"; marshaller = marshal_select }
278 let click_column : ([>`clist],_) t =
279 { name = "click_column"; marshaller = marshal_int }
280 external val_scroll_type : int -> scroll_type = "ml_Val_scroll_type"
281 let marshal_scroll f argv = function
282 | INT st :: FLOAT (pos : clampf) :: _ ->
283 f (val_scroll_type st) ~pos
284 | _ -> invalid_arg "GtkList.CList.Signals.marshal_scroll"
285 let scroll_horizontal : ([>`clist],_) t =
286 { name = "scroll_horizontal"; marshaller = marshal_scroll }
287 let scroll_vertical : ([>`clist],_) t =
288 { name = "scroll_vertical"; marshaller = marshal_scroll }
289 external emit_scroll :
290 'a obj -> name:string -> Tags.scroll_type -> pos:clampf -> unit
291 = "ml_gtk_signal_emit_scroll"
292 let emit_scroll = emit ~emitter:emit_scroll