Big changes:

[helm.git] / helm / matita / matitaMisc.ml

diff --git a/helm/matita/matitaMisc.ml b/helm/matita/matitaMisc.ml
index 99fea1a32cec09944963043c058fdeda576bd9d0..c12a1452733208ca2f3ab755bf727587a344ab42 100644 (file)
--- a/helm/matita/matitaMisc.ml
+++ b/helm/matita/matitaMisc.ml
@@ -26,6 +26,56 @@
 open Printf
 open MatitaTypes 
 
+let strip_trailing_slash =
+  let rex = Pcre.regexp "/$" in
+  fun s -> Pcre.replace ~rex s
+
+let baseuri_of_baseuri_decl st =
+  match st with
+  | GrafiteAst.Executable (_, GrafiteAst.Command (_, GrafiteAst.Set (_, "baseuri", buri))) ->
+      Some buri
+  | _ -> None
+
+let baseuri_of_file file = 
+  let uri = ref None in
+  let ic = open_in file in
+  let istream = Stream.of_channel ic in
+  (try
+    while true do
+      try 
+        let stm = GrafiteParser.parse_statement istream in
+        match baseuri_of_baseuri_decl stm with
+        | Some buri -> 
+            let u = strip_trailing_slash buri in
+            if String.length u < 5 || String.sub u 0 5 <> "cic:/" then
+              MatitaLog.error (file ^ " sets an incorrect baseuri: " ^ buri);
+            (try 
+              ignore(Http_getter.resolve u)
+            with
+            | Http_getter_types.Unresolvable_URI _ -> 
+                MatitaLog.error (file ^ " sets an unresolvable baseuri: "^buri)
+            | Http_getter_types.Key_not_found _ -> ());
+            uri := Some u;
+            raise End_of_file
+        | None -> ()
+      with
+        CicNotationParser.Parse_error _ as exn ->
+          prerr_endline ("Unable to parse: " ^ file);
+          prerr_endline (MatitaExcPp.to_string exn);
+          ()
+    done
+  with End_of_file -> close_in ic);
+  match !uri with
+  | Some uri -> uri
+  | None -> failwith ("No baseuri defined in " ^ file)
+
+let is_empty buri =
+ List.for_all
+  (function
+      Http_getter_types.Ls_section _ -> true
+    | Http_getter_types.Ls_object _ -> false)
+  (Http_getter.ls (Http_getter_misc.strip_trailing_slash buri ^ "/"))
+
 let safe_remove fname = if Sys.file_exists fname then Sys.remove fname
 
 let is_dir fname =
@@ -68,10 +118,6 @@ let strip_trailing_blanks =
   let rex = Pcre.regexp "\\s*$" in
   fun s -> Pcre.replace ~rex s
 
-let strip_trailing_slash =
-  let rex = Pcre.regexp "/$" in
-  fun s -> Pcre.replace ~rex s
-
 let empty_mathml () =
   DomMisc.domImpl#createDocument ~namespaceURI:(Some DomMisc.mathml_ns)
     ~qualifiedName:(Gdome.domString "math") ~doctype:None
@@ -221,7 +267,17 @@ let unopt = function None -> failwith "unopt: None" | Some v -> v
 let image_path n = sprintf "%s/%s" BuildTimeConf.images_dir n
 
 let end_ma_RE = Pcre.regexp "\\.ma$"
-let obj_file_of_script f = Pcre.replace ~rex:end_ma_RE ~templ:".moo" f
+
+let obj_file_of_baseuri baseuri =
+ let path =
+  Helm_registry.get "matita.basedir" ^ "/xml" ^
+   Pcre.replace ~pat:"^cic:" ~templ:"" baseuri
+ in
+  path ^ ".moo"
+
+let obj_file_of_script f =
+ let baseuri = baseuri_of_file f in
+  obj_file_of_baseuri baseuri
 
 let rec list_uniq = function 
   | [] -> []