Merge pull request #1024 from tleedjarv/retry-fixes

Some code cleanups for the repeat mode

src/uicommon.ml

@@ -353,10 +353,10 @@ let reconItem2string oldPath theRI status =
 let exn2string e =
   match e with
      Sys.Break      -> "Terminated!"
-   | Util.Fatal(s)  -> Printf.sprintf "Fatal error: %s" s
-   | Util.Transient(s) -> Printf.sprintf "Error: %s" s
+   | Util.Fatal s   -> s
+   | Util.Transient s -> s
    | Unix.Unix_error (err, fun_name, arg) ->
-       Printf.sprintf "Uncaught unix error: %s failed%s: %s%s\n%s"
+       Printf.sprintf "Uncaught unix error (please report a bug): %s failed%s: %s%s\n%s"
          fun_name
          (if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "")
          (Unix.error_message err)
@@ -369,8 +369,9 @@ let exn2string e =
          Technical information in case you need to report a bug:\n"
        ^ (Printexc.get_backtrace ())
    | Invalid_argument s ->
-       Printf.sprintf "Invalid argument: %s\n%s" s (Printexc.get_backtrace ())
-   | other -> Printf.sprintf "Uncaught exception %s\n%s"
+       Printf.sprintf "Invalid argument (please report a bug): %s\n%s"
+         s (Printexc.get_backtrace ())
+   | other -> Printf.sprintf "Uncaught exception (please report a bug): %s\n%s"
        (Printexc.to_string other) (Printexc.get_backtrace ())
 
 (* precondition: uc = File (Updates(_, ..) on both sides *)

src/uigtk3.ml

@@ -299,7 +299,7 @@ let primaryText msg =
    chosen, false if the second button is chosen. *)
 let twoBox ?(kind=`DIALOG_WARNING) ~parent ~title ~astock ~bstock message =
   let t =
-    GWindow.dialog ~parent ~border_width:6 ~modal:true
+    GWindow.dialog ~parent ~title ~border_width:6 ~modal:true
       ~resizable:false () in
   t#vbox#set_spacing 12;
   let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
@@ -345,7 +345,7 @@ let warnBox ~parent title message =
   if Prefs.read Globals.batch then begin
     (* In batch mode, just pop up a window and go ahead *)
     let t =
-      GWindow.dialog ~parent
+      GWindow.dialog ~parent ~title
         ~border_width:6 ~modal:true ~resizable:false () in
     t#vbox#set_spacing 12;
     let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
@@ -685,11 +685,11 @@ let gui_safe_eprintf fmt =
     if System.has_stderr ~info:s then Printf.eprintf "%s%!" s) fmt
 
 let fatalError ?(quit=false) message =
+  let title = if quit then "Fatal error" else "Error" in
   let () =
     Trace.sendLogMsgsToStderr := false; (* We don't know if stderr is available *)
-    try Trace.log (message ^ "\n")
+    try Trace.log (title ^ ": " ^ message ^ "\n")
     with Util.Fatal _ -> () in (* Can't allow fatal errors in fatal error handler *)
-  let title = "Fatal error" in
   let toplevelWindow =
     try Some (toplevelWindow ())
     with Util.Fatal err ->
@@ -1657,9 +1657,9 @@ let createProfile parent =
       if React.state fat then Printf.fprintf ch "fat = true\n";
       close_out ch);
       profileName := Some (React.state name)
-    with Sys_error _ as e ->
+    with Sys_error errmsg ->
       okBox ~parent:assistant ~typ:`ERROR ~title:"Could not save profile"
-        ~message:(Uicommon.exn2string e)
+        ~message:("Error when saving profile: " ^ errmsg)
     end;
     assistant#destroy ();
   in
@@ -2400,9 +2400,9 @@ let editProfile parent name =
              false);
         close_out ch);
         setModified false
-      with Sys_error _ as e ->
+      with Sys_error errmsg ->
         okBox ~parent:t ~typ:`ERROR ~title:"Could not save profile"
-          ~message:(Uicommon.exn2string e)
+          ~message:("Error when saving profile: " ^ errmsg)
     end
   in
   let applyButton =

src/uitext.ml

@@ -1585,7 +1585,10 @@ let handleException e =
   alwaysDisplay "\n";
   Util.set_infos "";
   restoreTerminal();
-  let msg = Uicommon.exn2string e in
+  let lbl =
+    if e = Sys.Break then ""
+    else "Error: " in
+  let msg = lbl ^ Uicommon.exn2string e in
   let () =
     try Trace.log (msg ^ "\n")
     with Util.Fatal _ -> () in (* Can't allow fatal errors in fatal error handler *)
@@ -1621,13 +1624,36 @@ let rec start interface =
     exit Uicommon.fatalExit
   end;
 
-  (* Uncaught exceptions up to this point are non-recoverable, treated
-     as permanent and will inevitably exit the process. Uncaught exceptions
-     from here onwards are treated as potentially temporary or recoverable.
-     The process does not have to exit if in repeat mode and can try again. *)
+  (* Some preference settings imply others... *)
+  if Prefs.read silent then begin
+    Prefs.set Globals.batch true;
+    Prefs.set Trace.terse true;
+    Prefs.set dumbtty true;
+    Trace.sendLogMsgsToStderr := false;
+  end;
+  if Prefs.read Uicommon.repeat <> `NoRepeat then begin
+    Prefs.set Globals.batch true;
+  end;
+  setColorPreference ();
+  Trace.statusFormatter := formatStatus;
+
+  start2 ()
+
+(* Uncaught exceptions up to this point are non-recoverable, treated
+   as permanent and will inevitably exit the process. Uncaught exceptions
+   from here onwards are treated as potentially temporary or recoverable.
+   The process does not have to exit if in repeat mode and can try again. *)
+and start2 () =
+  let noRepeat =
+    Prefs.read Uicommon.repeat = `NoRepeat
+      || Prefs.read Uicommon.runtests
+      || Prefs.read Uicommon.testServer
+  in
+  let terminate () =
+    handleException Sys.Break;
+    exit Uicommon.fatalExit
+  in
   begin try
-    if Prefs.read silent then Prefs.set Trace.terse true;
-
     Uicommon.connectRoots ~displayWaitMessage ();
 
     if Prefs.read Uicommon.testServer then exit 0;
@@ -1638,53 +1664,32 @@ let rec start interface =
       exit 0
     end;
 
-    (* Some preference settings imply others... *)
-    if Prefs.read silent then begin
-      Prefs.set Globals.batch true;
-      Prefs.set Trace.terse true;
-      Prefs.set dumbtty true;
-      Trace.sendLogMsgsToStderr := false;
-    end;
-    if Prefs.read Uicommon.repeat <> `NoRepeat then begin
-      Prefs.set Globals.batch true;
-    end;
-    setColorPreference ();
-
     (* Tell OCaml that we want to catch Control-C ourselves, so that
        we get a chance to reset the terminal before exiting *)
     Sys.catch_break true;
     (* Put the terminal in cbreak mode if possible *)
     if not (Prefs.read Globals.batch) then setupTerminal();
     setWarnPrinter();
-    Trace.statusFormatter := formatStatus;
 
     let exitStatus = synchronizeUntilDone() in
 
     (* Put the terminal back in "sane" mode, if necessary, and quit. *)
     restoreTerminal();
     exit exitStatus
-
   with
-    Sys.Break -> begin
-      (* If we've been killed, then die *)
-      handleException Sys.Break;
-      exit Uicommon.fatalExit
-    end
-  | e when breakRepeat e -> begin
+  | Sys.Break -> terminate ()
+  | e when noRepeat || breakRepeat e -> begin
       handleException e;
       exit Uicommon.fatalExit
     end
   | e -> begin
       (* If any other bad thing happened and the -repeat preference is
          set, then restart *)
       handleException e;
-      if Prefs.read Uicommon.repeat = `NoRepeat
-          || Prefs.read Uicommon.runtests then
-        exit Uicommon.fatalExit;
 
       Util.msg "\nRestarting in 10 seconds...\n\n";
-      begin try interruptibleSleep 10 with Sys.Break -> exit Uicommon.fatalExit end;
-      if safeStopRequested () then exit Uicommon.fatalExit else start interface
+      begin try interruptibleSleep 10 with Sys.Break -> terminate () end;
+      if safeStopRequested () then terminate () else start2 ()
     end
   end