Some fixes for latest upstream sexplib.
[rpmdepsize.git] / rpmdepsize_errors.ml
1 (* rpmdepsize - visualize the size of RPM dependencies
2  * (C) Copyright 2009 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17  *
18  * Written by Richard W.M. Jones <rjones@redhat.com>
19  *
20  * Some universal code to handle exceptions.
21  *)
22
23 open Printf
24 open Unix
25
26 let () =
27   let display_error title msg =
28     let icon = GMisc.image () in
29     icon#set_stock `DIALOG_ERROR;
30     icon#set_icon_size `DIALOG;
31     GToolbox.message_box ~title ~icon msg
32   in
33
34   let unexpected exn_name err =
35     sprintf "Unexpected %s exception:\n\n%s\n\nPlease report this error to the software authors" exn_name err
36   in
37
38   GtkSignal.user_handler :=
39     function
40     | Unix_error (err, syscall, filename) ->
41         display_error
42           "Filesystem error"
43           (syscall ^ ": " ^ filename ^ ": " ^ error_message err)
44     | Sys_error err ->
45         display_error
46           "System error"
47           err
48     | Invalid_argument err ->
49         display_error
50           "Invalid argument"
51           (unexpected "Invalid_argument" err)
52     | Failure err ->
53         display_error
54           "Internal error"
55           (unexpected "Failure" err)
56     | Assert_failure (err, start, end_) ->
57         display_error
58           "Assertion failure"
59           (unexpected "Assertion_failure"
60              (err ^ " (" ^ string_of_int start ^ ", " ^ string_of_int end_))
61     | Glib.GError err ->
62         display_error
63           "Gtk Internal error"
64           (unexpected "GLib.GError" err)
65     | exn ->
66         display_error
67           "Error"
68           (unexpected "internal" (Printexc.to_string exn))