Prevent directory expansion while reading directories.

diff --git a/v7/src/runtime/dosdir.scm b/v7/src/runtime/dosdir.scm
index 2515c68b28c8e7814db197515779890559c45686..45a929d9c43b158a5650f2c67a00801e097fd0dc 100644 (file)
--- a/v7/src/runtime/dosdir.scm
+++ b/v7/src/runtime/dosdir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dosdir.scm,v 1.5 1992/08/28 16:06:37 jinx Exp $
+$Id: dosdir.scm,v 1.6 1992/11/03 22:42:29 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -38,6 +38,7 @@ MIT in each case. |#
 (declare (usual-integrations))
 \f
 (define directory-read/adjust-patterns? true)
+(define *expand-directory-prefixes?* true)
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
@@ -61,8 +62,9 @@ MIT in each case. |#
       (map (lambda (pathname)
             (merge-pathnames pathname directory-path))
           (let ((pathnames
-                 (map ->pathname
-                      (generate-directory-pathnames directory-path))))
+                 (let ((fnames (generate-directory-pathnames directory-path)))
+                   (fluid-let ((*expand-directory-prefixes?* false))
+                     (map ->pathname fnames)))))
             (if (and (eq? (pathname-name pattern) 'WILD)
                      (eq? (pathname-type pattern) 'WILD))
                 pathnames

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index db08ccc40499c27f7bb59ee6dc471e260ab8d715..3a1e283eeb6fdcbf709caf8f922eb579faa31aa1 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dospth.scm,v 1.16 1992/10/08 18:20:25 jinx Exp $
+$Id: dospth.scm,v 1.17 1992/11/03 22:42:35 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -129,15 +129,16 @@ MIT in each case. |#
               component)))))
 
 (define (expand-directory-prefixes string)
-  (if (string-null? string)
+  (if (or (string-null? string)
+         (not *expand-directory-prefixes?*))
       (list string)
       (case (string-ref string 0)
        ((#\$)
-        (let ((name (string-tail string 1)))
-          (let ((value (get-environment-variable name)))
-            (if (not value)
-                (error "Unbound environment variable:" name))
-            (string-components value sub-directory-delimiters))))
+        (let* ((name (string-tail string 1))
+               (value (get-environment-variable name)))
+          (if (not value)
+              (list string)
+              (string-components value sub-directory-delimiters))))
        ((#\~)
         (let ((user-name (substring string 1 (string-length string))))
           (string-components

diff --git a/v7/src/runtime/unxdir.scm b/v7/src/runtime/unxdir.scm
index bff51d86f60b85948f13ea59ccb9fbac8a146b92..692c801bcf4ca532eb4f3b2a477750cd9e310218 100644 (file)
--- a/v7/src/runtime/unxdir.scm
+++ b/v7/src/runtime/unxdir.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxdir.scm,v 14.9 1992/02/08 15:08:44 cph Exp $
+$Id: unxdir.scm,v 14.10 1992/11/03 22:42:56 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -37,6 +37,8 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
+(define *expand-directory-prefixes?* true)
+
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
       (sort (directory-read-nosort pattern) pathname<?)
@@ -59,8 +61,9 @@ MIT in each case. |#
       (map (lambda (pathname)
             (merge-pathnames pathname directory-path))
           (let ((pathnames
-                 (map ->pathname
-                      (generate-directory-pathnames directory-path))))
+                 (let ((fnames (generate-directory-pathnames directory-path)))
+                   (fluid-let ((*expand-directory-prefixes?* false))
+                     (map ->pathname fnames)))))
             (if (and (eq? (pathname-name pattern) 'WILD)
                      (eq? (pathname-type pattern) 'WILD))
                 pathnames

diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 2d911262f33d7d9c159da4fd3a7c9f30854a6367..ef9c9dd05496bb4333d96a2754740964e3b15e85 100644 (file)
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxpth.scm,v 14.12 1992/08/12 08:42:46 jinx Exp $
+$Id: unxpth.scm,v 14.13 1992/11/03 22:42:43 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -98,7 +98,8 @@ MIT in each case. |#
       component))
 
 (define (expand-directory-prefixes string)
-  (if (string-null? string)
+  (if (or (string-null? string)
+         (not *expand-directory-prefixes?*))
       (list string)
       (case (string-ref string 0)
        ((#\$)