Fluidize *working-directory-pathname*.
authorMatt Birkholz <puck@birchwood-abbey.net>
Mon, 11 Aug 2014 22:30:07 +0000 (15:30 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Mon, 11 Aug 2014 22:30:07 +0000 (15:30 -0700)
src/runtime/rep.scm
src/runtime/wrkdir.scm

index 2d60e6ad0cfc29b60ebed9eaae94cde130541567..c91e1704de8e1461607a25816092826499024bd8 100644 (file)
@@ -121,6 +121,7 @@ USA.
              *notification-output-port* #f
              *trace-output-port* #f
              *interaction-i/o-port* #f
+             *working-directory-pathname* (fluid *working-directory-pathname*)
              (lambda ()
                (fluid-let ((*nearest-cmdl* cmdl)
                            (dynamic-handler-frames '())
@@ -129,8 +130,6 @@ USA.
                            (standard-error-hook #f)
                            (standard-warning-hook #f)
                            (standard-breakpoint-hook #f)
-                           (*working-directory-pathname*
-                            *working-directory-pathname*)
                            (*default-pathname-defaults*
                             *default-pathname-defaults*))
                  (let loop ((message message))
index 4cba6db94f255888c2625e4446a7e1771f0d115b..a7bfe1720e80ae59c5bf8a101af2bfb7e05201d3 100644 (file)
@@ -38,14 +38,14 @@ USA.
         (pathname-simplify
          (pathname-as-directory
           ((ucode-primitive working-directory-pathname))))))
-    (set! *working-directory-pathname* pathname)
+    (set-fluid! *working-directory-pathname* pathname)
     (set! *default-pathname-defaults* pathname))
   unspecific)
 
-(define *working-directory-pathname*)
+(define *working-directory-pathname* (make-fluid #f))
 
 (define (working-directory-pathname)
-  *working-directory-pathname*)
+  (fluid *working-directory-pathname*))
 
 (define (set-working-directory-pathname! name)
   (let ((pathname (new-pathname name)))
@@ -63,18 +63,17 @@ USA.
                                  "no such directory")
                              'SET-WORKING-DIRECTORY-PATHNAME!
                              (list name)))
-    (set! *working-directory-pathname* pathname)
+    (set-fluid! *working-directory-pathname* pathname)
     (set! *default-pathname-defaults* pathname)
     (cmdl/set-default-directory (nearest-cmdl) pathname)
     pathname))
 
 (define (with-working-directory-pathname name thunk)
   (let ((pathname (new-pathname name)))
-    (fluid-let ((*working-directory-pathname* pathname)
-               (*default-pathname-defaults* pathname))
-      (thunk))))
+    (fluid-let ((*default-pathname-defaults* pathname))
+      (let-fluid *working-directory-pathname* pathname thunk))))
 
 (define (new-pathname name)
   (pathname-simplify
    (pathname-as-directory
-    (merge-pathnames name *working-directory-pathname*))))
\ No newline at end of file
+    (merge-pathnames name (fluid *working-directory-pathname*)))))
\ No newline at end of file