]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaScript.ml
Esempi di auto.
[helm.git] / helm / software / matita / matitaScript.ml
index 188726d9510879720ff984782cd5d8e26fe558d6..891d09a50b20495e9c5da8f3c70d6f0d70792f68 100644 (file)
@@ -36,13 +36,13 @@ 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
 
 let heading_nl_RE = Pcre.regexp "^\\s*\n\\s*"
-let heading_nl_RE' = Pcre.regexp "^(\\s*\n\\s*)((.|\n)*)"
+let heading_nl_RE' = Pcre.regexp "^(\\s*\n\\s*)"
 let only_dust_RE = Pcre.regexp "^(\\s|\n|%%[^\n]*\n)*$"
 let multiline_RE = Pcre.regexp "^\n[^\n]+$"
 let newline_RE = Pcre.regexp "\n"
@@ -84,7 +84,10 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
   let initial_space,parsed_text =
    try
     let pieces = Pcre.extract ~rex:heading_nl_RE' parsed_text in
-     pieces.(1), pieces.(2)
+    let p1 = pieces.(1) in
+    let p1_len = String.length p1 in
+    let rest = String.sub parsed_text p1_len (parsed_text_length - p1_len) in
+     p1, rest
    with
     Not_found -> "", parsed_text in
   let inital_space,new_grafite_status,new_lexicon_status,new_status_and_text_list' =
@@ -158,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
@@ -321,7 +324,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" 
@@ -330,9 +335,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)
      | _ -> ()
@@ -414,7 +417,7 @@ class script  ~(source_view: GSourceView.source_view)
               () =
 let buffer = source_view#buffer in
 let source_buffer = source_view#source_buffer in
-let initial_statuses =
+let initial_statuses () =
  (* these include_paths are used only to load the initial notation *)
  let include_paths =
   Helm_registry.get_list Helm_registry.string "matita.includes" in
@@ -455,7 +458,7 @@ object (self)
 
   val mutable statements = []    (** executed statements *)
 
-  val mutable history = [ initial_statuses ]
+  val mutable history = [ initial_statuses () ]
     (** list of states before having executed statements. Head element of this
       * list is the current state, last element is the state at the beginning of
       * the script.
@@ -645,7 +648,7 @@ object (self)
 
   method private reset_buffer = 
     statements <- [];
-    history <- [ initial_statuses ];
+    history <- [ initial_statuses () ];
     userGoal <- None;
     self#notify;
     buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter;
@@ -800,6 +803,7 @@ object (self)
     try
       is_there_only_comments self#lexicon_status s
     with 
+    | HExtlib.Localized _
     | CicNotationParser.Parse_error _ -> false
     | Margin | End_of_file -> true