X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fmatita%2FmatitaScript.ml;h=94cedf29b748e1419d83d14a7486a79b8838ba0c;hb=6857e22b8a58162893119f7747c5848031fd59ce;hp=83aa603626a7300bf81a6146e97b0f3f67466cd2;hpb=29a3bd5d160f31873236c93a008a9e4fd31c305e;p=helm.git diff --git a/helm/matita/matitaScript.ml b/helm/matita/matitaScript.ml index 83aa60362..94cedf29b 100644 --- a/helm/matita/matitaScript.ml +++ b/helm/matita/matitaScript.ml @@ -83,8 +83,8 @@ let eval_with_engine status user_goal parsed_text st = let new_status = MatitaEngine.eval_ast status st in let new_aliases = match ex with - | TA.Command (_, TA.Alias _) -> - DisambiguateTypes.Environment.empty + | TA.Command (_, TA.Alias _) + | TA.Command (_, TA.Include _) -> DisambiguateTypes.Environment.empty | _ -> MatitaSync.alias_diff ~from:status new_status in (* we remove the defined object since we consider them "automathic aliases" *) @@ -251,21 +251,34 @@ let eval_macro status (mathviewer:MatitaTypes.mathViewer) urichooser let eval_executable status (mathviewer:MatitaTypes.mathViewer) urichooser -user_goal parsed_text script ex = +ask_confirmation user_goal parsed_text script ex = let module TA = TacticAst in let module TAPp = TacticAstPp in let module MD = MatitaDisambiguator in let parsed_text_length = String.length parsed_text in match ex with | TA.Command (loc, _) | TA.Tactical (loc, _) -> - eval_with_engine status user_goal parsed_text - (TA.Executable (loc, ex)) + (match MatitacleanLib.baseuri_of_baseuri_decl (TA.Executable (loc,ex))with + | None -> () + | Some u -> + if not (MatitacleanLib.is_empty u) then + match + ask_confirmation + ~title:"Baseuri redefinition" + ~message:( + "Baseuri " ^ u ^ " already exists.\n" ^ + "Do you want to redefine the corresponding "^ + "part of the library?") + with + | `YES -> MatitacleanLib.clean_baseuris [u] + | `NO -> () + | `CANCEL -> raise MatitaTypes.Cancel); + eval_with_engine status user_goal parsed_text (TA.Executable (loc, ex)) | TA.Macro (_,mac) -> eval_macro status mathviewer urichooser parsed_text script mac -let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) - urichooser user_goal script s -= +let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) urichooser +ask_confirmation user_goal script s = if Pcre.pmatch ~rex:only_dust_RE s then raise Margin; let st = CicTextualParser2.parse_statement (Stream.of_string s) in let text_of_loc loc = @@ -279,7 +292,8 @@ let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) let remain_len = String.length s - parsed_text_length in let s = String.sub s parsed_text_length remain_len in let s,len = - eval_statement status mathviewer urichooser user_goal script s + eval_statement status + mathviewer urichooser ask_confirmation user_goal script s in (match s with | (status, text) :: tl -> @@ -287,8 +301,9 @@ let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) | [] -> [], 0) | TacticAst.Executable (loc, ex) -> let parsed_text, parsed_text_length = text_of_loc loc in - eval_executable status mathviewer urichooser user_goal - parsed_text script ex + eval_executable + status mathviewer urichooser ask_confirmation + user_goal parsed_text script ex let fresh_script_id = let i = ref 0 in @@ -297,6 +312,7 @@ let fresh_script_id = class script ~(buffer: GText.buffer) ~(init: MatitaTypes.status) ~(mathviewer: MatitaTypes.mathViewer) ~set_star + ~ask_confirmation ~urichooser () = object (self) val mutable filename = None @@ -341,7 +357,9 @@ object (self) let s = match statement with Some s -> s | None -> self#getFuture in MatitaLog.debug ("evaluating: " ^ first_line s ^ " ..."); let (entries, parsed_len) = - eval_statement self#status mathviewer urichooser userGoal self s in + eval_statement self#status + mathviewer urichooser ask_confirmation userGoal self s + in let (new_statuses, new_statements) = List.split entries in (* prerr_endline "evalStatement returned"; @@ -373,10 +391,15 @@ List.iter (fun s -> prerr_endline ("'" ^ s ^ "'")) new_statements; method advance ?statement () = try - self#_advance ?statement () + self#_advance ?statement (); + self#notify with Margin -> () - method retract () = try self#_retract () with Margin -> () + method retract () = + try + self#_retract (); + self#notify + with Margin -> () method private getFuture = buffer#get_text ~start:(buffer#get_iter_at_mark (`MARK locked_mark)) @@ -397,7 +420,9 @@ List.iter (fun s -> prerr_endline ("'" ^ s ^ "'")) new_statements; buffer#move_mark mark ~where:new_mark_pos; buffer#apply_tag locked_tag ~start:buffer#start_iter ~stop:new_mark_pos; buffer#move_mark `INSERT old_insert; - self#notify + match self#status.proof_status with + Incomplete_proof (_,goal) -> self#setGoal goal + | _ -> () val mutable observers = [] @@ -439,19 +464,19 @@ List.iter (fun s -> prerr_endline ("'" ^ s ^ "'")) new_statements; statements <- []; history <- [ init ]; userGoal <- ~-1; - self#notify; buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter; buffer#move_mark (`MARK locked_mark) ~where:buffer#start_iter method reset () = self#goto_top; - buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter + buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter; + self#notify method goto (pos: [`Top | `Bottom | `Cursor]) () = match pos with - | `Top -> self#goto_top + | `Top -> self#goto_top; self#notify | `Bottom -> - (try while true do self#_advance () done with Margin -> ()) + (try while true do self#_advance () done; self#notify with Margin -> ()) | `Cursor -> let locked_iter () = buffer#get_iter_at_mark (`NAME "locked") in let cursor_iter () = buffer#get_iter_at_mark `INSERT in @@ -468,9 +493,9 @@ List.iter (fun s -> prerr_endline ("'" ^ s ^ "'")) new_statements; let cmp = (locked_iter ())#compare (cursor_iter ()) in (try if cmp < 0 then (* locked < cursor *) - forward_until_cursor () + (forward_until_cursor (); self#notify) else if cmp > 0 then (* locked > cursor *) - back_until_cursor () + (back_until_cursor (); self#notify) else (* cursor = locked *) () with Margin -> ()) @@ -499,8 +524,11 @@ end let _script = ref None -let script ~buffer ~init ~mathviewer ~urichooser ~set_star () = - let s = new script ~buffer ~init ~mathviewer ~urichooser ~set_star () in +let script ~buffer ~init ~mathviewer ~urichooser ~ask_confirmation ~set_star () += + let s = new script + ~buffer ~init ~mathviewer ~ask_confirmation ~urichooser ~set_star () + in _script := Some s; s