9 class tiwindow ~widget ~name ~parent_tree ~pos ?(insert_evbox=true)
13 inherit ticontainer ~name ~widget
14 ~insert_evbox:false ~parent_tree ~pos parent_window as container
16 method connect_event = window#event#connect
18 method private class_name = "GWindow.window"
20 method private get_mandatory_props = [ "title" ]
22 (* method private save_clean_proplist =
23 List.remove_assoc "title" container#save_clean_proplist
25 method private emit_clean_proplist plist =
26 List.remove_assoc "title" (container#emit_clean_proplist plist)
30 self#save_to_string sref;
31 let lexbuf = Lexing.from_string !sref in
32 let node = Load_parser.window Load_lexer.token lexbuf in
33 add_undo (Add_window node);
34 self#remove_me_without_undo ()
36 method copy () = self#copy_to_sel window_selection
38 method remove_me_without_undo () =
39 self#forall ~callback:(fun tiw -> tiw#remove_me_without_undo ());
40 parent_window#remove_sel (self : #tiwidget0 :> tiwidget0);
41 name_list := list_remove !name_list ~f:(fun n -> n=name);
42 Hashtbl.remove widget_map name;
46 method private get_packing packing = ""
48 method emit_code f param_list =
53 (String.concat ~sep:", '"
54 (List.map ~f:(fun c -> (String.make 1 c)) param_list)) ^
56 Format.fprintf f "(* Code for %s *)@\n@\n@[<hv 2>class %s%s () ="
57 name param_string name;
58 self#emit_init_code f ~packing:"";
59 Format.fprintf f "@]@\n@[<hv 2>object (self)";
60 self#emit_method_code f;
61 Format.fprintf f "@ method show () = %s#show ()" name;
62 Format.fprintf f "@ @[<v 2>initializer";
63 self#emit_initializer_code f;
64 Format.fprintf f "@ ()@]@]@ end@\n@\n"
66 (* method private save_start formatter =
67 Format.fprintf formatter "@[<0>@\n@[<2><window name=%s>" name;
68 Format.fprintf formatter "@\ntitle=\"%s\""
69 (List.assoc "title" proplist)#get
71 method private save_end formatter =
72 Format.fprintf formatter "@]@\n</window>@\n@]"
74 method private menu ~time =
75 let menu = GMenu.menu () and menu_add = GMenu.menu () in
78 let mi = GMenu.menu_item ~packing:menu_add#append ~label:n ()
79 in mi#connect#activate
80 ~callback:(fun () -> self#add_child n (); ()); ())
82 let mi_add = GMenu.menu_item ~packing:menu#append ~label:("add to "^ name) ()
83 and mi_paste = GMenu.menu_item ~packing:menu#append ~label:"Paste" ()
85 mi_add#set_submenu menu_add;
87 then begin mi_paste#connect#activate ~callback:self#paste; () end
88 else mi_paste#misc#set_sensitive false;
89 menu#popup ~button:3 ~time
94 window#set_title name;
95 proplist <- proplist @
97 new prop_string ~name:"title" ~init:name ~set:(ftrue window#set_title);
98 "allow_shrink", new prop_bool ~name:"allow_shrink" ~init:"false"
99 ~set:(ftrue window#set_allow_shrink);
100 "allow_grow", new prop_bool ~name:"allow_grow" ~init:"true"
101 ~set:(ftrue window#set_allow_grow);
102 "auto_shrink", new prop_bool ~name:"auto_shrink" ~init:"false"
103 ~set:(ftrue window#set_auto_shrink);
104 "x position", new prop_int ~name:"x" ~init:"-2"
105 ~set:(fun x -> window#misc#set_geometry ~x (); true);
106 "y position", new prop_int ~name:"y" ~init:"-2"
107 ~set:(fun y -> window#misc#set_geometry ~y (); true) ]
110 let new_tiwindow ~name ?(listprop = []) =
111 let w = GWindow.window ~show:true () in
112 w#misc#set_can_focus false;
113 w#misc#set_can_default false;
114 new tiwindow ~widget:w ~name