From 8cec672f9c109dd65dba9ff0d430deea7b8deb2f Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 3 Nov 1992 22:42:56 +0000 Subject: [PATCH] Prevent directory expansion while reading directories. --- v7/src/runtime/dosdir.scm | 8 +++++--- v7/src/runtime/dospth.scm | 15 ++++++++------- v7/src/runtime/unxdir.scm | 11 +++++++---- v7/src/runtime/unxpth.scm | 5 +++-- 4 files changed, 23 insertions(+), 16 deletions(-) diff --git a/v7/src/runtime/dosdir.scm b/v7/src/runtime/dosdir.scm index 2515c68b2..45a929d9c 100644 --- 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)) (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 db08ccc40..3a1e283ee 100644 --- 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 bff51d86f..692c801bc 100644 --- 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)) +(define *expand-directory-prefixes?* true) + (define (directory-read pattern #!optional sort?) (if (if (default-object? sort?) true sort?) (sort (directory-read-nosort pattern) pathnamepathname - (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 2d911262f..ef9c9dd05 100644 --- 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) ((#\$) -- 2.25.1