`include' relative paths relative to including file

* module/ice-9/psyntax.scm (include): Like `load', interpret relative
  paths as being relative to the file that does the `include'.

* doc/ref/api-evaluation.texi: Update docs.

2 files changed, 20 insertions, 8 deletions

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index f80d7ad7f..0ffb5014e 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1161,6 +1161,9 @@ parts of programs together at expansion-time instead of at run-time.
 Open @var{file-name}, at expansion-time, and read the Scheme forms that
 it contains, splicing them into the location of the @code{include},
 within a @code{begin}.
+
+If @var{file-name} is a relative path, it is searched for relative to
+the path that contains the file that the @code{include} for appears in.
 @end deffn
 
 If you are a C programmer, if @code{load} in Scheme is like
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 6c264a6df..d41a0eb96 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,7 +1,7 @@
 ;;;; -*-scheme-*-
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011,
-;;;;   2012 Free Software Foundation, Inc.
+;;;;   2012, 2013 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
@@ -2935,9 +2935,15 @@
 
 (define-syntax include
   (lambda (x)
+    (define (absolute-path? path)
+      (string-prefix? "/" path))
+
     (define read-file
-      (lambda (fn k)
-        (let ((p (open-input-file fn)))
+      (lambda (fn dir k)
+        (let ((p (open-input-file
+                  (if (absolute-path? fn)
+                      fn
+                      (in-vicinity dir fn)))))
           (let f ((x (read p))
                   (result '()))
             (if (eof-object? x)
@@ -2946,11 +2952,14 @@
                   (reverse result))
                 (f (read p)
                    (cons (datum->syntax k x) result)))))))
-    (syntax-case x ()
-      ((k filename)
-       (let ((fn (syntax->datum #'filename)))
-         (with-syntax (((exp ...) (read-file fn #'filename)))
-           #'(begin exp ...)))))))
+    (let* ((src (syntax-source x))
+           (file (and src (assq-ref src 'filename)))
+           (dir (and (string? file) (dirname file))))
+      (syntax-case x ()
+        ((k filename)
+         (let ((fn (syntax->datum #'filename)))
+           (with-syntax (((exp ...) (read-file fn dir #'filename)))
+             #'(begin exp ...))))))))
 
 (define-syntax include-from-path
   (lambda (x)