Fluidize (runtime directory) variable *expand-directory-prefixes?*.

diff --git a/src/runtime/dosdir.scm b/src/runtime/dosdir.scm
index 106038d1665fdb5d647d83c6c3feae928d130ab3..228cee84d0e3d3247da8e82519786cb87f467412 100644 (file)
--- a/src/runtime/dosdir.scm
+++ b/src/runtime/dosdir.scm
@@ -30,7 +30,10 @@ USA.
 (declare (usual-integrations))
 \f
 (define directory-read/adjust-patterns? true)
-(define *expand-directory-prefixes?* true)
+(define *expand-directory-prefixes?*)
+
+(define (initialize-package!)
+  (set! *expand-directory-prefixes?* (make-fluid true)))
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
@@ -53,8 +56,9 @@ USA.
             (merge-pathnames pathname directory-path))
           (let ((pathnames
                  (let ((fnames (generate-directory-pathnames directory-path)))
-                   (fluid-let ((*expand-directory-prefixes?* false))
-                     (map ->pathname fnames)))))
+                   (let-fluid *expand-directory-prefixes?* false
+                     (lambda ()
+                       (map ->pathname fnames))))))
             (if (and (eq? (pathname-name pattern) 'WILD)
                      (eq? (pathname-type pattern) 'WILD))
                 pathnames

diff --git a/src/runtime/dospth.scm b/src/runtime/dospth.scm
index f2b81ee848bd6c9e8d79fc3019c9f21f78735e62..801708e619c0f646e2147ba6643f3ebb6f7e1302 100644 (file)
--- a/src/runtime/dospth.scm
+++ b/src/runtime/dospth.scm
@@ -113,7 +113,7 @@ USA.
                     (cdr components))))))
     (let ((end (string-length string)))
       (if (or (= 0 end)
-             (not *expand-directory-prefixes?*))
+             (not (fluid *expand-directory-prefixes?*)))
          components
          (case (string-ref string 0)
            ((#\$)

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 6f6857fadf30a2a073bf7799f033817b27bbdc76..5fbf25630894e99c1247caed46c8d6795c02307e 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -494,6 +494,7 @@ USA.
    (RUNTIME PATHNAME UNIX)
    (RUNTIME PATHNAME DOS)
    (RUNTIME PATHNAME)
+   (RUNTIME DIRECTORY)
    (RUNTIME WORKING-DIRECTORY)
    (RUNTIME LOAD)
    (RUNTIME SIMPLE-FILE-OPS)

diff --git a/src/runtime/ntdir.scm b/src/runtime/ntdir.scm
index 139616548e4e5576b2501b2093c11f4ab4c9c7bb..799cfcccc15d721c5f509e79f89c5055010dcd67 100644 (file)
--- a/src/runtime/ntdir.scm
+++ b/src/runtime/ntdir.scm
@@ -29,7 +29,10 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define *expand-directory-prefixes?* #t)
+(define *expand-directory-prefixes?*)
+
+(define (initialize-package!)
+  (set! *expand-directory-prefixes?* (make-fluid #t)))
 
 (define (directory-read pattern #!optional sort? full?)
   (let ((sort? (if (default-object? sort?) #t sort?))
@@ -54,8 +57,9 @@ USA.
           (lambda (pathname)
             (merge-pathnames pathname directory-path)))
         (let ((fnames (generate-directory-pathnames pattern)))
-          (fluid-let ((*expand-directory-prefixes?* #f))
-            (map ->pathname fnames))))))
+          (let-fluid *expand-directory-prefixes?* #f
+            (lambda ()
+              (map ->pathname fnames)))))))
 
 (define (generate-directory-pathnames pathname)
   (let ((channel (directory-channel-open (->namestring pathname))))
@@ -74,9 +78,10 @@ USA.
             (cons (merge-pathnames (car entry) directory-path)
                   (cdr entry))))
         (let ((entries (generate-directory-entries pattern)))
-          (fluid-let ((*expand-directory-prefixes?* #f))
-            (map (lambda (entry) (cons (->pathname (car entry)) (cdr entry)))
-                 entries))))))
+          (let-fluid *expand-directory-prefixes?* #f
+            (lambda ()
+              (map (lambda (entry) (cons (->pathname (car entry)) (cdr entry)))
+                   entries)))))))
 
 (define (generate-directory-entries pathname)
   (let ((channel (directory-channel-open (->namestring pathname))))

diff --git a/src/runtime/os2dir.scm b/src/runtime/os2dir.scm
index cb5e9f224813506c8a1051df0751164c1a587b6d..66f7edd6052e3f50279641057d0a0c0cf2d04a31 100644 (file)
--- a/src/runtime/os2dir.scm
+++ b/src/runtime/os2dir.scm
@@ -29,7 +29,10 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define *expand-directory-prefixes?* #t)
+(define *expand-directory-prefixes?*)
+
+(define (initialize-package!)
+  (set! *expand-directory-prefixes?* (make-fluid #t)))
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) #t sort?)
@@ -42,8 +45,9 @@ USA.
           (lambda (pathname)
             (merge-pathnames pathname directory-path)))
         (let ((fnames (generate-directory-pathnames pattern)))
-          (fluid-let ((*expand-directory-prefixes?* #f))
-            (map ->pathname fnames))))))
+          (let-fluid *expand-directory-prefixes?* #f
+            (lambda ()
+              (map ->pathname fnames)))))))
 
 (define (generate-directory-pathnames pathname)
   (let ((channel (directory-channel-open (->namestring pathname))))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 47aade8a68a864a501ac66d1aff2280afce56987..a3ddc5176edbac972f929d6f7c902123c03d4901 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1614,7 +1614,8 @@ USA.
   (export (runtime pathname)
          *expand-directory-prefixes?*)
   (export ()
-         directory-read))
+         directory-read)
+  (initialization (initialize-package!)))
 
 (os-type-case
  ((unix)
@@ -6063,4 +6064,4 @@ USA.
          stack-sampler:debug-internal-errors?
          stack-sampler:show-expressions?
          with-stack-sampling)
-  (initialization (initialize-package!)))
\ No newline at end of file
+  (initialization (initialize-package!)))

diff --git a/src/runtime/unxdir.scm b/src/runtime/unxdir.scm
index a61fed0cd24385c539a09e2fd2ab7ec77558a63e..56c5bddb5c2d1e28c285d91bc7e27cc5c2718991 100644 (file)
--- a/src/runtime/unxdir.scm
+++ b/src/runtime/unxdir.scm
@@ -29,7 +29,10 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define *expand-directory-prefixes?* true)
+(define *expand-directory-prefixes?*)
+
+(define (initialize-package!)
+  (set! *expand-directory-prefixes?* (make-fluid true)))
 
 (define (directory-read pattern #!optional sort?)
   (if (if (default-object? sort?) true sort?)
@@ -52,8 +55,9 @@ USA.
             (merge-pathnames pathname directory-path))
           (let ((pathnames
                  (let ((fnames (generate-directory-pathnames directory-path)))
-                   (fluid-let ((*expand-directory-prefixes?* false))
-                     (map ->pathname fnames)))))
+                   (let-fluid *expand-directory-prefixes?* false
+                     (lambda ()
+                       (map ->pathname fnames))))))
             (if (and (eq? (pathname-name pattern) 'WILD)
                      (eq? (pathname-type pattern) 'WILD))
                 pathnames

diff --git a/src/runtime/unxpth.scm b/src/runtime/unxpth.scm
index 6cb79660cf61a06ed409cd47b1724ebcbafd1834..b0f873943128c465ecb729b8aad009f34bf8e8d0 100644 (file)
--- a/src/runtime/unxpth.scm
+++ b/src/runtime/unxpth.scm
@@ -82,7 +82,7 @@ USA.
                   (cdr components)))))
     (let ((end (string-length string)))
       (if (or (= 0 end)
-             (not *expand-directory-prefixes?*))
+             (not (fluid *expand-directory-prefixes?*)))
          components
          (case (string-ref string 0)
            ((#\$)