X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaGui.ml;h=7ac22dc8dd644ef0167b9bd7f59cd5d5c46e7cca;hb=ab336f7c09d052c45a09dd49e9b75a39e8b57e5b;hp=6b70a498f05e43bd9b93d6f09b13cd7661683e08;hpb=1d431843f49b3658593c8cc918b53a43479a6486;p=helm.git diff --git a/helm/matita/matitaGui.ml b/helm/matita/matitaGui.ml index 6b70a498f..7ac22dc8d 100644 --- a/helm/matita/matitaGui.ml +++ b/helm/matita/matitaGui.ml @@ -23,46 +23,73 @@ * http://helm.cs.unibo.it/ *) -(* -class stringListModel' uriChoiceDialog = - let tree_view = uriChoiceDialog#uriChoiceTreeView in - let column_list = new GTree.column_list in - let text_column = column_list#add Gobject.Data.string in - let list_store = GTree.list_store column_list in - let renderer = (GTree.cell_renderer_text [], ["text", text_column]) in - let view_column = GTree.view_column ~renderer () in - let _ = tree_view#set_model (Some (list_store :> GTree.model)) in - let _ = tree_view#append_column view_column in - object - method append s = - let tree_iter = list_store#append () in - list_store#set ~row:tree_iter ~column:text_column s - method clear () = list_store#clear () - end -*) - open Printf open MatitaGeneratedGui open MatitaGtkMisc open MatitaMisc +let gui_instance = ref None ;; + +class console ~evbox ~phrase_sep ~packing ~paned () = + let console = MatitaConsole.console ~evbox ~phrase_sep ~packing ~paned () in + object + method clear = console#clear + method echo_error = console#echo_error + method echo_message = console#echo_message + method wrap_exn: 'a. (unit -> 'a) -> 'a option = console#wrap_exn + method choose_uri uris = + let g = match !gui_instance with None -> assert false | Some g -> g in + let ul = g#newUriDialog () in + ul#toplevel#show (); + let model = new stringListModel ul#uriChoiceTreeView in + List.iter model#easy_append uris; + ul#uriChoiceDialog#set_title "Hints"; + ul#uriChoiceLabel#set_text "Suggested uris"; + ul#uriChoiceAbortButton#misc#hide (); + ul#uriChoiceAutoButton#misc#hide (); + ul#uriChoiceConstantsButton#misc#hide (); + ul#hbox2#misc#hide (); + ul#uriChoiceTreeView#selection#set_mode + (`SINGLE :> Gtk.Tags.selection_mode); + let _ = ul#uriChoiceTreeView#selection#connect#changed + ~callback:(fun () -> ()) in + let _ = ul#toplevel#connect#destroy + ~callback:(fun () -> GMain.Main.quit ()) in + let choices = ref None in + let _ = ul#uriChoiceSelectedButton#connect#clicked + ~callback:(fun () -> + (match model#easy_selection () with + | [] -> () + | [uri] -> choices := (Some uri) + | _ -> assert false); + ul#uriChoiceDialog#destroy (); + GMain.Main.quit ()) in + GMain.main (); + match !choices with + | Some u -> u + | None -> raise MatitaTypes.Cancel + + method show = console#show + + method console = console + end + class gui file = (* creation order _is_ relevant for windows placement *) let toolbar = new toolBarWin ~file () in let main = new mainWin ~file () in let about = new aboutWin ~file () in let fileSel = new fileSelectionWin ~file () in - let proof = new proofWin ~file () in - let check = new checkWin ~file () in let script = new scriptWin ~file () in let keyBindingBoxes = (* event boxes which should receive global key events *) - [ toolbar#toolBarEventBox; proof#proofWinEventBox; main#mainWinEventBox; - check#checkWinEventBox; script#scriptWinEventBox ] + [ toolbar#toolBarEventBox; main#mainWinEventBox; + script#scriptWinEventBox; main#consoleEventBox ] in let console = - MatitaConsole.console ~evbox:main#consoleEventBox ~phrase_sep:";;" - ~packing:main#scrolledConsole#add () + new console ~evbox:main#consoleEventBox + ~phrase_sep:BuildTimeConf.phrase_sep + ~packing:main#scrolledConsole#add ~paned:main#mainVPanes () in object (self) val mutable chosen_file = None @@ -71,27 +98,28 @@ class gui file = (* glade's check widgets *) List.iter (fun w -> w#check_widgets ()) (let c w = (w :> unit>) in - [ c about; c fileSel; c main; c proof; c toolbar; c check; c script ]); - (* show/hide commands *) - toggle_visibility toolbar#toolBarWin main#showToolBarMenuItem; - toggle_visibility proof#proofWin main#showProofMenuItem; - toggle_visibility check#checkWin main#showCheckMenuItem; - toggle_visibility script#scriptWin main#showScriptMenuItem; - (* "global" key bindings *) - List.iter (fun (key, callback) -> self#addKeyBinding key callback) + [ c about; c fileSel; c main; c toolbar; c script ]); + (* key bindings *) + List.iter (* global key bindings *) + (fun (key, callback) -> self#addKeyBinding key callback) +(* [ GdkKeysyms._F3, toggle_win ~check:main#showProofMenuItem proof#proofWin; GdkKeysyms._F4, toggle_win ~check:main#showCheckMenuItem check#checkWin; - GdkKeysyms._F5, +*) + [ GdkKeysyms._F5, toggle_win ~check:main#showScriptMenuItem script#scriptWin; + GdkKeysyms._x, (fun () -> console#console#toggle ()); ]; + add_key_binding GdkKeysyms._Escape console#console#hide + main#consoleEventBox; (* about win *) ignore (about#aboutWin#event#connect#delete (fun _ -> true)); ignore (main#aboutMenuItem#connect#activate (fun _ -> about#aboutWin#show ())); - ignore (about#aboutDismissButton#connect#clicked (fun _ -> - about#aboutWin#misc#hide ())); + connect_button about#aboutDismissButton (fun _ -> + about#aboutWin#misc#hide ()); about#aboutLabel#set_label (Pcre.replace ~pat:"@VERSION@" ~templ:BuildTimeConf.version about#aboutLabel#label); (* file selection win *) @@ -109,25 +137,38 @@ class gui file = | `CANCEL -> return None | `HELP -> () | `DELETE_EVENT -> return None)); + (* script *) (* menus *) + toggle_visibility toolbar#toolBarWin main#showToolBarMenuItem; +(* + toggle_visibility proof#proofWin main#showProofMenuItem; + toggle_visibility check#checkWin main#showCheckMenuItem; +*) + toggle_visibility script#scriptWin main#showScriptMenuItem; List.iter (fun w -> w#misc#set_sensitive false) [ main#saveMenuItem; main#saveAsMenuItem ]; main#helpMenu#set_right_justified true; + ignore (main#showConsoleMenuItem#connect#activate console#console#toggle); + (* main *) + connect_button main#hideConsoleButton console#console#hide; (* console *) console#echo_message (sprintf "\tMatita version %s\n" BuildTimeConf.version); - console#echo_prompt (); - console#misc#grab_focus () + console#console#echo_prompt (); + console#console#misc#grab_focus (); method about = about - method check = check - method console = console + method console = (console :> MatitaTypes.console) method fileSel = fileSel method main = main - method proof = proof method script = script method toolbar = toolbar + method newBrowserWin () = + let win = new browserWin ~file () in + win#check_widgets (); + win + method newUriDialog () = let dialog = new uriChoiceDialog ~file () in dialog#check_widgets (); @@ -157,16 +198,38 @@ class gui file = ignore (main#quitMenuItem#connect#activate callback); self#addKeyBinding GdkKeysyms._q callback - method setPhraseCallback = console#set_callback + method setPhraseCallback = console#console#set_callback method chooseFile () = fileSel#fileSelectionWin#show (); GtkThread.main (); chosen_file + method askText ?(title = "") ?(msg = "") () = + let dialog = new textDialog () in + dialog#textDialog#set_title title; + dialog#textDialogLabel#set_label msg; + let text = ref None in + let return v = + text := v; + dialog#textDialog#destroy (); + GMain.Main.quit () + in + ignore (dialog#textDialog#event#connect#delete (fun _ -> true)); + connect_button dialog#textDialogCancelButton (fun _ -> return None); + connect_button dialog#textDialogOkButton (fun _ -> + let text = dialog#textDialogTextView#buffer#get_text () in + return (Some text)); + dialog#textDialog#show (); + GtkThread.main (); + !text + end -let instance = - let gui = lazy (new gui (Helm_registry.get "matita.glade_file")) in - fun () -> Lazy.force gui +let gui () = + let g = new gui (Helm_registry.get "matita.glade_file") in + gui_instance := Some g; + g + +let instance = singleton gui