X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaMathView.ml;h=f9171068f2158d07ca7dcc1695ed7a638a57d5d6;hb=b6e1e47a8fdb45e9e47af9dfd047a0241ecf59c1;hp=f913639f945e2f0c2919dfd2e77355d195f0144d;hpb=d9394782ed9580f3565eb9b4682d8348aae6349e;p=helm.git diff --git a/helm/matita/matitaMathView.ml b/helm/matita/matitaMathView.ml index f913639f9..f9171068f 100644 --- a/helm/matita/matitaMathView.ml +++ b/helm/matita/matitaMathView.ml @@ -300,8 +300,6 @@ type term_source = | `String of string ] -exception Browser_failure of string - class type cicBrowser = object method load: MatitaTypes.mathViewer_entry -> unit @@ -309,6 +307,12 @@ object method loadInput: string -> unit end +let reloadable = function + | `About `Current_proof + | `Dir _ -> + true + | _ -> false + class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) () = @@ -316,9 +320,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) let whelp_RE = Pcre.regexp "^\\s*whelp" in let uri_RE = Pcre.regexp - "^cic:/(\\w+/)*\\w+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$" + "^cic:/([^/]+/)*[^/]+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$" in - let dir_RE = Pcre.regexp "^cic:((/(\\w+/)*\\w+(/)?)|/|)$" in + let dir_RE = Pcre.regexp "^cic:((/([^/]+/)*[^/]+(/)?)|/|)$" 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 @@ -351,7 +355,8 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) let toplevel = win#toplevel in let mathView = sequentViewer ~packing:win#scrolledBrowser#add () in let fail message = - MatitaGtkMisc.report_error ~title:"Cic browser" ~message () + MatitaGtkMisc.report_error ~title:"Cic browser" ~message + ~parent:toplevel () in let tags = [ "dir", GdkPixbuf.from_file (MatitaMisc.image_path "matita-folder.png"); @@ -360,8 +365,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) let handle_error f = try f () - with exn -> - fail (MatitaExcPp.to_string exn) + with exn -> fail (MatitaExcPp.to_string exn) in let handle_error' f = (fun () -> handle_error (fun () -> f ())) in object (self) @@ -403,9 +407,11 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) GMain.quit (); false)); ignore(win#whelpResultTreeview#connect#row_activated - ~callback:(fun _ _ -> self#loadInput (self#_getSelectedUri ()))); + ~callback:(fun _ _ -> + handle_error (fun () -> self#loadInput (self#_getSelectedUri ())))); mathView#set_href_callback (Some (fun uri -> - handle_error (fun () -> self#load (`Uri (UriManager.uri_of_string uri))))); + handle_error (fun () -> + self#load (`Uri (UriManager.uri_of_string uri))))); self#_load (`About `Blank); toplevel#show () @@ -416,10 +422,13 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) val model = new MatitaGtkMisc.taggedStringListModel tags win#whelpResultTreeview + val mutable lastDir = "" (* last loaded "directory" *) + method private _getSelectedUri () = match model#easy_selection () with | [sel] when is_uri sel -> sel (* absolute URI selected *) - | [sel] -> win#browserUri#entry#text ^ sel (* relative URI selected *) +(* | [sel] -> win#browserUri#entry#text ^ sel |+ relative URI selected +| *) + | [sel] -> lastDir ^ sel | _ -> assert false (** history RATIONALE @@ -466,25 +475,22 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) * @param uri string *) method private _load entry = try - if entry <> current_entry || entry = `About `Current_proof then begin - (match entry with - | `About `Current_proof -> self#home () - | `About `Blank -> self#blank () - | `About `Us -> () (* TODO implement easter egg here :-] *) - | `Check term -> self#_loadCheck term - | `Cic (term, metasenv) -> self#_loadTermCic term metasenv - | `Dir dir -> self#_loadDir dir - | `Uri uri -> self#_loadUriManagerUri uri - | `Whelp (query, results) -> - set_whelp_query query; - self#_loadList (List.map (fun r -> "obj", UriManager.string_of_uri r) results)); - self#setEntry entry - end - with - | UriManager.IllFormedUri uri -> fail (sprintf "invalid uri: %s" uri) - | CicEnvironment.Object_not_found uri -> - fail (sprintf "object not found: %s" (UriManager.string_of_uri uri)) - | Browser_failure msg -> fail msg + if entry <> current_entry || reloadable entry then begin + (match entry with + | `About `Current_proof -> self#home () + | `About `Blank -> self#blank () + | `About `Us -> () (* TODO implement easter egg here :-] *) + | `Check term -> self#_loadCheck term + | `Cic (term, metasenv) -> self#_loadTermCic term metasenv + | `Dir dir -> self#_loadDir dir + | `Uri uri -> self#_loadUriManagerUri uri + | `Whelp (query, results) -> + set_whelp_query query; + self#_loadList (List.map (fun r -> "obj", + UriManager.string_of_uri r) results)); + self#setEntry entry + end + with exn -> fail (MatitaExcPp.to_string exn) method private blank () = self#_showMath; @@ -517,13 +523,15 @@ 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 s -> "dir", s - | Http_getter_types.Ls_object o -> "obj", o.Http_getter_types.uri) - content + List.fast_sort + Pervasives.compare + (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"); + lastDir <- dir; self#_loadList l method private setEntry entry = @@ -587,7 +595,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) (try entry_of_string txt with Invalid_argument _ -> - raise (Browser_failure (sprintf "unsupported uri: %s" txt))) + command_error (sprintf "unsupported uri: %s" txt)) in self#_load entry; self#_historyAdd entry @@ -603,10 +611,9 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history) method history = history method currentEntry = current_entry method refresh () = - if current_entry = `About `Current_proof then - self#_load (`About `Current_proof) - end + if reloadable current_entry then self#_load current_entry + end let sequentsViewer ~(notebook:GPack.notebook) ~(sequentViewer:sequentViewer) ()