X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fapplications%2Fradtest%2FtiButton.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fapplications%2Fradtest%2FtiButton.ml;h=0000000000000000000000000000000000000000;hp=174c6ebffd0c3fcc3e98ff18bb220f67db09a146;hb=869549224eef6278a48c16ae27dd786376082b38;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8

diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/tiButton.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/tiButton.ml
deleted file mode 100644
index 174c6ebff..000000000
--- a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/tiButton.ml
+++ /dev/null
@@ -1,372 +0,0 @@
-open Utils
-open Property
-
-open TiBase
-open TiContainer
-
-(* the button inherits from widget because it can't accept
-   a child; 
-   needs to add the border_width property *)
-class tibutton ~(widget : #GButton.button) ~name ~parent_tree ~pos
-    ?(insert_evbox=true) parent_window =
-object(self)
-  val button = widget
-  inherit tiwidget ~name ~widget ~parent_tree ~pos ~insert_evbox
-       parent_window as widget
-
-  method private class_name = "GButton.button"
-
-  method private get_mandatory_props = [ "label" ]
-
-  initializer
-    classe <- "button";
-    proplist <-  proplist @
-      [ "border_width",	new prop_int ~name:"border_width" ~init:"0"
-	                  ~set:(ftrue button#set_border_width);
-	"label",
-	new prop_string ~name:"label" ~init:name ~set:
-	  begin fun v ->
-	    button#remove (List.hd button#children)#coerce;
-	    GMisc.label ~text:v ~xalign:0.5 ~yalign:0.5 ~packing:button#add ();
-	    true
-	  end ]
-end
-
-let new_tibutton ~name ?(listprop = []) =
-  let b = GButton.button ~label:name () in
-  b#event#connect#enter_notify
-    ~callback:(fun _ -> GtkSignal.stop_emit (); true);
-  b#event#connect#leave_notify
-    ~callback:(fun _ -> GtkSignal.stop_emit (); true);
-  new tibutton ~widget:b ~name
-
-
-class ticheck_button ~(widget : #GButton.toggle_button) ~name
-    ~parent_tree ~pos ?(insert_evbox=true) parent_window =
-object(self)
-  val button = widget
-  inherit tiwidget ~name ~widget ~insert_evbox
-      ~parent_tree ~pos parent_window as widget
-
-
-  method private class_name = "GButton.check_button"
-
-  method private get_mandatory_props = [ "label" ]
-
-  initializer
-    classe <- "check_button";
-    proplist <-  proplist @
-      [ "border_width",	new prop_int ~name:"border_width" ~init:"0"
-	                 ~set:(ftrue button#set_border_width);
-	"label",
-	new prop_string ~name:"label" ~init:name ~set:
-	  begin fun v ->
-	    button#remove (List.hd button#children)#coerce;
-	    GMisc.label ~text:v ~xalign:0.5 ~yalign:0.5 ~packing:button#add ();
-	    true
-	  end
-      ]
-end
-
-let new_ticheck_button ~name ?(listprop = []) =
-  new ticheck_button ~widget:(GButton.check_button ~label:name ()) ~name
-
-
-
-class titoggle_button ~(widget : #GButton.toggle_button) ~name
-    ~parent_tree ~pos ?(insert_evbox=true) parent_window =
-object(self)
-  val button = widget
-  inherit tiwidget ~name ~widget ~insert_evbox
-      ~parent_tree ~pos parent_window as widget
-
-  method private class_name = "GButton.toggle_button"
-
-  method private get_mandatory_props = [ "label" ]
-
-  initializer
-    classe <- "toggle_button";
-    proplist <-  proplist @
-      [ "border width",	new prop_int ~name:"border_width" ~init:"0"
-	                  ~set:(ftrue button#set_border_width);
-	"label",
-	new prop_string ~name:"label" ~init:name ~set:
-	  begin fun v ->
-	    button#remove (List.hd button#children)#coerce;
-	    GMisc.label ~text:v ~xalign:0.5 ~yalign:0.5 ~packing:button#add ();
-	    true
-	  end ]
-end
-
-let new_titoggle_button ~name ?(listprop = []) =
-  let b = GButton.toggle_button ~label:name () in
-(*  b#connect#event#enter_notify
-    ~callback:(fun _ -> GtkSignal.stop_emit ());
-  b#connect#event#leave_notify
-    ~callback:(fun _ -> GtkSignal.stop_emit ());
-*)
-  new titoggle_button ~name ~widget:b
-
-
-class tiradio_button ~(widget : #GButton.radio_button) ~name:nname
-    ~parent_tree ~pos ?(insert_evbox=true) parent_window =
-object(self)
-  val button = widget
-  inherit tiwidget ~name:nname ~widget ~insert_evbox
-      ~parent_tree ~pos parent_window as widget
-
-  val group_prop =
-    new prop_enum_dyn ~values:(fun () -> !radio_button_pool) ~name:"group"
-      ~set:(fun () -> true) ~init:nname
-
-
-  method private class_name = "GButton.radio_button"
-
-  method remove_me_without_undo () =
-    radio_button_pool := list_remove !radio_button_pool
-	~f:(fun x -> x = name);
-    widget#remove_me_without_undo ()
-
-  method private get_mandatory_props = [ "label" ]
-
-  method private emit_clean_proplist =
-    List.remove_assoc "group" widget#emit_clean_proplist
-
-  method emit_initializer_code formatter =
-    let groupname = group_prop#get in
-    if name <> groupname then
-      Format.fprintf formatter "@ %s#set_group %s#group;" name groupname
-
-  initializer
-    classe <- "radio_button";
-    radio_button_pool := name :: !radio_button_pool;
-    List.iter
-      ~f:(fun x -> Propwin.update (Hashtbl.find widget_map x) true)
-      (List.tl !radio_button_pool);
-
-    proplist <-  proplist @
-      [ "border_width",	new prop_int ~name:"border_width" ~init:"0"
-	                  ~set:(ftrue button#set_border_width);
-	"label",
-	new prop_string ~name:"label" ~init:name ~set:
-	  begin fun v ->
-	    button#remove (List.hd button#children)#coerce;
-	    GMisc.label ~text:v ~xalign:0.5 ~yalign:0.5 ~packing:button#add ();
-	    true
-	  end ;
-	"group", group_prop
-      ]
-end
-
-let new_tiradio_button ~name ?(listprop = []) =
-  let b = GButton.radio_button ~label:name () in
-  (*
-  b#event#connect#enter_notify
-    ~callback:(fun _ -> b#misc#stop_emit ~name:"enter_notify_event"; true);
-  b#event#connect#leave_notify
-    ~callback:(fun _ -> b#misc#stop_emit ~name:"leave_notify_event"; true);
-  *)
-  new tiradio_button ~name ~widget:b
-
-
-
-
-class tibutton_toolbar ~(widget : #GButton.button) ~name ~parent_tree ~pos
-    ?(insert_evbox=true) parent_window ~toolbar =
-object(self)
-  val button = widget
-  inherit tibutton ~name ~widget ~parent_tree ~pos ~insert_evbox
-       parent_window as button
-
-  method private get_mandatory_props =
-    [ "text"; "tooltip"; "tooltip_private" ]
-
-  method emit_init_code formatter ~packing =
-    Format.fprintf formatter "@ @[<hv 2>let %s =@ @[<hov 2>%s#insert_button"
-      name toolbar#name;
-    List.iter self#get_mandatory_props ~f:
-      begin fun name ->
-	Format.fprintf formatter "@ ~%s:%s" name
-	  (List.assoc name proplist)#code
-      end;
-    Format.fprintf formatter "@ ()@ in@]@]"
-
-  initializer
-    proplist <- List.remove_assoc "label" proplist
-end
-
-
-class titoggle_button_toolbar ~(widget : #GButton.toggle_button) ~name
-    ~parent_tree ~pos ?(insert_evbox=true) parent_window ~toolbar =
-object(self)
-  val button = widget
-  inherit titoggle_button ~name ~widget ~parent_tree ~pos ~insert_evbox
-       parent_window as button
-
-  method private get_mandatory_props =
-    [ "text"; "tooltip"; "tooltip_private" ]
-
-  method emit_init_code formatter ~packing =
-    Format.fprintf formatter
-      "@ @[<hv 2>let %s =@ @[<hov 2>%s#insert_toggle_button"
-      name toolbar#name;
-    List.iter self#get_mandatory_props ~f:
-      begin fun name ->
-	Format.fprintf formatter "@ ~%s:%s" name
-	  (List.assoc name proplist)#code
-      end;
-    Format.fprintf formatter "@ ()@ in@]@]"
-
-  initializer
-    proplist <- List.remove_assoc "label" proplist
-end
-
-
-class tiradio_button_toolbar ~(widget : #GButton.radio_button) ~name
-    ~parent_tree ~pos ?(insert_evbox=true) parent_window ~toolbar =
-object(self)
-  val button = widget
-  inherit tiradio_button ~name ~widget ~parent_tree ~pos ~insert_evbox
-       parent_window as button
-
-  method private get_mandatory_props =
-    [ "text"; "tooltip"; "tooltip_private" ]
-
-  method emit_init_code formatter ~packing =
-    Format.fprintf formatter
-      "@ @[<hv 2>let %s =@ @[<hov 2>%s#insert_radio_button"
-      name toolbar#name;
-    List.iter self#get_mandatory_props ~f:
-      begin fun name ->
-	Format.fprintf formatter "@ ~%s:%s" name
-	  (List.assoc name proplist)#code
-      end;
-    Format.fprintf formatter "@ ()@ in@]@]"
-
-  initializer
-    proplist <- List.remove_assoc "label" proplist
-end
-
-
-
-
-class titoolbar ~(widget : GToolbar2.toolbar2) ~name ~parent_tree ~pos
-    ?(insert_evbox=true) parent_window =
-object(self)
-  val toolbar = widget
-  inherit ticontainer ~name ~widget ~parent_tree ~pos
-    ~insert_evbox parent_window
-
-  method private class_name = "GButton.toolbar"
-
-  method private add child ~pos =
-    children <- children @ [child, `START]
-
-  method private get_pos child =
-    let rec aux n = function
-      |	[] -> failwith "toolbar::get_pos"
-      |	(hd, _)::tl -> if hd = child then n else aux (n+1) tl in
-    aux 0 children
-
-  method private make_child ~classe ?(pos = -1) ~name ~parent_tree
-      ?(insert_evbox = true) ?(listprop = []) parent_window =
-    match classe with
-    | "button" ->
-	let t = try List.assoc "text" listprop with Not_found -> "" in
-	let tt = try List.assoc "tooltip" listprop with Not_found -> "" in
-	let ptt = try List.assoc "tooltip_private" listprop
-	with Not_found -> "" in
-	let listp = List.fold_left ~f:(fun l p -> List.remove_assoc p l)
-	    ~init:listprop
-	    [ "text"; "tooltip"; "tooltip_private" ] in
-	let b = toolbar#insert_button ~text:t ~tooltip:tt
-	    ~tooltip_private:ptt () in
-	let child = new tibutton_toolbar ~name ~widget:b ~pos:(-1)
-	      ~insert_evbox:false ~parent_tree:stree parent_window ~toolbar:self in
-	let tp = new prop_string ~name:"text" ~init:t
-	    ~set:(fun v -> 
-	      toolbar#set_text v (self#get_pos child); true)
-	and ttp = new prop_string ~name:"tooltip" ~init:tt
-	    ~set:(fun _ -> true)
-	and pttp = new prop_string ~name:"tooltip_private" ~init:ptt
-	    ~set:(fun _ -> true) in
-	child#add_to_proplist
-	  [ "text", tp; "tooltip", ttp; "tooltip_private", pttp ];
-	child
-    | "toggle_button" ->
-	let t = try List.assoc "text" listprop with Not_found -> "" in
-	let tt = try List.assoc "tooltip" listprop with Not_found -> "" in
-	let ptt = try List.assoc "tooltip_private" listprop
-	with Not_found -> "" in
-	let listp = List.fold_left ~f:(fun l p -> List.remove_assoc p l)
-	    ~init:listprop
-	    [ "text"; "tooltip"; "tooltip_private" ] in
-	let b = toolbar#insert_toggle_button ~text:t ~tooltip:tt
-	    ~tooltip_private:ptt () in
-	let child = new titoggle_button_toolbar ~name ~widget:b ~pos:(-1)
-	      ~insert_evbox:false ~parent_tree:stree parent_window ~toolbar:self in
-	let tp = new prop_string ~name:"text" ~init:t
-	    ~set:(fun v -> toolbar#set_text v (self#get_pos child); true)
-	and ttp = new prop_string ~name:"tooltip" ~init:tt
-	    ~set:(fun _ -> true)
-	and pttp = new prop_string ~name:"tooltip_private" ~init:ptt
-	    ~set:(fun _ -> true) in
-	child#add_to_proplist
-	  [ "text", tp; "tooltip", ttp; "tooltip_private", pttp ];
-	child
-    | "radio_button" ->
-	let t = try List.assoc "text" listprop with Not_found -> "" in
-	let tt = try List.assoc "tooltip" listprop with Not_found -> "" in
-	let ptt = try List.assoc "tooltip_private" listprop
-	with Not_found -> "" in
-	let listp = List.fold_left ~f:(fun l p -> List.remove_assoc p l)
-	    ~init:listprop
-	    [ "text"; "tooltip"; "tooltip_private" ] in
-	let b = toolbar#insert_radio_button ~text:t ~tooltip:tt
-	    ~tooltip_private:ptt () in
-	let child = new tiradio_button_toolbar ~name ~widget:b ~pos:(-1)
-	      ~insert_evbox:false ~parent_tree:stree parent_window ~toolbar:self in
-	let tp = new prop_string ~name:"text" ~init:t
-	    ~set:(fun v -> toolbar#set_text v (self#get_pos child); true)
-	and ttp = new prop_string ~name:"tooltip" ~init:tt
-	    ~set:(fun _ -> true)
-	and pttp = new prop_string ~name:"tooltip_private" ~init:ptt
-	    ~set:(fun _ -> true) in
-	child#add_to_proplist
-	  [ "text", tp; "tooltip", ttp; "tooltip_private", pttp ];
-	child
-    | _ -> failwith "toolbar"
-
-
-
-  method remove child =
-    toolbar#remove (child#base);
-    children <- list_remove ~f:(fun (ch, _) -> ch = child) children;
-
-  initializer
-    classe <- "toolbar";
-    proplist <- proplist @
-      [ "orientation",
-	new prop_orientation ~name:"orientation" ~init:"HORIZONTAL"
-	  ~set:(ftrue toolbar#set_orientation);
-	"style",
-	new prop_toolbar_style ~name:"style" ~init:"BOTH"
-	  ~set:(ftrue toolbar#set_style);
-	"space_size",
-	new prop_int ~name:"space_size" ~init:"5"
-	  ~set:(ftrue toolbar#set_space_size);
-	"space_style",
-	new prop_toolbar_space_style ~name:"space_style" ~init:"EMPTY"
-	  ~set:(ftrue toolbar#set_space_style);
-	"tooltips",
-	new prop_bool ~name:"tooltips" ~init:"true"
-	  ~set:(ftrue toolbar#set_tooltips);
-	"button_relief",
-	new prop_relief_style ~name:"button_relief" ~init:"NORMAL"
-	  ~set:(ftrue toolbar#set_button_relief)
-      ]
-end
-
-let new_toolbar ~name ?(listprop = []) =
-  new titoolbar ~name ~widget:(GToolbar2.toolbar2 ())
-