10 let main_project_modify = ref false
12 let main_window = GWindow.window ~title:"ZOOM" ~x:10 ~y:10 ()
13 let main_vbox = GPack.vbox ~packing:main_window#add ()
14 let main_menu = GMenu.menu_bar ~packing:(main_vbox#pack ~expand:false) ()
16 let can_copy = ref (fun _ -> assert false)
17 let can_paste = ref (fun _ -> assert false)
20 let project_box = GPack.vbox ~packing:main_vbox#pack () in
21 let project_tree = GTree2.tree ~packing:project_box#pack () in
23 val mutable window_list = []
25 (* the selected window *)
26 val mutable selected = (None : window_and_tree option)
28 method change_selected sel =
32 sel#project_tree_item#misc#set_state `SELECTED;
35 if sel = old_sel then begin
37 sel#project_tree_item#misc#set_state `NORMAL;
40 old_sel#project_tree_item#misc#set_state `NORMAL;
42 sel#project_tree_item#misc#set_state `SELECTED;
46 val mutable filename = ""
47 val mutable dirname = ""
49 method set_filename f =
50 let dir, file = split_filename f ~ext:".rad" in
54 method get_filename () =
55 get_filename ~callback:self#set_filename ~dir:dirname ()
57 method dirname = dirname
59 (* method set_dirname f = dirname <- f *)
61 method add_window ~name ?tree:wt () =
62 let wt = match wt with
63 | None -> new window_and_tree ~name
65 let tiwin = wt#tiwin and tw=wt#tree_window in
66 let project_tree_item = wt#project_tree_item in
67 project_tree#append project_tree_item;
68 let show = ref true in
69 project_tree_item#event#connect#button_press ~callback:
71 match GdkEvent.get_type ev with
73 if GdkEvent.Button.button ev = 1 then begin
74 self#change_selected wt
76 if GdkEvent.Button.button ev = 3 then begin
77 let menu = GMenu.menu () in
78 let name = wt#tiwin#name in
79 let mi_remove = GMenu.menu_item ~label:("delete " ^ name)
80 ~packing:menu#append ()
81 and mi_copy = GMenu.menu_item ~label:("copy " ^ name)
82 ~packing:menu#append ()
83 and mi_cut = GMenu.menu_item ~label:("cut " ^ name)
84 ~packing:menu#append () in
85 mi_remove#connect#activate
86 ~callback:(fun () -> self#delete_window wt);
87 mi_copy#connect#activate
88 ~callback:(fun () -> self#copy_wt wt);
89 mi_cut#connect#activate
90 ~callback:(fun () -> self#cut_wt wt);
91 menu#popup ~button:3 ~time:(GdkEvent.Button.time ev)
93 GtkSignal.stop_emit ();
95 | `TWO_BUTTON_PRESS ->
96 if GdkEvent.Button.button ev = 1 then begin
99 tiwin#widget#misc#hide ();
104 tiwin#widget#misc#show ();
110 tiwin#connect_event#delete ~callback:
111 (fun _ -> show := false; tiwin#widget#misc#hide (); true);
112 tw#event#connect#delete ~callback:
113 (fun _ -> show := false; tw#misc#hide (); true);
114 window_list <- wt :: window_list;
115 add_undo (Remove_window name);
116 main_window#misc#set_can_focus false;
117 main_window#misc#grab_focus ()
120 method add_window_by_node
121 (Node ((classe, name, proplist), children)) =
122 if classe <> "window"
123 then failwith "add_window_by_node: class <> \"window\"";
124 let name = change_name name in (* for paste *)
125 let wt = new window_and_tree ~name in
126 let tiwin = wt#tiwin in
127 List.iter proplist ~f:(fun (n,v) -> tiwin#set_property n v);
128 begin match children with
130 | [ ch ] -> tiwin#add_children_wo_undo ch; ()
131 | _ -> failwith "add_window_by_node: more than one child"
133 self#add_window ~name ~tree:wt ()
135 method delete_window (wt : window_and_tree) =
136 let tiwin = wt#tiwin in
137 project_tree#remove wt#project_tree_item;
139 wt#tree_window#destroy ();
140 window_list <- list_remove ~f:(fun w -> w = wt) window_list
142 method delete_window_by_name ~name =
143 let wt = List.find window_list ~f:(fun wt -> wt#tiwin#name = name) in
144 self#delete_window wt
147 List.iter window_list
148 ~f:(fun wt -> self#delete_window wt);
149 main_vbox#remove project_box#coerce;
150 (* remove after test *)
151 if !name_list <> [] then failwith "name_list not empty"
153 method save_as () = if self#get_filename () then self#save ()
156 if filename = "" then self#save_as ()
158 let outch = open_out (dirname ^ filename ^ ".rad") in
159 let f = Format.formatter_of_out_channel outch in
160 List.iter window_list ~f:(fun wt -> wt#tiwin#save f);
162 main_project_modify := false
165 method copy_wt (wt : window_and_tree) =
169 method cut_wt (wt : window_and_tree) =
171 self#delete_window wt
175 | None -> failwith "main_project copy"
176 | Some sel -> self#copy_wt sel
180 | None -> failwith "main_project cut"
181 | Some sel -> self#cut_wt sel
184 let lexbuf = Lexing.from_string !window_selection in
185 let node = Load_parser.window Load_lexer.token lexbuf in
186 self#add_window_by_node node
189 let outc = open_out (dirname ^ filename ^ ".ml") in
190 let f = Format.formatter_of_out_channel outc in
191 List.iter window_list ~f:(fun wt -> wt#emit f);
192 Format.fprintf f "let main () =@\n";
193 (* this is just for demo *)
194 List.iter window_list ~f:
196 let name = wt#tiwin#name in
197 Format.fprintf f " let %s = new %s () in %s#show ();@\n"
201 " GMain.Main.main ()@\n@\nlet _ = main ()@\n";
207 let main_project = ref (new project ())
210 let filename = ref "" in
211 get_filename ~callback:(fun f -> filename := f) ~dir:!main_project#dirname ();
212 if !filename <> "" then begin
213 !main_project#delete ();
214 main_project := new project ();
215 let inch = open_in !filename in
216 let lexbuf = Lexing.from_channel inch in
217 let project_list = Load_parser.project Load_lexer.token lexbuf in
219 List.iter project_list
220 ~f:(fun node -> !main_project#add_window_by_node node);
221 !main_project#set_filename !filename
225 let interpret_undo = function
226 | Add (parent_name, node, pos) ->
227 let parent = Hashtbl.find widget_map parent_name in
228 parent#add_children node ~pos
229 | Remove child_name ->
230 let child = Hashtbl.find widget_map child_name in
232 | Property (property, value_string) ->
233 property#set value_string
234 | Add_window node -> !main_project#add_window_by_node node
235 | Remove_window name -> !main_project#delete_window_by_name ~name
238 if !last_action_was_undo then begin
239 match !next_undo_info with
240 | hd :: tl -> interpret_undo hd; next_undo_info := tl
241 | [] -> message "no more undo info"
244 match !undo_info with
245 | hd :: tl -> interpret_undo hd; next_undo_info := tl
246 | [] -> message "no undo info"
248 last_action_was_undo := true
251 let targets = [ { target = "STRING"; flags = []; info = 0} ]
254 let source_drag_data_get classe _ (data : selection_data) ~info ~time =
255 data#set ~typ:data#target ~format:0 ~data:classe in
256 let window = GWindow.window ~title:"icons" ~x:250 ~y:10 () in
257 window#misc#realize ();
258 let vbox = GPack.vbox ~packing:window#add () in
259 let table = GPack.table ~rows:1 ~columns:5 ~border_width:20
260 ~packing:vbox#pack () in
261 let tooltips = GData.tooltips () in
262 let add_xpm ~file ~left ~top ~tip =
263 let gdk_pix = GDraw.pixmap_from_xpm ~file ~window () in
264 let ev = GBin.event_box ~packing:(table#attach ~left ~top) () in
265 let pix = GMisc.pixmap gdk_pix ~packing:ev#add () in
266 ev#event#connect#button_press ~callback:
267 (fun ev -> match GdkEvent.get_type ev with
269 if GdkEvent.Button.button ev = 1 then begin
270 !main_project#add_window ~name:(make_new_name "window") ()
274 tooltips#set_tip ev#coerce ~text:tip
276 add_xpm ~file:"window.xpm" ~left:0 ~top:0 ~tip:"window";
277 GMisc.separator `HORIZONTAL ~packing:vbox#pack ();
278 let table = GPack.table ~rows:6 ~columns:6 ~packing:vbox#pack
279 ~row_spacings:20 ~col_spacings:20 ~border_width:20 () in
280 let add_xpm file ~left ~top ~classe =
281 let gdk_pix = GDraw.pixmap_from_xpm ~file ~window () in
282 let ev = GBin.event_box ~packing:(table#attach ~left ~top) () in
283 let pix = GMisc.pixmap gdk_pix ~packing:ev#add () in
284 ev#drag#source_set ~modi:[`BUTTON1] targets ~actions:[`COPY];
285 ev#drag#source_set_icon ~colormap:window#misc#style#colormap
287 ev#drag#connect#data_get ~callback:(source_drag_data_get classe);
288 tooltips#set_tip ev#coerce ~text:classe
291 add_xpm "button.xpm" ~left:0 ~top:0 ~classe:"button";
292 add_xpm "togglebutton.xpm" ~left:1 ~top:0 ~classe:"toggle_button";
293 add_xpm "checkbutton.xpm" ~left:2 ~top:0 ~classe:"check_button";
294 add_xpm "radiobutton.xpm" ~left:3 ~top:0 ~classe:"radio_button";
295 add_xpm "toolbar.xpm" ~left:4 ~top:0 ~classe:"toolbar";
296 add_xpm "hbox.xpm" ~left:0 ~top:1 ~classe:"hbox";
297 add_xpm "vbox.xpm" ~left:1 ~top:1 ~classe:"vbox";
298 add_xpm "hbuttonbox.xpm" ~left:2 ~top:1 ~classe:"hbutton_box";
299 add_xpm "vbuttonbox.xpm" ~left:3 ~top:1 ~classe:"vbutton_box";
300 add_xpm "fixed.xpm" ~left:4 ~top:1 ~classe:"fixed";
301 add_xpm "frame.xpm" ~left:0 ~top:2 ~classe:"frame";
302 add_xpm "aspectframe.xpm" ~left:1 ~top:2 ~classe:"aspect_frame";
303 add_xpm "scrolledwindow.xpm" ~left:2 ~top:2 ~classe:"scrolled_window";
304 add_xpm "eventbox.xpm" ~left:3 ~top:2 ~classe:"event_box";
305 add_xpm "handlebox.xpm" ~left:4 ~top:2 ~classe:"handle_box";
306 add_xpm "viewport.xpm" ~left:5 ~top:2 ~classe:"viewport";
307 add_xpm "hseparator.xpm" ~left:0 ~top:3 ~classe:"hseparator";
308 add_xpm "vseparator.xpm" ~left:1 ~top:3 ~classe:"vseparator";
309 add_xpm "clist.xpm" ~left:2 ~top:3 ~classe:"clist";
310 add_xpm "label.xpm" ~left:0 ~top:4 ~classe:"label";
311 add_xpm "statusbar.xpm" ~left:1 ~top:4 ~classe:"statusbar";
312 add_xpm "notebook.xpm" ~left:2 ~top:4 ~classe:"notebook";
313 add_xpm "colorselection.xpm" ~left:3 ~top:4 ~classe:"color_selection";
314 add_xpm "pixmap.xpm" ~left:4 ~top:4 ~classe:"pixmap";
315 add_xpm "entry.xpm" ~left:0 ~top:5 ~classe:"entry";
316 add_xpm "spinbutton.xpm" ~left:1 ~top:5 ~classe:"spin_button";
317 add_xpm "combo.xpm" ~left:2 ~top:5 ~classe:"combo";
324 let _ = GMain.Main.init () in
325 let prop_win = Propwin.init () in
326 let palette = xpm_window () in
328 main_window#connect#destroy ~callback:GMain.Main.quit;
330 let mp = main_project in
331 let f = new GMenu.factory main_menu in
332 let accel_group = f#accel_group in
333 main_window#add_accel_group accel_group;
334 prop_win#add_accel_group accel_group;
335 palette#add_accel_group accel_group;
337 let file_menu = new GMenu.factory (f#add_submenu "File") ~accel_group
338 and edit_menu = new GMenu.factory (f#add_submenu "Edit") ~accel_group
339 and view_menu = new GMenu.factory (f#add_submenu "View") ~accel_group
340 and project_menu = new GMenu.factory (f#add_submenu "Project") ~accel_group
343 file_menu#add_item "Quit" ~key:_Q ~callback:GMain.Main.quit;
345 project_menu#add_item "New" ~key:_N
346 ~callback:(fun () -> !mp#delete (); mp := new project ());
347 project_menu#add_item "Open..." ~key:_O ~callback:load;
348 project_menu#add_item "Save" ~key:_S ~callback:(fun () -> !mp#save ());
349 project_menu#add_item "Save as..." ~callback:(fun () -> !mp#save_as ());
350 project_menu#add_separator ();
351 project_menu#add_item "Emit code" ~callback:(fun () -> !mp#emit ());
354 edit_menu#add_item "Copy" ~key:_C ~callback:(fun () -> !mp#copy ())
356 edit_menu#add_item "Cut" ~key:_X ~callback:(fun () -> !mp#cut ())
358 edit_menu#add_item "Paste" ~key:_V ~callback:(fun () -> !mp#paste ())
361 (fun b -> copy_item#misc#set_sensitive b; cut_item#misc#set_sensitive b);
362 can_paste := paste_item#misc#set_sensitive;
363 !can_copy false; !can_paste false;
364 edit_menu#add_item "Undo" ~key:_Z ~callback:undo;
366 let palette_visible = ref true in
367 palette#event#connect#delete ~callback:
368 (fun _ -> palette_visible := false; palette#misc#hide (); true);
369 view_menu#add_item "Palette"
371 if !palette_visible then begin
372 palette#misc#hide ();
373 palette_visible := false
375 palette#misc#show ();
376 palette_visible := true
378 let prop_win_visible = ref true in
379 prop_win#event#connect#delete ~callback:
380 (fun _ -> prop_win_visible := false; prop_win#misc#hide (); true);
381 view_menu#add_item "Properties window"
383 if !prop_win_visible then begin
384 prop_win#misc#hide ();
385 prop_win_visible := false
387 prop_win#misc#show ();
388 prop_win_visible := true