X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=matita%2FmatitaScript.ml;h=4c40f9e14588686c9f9d879ab1721658b432eff3;hb=cbb6a26ba001722c0e10210a3e3d625c095f6767;hp=d243ebb2ead2ad2c5f65708646cf25c02137e363;hpb=32c96a65487f71bb22a609c18eac315bd700dc36;p=helm.git diff --git a/matita/matitaScript.ml b/matita/matitaScript.ml index d243ebb2e..4c40f9e14 100644 --- a/matita/matitaScript.ml +++ b/matita/matitaScript.ml @@ -36,7 +36,7 @@ let debug_print = if debug then prerr_endline else ignore (** raised when one of the script margins (top or bottom) is reached *) exception Margin exception NoUnfinishedProof -exception ActionCancelled +exception ActionCancelled of string let safe_substring s i j = try String.sub s i j with Invalid_argument _ -> assert false @@ -161,7 +161,7 @@ let wrap_with_developments guistuff f arg = else f arg in - let do_nothing () = raise ActionCancelled in + let do_nothing () = raise (ActionCancelled "Inclusion not performed") in let handle_with_devel d = let name = MatitamakeLib.name_for_development d in let title = "Unable to include " ^ what in @@ -221,27 +221,31 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status (* no idea why ocaml wants this *) let parsed_text_length = String.length parsed_text in let dbd = LibraryDb.instance () in - (* XXX use a real CIC -> string pretty printer *) - let pp_macro = TAPp.pp_macro ~term_pp:CicPp.ppterm in + let pp_macro = + let f t = ProofEngineReduction.replace + ~equality:(fun _ t -> match t with Cic.Meta _ -> true | _ -> false) + ~what:[()] ~with_what:[Cic.Implicit None] ~where:t + in + let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in + TAPp.pp_macro + ~term_pp:(fun x -> + ApplyTransformation.txt_of_cic_term max_int metasenv [] (f x)) + in match mac with (* WHELP's stuff *) | TA.WMatch (loc, term) -> let l = Whelp.match_term ~dbd term in - let query_url = - MatitaMisc.strip_suffix ~suffix:"." - (HExtlib.trim_blanks unparsed_text) - in - let entry = `Whelp (query_url, l) in + let entry = `Whelp (pp_macro mac, l) in guistuff.mathviewer#show_uri_list ~reuse:true ~entry l; [], parsed_text_length | TA.WInstance (loc, term) -> let l = Whelp.instance ~dbd term in - let entry = `Whelp (pp_macro (TA.WInstance (loc, term)), l) in + let entry = `Whelp (pp_macro mac, l) in guistuff.mathviewer#show_uri_list ~reuse:true ~entry l; [], parsed_text_length | TA.WLocate (loc, s) -> let l = Whelp.locate ~dbd s in - let entry = `Whelp (pp_macro (TA.WLocate (loc, s)), l) in + let entry = `Whelp (pp_macro mac, l) in guistuff.mathviewer#show_uri_list ~reuse:true ~entry l; [], parsed_text_length | TA.WElim (loc, term) -> @@ -251,13 +255,13 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status | _ -> failwith "Not a MutInd" in let l = Whelp.elim ~dbd uri in - let entry = `Whelp (pp_macro (TA.WElim (loc, term)), l) in + let entry = `Whelp (pp_macro mac, l) in guistuff.mathviewer#show_uri_list ~reuse:true ~entry l; [], parsed_text_length | TA.WHint (loc, term) -> let s = ((None,[0,[],term], Cic.Meta (0,[]) ,term),0) in let l = List.map fst (MQ.experimental_hint ~dbd s) in - let entry = `Whelp (pp_macro (TA.WHint (loc, term)), l) in + let entry = `Whelp (pp_macro mac, l) in guistuff.mathviewer#show_uri_list ~reuse:true ~entry l; [], parsed_text_length (* REAL macro *) @@ -324,7 +328,9 @@ and eval_executable include_paths (buffer : GText.buffer) guistuff lexicon_statu begin match ex with | TA.Command (_,TA.Set (_,"baseuri",u)) -> - if not (GrafiteMisc.is_empty u) then + if Http_getter_storage.is_read_only u then + raise (ActionCancelled ("baseuri " ^ u ^ " is readonly")); + if not (Http_getter_storage.is_empty u) then (match guistuff.ask_confirmation ~title:"Baseuri redefinition" @@ -333,9 +339,7 @@ and eval_executable include_paths (buffer : GText.buffer) guistuff lexicon_statu "Do you want to redefine the corresponding "^ "part of the library?") with - | `YES -> - let basedir = Helm_registry.get "matita.basedir" in - LibraryClean.clean_baseuris ~basedir [u] + | `YES -> LibraryClean.clean_baseuris [u] | `NO -> () | `CANCEL -> raise MatitaTypes.Cancel) | _ -> () @@ -535,6 +539,7 @@ object (self) self#notify with | Margin -> self#notify + | Not_found -> assert false | exc -> self#notify; raise exc method retract () =