--- /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
projects / helm.git / blobdiff