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.

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;
+}
+
 
 
 

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);
 

libguile/fports.c

@@ -281,30 +281,13 @@ fport_canonicalize_filename (SCM filename)
     }
   else if (scm_is_eq (mode, sym_relative))
     {
-      char *str, *canon;
+      SCM path, rel;
-      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);
+      path = scm_variable_ref (scm_c_module_lookup (scm_the_root_module (),
+                                                    "%load-path"));
+      rel = scm_i_relativize_path (filename, path);
 
-      for (load_path = scm_variable_ref
+      return scm_is_true (rel) ? rel : filename;
-             (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;
     }
   else if (scm_is_eq (mode, sym_absolute))
     {