diff --git a/src/uicommon.ml b/src/uicommon.ml index fbd5e94b3..540eeaf3d 100644 --- a/src/uicommon.ml +++ b/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 *) diff --git a/src/uigtk3.ml b/src/uigtk3.ml index 9d599c86c..352f5d290 100644 --- a/src/uigtk3.ml +++ b/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 = diff --git a/src/uitext.ml b/src/uitext.ml index 363e1cb2d..000104c7d 100644 --- a/src/uitext.ml +++ b/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,39 +1664,21 @@ 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 @@ -1678,13 +1686,10 @@ let rec start interface = (* 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