diff options
author | Samuel Mimram <smimram@debian.org> | 2006-01-19 22:34:29 +0000 |
---|---|---|
committer | Samuel Mimram <smimram@debian.org> | 2006-01-19 22:34:29 +0000 |
commit | 0c0eeea26aafd36301d4b5592225e34153ff955f (patch) | |
tree | 1d839759bc9efc76ab3a0e09a5b52aa3039fffc7 /lib/system.ml | |
parent | 46af7a39c66bc711fb32a5ce4fed4ab4f218d6af (diff) | |
parent | 018ee3b0c2be79eb81b1f65c3f3fa142d24129c8 (diff) |
Merge commit 'upstream/8.0pl3'
Diffstat (limited to 'lib/system.ml')
-rw-r--r-- | lib/system.ml | 32 |
1 files changed, 31 insertions, 1 deletions
diff --git a/lib/system.ml b/lib/system.ml index fd782fe6..9bbcc308 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: system.ml,v 1.31.8.1 2004/07/16 19:30:31 herbelin Exp $ *) +(* $Id: system.ml,v 1.31.8.3 2006/01/10 17:06:23 barras Exp $ *) open Pp open Util @@ -22,6 +22,8 @@ let safe_getenv_def var def = flush Pervasives.stdout; def +let getenv_else s dft = try Sys.getenv s with Not_found -> dft + let home = (safe_getenv_def "HOME" ".") let safe_getenv n = safe_getenv_def n ("$"^n) @@ -60,6 +62,34 @@ let glob s = expand_macros true s 0 type physical_path = string type load_path = physical_path list +(* Hints to partially detects if two paths refer to the same repertory *) +let rec remove_path_dot p = + let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *) + let n = String.length curdir in + if String.length p > n && String.sub p 0 n = curdir then + remove_path_dot (String.sub p n (String.length p - n)) + else + p + +let strip_path p = + let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *) + let n = String.length cwd in + if String.length p > n && String.sub p 0 n = cwd then + remove_path_dot (String.sub p n (String.length p - n)) + else + remove_path_dot p + +let canonical_path_name p = + let current = Sys.getcwd () in + try + Sys.chdir p; + let p' = Sys.getcwd () in + Sys.chdir current; + p' + with Sys_error _ -> + (* We give up to find a canonical name and just simplify it... *) + strip_path p + (* All subdirectories, recursively *) let exists_dir dir = |