X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaMathView.ml;h=f913639f945e2f0c2919dfd2e77355d195f0144d;hb=d9394782ed9580f3565eb9b4682d8348aae6349e;hp=1cb23366a2102ed820990e6e4a9dc87999655a1c;hpb=8631b0d6a32380ceb540fdb31ccea35ed8c7af18;p=helm.git diff --git a/helm/matita/matitaMathView.ml b/helm/matita/matitaMathView.ml index 1cb23366a..f913639f9 100644 --- a/helm/matita/matitaMathView.ml +++ b/helm/matita/matitaMathView.ml @@ -56,6 +56,16 @@ object (self) method private script = MatitaScript.instance () end +let cicBrowsers = ref [] + +let default_font_size () = + Helm_registry.get_opt_default Helm_registry.int + ~default:BuildTimeConf.default_font_size "matita.font_size" +let current_font_size = ref ~-1 +let increase_font_size () = incr current_font_size +let decrease_font_size () = decr current_font_size +let reset_font_size () = current_font_size := default_font_size () + class clickableMathView obj = let href = Gdome.domString "href" in let xref = Gdome.domString "xref" in @@ -66,23 +76,24 @@ class clickableMathView obj = method set_href_callback f = href_callback <- f initializer + self#set_font_size !current_font_size; ignore (self#connect#selection_changed self#choose_selection); ignore (self#connect#click (fun (gdome_elt, _, _, _) -> match gdome_elt with | Some elt (* element is an hyperlink, use href_callback on it *) - when elt#hasAttributeNS ~namespaceURI:Misc.xlink_ns ~localName:href -> + when elt#hasAttributeNS ~namespaceURI:DomMisc.xlink_ns ~localName:href -> (match href_callback with | None -> () | Some f -> let uri = - elt#getAttributeNS ~namespaceURI:Misc.xlink_ns ~localName:href + elt#getAttributeNS ~namespaceURI:DomMisc.xlink_ns ~localName:href in f (uri#to_string)) | Some elt -> ignore (self#action_toggle elt) | None -> ())) method private choose_selection gdome_elt = let rec aux elt = - if elt#hasAttributeNS ~namespaceURI:Misc.helm_ns ~localName:xref then + if elt#hasAttributeNS ~namespaceURI:DomMisc.helm_ns ~localName:xref then self#set_selection (Some elt) else try @@ -95,6 +106,10 @@ class clickableMathView obj = match gdome_elt with | Some elt -> aux elt | None -> self#set_selection None + + method update_font_size = + self#set_font_size !current_font_size + end let clickableMathView ?hadjustment ?vadjustment ?font_size ?log_verbosity = @@ -111,14 +126,14 @@ class sequentViewer obj = inherit clickableMathView obj val mutable current_infos = None - + method get_selected_terms = let selections = self#get_selections in list_map_fail (fun node -> let xpath = ((node : Gdome.element)#getAttributeNS - ~namespaceURI:Misc.helm_ns + ~namespaceURI:DomMisc.helm_ns ~localName:(Gdome.domString "xref"))#to_string in if xpath = "" then assert false (* "ERROR: No xref found!!!" *) @@ -135,7 +150,7 @@ class sequentViewer obj = (fun node -> let xpath = ((node : Gdome.element)#getAttributeNS - ~namespaceURI:Misc.helm_ns + ~namespaceURI:DomMisc.helm_ns ~localName:(Gdome.domString "xref"))#to_string in if xpath = "" then assert false (* "ERROR: No xref found!!!" *) @@ -154,7 +169,7 @@ class sequentViewer obj = current_infos <- Some (ids_to_terms, ids_to_father_ids, ids_to_hypotheses); (* debug_print "load_sequent: dumping MathML to ./prova"; - ignore (Misc.domImpl#saveDocumentToFile ~name:"./prova" ~doc:mathml ()); + ignore (DomMisc.domImpl#saveDocumentToFile ~name:"./prova" ~doc:mathml ()); *) self#load_root ~root:mathml#get_documentElement end @@ -287,8 +302,6 @@ type term_source = exception Browser_failure of string -let cicBrowsers = ref [] - class type cicBrowser = object method load: MatitaTypes.mathViewer_entry -> unit @@ -309,6 +322,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) let whelp_query_RE = Pcre.regexp "^\\s*whelp\\s+([^\\s]+)\\s+(.*)$" in let trailing_slash_RE = Pcre.regexp "/$" in let has_xpointer_RE = Pcre.regexp "#xpointer\\(\\d+/\\d+(/\\d+)?\\)$" in + let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in + let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in + let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in let gui = MatitaGui.instance () in let win = gui#newBrowserWin () in let queries = ["Locate";"Hint";"Match";"Elim";"Instance"] in @@ -334,9 +350,8 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) in let toplevel = win#toplevel in let mathView = sequentViewer ~packing:win#scrolledBrowser#add () in - let fail msg = - ignore (MatitaGtkMisc.ask_confirmation ~gui:(MatitaGui.instance ()) - ~title:"Cic browser" ~msg ~cancel:false ()); + let fail message = + MatitaGtkMisc.report_error ~title:"Cic browser" ~message () in let tags = [ "dir", GdkPixbuf.from_file (MatitaMisc.image_path "matita-folder.png"); @@ -346,9 +361,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) try f () with exn -> - fail (sprintf "Uncaught exception:\n%s" (Printexc.to_string exn)) + fail (MatitaExcPp.to_string exn) in - let handle_error' f = fun () -> handle_error f in (* used in callbacks *) + let handle_error' f = (fun () -> handle_error (fun () -> f ())) in object (self) inherit scriptAccessor @@ -356,7 +371,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) initializer activate_combo_query "" "locate"; - win#comboVbox#add (combo :> GObj.widget); + win#whelpBarComboVbox#add combo#coerce; let start_query () = let query = String.lowercase (List.nth queries combo#active) in let input = win#queryInputText#text in @@ -365,23 +380,15 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) in ignore(win#queryInputText#connect#activate ~callback:start_query); ignore(combo#connect#changed ~callback:start_query); - win#whelpImage2#set_file "icons/whelp.png"; - win#whelpBarToggleButton#set_active false; - win#whelpBarBox#misc#hide (); + win#whelpBarImage#set_file (MatitaMisc.image_path "whelp.png"); win#mathOrListNotebook#set_show_tabs false; - MatitaGtkMisc.connect_toggle_button win#whelpBarToggleButton - (fun () -> - if win#whelpBarToggleButton#active then - win#whelpBarBox#misc#show () - else - win#whelpBarBox#misc#hide ()); win#browserForwardButton#misc#set_sensitive false; win#browserBackButton#misc#set_sensitive false; - ignore (win#browserUri#connect#activate (handle_error' (fun () -> - self#loadInput win#browserUri#text))); + ignore (win#browserUri#entry#connect#activate (handle_error' (fun () -> + self#loadInput win#browserUri#entry#text))); ignore (win#browserHomeButton#connect#clicked (handle_error' (fun () -> - self#_load (`About `Current_proof)))); + self#load (`About `Current_proof)))); ignore (win#browserRefreshButton#connect#clicked (handle_error' self#refresh)); ignore (win#browserBackButton#connect#clicked (handle_error' self#back)); @@ -396,22 +403,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) GMain.quit (); false)); ignore(win#whelpResultTreeview#connect#row_activated - ~callback:(fun _ _ -> - let selection = self#_getWhelpResultTreeviewSelection () in - let is_cic s = - try - String.sub s 0 5 = "cic:/" - with Invalid_argument _ -> false - in - let txt = - if is_cic selection then - selection - else - win#browserUri#text ^ selection - in - self#loadInput txt)); + ~callback:(fun _ _ -> self#loadInput (self#_getSelectedUri ()))); mathView#set_href_callback (Some (fun uri -> - handle_error (fun () -> self#_load (`Uri uri)))); + handle_error (fun () -> self#load (`Uri (UriManager.uri_of_string uri))))); self#_load (`About `Blank); toplevel#show () @@ -419,21 +413,19 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) val mutable current_infos = None val mutable current_mathml = None -(* val model = new MatitaGtkMisc.stringListModel win#whelpResultTreeview *) val model = new MatitaGtkMisc.taggedStringListModel tags win#whelpResultTreeview - method private _getWhelpResultTreeviewSelection () = + method private _getSelectedUri () = match model#easy_selection () with - | [u] -> u - | _ -> assert false + | [sel] when is_uri sel -> sel (* absolute URI selected *) + | [sel] -> win#browserUri#entry#text ^ sel (* relative URI selected *) + | _ -> assert false (** history RATIONALE * - * all operations about history are done using _historyFoo - * - * only toplevel function like load loadInput can call - * _historyAdd + * All operations about history are done using _historyFoo. + * Only toplevel functions (ATM load and loadInput) call _historyAdd. *) method private _historyAdd item = @@ -460,8 +452,6 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) method private _showList = win#mathOrListNotebook#goto_page 1 method private _showMath = win#mathOrListNotebook#goto_page 0 - - method private back () = try self#_load (self#_historyPrev ()) @@ -484,10 +474,10 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) | `Check term -> self#_loadCheck term | `Cic (term, metasenv) -> self#_loadTermCic term metasenv | `Dir dir -> self#_loadDir dir - | `Uri uri -> self#_loadUriManagerUri (UriManager.uri_of_string uri) + | `Uri uri -> self#_loadUriManagerUri uri | `Whelp (query, results) -> set_whelp_query query; - self#_loadList (List.map (fun r -> "obj", r) results)); + self#_loadList (List.map (fun r -> "obj", UriManager.string_of_uri r) results)); self#setEntry entry end with @@ -533,10 +523,11 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) | Http_getter_types.Ls_object o -> "obj", o.Http_getter_types.uri) content in + if l = [] then raise (Browser_failure "no such directory"); self#_loadList l method private setEntry entry = - win#browserUri#set_text (string_of_entry entry); + win#browserUri#entry#set_text (string_of_entry entry); current_entry <- entry method private _loadObj obj = @@ -580,9 +571,6 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) (** this is what the browser does when you enter a string an hit enter *) method loadInput txt = let txt = strip_blanks txt in - let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in - let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in - let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in let fix_uri txt = UriManager.string_of_uri (UriManager.strip_xpointer (UriManager.uri_of_string txt)) @@ -593,14 +581,22 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) end else begin let entry = match txt with - | txt when is_uri txt -> `Uri (fix_uri txt) + | txt when is_uri txt -> `Uri (UriManager.uri_of_string (fix_uri txt)) | txt when is_dir txt -> `Dir (add_trailing_slash txt) - | _ -> raise (Browser_failure (sprintf "unsupported uri: %s" txt)) + | txt -> + (try + entry_of_string txt + with Invalid_argument _ -> + raise (Browser_failure (sprintf "unsupported uri: %s" txt))) in self#_load entry; self#_historyAdd entry end + (** {2 methods accessing underlying GtkMathView} *) + + method updateFontSize = mathView#set_font_size !current_font_size + (** {2 methods used by constructor only} *) method win = win @@ -640,8 +636,6 @@ let cicBrowser () = let history = new MatitaMisc.browser_history size (`About `Blank) in aux history -let refresh_all_browsers () = List.iter (fun b -> b#refresh ()) !cicBrowsers - let default_sequentViewer () = sequentViewer ~show:true () let sequentViewer_instance = MatitaMisc.singleton default_sequentViewer @@ -666,3 +660,10 @@ let mathViewer () = method show_uri_list ?(reuse=false) ~entry l = (self#get_browser reuse)#load entry end + +let refresh_all_browsers () = List.iter (fun b -> b#refresh ()) !cicBrowsers + +let update_font_sizes () = + List.iter (fun b -> b#updateFontSize) !cicBrowsers; + (sequentViewer_instance ())#update_font_size +