+++ /dev/null
-(* $Id$ *)
-
-open Gaux
-open Gtk
-open GtkBase
-open GtkList
-open GObj
-open GContainer
-
-class list_item obj = object
- inherit container (obj : Gtk.list_item obj)
- method event = new GObj.event_ops obj
- method as_item = obj
- method select () = Item.select obj
- method deselect () = Item.deselect obj
- method toggle () = Item.toggle obj
- method connect = new item_signals obj
-end
-
-let list_item ?label ?border_width ?width ?height ?packing ?(show=true) () =
- let w = ListItem.create ?label () in
- Container.set w ?border_width ?width ?height;
- let item = new list_item w in
- may packing ~f:(fun f -> (f item : unit));
- if show then item#misc#show ();
- item
-
-class liste obj = object
- inherit [list_item] item_container (obj : Gtk.liste obj)
- method private wrap w = new list_item (ListItem.cast w)
- method insert w = Liste.insert_item obj w#as_item
- method clear_items = Liste.clear_items obj
- method select_item = Liste.select_item obj
- method unselect_item = Liste.unselect_item obj
- method child_position (w : list_item) = Liste.child_position obj w#as_item
-end
-
-let liste ?selection_mode ?border_width ?width ?height
- ?packing ?show () =
- let w = Liste.create () in
- may selection_mode ~f:(Liste.set_selection_mode w);
- Container.set w ?border_width ?width ?height;
- pack_return (new liste w) ~packing ~show
-
-(* Cell lists *)
-
-class clist_signals obj = object
- inherit container_signals obj
- method click_column =
- GtkSignal.connect ~sgn:CList.Signals.click_column obj ~after
- method select_row =
- GtkSignal.connect ~sgn:CList.Signals.select_row obj ~after
- method unselect_row =
- GtkSignal.connect ~sgn:CList.Signals.unselect_row obj ~after
- method scroll_vertical =
- GtkSignal.connect ~sgn:CList.Signals.scroll_vertical obj ~after
- method scroll_horizontal =
- GtkSignal.connect ~sgn:CList.Signals.scroll_horizontal obj ~after
-end
-
-class ['a] clist obj = object (self)
- inherit widget (obj : Gtk.clist obj)
- method set_border_width = Container.set_border_width obj
- method event = new GObj.event_ops obj
- method connect = new clist_signals obj
- method rows = CList.get_rows obj
- method columns = CList.get_columns obj
- method focus_row = CList.get_focus_row obj
- method hadjustment = new GData.adjustment (CList.get_hadjustment obj)
- method vadjustment = new GData.adjustment (CList.get_vadjustment obj)
- method set_button_actions = CList.set_button_actions obj
- method freeze () = CList.freeze obj
- method thaw () = CList.thaw obj
- method column_title = CList.get_column_title obj
- method column_widget col =
- new widget (CList.get_column_widget obj col)
- method columns_autosize () = CList.columns_autosize obj
- method optimal_column_width = CList.optimal_column_width obj
- method moveto ?(row_align=0.) ?(col_align=0.) row col =
- CList.moveto obj row col ~row_align ~col_align
- method row_is_visible = CList.row_is_visible obj
- method cell_type = CList.get_cell_type obj
- method cell_text = CList.get_text obj
- method cell_pixmap row col =
- let pm, mask = CList.get_pixmap obj row col in
- may_map pm ~f:(fun x -> new GDraw.pixmap ?mask x)
- method cell_style row col =
- try Some (new style (CList.get_cell_style obj row col))
- with Gpointer.Null -> None
- method row_selectable row = CList.get_selectable obj ~row
- method row_style row =
- try Some (new style (CList.get_row_style obj ~row))
- with Gpointer.Null -> None
- method set_shift = CList.set_shift obj
- method insert ~row texts =
- let texts = List.map texts ~f:(fun x -> Some x) in
- CList.insert obj ~row texts
- method append = self#insert ~row:self#rows
- method prepend = self#insert ~row:0
- method remove = CList.remove obj
- method select = CList.select obj
- method unselect = CList.unselect obj
- method clear () = CList.clear obj
- method get_row_column = CList.get_row_column obj
- method select_all () = CList.select_all obj
- method unselect_all () = CList.unselect_all obj
- method swap_rows = CList.swap_rows obj
- method row_move = CList.row_move obj
- method sort () = CList.sort obj
- method set_hadjustment adj =
- CList.set_hadjustment obj (GData.as_adjustment adj)
- method set_vadjustment adj =
- CList.set_vadjustment obj (GData.as_adjustment adj)
- method set_shadow_type = CList.set_shadow_type obj
- method set_button_actions = CList.set_button_actions obj
- method set_selection_mode = CList.set_selection_mode obj
- method set_reorderable = CList.set_reorderable obj
- method set_use_drag_icons = CList.set_use_drag_icons obj
- method set_row_height = CList.set_row_height obj
- method set_titles_show = CList.set_titles_show obj
- method set_titles_active = CList.set_titles_active obj
- method set_sort = CList.set_sort obj
- method set_column ?widget =
- CList.set_column obj ?widget:(may_map widget ~f:as_widget)
- method set_row ?foreground ?background ?selectable ?style =
- let color = may_map ~f:(fun c -> Gpointer.optboxed (GDraw.optcolor c))
- and style = may_map ~f:(fun (st : style) -> st#as_style) style in
- CList.set_row obj
- ?foreground:(color foreground) ?background:(color background)
- ?selectable ?style
- method set_cell ?text ?pixmap ?spacing ?style =
- let pixmap, mask =
- match pixmap with None -> None, None
- | Some (pm : GDraw.pixmap) -> Some pm#pixmap, pm#mask
- and style = may_map ~f:(fun (st : style) -> st#as_style) style in
- CList.set_cell obj ?text ?pixmap ?mask ?spacing ?style
- method set_row_data n ~data =
- CList.set_row_data obj ~row:n (Obj.repr (data : 'a))
- method get_row_data n : 'a = Obj.obj (CList.get_row_data obj ~row:n)
- method scroll_vertical =
- CList.Signals.emit_scroll obj ~sgn:CList.Signals.scroll_vertical
- method scroll_horizontal =
- CList.Signals.emit_scroll obj ~sgn:CList.Signals.scroll_horizontal
-end
-
-let clist ?(columns=1) ?titles ?hadjustment ?vadjustment
- ?shadow_type ?button_actions ?selection_mode
- ?reorderable ?use_drag_icons ?row_height
- ?titles_show ?titles_active ?auto_sort ?sort_column ?sort_type
- ?border_width ?width ?height ?packing ?show () =
- let w =
- match titles with None -> CList.create ~cols:columns
- | Some titles -> CList.create_with_titles (Array.of_list titles)
- in
- CList.set w
- ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment)
- ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment)
- ?shadow_type ?button_actions ?selection_mode ?reorderable
- ?use_drag_icons ?row_height ?titles_show ?titles_active;
- CList.set_sort w ?auto:auto_sort ?column:sort_column ?dir:sort_type ();
- Container.set w ?border_width ?width ?height;
- pack_return (new clist w) ~packing ~show