From 83cdaac011bcf57a20c13697504902b026cec2fb Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 1 Mar 2010 21:27:03 +0000
Subject: [PATCH] Allow `path-up' to take multiple paths.

svn: r18415
---
 collects/scheme/require.ss                  | 43 ++++++++++++---------
 collects/scribblings/reference/syntax.scrbl | 23 +++++------
 2 files changed, 36 insertions(+), 30 deletions(-)

diff --git a/collects/scheme/require.ss b/collects/scheme/require.ss
index 90ccbf5b08..0c8d8aea36 100644
--- a/collects/scheme/require.ss
+++ b/collects/scheme/require.ss
@@ -68,26 +68,31 @@
 
 (provide path-up)
 (define-require-syntax (path-up stx)
-  (syntax-case stx ()
-    [(_ path-stx)
-     (let ([s (syntax-e #'path-stx)]) (and (string? s) (module-path? s)))
+  (syntax-case stx ()    
+    [(_ path-stx ...)
+     (for/and ([ps (in-list (syntax->list #'(path-stx ...)))]) 
+       (let ([s (syntax-e ps)]) (and (string? s) (module-path? s))))
      (let* ([src (syntax-source stx)]
             [dirname (lambda (path)
                        (let-values ([(dir name dir?) (split-path path)]) dir))]
             [srcdir (if (and (path-string? src) (complete-path? src))
-                      (dirname src)
-                      (or (current-load-relative-directory)
-                          (current-directory)))])
-       (define path (syntax-e #'path-stx))
-       (unless (complete-path? srcdir) (error 'path-up "internal error"))
-       (parameterize ([current-directory srcdir])
-         (let loop ([dir srcdir] [path (string->path path)] [pathstr path])
-           (if (file-exists? path)
-             (datum->syntax stx pathstr stx)
-             (let ([dir (dirname dir)])
-               (if dir
-                 (loop dir (build-path 'up path)
-                       (string-append "../" pathstr))
-                 (raise-syntax-error 'path-up
-                                     "file no found in any parent directory"
-                                     stx #'path-stx)))))))]))
+                        (dirname src)
+                        (or (current-load-relative-directory)
+                            (current-directory)))])
+       (with-syntax 
+           ([(paths ...)
+             (for/list ([ps (in-list (syntax->list #'(path-stx ...)))])
+               (define path (syntax-e ps))
+               (unless (complete-path? srcdir) (error 'path-up "internal error"))
+               (parameterize ([current-directory srcdir])
+                 (let loop ([dir srcdir] [path (string->path path)] [pathstr path])
+                   (if (file-exists? path)
+                       (datum->syntax stx pathstr stx stx)
+                       (let ([dir (dirname dir)])
+                         (if dir
+                             (loop dir (build-path 'up path)
+                                   (string-append "../" pathstr))
+                             (raise-syntax-error 'path-up
+                                                 "file no found in any parent directory"
+                                                 stx ps)))))))])
+         (syntax/loc stx (combine-in paths ...))))]))
diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl
index d3cb94da3b..a80f4f198b 100644
--- a/collects/scribblings/reference/syntax.scrbl
+++ b/collects/scribblings/reference/syntax.scrbl
@@ -11,7 +11,8 @@
                      scheme/provide
                      scheme/nest
                      scheme/package
-                     scheme/splicing))
+                     scheme/splicing
+                     scheme/runtime-path))
 
 @(define require-eval (make-base-eval))
 @(define syntax-eval
@@ -1078,11 +1079,11 @@ aliens
   will get the @scheme[scheme/base] bindings that match the regexp,
   and renamed to use ``camel case.''}
 
-@defform[(path-up rel-string)]{
+@defform[(path-up rel-string ...)]{
 
-This specifies a path to a module named @scheme[rel-string] in a
-similar way to using @scheme[rel-string] directly, except that if the
-required module file is not found there, it is searched in the parent
+This specifies paths to module named by the @scheme[rel-string]s in a
+similar way to using the @scheme[rel-string]s directly, except that if the
+required module files are not found there, they are searched for in the parent
 directory (in @filepath{../@scheme[_rel-string]}), and then in
 the grand-parent directory, going all the way up to the root.  (Note
 that the usual caveats hold for a macro that depends on files that it
@@ -1092,16 +1093,16 @@ of the compiled form.)
 This form is useful in setting up a ``project environment''.  For
 example, you can write a @filepath{config.ss} file in the root
 directory of your project with:
-@verbatim[#:indent 2]{
-  #lang scheme/base
+@schememod[
+  scheme/base
   (require scheme/require-syntax (for-syntax "utils/in-here.ss"))
   ;; require form for my utilities
   (provide utils-in)
   (define-require-syntax utils-in in-here-transformer)
-}
+]
 and in @filepath{utils/in-here.ss} in the root:
-@verbatim[#:indent 2]{
-  #lang scheme/base
+@schememod[
+  scheme/base
   (require scheme/runtime-path)
   (provide in-here-transformer)
   (define-runtime-path here ".")
@@ -1111,7 +1112,7 @@ and in @filepath{utils/in-here.ss} in the root:
        (identifier? #'sym)
        (let ([path (build-path here (format "~a.ss" (syntax-e #'sym)))])
          (datum->syntax stx `(file ,(path->string path)) stx))]))
-}
+]
 Finally, you can use it via @scheme[path-up]:
 @schemeblock[
   (require scheme/require (path-up "config.ss") (utils-in foo))]