Pretty error message in failure dialog.
authorRichard W.M. Jones <rjones@redhat.com>
Wed, 27 Jul 2011 18:39:51 +0000 (19:39 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Wed, 27 Jul 2011 18:39:51 +0000 (19:39 +0100)
utils.ml
utils.mli
window.ml

index 0bf18fa..9da9eb1 100644 (file)
--- a/utils.ml
+++ b/utils.ml
@@ -64,6 +64,24 @@ let connect_uri () = !connect_uri
 
 let utf8_rarrow = "\xe2\x86\x92"
 
+let pretty_string_of_exn =
+  function
+  | Guestfs.Error str ->
+      "Libguestfs error",
+      sprintf "libguestfs reported an error:
+
+%s
+
+To get more information about libguestfs errors, run guestfs-browser
+with the -x flag on the command line."
+        str
+
+  (* Add more exception types here as we come across them.  Last
+   * case below is the catch-all.
+   *)
+  | exn ->
+      "Error", Printexc.to_string exn
+
 let human_size i =
   if i < 1024L then
     sprintf "%Ld" i
index c74a413..e455252 100644 (file)
--- a/utils.mli
+++ b/utils.mli
@@ -58,6 +58,14 @@ val set_connect_uri : string option -> unit
 
       This is set through the [--connect] command line option. *)
 
+val pretty_string_of_exn : exn -> string * string
+  (** Pretty string from exception.
+
+      Returns a title and a detailed message, for use in message dialogs.
+
+      To get raw exception string, use {!Printexc.to_string} from the
+      standard library. *)
+
 val utf8_rarrow : string (** UTF-8 RIGHTWARDS ARROW *)
 
 val human_size : int64 -> string
index 6e720b7..c9955df 100644 (file)
--- a/window.ml
+++ b/window.ml
@@ -133,9 +133,10 @@ let progress ws (position, total) =
  * necessary to turn the exception into an error message.
  *)
 let failure ws exn =
-  let title = "Error" in
-  let msg = Printexc.to_string exn in
-  debug "failure hook: %s" msg;
+  let raw_msg = Printexc.to_string exn in
+  debug "failure hook: %s" raw_msg;
+
+  let title, msg = pretty_string_of_exn exn in
   let icon = GMisc.image () in
   icon#set_stock `DIALOG_ERROR;
   icon#set_icon_size `DIALOG;