/usr/lib/ocaml/lablgtk2/gtkList.ml is in liblablgtk2-ocaml-dev 2.18.3+dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | (**************************************************************************)
(* Lablgtk *)
(* *)
(* This program is free software; you can redistribute it *)
(* and/or modify it under the terms of the GNU Library General *)
(* Public License as published by the Free Software Foundation *)
(* version 2, with the exception described in file COPYING which *)
(* comes with the library. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General *)
(* Public License along with this program; if not, write to the *)
(* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *)
(* Boston, MA 02111-1307 USA *)
(* *)
(* *)
(**************************************************************************)
(* $Id$ *)
open StdLabels
open Gaux
open Gtk
open Tags
open GtkListProps
open GtkBase
external _gtklist_init : unit -> unit = "ml_gtklist_init"
let () = _gtklist_init ()
module ListItem = struct
include ListItem
external create_with_label : string -> list_item obj
= "ml_gtk_list_item_new_with_label"
let create ?label () =
match label with None -> create []
| Some label -> create_with_label label
end
module Liste = struct
include Liste
external insert_item :
[>`list] obj -> [>`listitem] obj -> pos:int -> unit
= "ml_gtk_list_insert_item"
let insert_items l wl ~pos =
let wl = if pos < 0 then wl else List.rev wl in
List.iter wl ~f:(insert_item l ~pos)
let append_items l = insert_items l ~pos:(-1)
let prepend_items l = insert_items l ~pos:0
external clear_items : [>`list] obj -> start:int -> stop:int -> unit =
"ml_gtk_list_clear_items"
external select_item : [>`list] obj -> pos:int -> unit
= "ml_gtk_list_select_item"
external unselect_item : [>`list] obj -> pos:int -> unit
= "ml_gtk_list_unselect_item"
external select_child : [>`list] obj -> [>`listitem] obj -> unit
= "ml_gtk_list_select_child"
external unselect_child : [>`list] obj -> [>`listitem] obj -> unit
= "ml_gtk_list_unselect_child"
external child_position : [>`list] obj -> [>`listitem] obj -> int
= "ml_gtk_list_child_position"
end
module CList = struct
include Clist
external create : cols:int -> clist obj = "ml_gtk_clist_new"
external create_with_titles : string array -> clist obj
= "ml_gtk_clist_new_with_titles"
external get_rows : [>`clist] obj -> int = "ml_gtk_clist_get_rows"
external get_columns : [>`clist] obj -> int = "ml_gtk_clist_get_columns"
external get_focus_row : [>`clist] obj -> int
= "ml_gtk_clist_get_focus_row"
external set_hadjustment : [>`clist] obj -> [>`adjustment] obj -> unit
= "ml_gtk_clist_set_hadjustment"
external set_vadjustment : [>`clist] obj -> [>`adjustment] obj -> unit
= "ml_gtk_clist_set_vadjustment"
external get_hadjustment : [>`clist] obj -> adjustment obj
= "ml_gtk_clist_get_hadjustment"
external get_vadjustment : [>`clist] obj -> adjustment obj
= "ml_gtk_clist_get_vadjustment"
external set_shadow_type : [>`clist] obj -> shadow_type -> unit
= "ml_gtk_clist_set_shadow_type"
external set_selection_mode : [>`clist] obj -> selection_mode -> unit
= "ml_gtk_clist_set_selection_mode"
external set_reorderable : [>`clist] obj -> bool -> unit
= "ml_gtk_clist_set_reorderable"
external set_use_drag_icons : [>`clist] obj -> bool -> unit
= "ml_gtk_clist_set_use_drag_icons"
external set_button_actions :
[>`clist] obj -> int -> button_action list -> unit
= "ml_gtk_clist_set_button_actions"
external freeze : [>`clist] obj -> unit = "ml_gtk_clist_freeze"
external thaw : [>`clist] obj -> unit = "ml_gtk_clist_thaw"
external column_titles_show : [>`clist] obj -> unit
= "ml_gtk_clist_column_titles_show"
external column_titles_hide : [>`clist] obj -> unit
= "ml_gtk_clist_column_titles_hide"
external column_title_active : [>`clist] obj -> int -> unit
= "ml_gtk_clist_column_title_active"
external column_title_passive : [>`clist] obj -> int -> unit
= "ml_gtk_clist_column_title_passive"
external column_titles_active : [>`clist] obj -> unit
= "ml_gtk_clist_column_titles_active"
external column_titles_passive : [>`clist] obj -> unit
= "ml_gtk_clist_column_titles_passive"
external set_column_title : [>`clist] obj -> int -> string -> unit
= "ml_gtk_clist_set_column_title"
external get_column_title : [>`clist] obj -> int -> string
= "ml_gtk_clist_get_column_title"
external set_column_widget : [>`clist] obj -> int -> [>`widget] obj -> unit
= "ml_gtk_clist_set_column_widget"
external get_column_widget : [>`clist] obj -> int -> widget obj
= "ml_gtk_clist_get_column_widget"
external set_column_justification :
[>`clist] obj -> int -> justification -> unit
= "ml_gtk_clist_set_column_justification"
external set_column_visibility : [>`clist] obj -> int -> bool -> unit
= "ml_gtk_clist_set_column_visibility"
external set_column_resizeable : [>`clist] obj -> int -> bool -> unit
= "ml_gtk_clist_set_column_resizeable"
external set_column_auto_resize : [>`clist] obj -> int -> bool -> unit
= "ml_gtk_clist_set_column_auto_resize"
external columns_autosize : [>`clist] obj -> unit
= "ml_gtk_clist_columns_autosize"
external optimal_column_width : [>`clist] obj -> int -> int
= "ml_gtk_clist_optimal_column_width"
external set_column_width : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_set_column_width"
external set_column_min_width : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_set_column_min_width"
external set_column_max_width : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_set_column_max_width"
external set_row_height : [>`clist] obj -> int -> unit
= "ml_gtk_clist_set_row_height"
external moveto :
[>`clist] obj ->
int -> int -> row_align:clampf -> col_align:clampf -> unit
= "ml_gtk_clist_moveto"
external row_is_visible : [>`clist] obj -> int -> visibility
= "ml_gtk_clist_row_is_visible"
external get_cell_type : [>`clist] obj -> int -> int -> cell_type
= "ml_gtk_clist_get_cell_type"
external set_text : [>`clist] obj -> int -> int -> string -> unit
= "ml_gtk_clist_set_text"
external get_text : [>`clist] obj -> int -> int -> string
= "ml_gtk_clist_get_text"
external set_pixmap :
[>`clist] obj ->
int -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit
= "ml_gtk_clist_set_pixmap"
external get_pixmap :
[>`clist] obj -> int -> int -> Gdk.pixmap option * Gdk.bitmap option
= "ml_gtk_clist_get_pixmap"
external set_pixtext :
[>`clist] obj -> int -> int ->
string -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit
= "ml_gtk_clist_set_pixtext_bc" "ml_gtk_clist_set_pixtext"
external set_foreground :
[>`clist] obj -> row:int -> Gdk.color Gpointer.optboxed -> unit
= "ml_gtk_clist_set_foreground"
external set_background :
[>`clist] obj -> row:int -> Gdk.color Gpointer.optboxed -> unit
= "ml_gtk_clist_set_background"
external get_cell_style : [>`clist] obj -> int -> int -> Gtk.style
= "ml_gtk_clist_get_cell_style"
external set_cell_style : [>`clist] obj -> int -> int -> Gtk.style -> unit
= "ml_gtk_clist_set_cell_style"
external get_row_style : [>`clist] obj -> row:int -> Gtk.style
= "ml_gtk_clist_get_row_style"
external set_row_style : [>`clist] obj -> row:int -> Gtk.style -> unit
= "ml_gtk_clist_set_row_style"
external set_selectable : [>`clist] obj -> row:int -> bool -> unit
= "ml_gtk_clist_set_selectable"
external get_selectable : [>`clist] obj -> row:int -> bool
= "ml_gtk_clist_get_selectable"
external set_shift :
[>`clist] obj -> int -> int -> vertical:int -> horizontal:int -> unit
= "ml_gtk_clist_set_shift"
external insert : [>`clist] obj -> row:int -> Gpointer.optstring array -> int
= "ml_gtk_clist_insert"
let insert w ~row texts =
let len = get_columns w in
if List.length texts > len then invalid_arg "CList.insert";
let arr = Array.create (get_columns w) None in
List.fold_left texts ~init:0
~f:(fun pos text -> arr.(pos) <- text; pos+1);
let r = insert w ~row (Array.map ~f:Gpointer.optstring arr) in
if r = -1 then invalid_arg "GtkCList::insert";
r
external remove : [>`clist] obj -> row:int -> unit
= "ml_gtk_clist_remove"
external set_row_data : [>`clist] obj -> row:int -> Obj.t -> unit
= "ml_gtk_clist_set_row_data"
external get_row_data : [>`clist] obj -> row:int -> Obj.t
= "ml_gtk_clist_get_row_data"
external select : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_select_row"
external unselect : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_unselect_row"
external clear : [>`clist] obj -> unit = "ml_gtk_clist_clear"
external get_row_column : [>`clist] obj -> x:int -> y:int -> int * int
= "ml_gtk_clist_get_selection_info"
external select_all : [>`clist] obj -> unit = "ml_gtk_clist_select_all"
external unselect_all : [>`clist] obj -> unit = "ml_gtk_clist_unselect_all"
external swap_rows : [>`clist] obj -> int -> int -> unit
= "ml_gtk_clist_swap_rows"
external row_move : [>`clist] obj -> int -> dst:int -> unit
= "ml_gtk_clist_row_move"
external set_sort_column : [>`clist] obj -> int -> unit
= "ml_gtk_clist_set_sort_column"
external set_sort_type : [>`clist] obj -> sort_type -> unit
= "ml_gtk_clist_set_sort_type"
external sort : [>`clist] obj -> unit
= "ml_gtk_clist_sort"
external set_auto_sort : [>`clist] obj -> bool -> unit
= "ml_gtk_clist_set_auto_sort"
let set_titles_show w = function
true -> column_titles_show w
| false -> column_titles_hide w
let set_titles_active w = function
true -> column_titles_active w
| false -> column_titles_passive w
let setter ~cont ?hadjustment ?vadjustment ?(button_actions=[])
?titles_show =
cont (fun w ->
let may_set f param = may param ~f:(f w) in
may_set set_hadjustment hadjustment;
may_set set_vadjustment vadjustment;
List.iter button_actions ~f:(fun (n,act) -> set_button_actions w n act);
may_set set_titles_show titles_show)
let set_sort w ?auto ?column ?dir:sort_type () =
may auto ~f:(set_auto_sort w);
may column ~f:(set_sort_column w);
may sort_type ~f:(set_sort_type w)
let set_cell w ?text ?pixmap ?mask ?(spacing=0) ?style row col =
begin match text, pixmap with
| Some text, None ->
set_text w row col text
| None, Some pm ->
set_pixmap w row col pm (Gpointer.optboxed mask)
| Some text, Some pm ->
set_pixtext w row col text spacing pm (Gpointer.optboxed mask)
| _ -> ()
end;
may style ~f:(set_cell_style w row col)
let set_column w ?widget ?title ?title_active ?justification
?visibility ?resizeable ?auto_resize ?width ?min_width ?max_width
col =
let may_set f param = may param ~f:(f w col) in
may_set set_column_widget widget;
may_set set_column_title title;
may title_active
~f:(fun active -> if active then column_title_active w col
else column_title_passive w col);
may_set set_column_justification justification;
may_set set_column_visibility visibility;
may_set set_column_resizeable resizeable;
may_set set_column_auto_resize auto_resize;
may_set set_column_width width;
may_set set_column_min_width min_width;
may_set set_column_max_width max_width
let set_row w ?foreground ?background ?selectable ?style row =
let may_set f = may ~f:(f w ~row) in
may_set set_foreground foreground;
may_set set_background background;
may_set set_selectable selectable;
may_set set_row_style style
external get_row_state :
[>`clist] obj -> int -> Gtk.Tags.state_type
= "ml_gtk_clist_get_row_state"
let emit_scroll =
GtkSignal.emit ~conv:ignore ~emitter:
(fun ~cont t ~(pos:clampf) ->
cont [|`INT(Gpointer.encode_variant GtkEnums.scroll_type t);
`FLOAT pos|])
end
|