mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
`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.
This commit is contained in:
parent
f0b6d8c71d
commit
84f5a82517
2 changed files with 20 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue