This commit was manufactured by cvs2svn to create branch

[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / applications / radtest / tiWindow.ml

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/tiWindow.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/tiWindow.ml
deleted file mode 100644 (file)
index b44b4d4..0000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/tiWindow.ml
+++ /dev/null
@@ -1,117 +0,0 @@
-
-open Utils
-open Property
-
-open TiBase
-open TiContainer
-
-
-class tiwindow ~widget ~name ~parent_tree ~pos ?(insert_evbox=true)
-    parent_window =
-object(self)
-  val window = widget
-  inherit ticontainer ~name ~widget
-      ~insert_evbox:false ~parent_tree ~pos parent_window as container
-
-  method connect_event = window#event#connect
-
-  method private class_name = "GWindow.window"
-
-  method private get_mandatory_props = [ "title" ]
-
-(*  method private save_clean_proplist =
-    List.remove_assoc "title" container#save_clean_proplist
-
-  method private emit_clean_proplist plist =
-    List.remove_assoc "title" (container#emit_clean_proplist plist)
-*)
-  method remove_me () =
-    let sref = ref "" in
-    self#save_to_string sref;
-    let lexbuf = Lexing.from_string !sref in
-    let node = Load_parser.window Load_lexer.token lexbuf in
-    add_undo (Add_window node);
-    self#remove_me_without_undo ()
-
-  method copy () = self#copy_to_sel window_selection
-
-  method remove_me_without_undo () =
-    self#forall ~callback:(fun tiw -> tiw#remove_me_without_undo ());
-    parent_window#remove_sel (self : #tiwidget0 :> tiwidget0);
-    name_list := list_remove !name_list ~f:(fun n -> n=name);
-    Hashtbl.remove widget_map name;
-    Propwin.remove name;
-    widget#destroy ()
-
-  method private get_packing packing = ""
-
-  method emit_code f param_list =
-    let param_string =
-      match param_list with
-      |         [] -> ""
-      |        _ -> "['" ^
-         (String.concat ~sep:", '"
-            (List.map ~f:(fun c -> (String.make 1 c)) param_list)) ^
-         "] " in
-    Format.fprintf f "(* Code for %s *)@\n@\n@[<hv 2>class %s%s () ="
-      name param_string name;
-    self#emit_init_code f ~packing:"";
-    Format.fprintf f "@]@\n@[<hv 2>object (self)";
-    self#emit_method_code f;
-    Format.fprintf f "@ method show () = %s#show ()" name;
-    Format.fprintf f "@ @[<v 2>initializer";
-    self#emit_initializer_code f;
-    Format.fprintf f "@ ()@]@]@ end@\n@\n"
-
-(*  method private save_start formatter =
-    Format.fprintf formatter "@[<0>@\n@[<2><window name=%s>" name;
-    Format.fprintf formatter "@\ntitle=\"%s\""
-      (List.assoc "title" proplist)#get
-*)
-  method private save_end formatter =
-    Format.fprintf formatter "@]@\n</window>@\n@]"
-
-  method private menu ~time =
-    let menu = GMenu.menu () and menu_add = GMenu.menu () in
-    List.iter
-      ~f:(fun n ->
-       let mi = GMenu.menu_item ~packing:menu_add#append ~label:n ()
-       in mi#connect#activate
-         ~callback:(fun () -> self#add_child n (); ()); ())
-      widget_add_list;      
-    let mi_add = GMenu.menu_item ~packing:menu#append ~label:("add to "^ name) ()
-    and mi_paste = GMenu.menu_item ~packing:menu#append ~label:"Paste" ()
-    in
-    mi_add#set_submenu menu_add;
-    if !selection <> ""
-    then begin mi_paste#connect#activate ~callback:self#paste; () end
-    else mi_paste#misc#set_sensitive false;
-    menu#popup ~button:3 ~time
-
-
-  initializer
-    classe <- "window";
-    window#set_title name;
-    proplist <-        proplist @
-      [ "title",
-       new prop_string ~name:"title" ~init:name ~set:(ftrue window#set_title);
-       "allow_shrink", new prop_bool ~name:"allow_shrink" ~init:"false"
-                         ~set:(ftrue window#set_allow_shrink);
-       "allow_grow", new prop_bool ~name:"allow_grow" ~init:"true"
-                       ~set:(ftrue window#set_allow_grow);
-       "auto_shrink", new prop_bool ~name:"auto_shrink" ~init:"false"
-                        ~set:(ftrue window#set_auto_shrink);
-       "x position", new prop_int ~name:"x" ~init:"-2"
-         ~set:(fun x -> window#misc#set_geometry ~x (); true);
-       "y position", new prop_int ~name:"y" ~init:"-2"
-         ~set:(fun y -> window#misc#set_geometry ~y (); true) ]
-end
-
-let new_tiwindow ~name ?(listprop = []) =
-  let w = GWindow.window ~show:true () in
-  w#misc#set_can_focus false;
-  w#misc#set_can_default false;
-  new tiwindow ~widget:w ~name
-
-
-