X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Fradtest%2FtiWindow.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fapplications%2Fradtest%2FtiWindow.ml;h=0000000000000000000000000000000000000000;hp=b44b4d479a9f694cceffe23007a9f781aa9b376f;hb=869549224eef6278a48c16ae27dd786376082b38;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8 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 index b44b4d479..000000000 --- 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@[class %s%s () =" - name param_string name; - self#emit_init_code f ~packing:""; - Format.fprintf f "@]@\n@[object (self)"; - self#emit_method_code f; - Format.fprintf f "@ method show () = %s#show ()" name; - Format.fprintf f "@ @[initializer"; - self#emit_initializer_code f; - Format.fprintf f "@ ()@]@]@ end@\n@\n" - -(* method private save_start formatter = - Format.fprintf formatter "@[<0>@\n@[<2>" name; - Format.fprintf formatter "@\ntitle=\"%s\"" - (List.assoc "title" proplist)#get -*) - method private save_end formatter = - Format.fprintf formatter "@]@\n@\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 - - -