X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fmatita%2Fmatitaclean.ml;h=883aa3976196c8d55278a4e82f4d8cbcecb9aece;hb=26d2ecb945a881c61d03f3c259996374209f5d7f;hp=d04e9fba9fab806ac32f0bc337f8967d31ca6a75;hpb=f6b7c6ae353e014761a3d24dbc87e00d828d7f2d;p=helm.git diff --git a/matita/matita/matitaclean.ml b/matita/matita/matitaclean.ml index d04e9fba9..883aa3976 100644 --- a/matita/matita/matitaclean.ml +++ b/matita/matita/matitaclean.ml @@ -25,9 +25,7 @@ (* $Id$ *) -open Printf - -module TA = GrafiteAst +module L = Librarian let clean_suffixes = [ ".moo"; ".lexicon"; ".metadata"; ".xml.gz" ] @@ -52,7 +50,6 @@ let ask_confirmation _ = flush stdout; exit 1 end -;; let clean_all () = if Helm_registry.get_bool "matita.system" then @@ -72,7 +69,7 @@ let clean_all () = String.concat " -o " (List.map (fun suf -> "-name \\*" ^ suf) clean_suffixes) in let clean_cmd = - sprintf "find %s \\( %s \\) -exec rm \\{\\} \\; 2> /dev/null" + Printf.sprintf "find %s \\( %s \\) -exec rm \\{\\} \\; 2> /dev/null" xmldir clean_pat in ignore (Sys.command clean_cmd); ignore @@ -80,42 +77,50 @@ let clean_all () = " -type d -exec rmdir -p {} \\; 2> /dev/null"))) prefixes; ignore (Sys.command ("rm -rf " ^ Helm_registry.get "matita.basedir")) -;; -let main () = - let _ = MatitaInit.initialize_all () in - if not (Helm_registry.get_bool "matita.verbose") then MatitaMisc.shutup (); - let files = - match Helm_registry.get_list Helm_registry.string "matita.args" with - | [ "all" ] -> clean_all (); exit 0 - | [] -> - (match Librarian.find_roots_in_dir (Sys.getcwd ()) with - | [x] -> - Sys.chdir (Filename.dirname x); - HExtlib.find ~test:(fun x -> Filename.check_suffix x ".ma") "." - | [] -> - prerr_endline "No targets and no root found"; exit 1 - | roots -> - let roots = List.map (HExtlib.chop_prefix (Sys.getcwd()^"/")) roots in - prerr_endline ("Too many roots found:\n\t" ^ String.concat "\n\t" roots); - prerr_endline ("\nEnter one of these directories and retry"); - exit 1); - | files -> files - in - let uris_to_remove = - List.fold_left - (fun uris_to_remove suri -> +let get_all_scripts () = + match L.find_roots_in_dir (Sys.getcwd ()) with + | [root] -> + let bdir = Filename.dirname root in + HExtlib.find ~test:(fun x -> Filename.check_suffix x ".ma") bdir + | [] -> + prerr_endline "no roots found"; exit 1 + | roots -> + let roots = List.map (HExtlib.chop_prefix (Sys.getcwd()^"/")) roots in + prerr_endline ("Too many roots found:\n\t" ^ String.concat "\n\t" roots); + prerr_endline ("\nEnter one of these directories and retry"); + exit 1 + +let remove_all_items items = + let map item = + if L.is_uri item then item else + let _,buri,_,_ = L.baseuri_of_script ~include_paths:[] item in + buri + in +(*MATITA 1.0, CSC: verify that uris_to_remove are reasonable uris *) + let uris_to_remove = List.map map items in + LibraryClean.clean_baseuris ~verbose:true uris_to_remove + +(* FG: Old code kept for reference + let uri = - (*MATITA 1.0, CSC: verify that suri is a reasonable uri *) (*try*) NUri.baseuri_of_uri (NUri.uri_of_string suri) (*with UM.IllFormedUri _ -> - let _,u,_,_ = Librarian.baseuri_of_script ~include_paths:[] suri in - if Librarian.is_uri u then u else begin + let _,u,_,_ = L.baseuri_of_script ~include_paths:[] suri in + if L.is_uri u then u else begin HLog.error (sprintf "File %s defines a bad baseuri: %s" suri u); exit 1 end *) - in - uri::uris_to_remove) [] files - in - LibraryClean.clean_baseuris uris_to_remove +*) + +let main () = + let _ = MatitaInit.initialize_all () in + if not (Helm_registry.get_bool "matita.verbose") then MatitaMisc.shutup (); + match Helm_registry.get_list Helm_registry.string "matita.args" with + | [ "all" ] -> clean_all (); exit 0 + | [] -> + let items = get_all_scripts () in + remove_all_items items + | items -> + remove_all_items items