snapshot

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

diff --git a/helm/matita/matitaGtkMisc.ml b/helm/matita/matitaGtkMisc.ml
index 80f5676cd7665ca66c0c59aaa5230d66934b9f64..e24bf27c1ffae831247b0b42efb630e71a69aba4 100644 (file)
--- a/helm/matita/matitaGtkMisc.ml
+++ b/helm/matita/matitaGtkMisc.ml
@@ -85,11 +85,12 @@ let non p x = not (p x)
 class type gui =
   object
     method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
-    method newConfirmationDialog :
-      title:string -> msg:string -> unit ->
-        MatitaGeneratedGui.confirmationDialog
+    method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
+    method newTextDialog: unit -> MatitaGeneratedGui.textDialog
   end
 
+exception Cancel
+
 let interactive_user_uri_choice
   ~(gui:#gui) ~(selection_mode:Gtk.Tags.selection_mode) ?(title = "")
   ?(msg = "") ?(nonvars_button=false) uris
@@ -114,6 +115,7 @@ let interactive_user_uri_choice
       dialog#uriChoiceDialog#destroy ();
       GMain.Main.quit ()
     in
+    ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
     ignore (dialog#uriChoiceConstantsButton#connect#clicked (fun _ ->
       return (Some (Lazy.force nonvars_uris))));
     ignore (dialog#uriChoiceAutoButton#connect#clicked (fun _ ->
@@ -124,11 +126,10 @@ let interactive_user_uri_choice
       | [] -> ()
       | uris -> return (Some uris)));
     ignore (dialog#uriChoiceAbortButton#connect#clicked (fun _ -> return None));
-    ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
     dialog#uriChoiceDialog#show ();
     GtkThread.main ();
     (match !choices with 
-    | None -> raise MatitaTypes.No_choice
+    | None -> raise Cancel
     | Some uris -> uris)
   end
 
@@ -139,17 +140,48 @@ let interactive_interp_choice ~(gui:#gui) choices =
   [0]
 
 let ask_confirmation ~(gui:#gui) ?(title = "") ?(msg = "") () =
-  let dialog = gui#newConfirmationDialog ~title ~msg () in
+  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 ()
   in
+  ignore (dialog#confirmationDialog#event#connect#delete (fun _ -> true));
   ignore (dialog#confirmationDialogOkButton#connect#clicked (return true));
   ignore (dialog#confirmationDialogCancelButton#connect#clicked (return false));
-  ignore (dialog#confirmationDialog#event#connect#delete (fun _ -> true));
   dialog#confirmationDialog#show ();
   GtkThread.main ();
   (match !result with None -> assert false | Some r -> r)
 
+let ask_text ~(gui:#gui) ?(title = "") ?(msg = "") ?(multiline = false) () =
+  let dialog = gui#newTextDialog () in
+  dialog#textDialog#set_title title;
+  dialog#textDialogLabel#set_label msg;
+  let result = ref None in
+  let return r =
+    result := r;
+    dialog#textDialog#destroy ();
+    GMain.Main.quit ()
+  in
+  ignore (dialog#textDialog#event#connect#delete (fun _ -> true));
+  if multiline then begin (* multiline input required: use a TextView widget *)
+    let win =
+      GBin.scrolled_window ~width:400 ~height:150 ~hpolicy:`NEVER
+        ~vpolicy:`ALWAYS ~packing:dialog#textDialogVBox#add ()
+    in
+    let view = GText.view ~wrap_mode:`CHAR ~packing:win#add () in
+    ignore (dialog#textDialogOkButton#connect#clicked (fun _ ->
+      return (Some (view#buffer#get_text ()))))
+  end else begin (* monoline input required: use a TextEntry widget *)
+    let entry = GEdit.entry ~packing:dialog#textDialogVBox#add () in
+    ignore (dialog#textDialogOkButton#connect#clicked (fun _ ->
+      return (Some entry#text)))
+  end;
+  ignore (dialog#textDialogCancelButton#connect#clicked (fun _ -> return None));
+  dialog#textDialog#show ();
+  GtkThread.main ();
+  (match !result with None -> raise Cancel | Some r -> r)
+