X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgList.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2FgList.ml;h=0000000000000000000000000000000000000000;hb=c7514aaa249a96c5fdd39b1123fbdb38d92f20b6;hp=3b1abe43b91b086d46edbd028145cf62ce810460;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gList.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gList.ml deleted file mode 100644 index 3b1abe43b..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gList.ml +++ /dev/null @@ -1,162 +0,0 @@ -(* $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