--- /dev/null
+(* $Id$ *)
+
+open GdkKeysyms
+open Gtk
+open GObj
+
+open Utils
+open TiBase
+
+let main_project_modify = ref false
+
+let main_window = GWindow.window ~title:"ZOOM" ~x:10 ~y:10 ()
+let main_vbox = GPack.vbox ~packing:main_window#add ()
+let main_menu = GMenu.menu_bar ~packing:(main_vbox#pack ~expand:false) ()
+
+let can_copy = ref (fun _ -> assert false)
+let can_paste = ref (fun _ -> assert false)
+
+class project () =
+ let project_box = GPack.vbox ~packing:main_vbox#pack () in
+ let project_tree = GTree2.tree ~packing:project_box#pack () in
+ object(self)
+ val mutable window_list = []
+
+(* the selected window *)
+ val mutable selected = (None : window_and_tree option)
+
+ method change_selected sel =
+ match selected with
+ | None ->
+ selected <- Some sel;
+ sel#project_tree_item#misc#set_state `SELECTED;
+ !can_copy true
+ | Some old_sel ->
+ if sel = old_sel then begin
+ selected <- None;
+ sel#project_tree_item#misc#set_state `NORMAL;
+ !can_copy false
+ end else begin
+ old_sel#project_tree_item#misc#set_state `NORMAL;
+ selected <- Some sel;
+ sel#project_tree_item#misc#set_state `SELECTED;
+ !can_copy true
+ end
+
+ val mutable filename = ""
+ val mutable dirname = ""
+
+ method set_filename f =
+ let dir, file = split_filename f ~ext:".rad" in
+ filename <- file;
+ dirname <- dir
+
+ method get_filename () =
+ get_filename ~callback:self#set_filename ~dir:dirname ()
+
+ method dirname = dirname
+
+(* method set_dirname f = dirname <- f *)
+
+ method add_window ~name ?tree:wt () =
+ let wt = match wt with
+ | None -> new window_and_tree ~name
+ | Some wt -> wt in
+ let tiwin = wt#tiwin and tw=wt#tree_window in
+ let project_tree_item = wt#project_tree_item in
+ project_tree#append project_tree_item;
+ let show = ref true in
+ project_tree_item#event#connect#button_press ~callback:
+ (fun ev ->
+ match GdkEvent.get_type ev with
+ | `BUTTON_PRESS ->
+ if GdkEvent.Button.button ev = 1 then begin
+ self#change_selected wt
+ end else
+ if GdkEvent.Button.button ev = 3 then begin
+ let menu = GMenu.menu () in
+ let name = wt#tiwin#name in
+ let mi_remove = GMenu.menu_item ~label:("delete " ^ name)
+ ~packing:menu#append ()
+ and mi_copy = GMenu.menu_item ~label:("copy " ^ name)
+ ~packing:menu#append ()
+ and mi_cut = GMenu.menu_item ~label:("cut " ^ name)
+ ~packing:menu#append () in
+ mi_remove#connect#activate
+ ~callback:(fun () -> self#delete_window wt);
+ mi_copy#connect#activate
+ ~callback:(fun () -> self#copy_wt wt);
+ mi_cut#connect#activate
+ ~callback:(fun () -> self#cut_wt wt);
+ menu#popup ~button:3 ~time:(GdkEvent.Button.time ev)
+ end;
+ GtkSignal.stop_emit ();
+ true
+ | `TWO_BUTTON_PRESS ->
+ if GdkEvent.Button.button ev = 1 then begin
+ if !show then begin
+ show := false;
+ tiwin#widget#misc#hide ();
+ tw#misc#hide ()
+ end
+ else begin
+ show := true;
+ tiwin#widget#misc#show ();
+ tw#misc#show ()
+ end
+ end;
+ true
+ | _ -> false);
+ tiwin#connect_event#delete ~callback:
+ (fun _ -> show := false; tiwin#widget#misc#hide (); true);
+ tw#event#connect#delete ~callback:
+ (fun _ -> show := false; tw#misc#hide (); true);
+ window_list <- wt :: window_list;
+ add_undo (Remove_window name);
+ main_window#misc#set_can_focus false;
+ main_window#misc#grab_focus ()
+
+
+ method add_window_by_node
+ (Node ((classe, name, proplist), children)) =
+ if classe <> "window"
+ then failwith "add_window_by_node: class <> \"window\"";
+ let name = change_name name in (* for paste *)
+ let wt = new window_and_tree ~name in
+ let tiwin = wt#tiwin in
+ List.iter proplist ~f:(fun (n,v) -> tiwin#set_property n v);
+ begin match children with
+ | [] -> ()
+ | [ ch ] -> tiwin#add_children_wo_undo ch; ()
+ | _ -> failwith "add_window_by_node: more than one child"
+ end;
+ self#add_window ~name ~tree:wt ()
+
+ method delete_window (wt : window_and_tree) =
+ let tiwin = wt#tiwin in
+ project_tree#remove wt#project_tree_item;
+ tiwin#remove_me ();
+ wt#tree_window#destroy ();
+ window_list <- list_remove ~f:(fun w -> w = wt) window_list
+
+ method delete_window_by_name ~name =
+ let wt = List.find window_list ~f:(fun wt -> wt#tiwin#name = name) in
+ self#delete_window wt
+
+ method delete () =
+ List.iter window_list
+ ~f:(fun wt -> self#delete_window wt);
+ main_vbox#remove project_box#coerce;
+(* remove after test *)
+ if !name_list <> [] then failwith "name_list not empty"
+
+ method save_as () = if self#get_filename () then self#save ()
+
+ method save () =
+ if filename = "" then self#save_as ()
+ else begin
+ let outch = open_out (dirname ^ filename ^ ".rad") in
+ let f = Format.formatter_of_out_channel outch in
+ List.iter window_list ~f:(fun wt -> wt#tiwin#save f);
+ close_out outch;
+ main_project_modify := false
+ end
+
+ method copy_wt (wt : window_and_tree) =
+ wt#tiwin#copy ();
+ !can_paste true
+
+ method cut_wt (wt : window_and_tree) =
+ self#copy_wt wt;
+ self#delete_window wt
+
+ method copy () =
+ match selected with
+ | None -> failwith "main_project copy"
+ | Some sel -> self#copy_wt sel
+
+ method cut () =
+ match selected with
+ | None -> failwith "main_project cut"
+ | Some sel -> self#cut_wt sel
+
+ method paste () =
+ let lexbuf = Lexing.from_string !window_selection in
+ let node = Load_parser.window Load_lexer.token lexbuf in
+ self#add_window_by_node node
+
+ method emit () =
+ let outc = open_out (dirname ^ filename ^ ".ml") in
+ let f = Format.formatter_of_out_channel outc in
+ List.iter window_list ~f:(fun wt -> wt#emit f);
+ Format.fprintf f "let main () =@\n";
+(* this is just for demo *)
+ List.iter window_list ~f:
+ begin fun wt ->
+ let name = wt#tiwin#name in
+ Format.fprintf f " let %s = new %s () in %s#show ();@\n"
+ name name name
+ end;
+ Format.fprintf f
+ " GMain.Main.main ()@\n@\nlet _ = main ()@\n";
+ close_out outc
+
+ end
+
+
+let main_project = ref (new project ())
+
+let load () =
+ let filename = ref "" in
+ get_filename ~callback:(fun f -> filename := f) ~dir:!main_project#dirname ();
+ if !filename <> "" then begin
+ !main_project#delete ();
+ main_project := new project ();
+ let inch = open_in !filename in
+ let lexbuf = Lexing.from_channel inch in
+ let project_list = Load_parser.project Load_lexer.token lexbuf in
+ close_in inch;
+ List.iter project_list
+ ~f:(fun node -> !main_project#add_window_by_node node);
+ !main_project#set_filename !filename
+ end
+
+
+let interpret_undo = function
+ | Add (parent_name, node, pos) ->
+ let parent = Hashtbl.find widget_map parent_name in
+ parent#add_children node ~pos
+ | Remove child_name ->
+ let child = Hashtbl.find widget_map child_name in
+ child#remove_me ()
+ | Property (property, value_string) ->
+ property#set value_string
+ | Add_window node -> !main_project#add_window_by_node node
+ | Remove_window name -> !main_project#delete_window_by_name ~name
+
+let undo () =
+ if !last_action_was_undo then begin
+ match !next_undo_info with
+ | hd :: tl -> interpret_undo hd; next_undo_info := tl
+ | [] -> message "no more undo info"
+ end
+ else begin
+ match !undo_info with
+ | hd :: tl -> interpret_undo hd; next_undo_info := tl
+ | [] -> message "no undo info"
+ end;
+ last_action_was_undo := true
+
+
+let targets = [ { target = "STRING"; flags = []; info = 0} ]
+
+let xpm_window () =
+ let source_drag_data_get classe _ (data : selection_data) ~info ~time =
+ data#set ~typ:data#target ~format:0 ~data:classe in
+ let window = GWindow.window ~title:"icons" ~x:250 ~y:10 () in
+ window#misc#realize ();
+ let vbox = GPack.vbox ~packing:window#add () in
+ let table = GPack.table ~rows:1 ~columns:5 ~border_width:20
+ ~packing:vbox#pack () in
+ let tooltips = GData.tooltips () in
+ let add_xpm ~file ~left ~top ~tip =
+ let gdk_pix = GDraw.pixmap_from_xpm ~file ~window () in
+ let ev = GBin.event_box ~packing:(table#attach ~left ~top) () in
+ let pix = GMisc.pixmap gdk_pix ~packing:ev#add () in
+ ev#event#connect#button_press ~callback:
+ (fun ev -> match GdkEvent.get_type ev with
+ | `BUTTON_PRESS ->
+ if GdkEvent.Button.button ev = 1 then begin
+ !main_project#add_window ~name:(make_new_name "window") ()
+ end;
+ true
+ | _ -> false);
+ tooltips#set_tip ev#coerce ~text:tip
+ in
+ add_xpm ~file:"window.xpm" ~left:0 ~top:0 ~tip:"window";
+ GMisc.separator `HORIZONTAL ~packing:vbox#pack ();
+ let table = GPack.table ~rows:6 ~columns:6 ~packing:vbox#pack
+ ~row_spacings:20 ~col_spacings:20 ~border_width:20 () in
+ let add_xpm file ~left ~top ~classe =
+ let gdk_pix = GDraw.pixmap_from_xpm ~file ~window () in
+ let ev = GBin.event_box ~packing:(table#attach ~left ~top) () in
+ let pix = GMisc.pixmap gdk_pix ~packing:ev#add () in
+ ev#drag#source_set ~modi:[`BUTTON1] targets ~actions:[`COPY];
+ ev#drag#source_set_icon ~colormap:window#misc#style#colormap
+ gdk_pix;
+ ev#drag#connect#data_get ~callback:(source_drag_data_get classe);
+ tooltips#set_tip ev#coerce ~text:classe
+ in
+
+ add_xpm "button.xpm" ~left:0 ~top:0 ~classe:"button";
+ add_xpm "togglebutton.xpm" ~left:1 ~top:0 ~classe:"toggle_button";
+ add_xpm "checkbutton.xpm" ~left:2 ~top:0 ~classe:"check_button";
+ add_xpm "radiobutton.xpm" ~left:3 ~top:0 ~classe:"radio_button";
+ add_xpm "toolbar.xpm" ~left:4 ~top:0 ~classe:"toolbar";
+ add_xpm "hbox.xpm" ~left:0 ~top:1 ~classe:"hbox";
+ add_xpm "vbox.xpm" ~left:1 ~top:1 ~classe:"vbox";
+ add_xpm "hbuttonbox.xpm" ~left:2 ~top:1 ~classe:"hbutton_box";
+ add_xpm "vbuttonbox.xpm" ~left:3 ~top:1 ~classe:"vbutton_box";
+ add_xpm "fixed.xpm" ~left:4 ~top:1 ~classe:"fixed";
+ add_xpm "frame.xpm" ~left:0 ~top:2 ~classe:"frame";
+ add_xpm "aspectframe.xpm" ~left:1 ~top:2 ~classe:"aspect_frame";
+ add_xpm "scrolledwindow.xpm" ~left:2 ~top:2 ~classe:"scrolled_window";
+ add_xpm "eventbox.xpm" ~left:3 ~top:2 ~classe:"event_box";
+ add_xpm "handlebox.xpm" ~left:4 ~top:2 ~classe:"handle_box";
+ add_xpm "viewport.xpm" ~left:5 ~top:2 ~classe:"viewport";
+ add_xpm "hseparator.xpm" ~left:0 ~top:3 ~classe:"hseparator";
+ add_xpm "vseparator.xpm" ~left:1 ~top:3 ~classe:"vseparator";
+ add_xpm "clist.xpm" ~left:2 ~top:3 ~classe:"clist";
+ add_xpm "label.xpm" ~left:0 ~top:4 ~classe:"label";
+ add_xpm "statusbar.xpm" ~left:1 ~top:4 ~classe:"statusbar";
+ add_xpm "notebook.xpm" ~left:2 ~top:4 ~classe:"notebook";
+ add_xpm "colorselection.xpm" ~left:3 ~top:4 ~classe:"color_selection";
+ add_xpm "pixmap.xpm" ~left:4 ~top:4 ~classe:"pixmap";
+ add_xpm "entry.xpm" ~left:0 ~top:5 ~classe:"entry";
+ add_xpm "spinbutton.xpm" ~left:1 ~top:5 ~classe:"spin_button";
+ add_xpm "combo.xpm" ~left:2 ~top:5 ~classe:"combo";
+
+ window#show ();
+ window
+
+
+let main () =
+ let _ = GMain.Main.init () in
+ let prop_win = Propwin.init () in
+ let palette = xpm_window () in
+ main_window#show ();
+ main_window#connect#destroy ~callback:GMain.Main.quit;
+
+ let mp = main_project in
+ let f = new GMenu.factory main_menu in
+ let accel_group = f#accel_group in
+ main_window#add_accel_group accel_group;
+ prop_win#add_accel_group accel_group;
+ palette#add_accel_group accel_group;
+
+ let file_menu = new GMenu.factory (f#add_submenu "File") ~accel_group
+ and edit_menu = new GMenu.factory (f#add_submenu "Edit") ~accel_group
+ and view_menu = new GMenu.factory (f#add_submenu "View") ~accel_group
+ and project_menu = new GMenu.factory (f#add_submenu "Project") ~accel_group
+ in
+
+ file_menu#add_item "Quit" ~key:_Q ~callback:GMain.Main.quit;
+
+ project_menu#add_item "New" ~key:_N
+ ~callback:(fun () -> !mp#delete (); mp := new project ());
+ project_menu#add_item "Open..." ~key:_O ~callback:load;
+ project_menu#add_item "Save" ~key:_S ~callback:(fun () -> !mp#save ());
+ project_menu#add_item "Save as..." ~callback:(fun () -> !mp#save_as ());
+ project_menu#add_separator ();
+ project_menu#add_item "Emit code" ~callback:(fun () -> !mp#emit ());
+
+ let copy_item =
+ edit_menu#add_item "Copy" ~key:_C ~callback:(fun () -> !mp#copy ())
+ and cut_item =
+ edit_menu#add_item "Cut" ~key:_X ~callback:(fun () -> !mp#cut ())
+ and paste_item =
+ edit_menu#add_item "Paste" ~key:_V ~callback:(fun () -> !mp#paste ())
+ in
+ can_copy :=
+ (fun b -> copy_item#misc#set_sensitive b; cut_item#misc#set_sensitive b);
+ can_paste := paste_item#misc#set_sensitive;
+ !can_copy false; !can_paste false;
+ edit_menu#add_item "Undo" ~key:_Z ~callback:undo;
+
+ let palette_visible = ref true in
+ palette#event#connect#delete ~callback:
+ (fun _ -> palette_visible := false; palette#misc#hide (); true);
+ view_menu#add_item "Palette"
+ ~callback:(fun () ->
+ if !palette_visible then begin
+ palette#misc#hide ();
+ palette_visible := false
+ end else begin
+ palette#misc#show ();
+ palette_visible := true
+ end);
+ let prop_win_visible = ref true in
+ prop_win#event#connect#delete ~callback:
+ (fun _ -> prop_win_visible := false; prop_win#misc#hide (); true);
+ view_menu#add_item "Properties window"
+ ~callback:(fun () ->
+ if !prop_win_visible then begin
+ prop_win#misc#hide ();
+ prop_win_visible := false
+ end else begin
+ prop_win#misc#show ();
+ prop_win_visible := true
+ end);
+
+ GMain.Main.main ()
+
+let _ = main ()
projects / helm.git / blobdiff