X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2FmatitaScript.ml;h=1a128fb1c753bfa58cd30c1631997e0742614b41;hb=6d5f1a19aaa18813dca94b4e2e7e5ee3b97b4e4b;hp=62d760c3b993b365b01b133b362855b3a3b20324;hpb=358720b93255d1aa526dc03c63a5d6193658b93b;p=helm.git

diff --git a/matita/matitaScript.ml b/matita/matitaScript.ml
index 62d760c3b..1a128fb1c 100644
--- a/matita/matitaScript.ml
+++ b/matita/matitaScript.ml
@@ -85,9 +85,11 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
   let parsed_text_length =
     String.length skipped_txt + String.length nonskipped_txt 
   in
+  let text = skipped_txt ^ nonskipped_txt in
+  let prefix_len = MatitaGtkMisc.utf8_string_length skipped_txt in
   let enriched_history_fragment =
    MatitaEngine.eval_ast ~do_heavy_checks:true
-    lexicon_status grafite_status st
+    lexicon_status grafite_status (text,prefix_len,st)
   in
   let enriched_history_fragment = List.rev enriched_history_fragment in
   (* really fragile *)
@@ -101,64 +103,74 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
             (status,to_prepend ^ newtxt ^ "\n")::acc, "")
       ([],skipped_txt) enriched_history_fragment
   in
-  let res = (*List.combine (List.map fst (List.rev enriched_history_fragment))
-  strings*) res 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 =
+    let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" lexiconfile in
+    let target = Pcre.replace ~pat:"metadata$" ~templ:"moo" target in
+    let refresh_cb () = 
+      while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
+    in
+    if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
+      raise exc
+    else
+      f arg
+  in
+  let do_nothing () = raise (ActionCancelled "Inclusion not performed") in
+  let check_if_file_is_exists f =
+    assert(Pcre.pmatch ~pat:"ma$" f);
+    let pwd = Sys.getcwd () in
+    let f_pwd = pwd ^ "/" ^ f in
+    if not (HExtlib.is_regular f_pwd) then
+      raise (ActionCancelled ("File "^f_pwd^" does not exists!"))
+    else
+      raise 
+        (ActionCancelled 
+          ("Internal error: "^f_pwd^" exists but I'm unable to include it!"))
+  in
+  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 = 
+      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
+    | `YES -> compile_needed_and_go_on lexiconfile d exc
+    | `NO -> raise exc
+    | `CANCEL -> do_nothing ())
+  in
+  let handle_without_devel mafilename exc =
+    let title = "Unable to include " ^ mafilename in
+    let message = 
+     mafilename ^ " is <b>not</b> handled by a development.\n" ^
+     "All dependencies are automatically solved for a development.\n\n" ^
+     "<i>Do you want to set up a development?</i>"
+    in
+    (match guistuff.ask_confirmation ~title ~message with
+    | `YES -> 
+        guistuff.develcreator ~containing:(Some (Filename.dirname mafilename));
+        do_nothing ()
+    | `NO -> raise exc
+    | `CANCEL -> do_nothing())
+  in
   try 
     f arg
   with
-  | DependenciesParser.UnableToInclude what 
-  | LexiconEngine.IncludedFileNotCompiled what 
-  | GrafiteEngine.IncludedFileNotCompiled what as exc ->
-      let compile_needed_and_go_on d =
-        let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" what in
-        let refresh_cb () = 
-          while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
-        in
-        if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
-          raise exc
-        else
-          f arg
-      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
-        let message = 
-          what ^ " 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
-        | `YES -> compile_needed_and_go_on d
-        | `NO -> raise exc
-        | `CANCEL -> do_nothing ())
-      in
-      let handle_without_devel filename =
-        let title = "Unable to include " ^ what in
-        let message = 
-         what ^ " is <b>not</b> handled by a development.\n" ^
-         "All dependencies are automatically solved for a development.\n\n" ^
-         "<i>Do you want to set up a development?</i>"
-        in
-        (match guistuff.ask_confirmation ~title ~message with
-        | `YES -> 
-            (match filename with
-            | Some f -> 
-                guistuff.develcreator ~containing:(Some (Filename.dirname f))
-            | None -> guistuff.develcreator ~containing:None);
-            do_nothing ()
-        | `NO -> raise exc
-        | `CANCEL -> do_nothing())
-      in
-      match guistuff.filenamedata with
-      | None,None -> handle_without_devel None
-      | None,Some d -> handle_with_devel d
-      | Some f,_ ->
-          match MatitamakeLib.development_for_dir (Filename.dirname f) with
-          | None -> handle_without_devel (Some f)
-          | Some d -> handle_with_devel d
+  | DependenciesParser.UnableToInclude mafilename -> 
+      assert (Pcre.pmatch ~pat:"ma$" mafilename);
+      check_if_file_is_exists mafilename
+  | LexiconEngine.IncludedFileNotCompiled (xfilename,mafilename) 
+  | GrafiteEngine.IncludedFileNotCompiled (xfilename,mafilename) as exn ->
+      assert (Pcre.pmatch ~pat:"ma$" mafilename);
+      assert (Pcre.pmatch ~pat:"lexicon$" xfilename || 
+              Pcre.pmatch ~pat:"mo$" xfilename );
+      (* we know that someone was able to include the .ma, get the baseuri
+       * 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 mafilename exn
 ;;
     
 let eval_with_engine
@@ -200,17 +212,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
@@ -220,13 +232,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 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' =
@@ -239,7 +251,7 @@ 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 =
@@ -253,12 +265,12 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
           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";
@@ -275,12 +287,54 @@ 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"
-  | TA.Search_pat (_, search_kind, str) -> failwith "not implemented"
-  | TA.Search_term (_, search_kind, term) -> failwith "not implemented"
+      [], "", parsed_text_length
+  | TA.Inline (_,style,suri,prefix) ->
+     let dbd = LibraryDb.instance () in
+     let uris =
+      let sql_pat =
+       (Pcre.replace ~rex:(Pcre.regexp "_") ~templ:"\\_" suri) ^ "%" in
+      let query =
+       sprintf ("SELECT source FROM %s WHERE source LIKE \"%s\" UNION "^^
+                "SELECT source FROM %s WHERE source LIKE \"%s\"")
+         (MetadataTypes.name_tbl ()) sql_pat
+         MetadataTypes.library_name_tbl sql_pat in
+      let result = HMysql.exec dbd query in
+       HMysql.map result
+        (function cols ->
+          match cols.(0) with
+             Some s -> UriManager.uri_of_string s
+           | _ -> assert false)
+     in
+prerr_endline "Inizio sorting";
+      let sorted_uris = MetadataDeps.topological_sort ~dbd uris in
+prerr_endline "Fine sorting";
+      let sorted_uris_without_xpointer =
+       HExtlib.filter_map
+        (function uri ->
+          let s =
+           Pcre.replace ~rex:(Pcre.regexp "#xpointer\\(1/1\\)") ~templ:""
+            (UriManager.string_of_uri uri) in
+          try
+           ignore (Pcre.exec ~rex:(Pcre.regexp"#xpointer") s);
+           None
+          with
+           Not_found ->
+            Some (UriManager.uri_of_string s)
+        ) sorted_uris
+      in
+      let declarative =
+       String.concat "\n\n"
+        (List.map
+          (fun uri ->
+prerr_endline ("Stampo " ^ UriManager.string_of_uri uri);
+            try
+             ObjPp.obj_to_string 78 style prefix (* FG: mi pare meglio 78 *)
+              (fst (CicEnvironment.get_obj CicUniv.empty_ugraph uri))
+            with
+             _ (* BRRRRRRRRR *) -> "ERRORE IN STAMPA DI " ^ UriManager.string_of_uri uri
+          ) sorted_uris_without_xpointer)
+      in
+       [],declarative,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
@@ -309,11 +363,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
@@ -350,28 +407,30 @@ 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)
        with
           HExtlib.Localized (floc, exn) ->
-           HExtlib.raise_localized_exception ~offset:parsed_text_length floc exn
+           HExtlib.raise_localized_exception 
+             ~offset:(MatitaGtkMisc.utf8_string_length parsed_text) floc exn
         | GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
            raise
             (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 
@@ -445,6 +504,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"]
 
@@ -460,7 +522,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)
@@ -484,7 +546,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
@@ -575,6 +638,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;
@@ -719,7 +787,7 @@ object (self)
              self#_retract (icmp - len) lexicon_status grafite_status statements
               history
           | statement::tl1, _::tl2 ->
-             back_until_cursor (len - String.length statement) (tl1,tl2)
+             back_until_cursor (len - MatitaGtkMisc.utf8_string_length statement) (tl1,tl2)
           | _,_ -> assert false
         in
         (try
@@ -771,9 +839,10 @@ object (self)
       in
       match st with
       | GrafiteParser.LSome (GrafiteAst.Comment (loc,_)) -> 
-          let _,parsed_text_length = 
-            MatitaGtkMisc.utf8_parsed_text s loc 
-          in
+          let _,parsed_text_length = MatitaGtkMisc.utf8_parsed_text s loc in
+          (* CSC: why +1 in the following lines ???? *)
+          let parsed_text_length = parsed_text_length + 1 in
+prerr_endline ("## " ^ string_of_int parsed_text_length);
           let remain_len = String.length s - parsed_text_length in
           let next = String.sub s parsed_text_length remain_len in
           is_there_only_comments lexicon_status next
@@ -783,6 +852,7 @@ object (self)
     try
       is_there_only_comments self#lexicon_status self#getFuture
     with 
+    | LexiconEngine.IncludedFileNotCompiled _
     | HExtlib.Localized _
     | CicNotationParser.Parse_error _ -> false
     | Margin | End_of_file -> true