]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaScript.ml
some improvements
[helm.git] / helm / software / matita / matitaScript.ml
index a6842d832e2076251a7a14fdf82631b51e11d319..9eb1dbf69c608c9ba231d4e46f45f3ae78fb1f18 100644 (file)
@@ -60,14 +60,6 @@ let first_line s =
     String.sub s 0 nl_pos
   with Not_found -> s
 
-  (** creates a statement AST for the Goal tactic, e.g. "goal 7" *)
-let goal_ast n =
-  let module A = GrafiteAst in
-  let loc = HExtlib.dummy_floc in
-  A.Executable (loc, A.Tactical (loc,
-    A.Tactic (loc, A.Goal (loc, n)),
-    Some (A.Dot loc)))
-
 type guistuff = {
   mathviewer:MatitaTypes.mathViewer;
   urichooser: UriManager.uri list -> UriManager.uri list;
@@ -103,7 +95,7 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
             (status,to_prepend ^ newtxt ^ "\n")::acc, "")
       ([],skipped_txt) enriched_history_fragment
   in
-  res,parsed_text_length
+  res,"",parsed_text_length
 
 let wrap_with_developments guistuff f arg = 
   let compile_needed_and_go_on lexiconfile d exc =
@@ -129,11 +121,11 @@ let wrap_with_developments guistuff f arg =
         (ActionCancelled 
           ("Internal error: "^f_pwd^" exists but I'm unable to include it!"))
   in
-  let handle_with_devel d lexiconfile exc =
+  let handle_with_devel d lexiconfile mafile exc =
     let name = MatitamakeLib.name_for_development d in
     let title = "Unable to include " ^ lexiconfile in
     let message = 
-      lexiconfile ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
+      mafile ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
       "<i>Should I compile it and Its dependencies?</i>"
     in
     (match guistuff.ask_confirmation ~title ~message with
@@ -170,7 +162,7 @@ let wrap_with_developments guistuff f arg =
        * but was unable to get the compilation output 'xfilename' *)
       match MatitamakeLib.development_for_dir (Filename.dirname mafilename) with
       | None -> handle_without_devel mafilename exn
-      | Some d -> handle_with_devel d xfilename exn
+      | Some d -> handle_with_devel d xfilename mafilename exn
 ;;
     
 let eval_with_engine
@@ -212,17 +204,17 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
      let l =  Whelp.match_term ~dbd term in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WInstance (loc, term) ->
      let l = Whelp.instance ~dbd term in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WLocate (loc, s) -> 
      let l = Whelp.locate ~dbd s in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WElim (loc, term) ->
      let uri =
        match term with
@@ -232,13 +224,13 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
      let l = Whelp.elim ~dbd uri in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WHint (loc, term) ->
-     let s = ((None,[0,[],term], Cic.Meta (0,[]) ,term),0) in
+     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 mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   (* REAL macro *)
   | TA.Hint loc -> 
       let user_goal' =
@@ -251,26 +243,25 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       let l = List.map fst (MQ.experimental_hint ~dbd proof_status) in
       let selected = guistuff.urichooser l in
       (match selected with
-      | [] -> [], parsed_text_length
+      | [] -> [], "", parsed_text_length
       | [uri] -> 
           let suri = UriManager.string_of_uri uri in
           let ast loc =
-            TA.Executable (loc, (TA.Tactical (loc,
-              TA.Tactic (loc,
-                TA.Apply (loc, CicNotationPt.Uri (suri, None))),
-                Some (TA.Dot loc)))) in
+            TA.Executable (loc, (TA.Tactic (loc,
+             Some (TA.Apply (loc, CicNotationPt.Uri (suri, None))),
+             TA.Dot loc))) in
           let text =
            comment parsed_text ^ "\n" ^
             pp_eager_statement_ast (ast HExtlib.dummy_floc) in
           let text_len = MatitaGtkMisc.utf8_string_length text in
           let loc = HExtlib.floc_of_loc (0,text_len) in
           let statement = `Ast (GrafiteParser.LSome (ast loc),text) in
-          let res,_parsed_text_len =
+          let res,_,_parsed_text_len =
            eval_statement include_paths buffer guistuff lexicon_status
             grafite_status user_goal script statement
           in
            (* we need to replace all the parsed_text *)
-           res,String.length parsed_text
+           res,"",String.length parsed_text
       | _ -> 
           HLog.error 
             "The result of the urichooser should be only 1 uri, not:\n";
@@ -287,10 +278,10 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       let ty,_ = CTC.type_of_aux' metasenv context term CicUniv.empty_ugraph in
       let t_and_ty = Cic.Cast (term,ty) in
       guistuff.mathviewer#show_entry (`Cic (t_and_ty,metasenv));
-      [], parsed_text_length
-  (* TODO *)
-  | TA.Quit _ -> failwith "not implemented"
-  | TA.Print (_,kind) -> failwith "not implemented"
+      [], "", parsed_text_length
+  | TA.Inline (_,style,suri,prefix) ->
+       let str = ApplyTransformation.txt_of_inline_macro style suri prefix in
+       [], str, String.length parsed_text
                                 
 and eval_executable include_paths (buffer : GText.buffer) guistuff
 lexicon_status grafite_status user_goal unparsed_text skipped_txt nonskipped_txt
@@ -319,11 +310,14 @@ script ex loc
            | `CANCEL -> raise MatitaTypes.Cancel)
      | _ -> ()
    end;
+   ignore (buffer#move_mark (`NAME "beginning_of_statement")
+    ~where:((buffer#get_iter_at_mark (`NAME "locked"))#forward_chars
+       (Glib.Utf8.length skipped_txt))) ;
    eval_with_engine
     guistuff lexicon_status grafite_status user_goal skipped_txt nonskipped_txt
      (TA.Executable (loc, ex))
   with
-     MatitaTypes.Cancel -> [], 0
+     MatitaTypes.Cancel -> [], "", 0
    | GrafiteEngine.Macro (_loc,lazy_macro) ->
       let context =
        match user_goal with
@@ -360,13 +354,13 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
   match st with
   | GrafiteParser.LNone loc ->
       let parsed_text, _, _, parsed_text_length = text_of_loc loc in
-       [(grafite_status,lexicon_status),parsed_text],
+       [(grafite_status,lexicon_status),parsed_text],"",
         parsed_text_length
   | GrafiteParser.LSome (GrafiteAst.Comment (loc, _)) -> 
       let parsed_text, _, _, parsed_text_length = text_of_loc loc in
       let remain_len = String.length unparsed_text - parsed_text_length in
       let s = String.sub unparsed_text parsed_text_length remain_len in
-      let s,len = 
+      let s,text,len = 
        try
         eval_statement include_paths buffer guistuff lexicon_status
          grafite_status user_goal script (`Raw s)
@@ -379,10 +373,11 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
             (GrafiteDisambiguator.DisambiguationError
               (offset+parsed_text_length, errorll))
       in
+      assert (text=""); (* no macros inside comments, please! *)
       (match s with
       | (statuses,text)::tl ->
-         (statuses,parsed_text ^ text)::tl,parsed_text_length + len
-      | [] -> [], 0)
+         (statuses,parsed_text ^ text)::tl,"",parsed_text_length + len
+      | [] -> [], "", 0)
   | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) ->
      let _, nonskipped, skipped, parsed_text_length = 
        text_of_loc loc 
@@ -456,6 +451,9 @@ object (self)
   (** text mark and tag representing locked part of a script *)
   val locked_mark =
     buffer#create_mark ~name:"locked" ~left_gravity:true buffer#start_iter
+  val beginning_of_statement_mark =
+    buffer#create_mark ~name:"beginning_of_statement"
+     ~left_gravity:true buffer#start_iter
   val locked_tag = buffer#create_tag [`BACKGROUND "lightblue"; `EDITABLE false]
   val error_tag = buffer#create_tag [`UNDERLINE `SINGLE; `FOREGROUND "red"]
 
@@ -471,7 +469,7 @@ object (self)
   method private _advance ?statement () =
    let s = match statement with Some s -> s | None -> self#getFuture in
    HLog.debug ("evaluating: " ^ first_line s ^ " ...");
-   let (entries, parsed_len) = 
+   let entries, newtext, parsed_len = 
     try
      eval_statement include_paths buffer guistuff self#lexicon_status
       self#grafite_status userGoal self (`Raw s)
@@ -495,7 +493,8 @@ object (self)
        buffer#insert ~iter:start new_text;
      end;
    end;
-   self#moveMark (Glib.Utf8.length  new_text);
+   self#moveMark (Glib.Utf8.length new_text);
+   buffer#insert ~iter:(buffer#get_iter_at_mark (`MARK locked_mark)) newtext;
    (* here we need to set the Goal in case we are going to cursor (or to
       bottom) and we will face a macro *)
    match self#grafite_status.proof_status with
@@ -524,6 +523,7 @@ object (self)
     with 
     | Margin -> self#notify
     | Not_found -> assert false
+    | Invalid_argument "Array.make" -> HLog.error "The script is too big!\n"
     | exc -> self#notify; raise exc
 
   method retract () =
@@ -541,6 +541,7 @@ object (self)
        self#notify
     with 
     | Margin -> self#notify
+    | Invalid_argument "Array.make" -> HLog.error "The script is too big!\n"
     | exc -> self#notify; raise exc
 
   method private getFuture =
@@ -586,6 +587,11 @@ object (self)
     let grafite_status = self#grafite_status in
     List.iter (fun o -> o lexicon_status grafite_status) observers
 
+  method loadFromString s =
+    buffer#set_text s;
+    self#reset_buffer;
+    buffer#set_modified true
+
   method loadFromFile f =
     buffer#set_text (HExtlib.input_file f);
     self#reset_buffer;
@@ -669,6 +675,7 @@ object (self)
      set_star (Filename.basename self#ppFilename) false
 
   method goto (pos: [`Top | `Bottom | `Cursor]) () =
+  try  
     let old_locked_mark =
      `MARK
        (buffer#create_mark ~name:"old_locked_mark"
@@ -748,7 +755,9 @@ object (self)
         | Margin -> dispose_remember (); dispose_old_locked_mark (); self#notify
         | exc -> dispose_remember (); dispose_old_locked_mark ();
                  self#notify; raise exc)
-              
+  with Invalid_argument "Array.make" ->
+     HLog.error "The script is too big!\n"
+  
   method onGoingProof () =
     match self#grafite_status.proof_status with
     | No_proof | Proof _ -> false
@@ -799,6 +808,7 @@ prerr_endline ("## " ^ string_of_int parsed_text_length);
     | HExtlib.Localized _
     | CicNotationParser.Parse_error _ -> false
     | Margin | End_of_file -> true
+    | Invalid_argument "Array.make" -> false
 
   (* debug *)
   method dump () =