X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaMathView.ml;h=f913639f945e2f0c2919dfd2e77355d195f0144d;hb=bbe7741f3bbaacb93f2876c018dace82f5e929b8;hp=0a2e8f90df37fbb5b2423e782333086cf209ec68;hpb=a256fcff08b4a21c736167910c1ce342cffb0388;p=helm.git diff --git a/helm/matita/matitaMathView.ml b/helm/matita/matitaMathView.ml index 0a2e8f90d..f913639f9 100644 --- a/helm/matita/matitaMathView.ml +++ b/helm/matita/matitaMathView.ml @@ -39,12 +39,33 @@ let list_map_fail f = in aux +let add_trailing_slash = + let rex = Pcre.regexp "/$" in + fun s -> + if Pcre.pmatch ~rex s then s + else s ^ "/" + +let strip_blanks = + let rex = Pcre.regexp "^\\s*([^\\s]*)\\s*$" in + fun s -> + (Pcre.extract ~rex s).(1) + (** inherit from this class if you want to access current script *) class scriptAccessor = 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 @@ -55,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 @@ -84,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 = @@ -100,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!!!" *) @@ -124,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!!!" *) @@ -143,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 @@ -276,8 +302,6 @@ type term_source = exception Browser_failure of string -let cicBrowsers = ref [] - class type cicBrowser = object method load: MatitaTypes.mathViewer_entry -> unit @@ -290,9 +314,17 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) = let term_RE = Pcre.regexp "^term:(.*)" in let whelp_RE = Pcre.regexp "^\\s*whelp" in + let uri_RE = + Pcre.regexp + "^cic:/(\\w+/)*\\w+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$" + in + let dir_RE = Pcre.regexp "^cic:((/(\\w+/)*\\w+(/)?)|/|)$" in 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 @@ -318,17 +350,20 @@ 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"); + "obj", GdkPixbuf.from_file (MatitaMisc.image_path "matita-object.png") ] in let handle_error f = 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 @@ -336,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 @@ -345,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)); @@ -376,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 () @@ -399,19 +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 = @@ -438,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 ()) @@ -462,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 results); + self#_loadList (List.map (fun r -> "obj", UriManager.string_of_uri r) results)); self#setEntry entry end with @@ -504,15 +516,18 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) method private _loadDir dir = let content = Http_getter.ls dir in - let l = List.map (function - | Http_getter_types.Ls_section sec -> sec - | Http_getter_types.Ls_object obj -> obj.Http_getter_types.uri - ) content + let l = + List.map + (function + | Http_getter_types.Ls_section s -> "dir", s + | 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 = @@ -545,53 +560,43 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) method private _loadList l = model#list_store#clear (); - List.iter model#easy_append l; + List.iter (fun (tag, s) -> model#easy_append ~tag s) l; self#_showList (** { public methods, all must call _load!! } *) - method load uri = - handle_error (fun () -> self#_load uri); - self#_historyAdd uri + method load entry = + handle_error (fun () -> self#_load entry; self#_historyAdd entry) (** this is what the browser does when you enter a string an hit enter *) - method loadInput txt = - let add_terminating_slash s = - if not(Pcre.pmatch ~rex:trailing_slash_RE s) && - not(Pcre.pmatch ~rex:has_xpointer_RE s) then s^"/" else s - in - let is_uri txt = - try - let u = UriManager.strip_xpointer (UriManager.uri_of_string txt) in - ignore (Http_getter.resolve' u); - true - with - | Http_getter_types.Key_not_found _ - | Http_getter_types.Unresolvable_URI _ - | UriManager.IllFormedUri ("cic:/" | "cic:") -> false - | UriManager.IllFormedUri u -> failwith ("Malformed URI '" ^ u ^ "'") + method loadInput txt = + let txt = strip_blanks txt in + let fix_uri txt = + UriManager.string_of_uri + (UriManager.strip_xpointer (UriManager.uri_of_string txt)) in - let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in - if is_whelp txt then - begin - set_whelp_query txt; - - - (MatitaScript.instance ())#advance ~statement:(txt^".") () - end - else - begin - let entry = - if is_uri txt then - (`Uri txt) - else - (`Dir (add_terminating_slash txt)) - in - self#_load entry; - self#_historyAdd entry - end - - + if is_whelp txt then begin + set_whelp_query txt; + (MatitaScript.instance ())#advance ~statement:(txt ^ ".") () + end else begin + let entry = + match txt with + | txt when is_uri txt -> `Uri (UriManager.uri_of_string (fix_uri txt)) + | txt when is_dir txt -> `Dir (add_trailing_slash 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 @@ -631,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 @@ -657,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 +