-let ask_confirmation ~(gui:#gui) ?(cancel = true) ?(title = "") ?(msg = "") () =
- let dialog = gui#newConfirmationDialog () in
- dialog#confirmationDialog#set_title title;
- dialog#confirmationDialogLabel#set_label msg;
- let result = ref None in
- let return r _ =
- result := Some r;
- dialog#confirmationDialog#destroy ();
- GMain.Main.quit ()
+let popup_message
+ ~title ~message ~buttons ~callback
+ ?(message_type=`QUESTION) ?parent ?(use_markup=true)
+ ?(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.message_dialog
+ ~message ~use_markup ~message_type ~buttons ?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
+ 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 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:false ()
+ in
+ let stock =
+ match message_type with
+ | `WARNING -> `DIALOG_WARNING
+ | `INFO -> `DIALOG_INFO
+ | `ERROR ->`DIALOG_ERROR
+ | `QUESTION -> `DIALOG_QUESTION