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))