From 6b9a3b9c97a7b8e472e0bbcff94f904756d94974 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 28 May 2021 11:47:22 +0200
Subject: [PATCH] Fix: make the rdbgui4sasa undo button work
---
tools/rdbg4sasa/gtkgui.ml | 36 ++++++++++++++++++++----------------
1 file changed, 20 insertions(+), 16 deletions(-)
diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml
index caed3dd7..8d9a50c2 100644
--- a/tools/rdbg4sasa/gtkgui.ml
+++ b/tools/rdbg4sasa/gtkgui.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 28/05/2021 (at 10:12) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/05/2021 (at 11:47) by Erwan Jahier> *)
#thread
#require "lablgtk3"
@@ -103,7 +103,7 @@ let write_add color b str =
let blue = write "blue_foreground"
let black = write "black_foreground"
let red = write "red_foreground"
-let green = write "green_foreground"
+let green = write "green_foreground"
let blue_add = write_add "blue_foreground"
let black_add = write_add "black_foreground"
@@ -118,8 +118,9 @@ let display_event b =
(* *)
let goto_hook_call () =
- if custom_mode then
+ if custom_mode then (
e := next_cond !e (fun e -> e.name = "mv_hook" && e.kind = Call)
+ )
let goto_hook_exit () =
if custom_mode then
@@ -293,6 +294,7 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
goto_hook_exit ();
goto_hook_call ();
display_event gtext;
+ store !e.nb;
refresh ();
false));
Hashtbl.add pushbox_map name pushbox
@@ -476,6 +478,7 @@ let custom_daemon p gtext vbox step_button round_button legitimate_button =
| Manual ->
goto_hook_exit ();
goto_hook_call ();
+ store !e.nb;
d ()
in
step
@@ -525,12 +528,13 @@ let main () =
button#set_image icon;
refresh ()
in
- let button_cb display_event_flag cmd () =
+ let button_cb display_event_flag store_flag cmd () =
blue text_out#buffer "From ";
let txt = Printf.sprintf "\n%s%!" (str_of_sasa_event false !e) in
(* text_out#buffer#set_text txt; *)
blue_add text_out#buffer txt;
cmd ();
+ if store_flag then store !e.nb;
if display_event_flag then display_event text_out;
refresh ()
in
@@ -546,7 +550,7 @@ let main () =
let back_step_button = button ~use_mnemonic:true ~stock:`GO_BACK ~packing:bbox#add () in
set_tooltip back_step_button "Move BACKWARD to the previous STEP";
change_label back_step_button "Ste_p";
- ignore (back_step_button#connect#clicked ~callback:(button_cb true bd));
+ ignore (back_step_button#connect#clicked ~callback:(button_cb true true bd));
let step_button = button ~use_mnemonic:true ~packing:bbox#add ~stock:`GO_FORWARD () in
let back_round_button =
@@ -577,7 +581,7 @@ let main () =
in
(* change_label legitimate_button "Silen_t"; *)
ignore (legitimate_button#connect#clicked ~callback:
- (button_cb true (fun () ->
+ (button_cb true true (fun () ->
if custom_mode then legitimate_gui() else legitimate ())
)
);
@@ -590,12 +594,12 @@ let main () =
set_tooltip step_button "Move FORWARD to the next STEP";
change_label step_button "_Step";
- ignore (step_button#connect#clicked ~callback:(button_cb true step));
+ ignore (step_button#connect#clicked ~callback:(button_cb true true step));
set_tooltip round_button "Move FORWARD to the next ROUND";
change_label round_button "_Round";
ignore (round_button#connect#clicked
~callback:(
- button_cb true (fun () ->
+ button_cb true true (fun () ->
if custom_mode then (
next_round_gui !roundnb;
if custom_mode && !e.name <> "mv_hook" && !e.kind <> Call then
@@ -608,7 +612,7 @@ let main () =
set_tooltip back_round_button "Move BACKWARD to the previous ROUND";
change_label back_round_button "Roun_d";
ignore (back_round_button#connect#clicked
- ~callback:(button_cb true (fun () -> pr();pr(); goto_hook_call ())));
+ ~callback:(button_cb true true (fun () -> pr();pr(); goto_hook_call ())));
let graph () =
@@ -616,7 +620,7 @@ let main () =
set_tooltip graph_button "Visualize the Topology states: Green=Enabled ; Gold=Active";
let image = GMisc.image ~file:(libui_prefix^"/graph_small.png") () in
graph_button#set_image image#coerce;
- ignore (graph_button#connect#clicked ~callback:(button_cb false graph_view));
+ ignore (graph_button#connect#clicked ~callback:(button_cb false false graph_view));
in
graph ();
@@ -632,14 +636,14 @@ let main () =
let oracle_button =
make_button `OK "_Oracle" "Move FORWARD until an oracle is violated"
(button_cb_string
- (fun () -> let str = viol_string () in goto_hook_call (); d();str))
+ (fun () -> let str = viol_string () in goto_hook_call (); d(); store !e.nb; str))
in
oracle_button#misc#hide(); (* indeed, in the defaut mode (manual central), it should be hided *)
oracle_button_ref := Some oracle_button
);
- let _ = make_button `UNDO "_Undo" "Undo the last move" (button_cb true (fun ()->u();d())) in
+ let _ = make_button `UNDO "_Undo" "Undo the last move" (button_cb true false (fun ()->u();d())) in
let _ = make_button `REFRESH "Restar_t" "Restart from the beginning"
- (button_cb true
+ (button_cb true true
(fun ()->
let seed = Seed.get dotfile in
Seed.set seed;
@@ -654,7 +658,7 @@ let main () =
d()))
in
let _ = make_button `REFRESH "_New Seed" "Restart from the beginning using a New Seed"
- (button_cb true
+ (button_cb true true
(fun ()->
Seed.reset();
Seed.replay_seed := false;
@@ -671,10 +675,10 @@ let main () =
d()))
in
let _ = make_button `MEDIA_PLAY "_Sim2chro" "Launch sim2chro on the generated data (so far)"
- (button_cb false sim2chro)
+ (button_cb false false sim2chro)
in
let _ = make_button `MEDIA_PLAY "_Gnuplot" "Launch gnuplot-rif on the generated data (so far)"
- (button_cb false gnuplot)
+ (button_cb false false gnuplot)
in
let _ = make_button `INFO "_Info" "Get information about the current session"
(button_cb_string info_string)
--
GitLab