1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
(**************************************************************************)
(* *)
(* This file is part of OcamlGraph. *)
(* *)
(* Copyright (C) 2009-2010 *)
(* CEA (Commissariat l'nergie Atomique) *)
(* *)
(* you can redistribute it and/or modify it under the terms of the GNU *)
(* Lesser General Public License as published by the Free Software *)
(* Foundation, version 2.1, with a linking exception. *)
(* *)
(* It is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Lesser General Public License for more details. *)
(* *)
(* See the file ../LICENSE for more details. *)
(* *)
(* Authors: *)
(* - Julien Signoles (Julien.Signoles@cea.fr) *)
(* - Jean-Denis Koeck (jdkoeck@gmail.com) *)
(* - Benoit Bataille (benoit.bataille@gmail.com) *)
(* *)
(**************************************************************************)
open Graph
open Dgraph
open Printf
let ($) f x = f x
let get_some = function Some t -> t | None -> assert false
let debug = false
module Content = DGraphContainer.Dot
type state = {
mutable file: string option;
mutable window: GWindow.window;
mutable content: (GPack.table * Content.view_container) option
}
let init_state () =
let window =
GWindow.window
~width:1280 ~height:1024
~title:"Graph Widget"
~allow_shrink:true ~allow_grow:true ()
in
let status = GMisc.label ~markup:"" () in
status#set_use_markup true;
let file = ref None in
for i=1 to Array.length Sys.argv - 1 do
file := Some Sys.argv.(i)
done;
{ file = !file;
window = window;
content = None }
(* Top menu *)
let menu_desc = "<ui>\
<menubar name='MenuBar'>\
<menu action='FileMenu'>\
<menuitem action='Open'/>\
<menuitem action='Zoom fit'/>\
<menuitem action='Quit'/>\
</menu>\
</menubar>
</ui>"
let update_state state ~packing =
(match state.content with None -> () | Some (t, _) -> t#destroy ());
try
let _, view as content = match state.file with
| Some file ->
if debug then printf "Building Model...\n";
state.file <- Some file;
Content.from_dot_with_commands ~packing file
| None ->
raise Not_found
in
state.content <- Some content;
state.window#show ();
view#adapt_zoom ()
with Not_found ->
if debug then printf "No model\n"
let all_files () =
let f = GFile.filter ~name:"All" () in
f#add_pattern "*" ;
f
let open_file state ~packing () =
let dialog =
GWindow.file_chooser_dialog
~action:`OPEN
~title:"Open File"
~parent:state.window ()
in
dialog#add_button_stock `CANCEL `CANCEL ;
dialog#add_select_button_stock `OPEN `OPEN ;
dialog#add_filter (all_files ()) ;
match dialog#run () with
| `OPEN ->
state.file <- dialog#filename;
dialog#destroy ();
update_state state ~packing
| `DELETE_EVENT | `CANCEL -> dialog#destroy ()
let create_menu state ~packing =
let ui_m = GAction.ui_manager () in
let actions = GAction.action_group ~name:"Actions" () in
GAction.add_actions actions [
GAction.add_action "FileMenu" ~label:"File" ;
GAction.add_action "Open" ~label:"Open" ~accel:"<Control>o" ~stock:`OPEN
~callback:(fun _ -> open_file state ~packing ());
GAction.add_action
"Zoom fit" ~label:"Zoom fit" ~accel:"<Control>t" ~stock:`ZOOM_FIT
~callback:(fun _ -> match state.content with
|None -> ()
|Some (_,v) -> v#adapt_zoom ());
GAction.add_action "Quit" ~label:"Quit" ~accel:"<Control>q" ~stock:`QUIT
~callback:(fun _ -> GMain.Main.quit ());
];
ui_m#insert_action_group actions 0 ;
ignore $ ui_m#add_ui_from_string menu_desc;
ui_m
(* Main loop *)
let main () =
(* GUI *)
let state = init_state () in
let vbox =
GPack.vbox ~border_width:4 ~spacing:4 ~packing:state.window#add ()
in
let packing = vbox#pack ~expand:true ~fill:true in
(* Menu *)
let ui_m = create_menu state ~packing in
state.window#add_accel_group ui_m#get_accel_group ;
vbox#pack ~expand:false (ui_m#get_widget "/MenuBar");
ignore $ state.window#connect#destroy ~callback:GMain.Main.quit;
if debug then printf "GUI built, time: %f\n" (Sys.time ());
update_state state ~packing;
state.window#show ();
GMain.Main.main ()
(* [JS 2009/09/21] Printexc.print prevents to use ocaml < 3.11 *)
let _ = (*Printexc.print*) main ()
|
