fixed save/exit stuff

[helm.git] / helm / matita / matitaGtkMisc.ml

diff --git a/helm/matita/matitaGtkMisc.ml b/helm/matita/matitaGtkMisc.ml
index 038aa7fd13539a0cf7d1a6575d36dfa6628f556e..b8c9b91b3308b327ce14015248338a4ac0f9d17d 100644 (file)
--- a/helm/matita/matitaGtkMisc.ml
+++ b/helm/matita/matitaGtkMisc.ml
@@ -189,27 +189,68 @@ let popup_message
   GtkThread.main ();
   m#destroy () 
 
+let popup_message_lowlevel
+  ~title ~message ?(no_separator=true) ~callback ~message_type ~buttons
+  ?parent  ?(destroy_with_parent=true) ?(allow_grow=false) ?(allow_shrink=false)
+  ?icon ?(modal=true) ?(resizable=false) ?screen ?type_hint
+  ?(position=`CENTER_ON_PARENT) ?wm_name ?wm_class ?border_width ?width 
+  ?height ?(show=true) ()
+=
+  let m = 
+    GWindow.dialog 
+      ~no_separator 
+      ?parent ~destroy_with_parent 
+      ~title ~allow_grow ~allow_shrink ?icon ~modal ~resizable ?screen 
+      ?type_hint ~position ?wm_name ?wm_class ?border_width ?width ?height 
+      ~show () 
+  in
+  let stock = 
+    match message_type with
+    | `WARNING -> `DIALOG_WARNING
+    | `INFO -> `DIALOG_INFO
+    | `ERROR ->`DIALOG_ERROR 
+    | `QUESTION -> `DIALOG_QUESTION
+  in
+  let image = GMisc.image ~stock ~icon_size:`DIALOG () in
+  let label = GMisc.label ~markup:message () in
+  let hbox = GPack.hbox ~spacing:10 () in
+  hbox#pack ~from:`START ~expand:true ~fill:true (image:>GObj.widget);
+  hbox#pack ~from:`START ~expand:true ~fill:true (label:>GObj.widget);
+  m#vbox#pack ~from:`START 
+    ~padding:20 ~expand:true ~fill:true (hbox:>GObj.widget);
+  List.iter (fun (x,y) -> m#add_button_stock x y) buttons;
+  ignore(m#connect#response 
+    ~callback:(fun a ->  GMain.Main.quit ();callback a));
+  ignore(m#connect#close 
+    ~callback:(fun _ -> GMain.Main.quit ();raise PopupClosed));
+  GtkThread.main ();
+  m#destroy () 
+
 
 let ask_confirmation ~title ~message ?parent () =
-  let rc = ref false in
+  let rc = ref `YES in
   let callback = 
-    function `YES -> rc := true | `NO -> rc := false | _ -> rc := false
+    function 
+    | `YES -> rc := `YES
+    | `NO -> rc := `NO
+    | `CANCEL -> rc := `CANCEL
+    | `DELETE_EVENT -> rc := `CANCEL
   in
-  let buttons = GWindow.Buttons.yes_no in
+  let buttons = [`CANCEL,`CANCEL ; `NO,`NO ; `YES,`YES] in
   try
-    popup_message ~title ~message ~message_type:`WARNING ~callback ~buttons
-      ?parent ();
+    popup_message_lowlevel 
+      ~title ~message ~message_type:`WARNING ~callback ~buttons ?parent ();
     !rc
   with
-  | PopupClosed -> false
+  | PopupClosed -> `CANCEL
 
 let report_error ~title ~message ?parent () =
   let rc = ref false in
   let callback _ = () in
   let buttons = GWindow.Buttons.ok in
   try 
-    popup_message ~title ~message ~message_type:`ERROR ~callback ~buttons 
-    ?parent ()
+    popup_message 
+      ~title ~message ~message_type:`ERROR ~callback ~buttons ?parent ()
   with
   | PopupClosed -> ()