guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-34-gb9


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-10-34-gb9e6776
Date: Mon, 19 Apr 2010 11:33:40 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b9e67767ae7f7544563286f731b135435967fa26

The branch, master has been updated
       via  b9e67767ae7f7544563286f731b135435967fa26 (commit)
       via  69cac23837eaa3f506658696bd8692764a432e4a (commit)
       via  0157a341577223a981d912c93b568792e9dc67e3 (commit)
       via  427c73b9ca0f4f29194ba0933b2d03d51275f7c6 (commit)
      from  4597cd2027876cd857bf5e4a8a86e308296d9d2a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b9e67767ae7f7544563286f731b135435967fa26
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 19 13:34:29 2010 +0200

    compile-file gets #:canonicalization arg, defaults to 'relative
    
    * module/system/base/compile.scm (compile-file, compile-and-load): Add a
      keyword arg #:canonicalization, which defaults to 'relative. In this
      way, one might compile "../module/ice-9/boot-9.scm", but the path that
      gets residualized into the .go is "ice-9/boot-9.scm".

commit 69cac23837eaa3f506658696bd8692764a432e4a
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 19 13:18:07 2010 +0200

    %file-port-name-canonicalization is a fluid
    
    * libguile/fports.c (fport_canonicalize_filename):
      (scm_init_fports): Change %file-port-name-canonicalization to be a
      fluid.

commit 0157a341577223a981d912c93b568792e9dc67e3
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 19 13:14:43 2010 +0200

    add %file-port-name-canonicalization option
    
    * libguile/fports.c (%file-port-name-canonicalization): New global var.
      (fport_canonicalize_filename): New helper. If
      %file-port-name-canonicalization is 'absolute, then run file port
      names through canonicalize_path; if it's 'relative, then canonicalize
      the name, but strip off load paths; otherwise leave the port name
      alone.
      (scm_open_file): Use fport_canonicalize_filename.
      (scm_init_fports): Define %file-port-name-canonicalization.

commit 427c73b9ca0f4f29194ba0933b2d03d51275f7c6
Author: Andy Wingo <address@hidden>
Date:   Mon Apr 19 13:12:26 2010 +0200

    formatting fix
    
    * libguile/filesys.c (scm_canonicalize_path): Format fix.

-----------------------------------------------------------------------

Summary of changes:
 libguile/filesys.c             |    3 +-
 libguile/fports.c              |   64 +++++++++++++++++++++++++++++++++++++++-
 module/system/base/compile.scm |   41 ++++++++++++++-----------
 3 files changed, 88 insertions(+), 20 deletions(-)

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 5ca1233..0dbcc2b 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1638,7 +1638,8 @@ SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 
1, 0, 0,
             "separators (@code{/}) nor symlinks.\n\n"
             "Raises an error if any component of @var{path} does not exist.")
 #define FUNC_NAME s_scm_canonicalize_path
-{ char *str, *canon;
+{
+  char *str, *canon;
   
   SCM_VALIDATE_STRING (1, path);
 
diff --git a/libguile/fports.c b/libguile/fports.c
index 232c436..800e863 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -266,6 +266,63 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0,
 #undef FUNC_NAME
 
 
+static SCM sys_file_port_name_canonicalization;
+SCM_SYMBOL (sym_relative, "relative");
+SCM_SYMBOL (sym_absolute, "absolute");
+
+static SCM
+fport_canonicalize_filename (SCM filename)
+{
+  SCM mode = scm_fluid_ref (sys_file_port_name_canonicalization);
+
+  if (!scm_is_string (filename))
+    {
+      return 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;
+    }
+  else if (scm_is_eq (mode, sym_absolute))
+    {
+      char *str, *canon;
+  
+      str = scm_to_locale_string (filename);
+      canon = canonicalize_file_name (str);
+      free (str);
+  
+      return canon ? scm_take_locale_string (canon) : filename;
+    }
+  else
+    {
+      return filename;
+    }
+}
+
+
 /* scm_open_file
  * Return a new port open on a given file.
  *
@@ -386,7 +443,8 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
        }
     }
 
-  port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode), filename);
+  port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode),
+                             fport_canonicalize_filename (filename));
 
   scm_dynwind_end ();
 
@@ -894,6 +952,10 @@ scm_init_fports ()
   scm_c_define ("_IOLBF", scm_from_int (_IOLBF));
   scm_c_define ("_IONBF", scm_from_int (_IONBF));
 
+  sys_file_port_name_canonicalization = scm_make_fluid ();
+  scm_c_define ("%file-port-name-canonicalization",
+                sys_file_port_name_canonicalization);
+                                    
 #include "libguile/fports.x"
 }
 
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 34e097b..71f768a 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -76,6 +76,7 @@
         thunk
         (lambda () #t))))
 
+;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 (define* (call-with-output-file/atomic filename proc #:optional reference)
   (let* ((template (string-append filename ".XXXXXX"))
          (tmp (mkstemp! template)))
@@ -146,26 +147,30 @@
                        (from (current-language))
                        (to 'objcode)
                        (env (default-environment from))
-                       (opts '()))
-  (let* ((comp (or output-file (compiled-file-name file)))
-         (in (open-input-file file))
-         (enc (file-encoding in)))
-    (if enc
-        (set-port-encoding! in enc))
-    (ensure-writable-dir (dirname comp))
-    (call-with-output-file/atomic comp
-      (lambda (port)
-        ((language-printer (ensure-language to))
-         (read-and-compile in #:env env #:from from #:to to #:opts opts)
-         port))
-      file)
-    comp))
+                       (opts '())
+                       (canonicalization 'relative))
+  (with-fluids ((%file-port-name-canonicalization canonicalization))
+    (let* ((comp (or output-file (compiled-file-name file)))
+           (in (open-input-file file))
+           (enc (file-encoding in)))
+      (if enc
+          (set-port-encoding! in enc))
+      (ensure-writable-dir (dirname comp))
+      (call-with-output-file/atomic comp
+        (lambda (port)
+          ((language-printer (ensure-language to))
+           (read-and-compile in #:env env #:from from #:to to #:opts opts)
+           port))
+        file)
+      comp)))
 
 (define* (compile-and-load file #:key (from 'scheme) (to 'value)
-                           (env (current-module)) (opts '()))
-  (read-and-compile (open-input-file file)
-                    #:from from #:to to #:opts opts
-                    #:env env))
+                           (env (current-module)) (opts '())
+                           (canonicalization 'relative))
+  (with-fluids ((%file-port-name-canonicalization canonicalization))
+    (read-and-compile (open-input-file file)
+                      #:from from #:to to #:opts opts
+                      #:env env)))
 
 
 ;;;


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]