diff options
author | Andy Wingo <wingo@pobox.com> | 2010-04-19 16:39:11 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-04-19 16:39:11 +0200 |
commit | 22457d5730b2d5302c55a8f1f4c07470be975021 (patch) | |
tree | 8f5d07f95bff0346203331f203218c12f1bba045 | |
parent | 0abc21094420dc00312cfa74788e5d9c1524b04a (diff) | |
download | guile-22457d5730b2d5302c55a8f1f4c07470be975021.tar.gz |
filesystem trickery to scm_i_relativize_path in filesys.c; bugfix.
* libguile/filesys.h:
* libguile/filesys.c (scm_i_relativize_path): New function, moved here
from fports.c. Internal for now; we can make it external though if
people like its interface.
* libguile/fports.c (fport_canonicalize_filename): Move all of the
tricky bits to filesys.c. Also fixes a bug in which a delimiter wasn't
stripped.
-rw-r--r-- | libguile/filesys.c | 46 | ||||
-rw-r--r-- | libguile/filesys.h | 3 | ||||
-rw-r--r-- | libguile/fports.c | 31 |
3 files changed, 55 insertions, 25 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 0dbcc2b12..68d90d926 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1654,6 +1654,52 @@ SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0, } #undef FUNC_NAME +SCM +scm_i_relativize_path (SCM path, SCM in_path) +{ + char *str, *canon; + SCM scanon; + + str = scm_to_locale_string (path); + canon = canonicalize_file_name (str); + free (str); + + if (!canon) + return SCM_BOOL_F; + + scanon = scm_take_locale_string (canon); + + for (; scm_is_pair (in_path); in_path = scm_cdr (in_path)) + if (scm_is_true (scm_string_prefix_p (scm_car (in_path), + scanon, + SCM_UNDEFINED, SCM_UNDEFINED, + SCM_UNDEFINED, SCM_UNDEFINED))) + { + size_t len = scm_c_string_length (scm_car (in_path)); + + /* The path either has a trailing delimiter or doesn't. scanon will be + delimited by single delimiters. In the case in which the path does + not have a trailing delimiter, add one to the length to strip off the + delimiter within scanon. */ + if (!len +#ifdef __MINGW32__ + || (scm_i_string_ref (scm_car (in_path), len - 1) != '/' + && scm_i_string_ref (scm_car (in_path), len - 1) != '\\') +#else + || scm_i_string_ref (scm_car (in_path), len - 1) != '/' +#endif + ) + len++; + + if (scm_c_string_length (scanon) > len) + return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED); + else + return SCM_BOOL_F; + } + + return SCM_BOOL_F; +} + diff --git a/libguile/filesys.h b/libguile/filesys.h index a07f20496..967ce7450 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -3,7 +3,7 @@ #ifndef SCM_FILESYS_H #define SCM_FILESYS_H -/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -66,6 +66,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_basename (SCM filename, SCM suffix); SCM_API SCM scm_canonicalize_path (SCM path); +SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path); SCM_INTERNAL void scm_init_filesys (void); diff --git a/libguile/fports.c b/libguile/fports.c index 800e863d0..d541d95eb 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -281,30 +281,13 @@ fport_canonicalize_filename (SCM filename) } else if (scm_is_eq (mode, sym_relative)) { - char *str, *canon; - SCM scanon, load_path; - - str = scm_to_locale_string (filename); - canon = canonicalize_file_name (str); - free (str); - - if (!canon) - return filename; - - scanon = scm_take_locale_string (canon); - - for (load_path = scm_variable_ref - (scm_c_module_lookup (scm_the_root_module (), "%load-path")); - scm_is_pair (load_path); - load_path = scm_cdr (load_path)) - if (scm_is_true (scm_string_prefix_p (scm_car (load_path), - scanon, - SCM_UNDEFINED, SCM_UNDEFINED, - SCM_UNDEFINED, SCM_UNDEFINED))) - return scm_substring (scanon, - scm_string_length (scm_car (load_path)), - SCM_UNDEFINED); - return filename; + SCM path, rel; + + path = scm_variable_ref (scm_c_module_lookup (scm_the_root_module (), + "%load-path")); + rel = scm_i_relativize_path (filename, path); + + return scm_is_true (rel) ? rel : filename; } else if (scm_is_eq (mode, sym_absolute)) { |