summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-04-19 16:39:11 +0200
committerAndy Wingo <wingo@pobox.com>2010-04-19 16:39:11 +0200
commit22457d5730b2d5302c55a8f1f4c07470be975021 (patch)
tree8f5d07f95bff0346203331f203218c12f1bba045
parent0abc21094420dc00312cfa74788e5d9c1524b04a (diff)
downloadguile-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.c46
-rw-r--r--libguile/filesys.h3
-rw-r--r--libguile/fports.c31
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))
{