}
#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;
+}
+
\f
#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
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);
}
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))
{