From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: `include' relative to current file Date: Sun, 20 Jan 2013 20:28:21 +0100 Message-ID: <87txqbac2y.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1358710109 9507 80.91.229.3 (20 Jan 2013 19:28:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 20 Jan 2013 19:28:29 +0000 (UTC) To: guile-devel Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Jan 20 20:28:48 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Tx0ZU-0004YE-7g for guile-devel@m.gmane.org; Sun, 20 Jan 2013 20:28:48 +0100 Original-Received: from localhost ([::1]:33222 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Tx0ZD-0001IV-37 for guile-devel@m.gmane.org; Sun, 20 Jan 2013 14:28:31 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:32923) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Tx0ZA-0001Ct-76 for guile-devel@gnu.org; Sun, 20 Jan 2013 14:28:29 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Tx0Z8-0007zY-Oy for guile-devel@gnu.org; Sun, 20 Jan 2013 14:28:28 -0500 Original-Received: from a-pb-sasl-quonix.pobox.com ([208.72.237.25]:60485 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Tx0Z8-0007zP-Jp for guile-devel@gnu.org; Sun, 20 Jan 2013 14:28:26 -0500 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 92C7AB3B4 for ; Sun, 20 Jan 2013 14:28:25 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to :subject:date:message-id:mime-version:content-type; s=sasl; bh=O SAeQTY+MM2JM5wdWTOE1QjDkQI=; b=ooPH/1Sjzq2NfBCSUVNgBJEkaFGeRHhDs mSJGyesoQUEIFiwRjvGzo3LjhZ6WZResRGjdC9xFZNGPy2WGJX4QXHpHgh36ojnt 1jN6gKNSvQyVFhvvaKzTpMdojtAlgyV5Pbo/Iud2mOB7VsGpT3AFL/YnbErWRlNS WuBqtktmjw= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:subject :date:message-id:mime-version:content-type; q=dns; s=sasl; b=Pmh OFbuv6Wt93UmAk+S5OD+XO7hzuTRHGXtZXChK5Vql9E0//ME5RHpmvAm/hegxIbS luEDS48F+xtHXYx9sJtPq3DvjaiV7a7lJVqu7v+ZKbCJ2uuDSw1F7Wtuj680VhAP 4BqHC4uDkhkJC7AAFY9BE2iRbPihvaghbBXXg/6A= Original-Received: from a-pb-sasl-quonix.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 8BFD7B3B3 for ; Sun, 20 Jan 2013 14:28:25 -0500 (EST) Original-Received: from badger (unknown [88.160.190.192]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTPSA id 02D16B3B2 for ; Sun, 20 Jan 2013 14:28:24 -0500 (EST) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.2 (gnu/linux) X-Pobox-Relay-ID: 8F334C9A-6337-11E2-87E4-0A4F0E5B5709-02397024!a-pb-sasl-quonix.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 X-Received-From: 208.72.237.25 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15477 Archived-At: --=-=-= Content-Type: text/plain Thoughts on this patch? It fixes SLIB in CVS, which now does an (include "guile-2.init") in the Guile 2.x case. To test, check out Slib from CVS, then (load "/path/to/slib/guile.init"). Andy --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-include-relative-paths-relative-to-including-file.patch >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 --=-=-= Content-Type: text/plain -- http://wingolog.org/ --=-=-=--