From 856d0ef6e7a5236da36c2fae13271e643580507d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 20 Jan 2013 20:26:59 +0100 Subject: [PATCH] `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'. --- module/ice-9/psyntax.scm | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 6c264a6..d41a0eb 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) -- 1.7.10.4