2 files changed, 46 insertions, 0 deletions
diff --git a/ide/configwin_ihm.ml b/ide/configwin_ihm.ml
index a6a3d52a38..91695e944e 100644
--- a/ide/configwin_ihm.ml
+++ b/ide/configwin_ihm.ml
@@ -808,3 +808,40 @@ let custom ?label box f expand =
       custom_expand = expand ;
       custom_framed = label ;
     }
+
+(* Copying lablgtk question_box + forbidding hiding *)
+
+let question_box ~title ~buttons ?(default=1) ?icon ?parent message =
+  let button_nb = ref 0 in
+  let window = GWindow.dialog ~position:`CENTER ~modal:true ?parent ~type_hint:`DIALOG ~title () in
+  let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in
+  let bbox = window#action_area in
+  begin match icon with
+    None -> ()
+  | Some i -> hbox#pack i#coerce ~padding:4
+  end;
+  ignore (GMisc.label ~text: message ~packing: hbox#add ());
+  (* the function called to create each button by iterating *)
+  let rec iter_buttons n = function
+      [] ->
+        ()
+    | button_label :: q ->
+        let b = GButton.button ~label: button_label
+            ~packing:(bbox#pack ~expand:true ~padding:4) ()
+        in
+        ignore (b#connect#clicked ~callback:
+          (fun () -> button_nb := n; window#destroy ()));
+	(* If it's the first button then give it the focus *)
+        if n = default then b#grab_default () else ();
+
+	iter_buttons (n+1) q
+  in
+  iter_buttons 1 buttons;
+  ignore (window#connect#destroy ~callback: GMain.Main.quit);
+  window#set_position `CENTER;
+  window#show ();
+  GMain.Main.main ();
+  !button_nb
+
+let message_box ~title ?icon ?parent ?(ok="Ok") message =
+  ignore (question_box ?icon ?parent ~title message ~buttons:[ ok ])
diff --git a/ide/configwin_ihm.mli b/ide/configwin_ihm.mli
index 94a3f12b39..772a0958ff 100644
--- a/ide/configwin_ihm.mli
+++ b/ide/configwin_ihm.mli
@@ -65,3 +65,12 @@ val edit :
   ?height:int ->
   configuration_structure list ->
   return_button
+
+val question_box : title:string ->
+  buttons:string list ->
+  ?default:int -> ?icon:#GObj.widget ->
+  ?parent:GWindow.window -> string -> int
+
+val message_box :
+  title:string -> ?icon:#GObj.widget ->
+  ?parent:GWindow.window -> ?ok:string -> string -> unit