From 1bcade07b02a71748d14238c4061f5bfecdf82af Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Mon, 11 Aug 2014 15:30:07 -0700 Subject: [PATCH] Fluidize *working-directory-pathname*. --- src/runtime/rep.scm | 3 +-- src/runtime/wrkdir.scm | 15 +++++++-------- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/runtime/rep.scm b/src/runtime/rep.scm index 2d60e6ad0..c91e1704d 100644 --- a/src/runtime/rep.scm +++ b/src/runtime/rep.scm @@ -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)) diff --git a/src/runtime/wrkdir.scm b/src/runtime/wrkdir.scm index 4cba6db94..a7bfe1720 100644 --- a/src/runtime/wrkdir.scm +++ b/src/runtime/wrkdir.scm @@ -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 -- 2.25.1