aboutsummaryrefslogtreecommitdiff
path: root/lib/system.ml
diff options
context:
space:
mode:
authorHugo Herbelin2015-01-31 09:09:28 +0100
committerHugo Herbelin2015-02-12 17:20:35 +0100
commit5268efdefb396267bfda0c17eb045fa2ed516b3c (patch)
treeb27a12e165d2c5b8c1b4d3171f961b8a5025bbb3 /lib/system.ml
parente03513b7309008a45957609739bcdaf3789f3052 (diff)
Using same code for browsing physical directories in coqtop and coqdep.
In particular: - abstracting the code using calls to Unix opendir, stat, and closedir, - uniformly using warnings when a directory does not exist (coqtop was ignoring silently and coqdep was exiting via handle_unix_error).
Diffstat (limited to 'lib/system.ml')
-rw-r--r--lib/system.ml48
1 files changed, 15 insertions, 33 deletions
diff --git a/lib/system.ml b/lib/system.ml
index 73095f9cd6..6c01a270e2 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -12,45 +12,27 @@ open Pp
open Errors
open Util
open Unix
+open Systemdirs
-(* All subdirectories, recursively *)
-
-let exists_dir dir =
- try let _ = closedir (opendir dir) in true with Unix_error _ -> false
-
-let skipped_dirnames = ref ["CVS"; "_darcs"]
-
-let exclude_search_in_dirname f = skipped_dirnames := f :: !skipped_dirnames
-
-let ok_dirname f =
- not (String.is_empty f) && f.[0] != '.' &&
- not (String.List.mem f !skipped_dirnames) &&
- (match Unicode.ident_refutation f with None -> true | _ -> false)
+(** Returns the list of all recursive subdirectories of [root] in
+ depth-first search, with sons ordered as on the file system;
+ warns if [root] does not exist *)
let all_subdirs ~unix_path:root =
let l = ref [] in
let add f rel = l := (f, rel) :: !l in
- let rec traverse dir rel =
- let dirh = opendir dir in
- try
- while true do
- let f = readdir dirh in
- if ok_dirname f then
- let file = Filename.concat dir f in
- try
- begin match (stat file).st_kind with
- | S_DIR ->
- let newrel = rel @ [f] in
- add file newrel;
- traverse file newrel
- | _ -> ()
- end
- with Unix_error (e,s1,s2) -> ()
- done
- with End_of_file ->
- closedir dirh
+ let rec traverse path rel =
+ let f = function
+ | FileDir (path,f) ->
+ let newrel = rel @ [f] in
+ add path newrel;
+ traverse path newrel
+ | _ -> ()
+ in process_directory f path
in
- if exists_dir root then traverse root [];
+ check_unix_dir (fun s -> msg_warning (str s)) root;
+ if exists_dir root then traverse root []
+ else msg_warning (str ("Cannot open " ^ root));
List.rev !l
let rec search paths test =