Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

Commit 8c181009 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurette 0.105 Wed, 23 Oct 2002 13:50:03 +0200 by jahier

Parent-Version:      0.104
Version-Log:

ihm/xlurette/*:
   Look up the pipe every 1/10 sec. instead of reading it after
   each command until a certain string is encoutered. It make
   the code more robust (no protocol), it avoid that xlurette
   is blocked during the process. Moreover, it let the progress
   bar works gently.

   Add a stop button that sends a sigint to lurettetop that
   ougth to stop the current execution (does not work, why?).

Project-Description: Lurette
parent 15c3bf1d
......@@ -27,7 +27,7 @@
(source/luc_exe.ml 12191 1034351455 b/32_ima_exe.ml 1.21)
(test/heater_float.rif.exp 1485 1034951022 b/30_heater_flo 1.11)
(source/graph.ml 2563 1027066799 14_graph.ml 1.7)
(ihm/xlurette/makefile 1397 1034951022 c/16_makefile 1.3)
(ihm/xlurette/makefile 1475 1035373803 c/16_makefile 1.4)
(test/usager.luc 495 1032789516 b/14_usager.env 1.9)
(mlcuddidl/manager.ml 8017 1034006019 c/47_manager.ml 1.1)
(cuddaux/cuddauxInt.h 2058 1034006019 c/28_cuddauxInt 1.1)
......@@ -42,13 +42,13 @@
(mlcuddidl/rdd.mli 7174 1034006019 c/40_rdd.mli 1.1)
(test/Makefile 32 1034951022 c/0_Makefile 1.7)
(source/parse_env.ml 24584 1033723811 41_parse_env. 1.29)
(ihm/xlurette/xlurette_glade_main.ml 17634 1034951022 c/12_xlurette_g 1.7)
(ihm/xlurette/xlurette_glade_main.ml 17194 1035373803 c/12_xlurette_g 1.8)
(demo/chaudiere/chaudiere_oracle.lus 107 1031732392 c/8_chaudiere_ 1.1)
(source/solver.ml 31802 1033732198 39_solver.ml 1.32)
(test/ControleurPorte.lus 3219 1032940601 c/17_Controleur 1.1)
(source/lurette.ml 13532 1033738731 12_lurette.ml 1.54)
(source/lurette.ml 13556 1035373803 12_lurette.ml 1.55)
(source/Makefile 1082 1034951022 c/20_Makefile 1.6)
(source/util.ml 18695 1034951022 35_util.ml 1.29)
(source/util.ml 18693 1035373803 35_util.ml 1.30)
(mlcuddidl/manager.mli 7912 1034006019 c/46_manager.ml 1.1)
(test/time.res 5580 1034006019 b/49_time.res 1.15)
(doc/Interface_draft 5232 1003928781 19_Interface_ 1.1)
......@@ -69,8 +69,8 @@
(test/porte.luc 1050 1032789516 b/16_porte.env 1.8)
(make_lurette 1306 1034006019 27_make_luret 1.17)
(source/control.ml 4416 1030975996 c/4_control.ml 1.3)
(ihm/xlurette/xlurette_glade_interface.ml 30194 1034951022 c/15_xlurette_g 1.4)
(source/lurettetop.ml 25200 1034951022 c/1_lurettetop 1.14)
(ihm/xlurette/xlurette_glade_interface.ml 30518 1035373803 c/15_xlurette_g 1.5)
(source/lurettetop.ml 25262 1035373803 c/1_lurettetop 1.15)
(mlcuddidl/README 1574 1034006019 d/8_README 1.1)
(cuddaux/README 1427 1034006019 c/34_README 1.1)
(source/ne.mli 2376 1033723811 c/22_ne.mli 1.1)
......@@ -82,7 +82,7 @@
(source/env.mli 2027 1033738731 15_env.mli 1.16)
(mlcuddidl/rdd_caml.c 41613 1034006019 c/39_rdd_caml.c 1.1)
(Makefile.common.in 528 1034951022 d/12_Makefile.c 1.2)
(user-rules 14564 1034951022 c/14_myrules 1.11)
(user-rules 14696 1035373803 c/14_myrules 1.12)
(doc/archi.fig 3693 1003928781 20_archi.fig 1.1)
(source/lurette.mli 448 1016027474 11_lurette.ml 1.12)
(source/gne.mli 1552 1033397911 b/36_gne.mli 1.4)
......@@ -96,7 +96,7 @@
(mlcuddidl/manager.idl 11024 1034006019 c/48_manager.id 1.1)
(test/vrai_tram.c 3060 1027066799 b/8_vrai_tram. 1.3)
(source/command_line.mli 1442 1031053030 b/21_command_li 1.7)
(ihm/xlurette/xlurette.glade 45911 1034951022 c/13_xlurette.g 1.5)
(ihm/xlurette/xlurette.glade 46415 1035373803 c/13_xlurette.g 1.6)
(demo/chaudiere/chaudiere.luc 446 1032789516 c/11_chaudiere. 1.5)
(source/graph.mli 2218 1027066799 13_graph.mli 1.9)
(mlcuddidl/bdd_caml.c 57199 1034006019 d/4_bdd_caml.c 1.1)
......
......@@ -7,19 +7,22 @@ ifndef BIN_INSTALL_DIR
endif
THREAD=
# THREAD=-thread threads.cma
xlurette: dummy
mlglade xlurette.glade
ocamlc -c -I +lablgtk -labels -c xlurette_glade_interface.ml
ocamlc -c -i -I +lablgtk -labels -c xlurette_glade_callbacks.ml
ocamlc -c -I +lablgtk -c xlurette_glade_main.ml
ocamlc -I +lablgtk -o xlurette unix.cma lablgtk.cma gtkInit.cmo \
ocamlc -c -I +lablgtk $(THREAD) -c xlurette_glade_main.ml
ocamlc $(THREAD) -I +lablgtk -o xlurette unix.cma lablgtk.cma gtkInit.cmo \
xlurette_glade_callbacks.cmo xlurette_glade_interface.cmo xlurette_glade_main.cmo
xlurette.opt: dummy
mlglade xlurette.glade
ocamlopt -c -I +lablgtk -labels -c xlurette_glade_interface.ml
ocamlopt -c -I +lablgtk -labels -c xlurette_glade_callbacks.ml
ocamlopt -c -I +lablgtk -c xlurette_glade_main.ml
ocamlopt -c -I +lablgtk $(THREAD) -c xlurette_glade_main.ml
ocamlopt -I +lablgtk -labels -o xlurette unix.cmxa lablgtk.cmxa gtkInit.cmx \
xlurette_glade_callbacks.cmx xlurette_glade_interface.cmx xlurette_glade_main.cmx
......@@ -27,12 +30,12 @@ xlurette.opt_opt: dummy
mlglade xlurette.glade
ocamlopt.opt -c -I +lablgtk -labels -c xlurette_glade_interface.ml
ocamlopt.opt -c -I +lablgtk -labels -c xlurette_glade_callbacks.ml
ocamlopt.opt -c -I +lablgtk -c xlurette_glade_main.ml
ocamlopt.opt -c -I +lablgtk $(THREAD) -c xlurette_glade_main.ml
ocamlopt.opt -I +lablgtk -labels -o xlurette unix.cmxa lablgtk.cmxa gtkInit.cmx \
xlurette_glade_callbacks.cmx xlurette_glade_interface.cmx xlurette_glade_main.cmx
install: xlurette
install: xlurette
cp xlurette $(BIN_INSTALL_DIR)
......
......@@ -292,7 +292,7 @@
<bar_style>GTK_PROGRESS_CONTINUOUS</bar_style>
<orientation>GTK_PROGRESS_LEFT_TO_RIGHT</orientation>
<activity_mode>False</activity_mode>
<show_text>False</show_text>
<show_text>True</show_text>
<format>%P %%</format>
<text_xalign>0.5</text_xalign>
<text_yalign>0.5</text_yalign>
......@@ -596,6 +596,23 @@
<border_width>4</border_width>
<width>150</width>
<height>100</height>
<tooltip>Stop the current run</tooltip>
<signal>
<name>clicked</name>
<handler>stop_run</handler>
<last_modification_time>Tue, 22 Oct 2002 13:12:35 GMT</last_modification_time>
</signal>
<label> </label>
<icon>halt.xpm</icon>
</widget>
<widget>
<class>GtkButton</class>
<child_name>Toolbar:button</child_name>
<name>button36</name>
<border_width>4</border_width>
<width>150</width>
<height>100</height>
<tooltip>Quit xlurette</tooltip>
<signal>
<name>clicked</name>
......@@ -1353,7 +1370,7 @@
<name>radiobutton_verbose_on</name>
<can_focus>True</can_focus>
<label>On</label>
<active>False</active>
<active>True</active>
<draw_indicator>True</draw_indicator>
<child>
<padding>0</padding>
......@@ -1367,7 +1384,7 @@
<name>radiobutton_verbose_off</name>
<can_focus>True</can_focus>
<label>Off</label>
<active>True</active>
<active>False</active>
<draw_indicator>True</draw_indicator>
<group>radiobutton_verbose_on</group>
<child>
......
......@@ -215,7 +215,7 @@ let progressbar = GRange.progress_bar
~text_yalign:0.5
~bar_style:`CONTINUOUS
~activity_mode:false
~show_text:false
~show_text:true
~format_string: "%P %%"
()
in
......@@ -381,10 +381,16 @@ in
let _ = tooltips#set_tip ~text:"Save session" button19#coerce in
let button20 = toolbar4#insert_button
~text: " "
~icon:(GMisc.pixmap (GDraw.pixmap_from_xpm ~file:"pixmaps/halt.xpm" ()) ())#coerce
()
in
let _ = tooltips#set_tip ~text:"Stop the current run" button20#coerce in
let button36 = toolbar4#insert_button
~text: " "
~icon:(GMisc.pixmap (GDraw.pixmap_from_xpm ~file:"pixmaps/close.xpm" ()) ())#coerce
()
in
let _ = tooltips#set_tip ~text:"Quit xlurette" button20#coerce in
let _ = tooltips#set_tip ~text:"Quit xlurette" button36#coerce in
let label9 = GMisc.label
~text: "Run "
~xalign:0.5
......@@ -966,7 +972,7 @@ let radiobutton_verbose_on = GButton.radio_button
)
~label: "On"
~draw_indicator:true
~active:false
~active:true
()
in
let _ = GtkBase.Widget.set_can_focus radiobutton_verbose_on#as_widget true in
......@@ -978,7 +984,7 @@ let radiobutton_verbose_off = GButton.radio_button
)
~label: "Off"
~draw_indicator:true
~active:true
~active:false
()
in
let _ = GtkBase.Widget.set_can_focus radiobutton_verbose_off#as_widget true in
......@@ -1032,8 +1038,10 @@ let _ = button14#connect#clicked
~callback:callbacks#call_sim2chro_clicked in
let _ = button2#connect#clicked
~callback:callbacks#save_session in
let _ = button20#connect#clicked
let _ = button36#connect#clicked
~callback:callbacks#quit in
let _ = button20#connect#clicked
~callback:callbacks#stop_run in
let _ = button19#connect#clicked
~callback:callbacks#save_session in
let _ = button18#connect#clicked
......@@ -1085,6 +1093,7 @@ method button17 = button17
method button18 = button18
method button19 = button19
method button20 = button20
method button36 = button36
method label9 = label9
method option_panel = option_panel
method vbox8 = vbox8
......
open GMain
open GEdit
let debug = false
let debug =
(* true *)
false
let pid = ref 0
(* Flag telling if any saved package need to be restored *)
let restore = ref false
......@@ -17,86 +20,91 @@ let ic = Unix.in_channel_of_descr lurette_stdout_in
let oc = Unix.out_channel_of_descr lurette_stdin_out
let _ = set_binary_mode_in ic false
let _ = set_binary_mode_out oc false
let _ =
set_binary_mode_in ic false;
set_binary_mode_out oc false
(* XXX won't work under window$ !!! *)
; Unix.set_nonblock lurette_stdout_out
; Unix.set_nonblock lurette_stdout_in
type draw_mode = Verteces | Edges | Inside
(**************************************************************************)
let ignore_list = [" Type h for help, or man for a small user manual."]
let rec (read_ic_until_lurette_prompt: (string -> unit) ->
(float -> unit) -> unit) =
fun display progress ->
try
let str = input_line ic in
(* display (str ^ "\n"); *)
if debug then (print_string (str ^ "\n"); flush stdout);
if
str = "<lurette> "
then
()
else if
str = "One more loop ? [type any char to stop, `CR' to continue]"
then
display (
"One more loop ?
click on the step (resp. stop) button to continue (resp. stop)\n")
else if
str = " Type h for help, or man for a small user manual."
then
(
display "No program is currently running.\n";
read_ic_until_lurette_prompt display progress
)
else if
String.length str > 4 && String.sub str 0 4 = "*** "
then
(
display (str ^ "\n");
read_ic_until_lurette_prompt display progress
)
else
(
display (str ^ "\n");
if
((String.length str > 9) && ((String.sub str 0 9) = "--- step "))
then
(
let dot_index = String.index str ':' in
let step_str = String.sub str 9 (dot_index-9) in
let stepf = float_of_string step_str in
progress stepf
);
read_ic_until_lurette_prompt display progress
)
with e ->
display ((Printexc.to_string e) ^ "*** \n")
(**************************************************************************)
(**************************************************************************)
class customized_callbacks = object(self)
inherit Xlurette_glade_callbacks.default_callbacks
method read_until_promt () =
let length = float_of_string self#top_xlurette#test_length#text in
read_ic_until_lurette_prompt self#top_xlurette#output_window#insert
(fun f ->
let p = f /. length in
let pi = int_of_float (p *. 100.) in
self#top_xlurette#step_number_label#set_text
((string_of_int pi) ^ " %");
self#top_xlurette#progressbar#set_percentage p
)
method read_pipe () =
let length = float_of_string self#top_xlurette#test_length#text in
let
display = self#top_xlurette#output_window#insert
and
progress =
( fun f ->
let p = f /. length in
let pi = int_of_float (p *. 100.) in
self#top_xlurette#step_number_label#set_text
((string_of_int pi) ^ " % \n(" ^ (string_of_int (int_of_float f))
^ "/" ^ (string_of_int (int_of_float length)) ^ ")");
self#top_xlurette#progressbar#set_percentage p )
in
( try
while true do
let str = input_line ic in
if debug then (print_string (str ^ "\n"); flush stdout);
if
str = ""
then
()
else
if
str = "One more loop ? [type any char to stop, `CR' to continue]"
then
display (
"One more loop ?
click on the step (resp. stop) button to continue (resp. stop)\n")
else if
str = " Type h for help, or man for a small user manual."
then
(
display "No program is currently running.\n";
()
)
else if
String.length str > 4 && String.sub str 0 4 = "*** "
then
(
display (str ^ "\n")
)
else if
String.length str > 7 && String.sub str 0 8 = "<lurette"
then
()
else
if
((String.length str > 9) && ((String.sub str 0 9) = "--- step "))
then
(
let dot_index = String.index str ':' in
let step_str = String.sub str 9 (dot_index-9) in
let stepf = float_of_string step_str in
progress stepf
)
else
display (str ^ "\n")
done
with _ -> ()
);
true
method show_step_window () =
self#top_step_by_step_window#step_by_step_window#show ()
(* sut file selection window *)
......@@ -160,17 +168,14 @@ class customized_callbacks = object(self)
output_string oc cmd_show ;
if debug then (output_string stderr cmd_show; flush stderr);
flush oc;
self#read_until_promt ();
self#read_until_promt ()
flush oc
method quit () =
output_string oc "quit\n";
flush oc;
prerr_endline "bye! " ;
Unix.kill !pid 9;
Unix.kill !pid (Sys.sigkill);
exit 0; ()
method step () =
......@@ -181,12 +186,16 @@ class customized_callbacks = object(self)
let cmd_step = (" \n") in
if debug then (output_string stderr cmd_step; flush stderr);
output_string oc cmd_step;
flush oc;
self#read_until_promt ()
flush oc
)
else
self#top_xlurette#output_window#insert
"Step button unactive because step-by-step mode is off\n"
"Step button unactive because step-by-step mode is off\n"
method stop_run () =
self#top_xlurette#output_window#insert "Stopping the current run.\n";
Unix.kill (!pid) Sys.sigint ;
()
method stop () =
if
......@@ -197,13 +206,12 @@ class customized_callbacks = object(self)
if debug then (output_string stderr cmd_stop; flush stderr);
output_string oc cmd_stop;
flush oc;
self#top_step_by_step_window#step_by_step_window#misc#hide ();
self#read_until_promt ()
self#top_step_by_step_window#step_by_step_window#misc#hide ()
)
else
self#top_xlurette#output_window#insert
"Stop button unactive because step-by-step mode is off\n"
method display_rif_file_clicked () =
let cmd_display =
("set_output " ^ self#top_xlurette#rif_file#text ^ "\n" ^
......@@ -224,7 +232,6 @@ class customized_callbacks = object(self)
flush oc;
flush stderr
method run_lurette () =
let sut = self#top_xlurette#sut_name#text in
let cmd_sut = ("set_sut \"" ^ sut ^ "\"\n") in
......@@ -293,111 +300,68 @@ class customized_callbacks = object(self)
output_string oc cmd_oracle ;
if debug then output_string stderr cmd_oracle;
flush oc;
output_string oc cmd_test_length ;
if debug then output_string stderr cmd_test_length;
flush oc;
output_string oc cmd_formula_nb ;
if debug then output_string stderr cmd_formula_nb;
flush oc;
output_string oc cmd_draw_nb ;
if debug then output_string stderr cmd_draw_nb;
flush oc;
output_string oc cmd_rif_file ;
if debug then output_string stderr cmd_rif_file;
flush oc;
output_string oc cmd_env ;
if debug then output_string stderr cmd_env;
flush oc;
output_string oc cmd_sut ;
if debug then output_string stderr cmd_sut;
flush oc;
output_string oc cmd_step ;
if debug then output_string stderr cmd_step;
flush oc;
output_string oc cmd_seed ;
if debug then output_string stderr cmd_seed;
flush oc;
output_string oc cmd_draw_mode ;
if debug then output_string stderr cmd_draw_mode;
flush oc;
output_string oc cmd_call_sim2chro ;
if debug then output_string stderr cmd_call_sim2chro;
flush oc;
output_string oc cmd_display_local ;
if debug then output_string stderr cmd_display_local;
flush oc;
output_string oc cmd_verbose ;
if debug then output_string stderr cmd_verbose;
flush oc;
output_string oc cmd ;
if debug then output_string stderr cmd;
flush oc;
flush stderr;
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ();
self#read_until_promt ()
flush stderr
method save_session () =
output_string oc ("pack " ^ self#top_xlurette#saved_session_file#text ^ " \n");
flush oc;
prerr_endline "save session ...";
self#read_until_promt ();
()
......@@ -457,7 +421,8 @@ end
let usage = "
usage: xlurette [<options>] [<env ([x] env)*>]
xlurette is a lurette GUI.
xlurette is a Graphical interface over lurettetop, which lets
one automatically test reactive programs written in lustre.
Command line <options> are:
"
......@@ -518,27 +483,23 @@ let rec speclist callbacks =
"-h", Arg.Unit (fun _ -> (Arg.usage (speclist callbacks) usage ; exit 0)),
""
]
(******************************************************************************)
(* Toolbar *)
let icon file_name =
let info = GDraw.pixmap_from_xpm ~file:file_name () in
fun () -> (GMisc.pixmap info ())#coerce
(******************************************************************************)
(* let _ = *)
(* callbacks#read_pipe_thread_loop 1.1 *)
let main () =
(* To turn around a bug in mlglade which searches the pixmaps dir
in the current dir instead of the xlurette one. *)
let main () =
let _ =
let _ =
(* Check that LURETTE_PATH env var is set. *)
try
Sys.getenv "LURETTE_PATH"
with Not_found ->
......@@ -550,8 +511,11 @@ let main () =
)
in
if not (Sys.file_exists "pixmaps")
(* To turn around a bug in mlglade which searches the pixmaps dir
in the current dir instead of the xlurette one... *)
then
try
(* XXX Won't work under window$ !!! *)
Unix.symlink
(Filename.concat (Unix.getenv "LURETTE_PATH") "ihm/xlurette/pixmaps")
"pixmaps";
......@@ -559,7 +523,6 @@ let main () =
print_string "*** Can not create a file in the current directory.\n";
flush stdout
in
let callbacks = new customized_callbacks in
let xlurette = new Xlurette_glade_interface.top_xlurette callbacks in
......@@ -578,18 +541,15 @@ let main () =
let browse_add_env =
new Xlurette_glade_interface.top_fileselection_add_env callbacks
in
(*
You should probably remove the next line if you want to use the
event masks from glade
(* msg generated by mlglade :
You should probably remove the next line if you want to use the