-
Notifications
You must be signed in to change notification settings - Fork 1.1k
/
pc_common.ml
218 lines (188 loc) · 7.08 KB
/
pc_common.ml
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
(*
* $Id$
*
* Paparazzi center utilities
*
* Copyright (C) 2007 ENAC, Pascal Brisset, Antoine Drouin
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
open Printf
let (//) = Filename.concat
let conf_dir = Env.paparazzi_home // "conf"
(** From OCaml otherlibs/unix/unix.ml *)
let my_open_process_in = fun cmd ->
let (in_read, in_write) = Unix.pipe () in
let inchan = Unix.in_channel_of_descr in_read in
let pid = Unix.create_process_env "/bin/sh" [|"/bin/sh"; "-c"; cmd|] (Array.append (Unix.environment ()) [|"GTK_SETLOCALE=0"|]) Unix.stdin in_write Unix.stderr in
Unix.close in_write;
pid, inchan
let buf_size = 128
let run_and_log = fun log com ->
let com = com ^ " 2>&1" in
let pid, com_stdout = my_open_process_in com in
let channel_out = GMain.Io.channel_of_descr (Unix.descr_of_in_channel com_stdout) in
let cb = fun ev ->
if List.mem `IN ev then begin
(* read one line, add the newline again and log it *)
let line = input_line com_stdout in
log (line ^ "\n");
true
end else begin
let buf = String.create buf_size in
(* loop until input returns zero *)
let rec log_input = fun out ->
let n = input out buf 0 buf_size in
if n < buf_size then log (String.sub buf 0 n)
else begin
log buf;
log_input out
end;
in
log_input com_stdout;
log (sprintf "\nDONE (%s)\n\n" com);
false
end in
let io_watch_out = Glib.Io.add_watch [`IN; `HUP] cb channel_out in
pid, channel_out, com_stdout, io_watch_out
let strip_prefix = fun dir file ->
let n = String.length dir in
if not (String.length file > n && String.sub file 0 n = dir) then begin
let msg = sprintf "Selected file '%s' should be in '%s'" file dir in
GToolbox.message_box ~title:"Error" msg;
raise Exit
end else
String.sub file (n+1) (String.length file - n - 1)
let choose_xml_file = fun ?(multiple = false) title subdir cb ->
let dir = conf_dir // subdir in
let dialog = GWindow.file_chooser_dialog ~action:`OPEN ~title () in
ignore (dialog#set_current_folder dir);
dialog#add_filter (GFile.filter ~name:"xml" ~patterns:["*.xml"] ());
dialog#add_button_stock `CANCEL `CANCEL ;
dialog#add_select_button_stock `OPEN `OPEN ;
dialog#set_select_multiple multiple;
begin match dialog#run (), dialog#filename with
| `OPEN, _ when multiple ->
let names = dialog#get_filenames in
dialog#destroy ();
cb (List.map (fun f -> subdir // strip_prefix dir f) names)
| `OPEN, Some name ->
dialog#destroy ();
cb [subdir // strip_prefix dir name]
| _ -> dialog#destroy ()
end
let run_and_monitor = fun ?(once = false) ?file gui log com_name com args ->
let c = sprintf "%s %s" com args in
let p = new Gtk_process.hbox_program ?file () in
(gui#vbox_programs:GPack.box)#pack p#toplevel#coerce;
p#label_com_name#set_text com_name;
p#entry_program#set_text c;
let pid = ref (-1)
and outchan = ref stdin
and watches = ref [] in
let run = fun callback ->
let c = p#entry_program#text in
log (sprintf "Run '%s'\n" c);
let (pi, out, unixfd, io_watch) = run_and_log log ("exec "^c) in
let stop_cb_delay = 500 in (* ms *)
pid := pi;
outchan := unixfd;
let io_watch' = Glib.Io.add_watch [`HUP;`OUT] (fun _ ->
ignore (Glib.Timeout.add stop_cb_delay (fun () -> callback true; false));
false) out in
watches := [ io_watch; io_watch'] in
let remove_callback = fun () ->
gui#vbox_programs#remove p#toplevel#coerce in
let rec callback = fun stop ->
match p#button_stop#label, stop with
"gtk-stop", _ ->
List.iter Glib.Io.remove !watches;
close_in !outchan;
ignore (Unix.kill !pid Sys.sigkill);
ignore (Unix.waitpid [] !pid);
p#button_stop#set_label "gtk-redo";
p#button_remove#misc#set_sensitive true;
if once then
remove_callback ()
else if stop && p#checkbutton_autolaunch#active then
callback false
| "gtk-redo", false ->
p#button_stop#set_label "gtk-stop";
run callback;
p#button_remove#misc#set_sensitive false
| _ -> ()
in
ignore (p#button_stop#connect#clicked ~callback:(fun () -> callback false));
ignore (p#entry_program#connect#activate ~callback:(fun () -> callback false));
run callback;
(* Stop the program if the box is closed *)
let callback = fun () ->
callback true in
ignore(p#toplevel#connect#destroy ~callback);
(* Remove button *)
ignore (p#button_remove#connect#clicked ~callback:remove_callback)
let basic_command = fun (log:string->unit) ac_name target ->
let com = sprintf "export PATH=/usr/bin:$PATH; make -C %s -f Makefile.ac AIRCRAFT=%s %s" Env.paparazzi_src ac_name target in
log com;
ignore (run_and_log log com)
let command = fun ?file gui (log:string->unit) ac_name target ->
let com = sprintf "make -C %s -f Makefile.ac AIRCRAFT=%s %s" Env.paparazzi_src ac_name target in
run_and_monitor ~once:true ?file gui log "make" com ""
let conf_is_set = fun home ->
Sys.file_exists home &&
Sys.file_exists (home // "conf") &&
Sys.file_exists (home // "data")
let druid = fun home ->
let w = GWindow.window ~title:"Configuring Paparazzi" () in
let d = GnoDruid.druid ~packing:w#add () in
ignore (d#connect#cancel (fun () -> exit 1));
begin
let fp = GnoDruid.druid_page_edge ~position:`START ~aa:true ~title:"Configure Paparazzi !!" () in
fp#set_text (sprintf "Configuration files need to be installed in your Paparazzi home (%s). To use another directory, please exit this utility, set the PAPARAZZI_HOME variable to the desired folder and restart." home);
d#append_page fp;
ignore (fp#connect#next
(fun _ ->
basic_command prerr_endline "" "init";
false
))
end;
begin
let ep = GnoDruid.druid_page_edge ~position:`FINISH ~aa:true ~title:"The end" () in
ep#set_text "You are ready. Congratulations!" ;
d#append_page ep ;
ignore (ep#connect#finish
(fun _ ->
w#destroy ();
GMain.quit ()
))
end;
w#show ();
GMain.main ()
let _ =
let home = Env.paparazzi_home in
if not (conf_is_set home) then
druid home
let conf_xml_file = conf_dir // "conf.xml"
let backup_xml_file = conf_xml_file ^ "~"
let aircrafts = Hashtbl.create 7
let build_aircrafts = fun () ->
let conf_xml = ExtXml.parse_file conf_xml_file in
List.iter (fun aircraft ->
Hashtbl.add aircrafts (ExtXml.attrib aircraft "name") aircraft)
(Xml.children conf_xml)