From b1e1f892feedbda1d3f062c9c5fcb1a67fada26c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= <toivol@gmail.com>
Date: Fri, 1 Mar 2024 16:49:05 +0100
Subject: [PATCH] Classify/Label errors in the UI, not in [exn2str]

The [exn2str] function used to add superfluous labels to error messages,
in some cases classifying errors as fatal or not (historically likely at
least partially due to debugging needs). This function does not know the
consequences of the error nor further actions to be taken. These labels
can then become misleading.

These labels, if needed at all, should be under the control of each
respective UI.
---
 src/uicommon.ml | 11 ++++++-----
 src/uigtk3.ml   | 16 ++++++++--------
 src/uitext.ml   |  5 ++++-
 3 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/src/uicommon.ml b/src/uicommon.ml
index 6dd6a4067..a428dfc05 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)
@@ -365,8 +365,9 @@ let exn2string e =
           | _                  -> "")
          (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 23c5ba2c0..15c65bad3 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 ->
@@ -1650,9 +1650,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
@@ -2393,9 +2393,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 a2aaccf97..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 *)