Make WORKING-DIRECTORY-PATHNAME and *DEFAULT-PATHNAME-DEFAULTS* be

different for each CMDL.  Change SET-WORKING-DIRECTORY-PATHNAME! so
that it only changes the working directory of the Scheme process if
the CMDL is the initial top-level REPL.

The end result of these changes is to make the working directory of an
Edwin inferior REPL buffer be independent of the global working
directory.

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index e63502d312aebcf11e87e41cccfec8322484834f..b5c9f551779ca1d53a279e36a53a6c54f64ed5f5 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rep.scm,v 14.30 1993/01/18 05:21:57 cph Exp $
+$Id: rep.scm,v 14.31 1993/07/31 03:11:54 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -58,16 +58,23 @@ MIT in each case. |#
                            user-initial-environment
                            user-initial-syntax-table
                            false
-                           '()
+                           `((SET-DEFAULT-DIRECTORY
+                              ,top-level-repl/set-default-directory))
                            user-initial-prompt)
                 (cmdl-message/strings "Cold load finished")))))
 
 (define root-continuation)
+
+(define (top-level-repl/set-default-directory cmdl pathname)
+  cmdl
+  ((ucode-primitive set-working-directory-pathname! 1)
+   (->namestring pathname)))
 \f
 ;;;; Command Loops
 
 (define cmdl-rtd
-  (make-record-type "cmdl" '(LEVEL PARENT PORT DRIVER STATE OPERATIONS)))
+  (make-record-type "cmdl"
+                   '(LEVEL PARENT PORT DRIVER STATE OPERATIONS PROPERTIES)))
 
 (define cmdl? (record-predicate cmdl-rtd))
 (define cmdl/level (record-accessor cmdl-rtd 'LEVEL))
@@ -78,11 +85,13 @@ MIT in each case. |#
 (define cmdl/state (record-accessor cmdl-rtd 'STATE))
 (define set-cmdl/state! (record-updater cmdl-rtd 'STATE))
 (define cmdl/operations (record-accessor cmdl-rtd 'OPERATIONS))
+(define cmdl/properties (record-accessor cmdl-rtd 'PROPERTIES))
 
 (define make-cmdl
   (let ((constructor
-        (record-constructor cmdl-rtd
-                            '(LEVEL PARENT PORT DRIVER STATE OPERATIONS))))
+        (record-constructor
+         cmdl-rtd
+         '(LEVEL PARENT PORT DRIVER STATE OPERATIONS PROPERTIES))))
     (lambda (parent port driver state operations)
       (if (not (or (false? parent) (cmdl? parent)))
          (error:wrong-type-argument parent "cmdl" 'MAKE-CMDL))
@@ -91,7 +100,8 @@ MIT in each case. |#
                   port
                   driver
                   state
-                  (parse-operations-list operations 'MAKE-CMDL)))))
+                  (parse-operations-list operations 'MAKE-CMDL)
+                  (make-1d-table)))))
 
 (define (push-cmdl driver state operations)
   (let ((parent (nearest-cmdl)))
@@ -102,6 +112,12 @@ MIT in each case. |#
     (if parent
        (cmdl/base parent)
        cmdl)))
+
+(define (cmdl/set-default-directory cmdl pathname)
+  (let ((operation (cmdl/local-operation cmdl 'SET-DEFAULT-DIRECTORY)))
+    (if operation
+       (operation cmdl pathname)))
+  (port/set-default-directory (cmdl/port cmdl) pathname))
 \f
 (define (cmdl/start cmdl message)
   (let ((operation
@@ -113,7 +129,13 @@ MIT in each case. |#
           (fluid-let ((*nearest-cmdl* cmdl)
                       (dynamic-handler-frames '())
                       (*bound-restarts*
-                       (if (cmdl/parent cmdl) *bound-restarts* '())))
+                       (if (cmdl/parent cmdl) *bound-restarts* '()))
+                      (standard-error-hook false)
+                      (standard-warning-hook false)
+                      (*working-directory-pathname*
+                       *working-directory-pathname*)
+                      (*default-pathname-defaults*
+                       *default-pathname-defaults*))
             (let loop ((message message))
               (loop
                (call-with-current-continuation
@@ -325,6 +347,9 @@ MIT in each case. |#
             (append (if (default-object? operations) '() operations)
                     default-repl-operations)))
 
+(define default-repl-operations
+  `((START-CHILD ,(lambda (cmdl thunk) cmdl (with-history-disabled thunk)))))
+
 (define (push-repl environment syntax-table
                   #!optional condition operations prompt)
   (let ((parent (nearest-cmdl)))
@@ -335,31 +360,29 @@ MIT in each case. |#
               (if (default-object? condition) false condition)
               (if (default-object? operations) '() operations)
               (if (default-object? prompt) 'INHERIT prompt))))
-
+\f
 (define (repl-driver repl)
   (let ((reader-history (repl/reader-history repl))
        (printer-history (repl/printer-history repl)))
     (port/set-default-environment (cmdl/port repl) (repl/environment repl))
     (port/set-default-syntax-table (cmdl/port repl) (repl/syntax-table repl))
-    (fluid-let ((standard-error-hook false)
-               (standard-warning-hook false))
-      (do () (false)
-       (hook/repl-write
-        repl
-        (let ((value
-               (hook/repl-eval
-                (let ((s-expression
-                       (hook/repl-prompt
-                        (string-append (number->string (cmdl/level repl))
-                                       " "
-                                       (repl/prompt repl))
-                        (cmdl/port repl))))
-                  (repl-history/record! reader-history s-expression)
-                  s-expression)
-                (repl/environment repl)
-                (repl/syntax-table repl))))
-          (repl-history/record! printer-history value)
-          value))))))
+    (do () (false)
+      (hook/repl-write
+       repl
+       (let ((value
+             (hook/repl-eval
+              (let ((s-expression
+                     (hook/repl-prompt
+                      (string-append (number->string (cmdl/level repl))
+                                     " "
+                                     (repl/prompt repl))
+                      (cmdl/port repl))))
+                (repl-history/record! reader-history s-expression)
+                s-expression)
+              (repl/environment repl)
+              (repl/syntax-table repl))))
+        (repl-history/record! printer-history value)
+        value)))))
 
 (define hook/repl-prompt)
 (define (default/repl-prompt prompt port)
@@ -379,9 +402,6 @@ MIT in each case. |#
                          (not (interned-symbol? object))
                          (not (number? object))
                          (object-hash object))))
-
-(define default-repl-operations
-  `((START-CHILD ,(lambda (cmdl thunk) cmdl (with-history-disabled thunk)))))
 \f
 (define (repl/start repl #!optional message)
   (cmdl/start repl
@@ -442,10 +462,11 @@ MIT in each case. |#
        (if (not (interpreter-environment? environment))
            (begin
              (fresh-line port)
-             (write-string ";Warning! this environment is a compiled-code environment:
+             (write-string
+              ";Warning! this environment is a compiled-code environment:
 ; Assignments to most compiled-code bindings are prohibited,
 ; as are certain other environment operations."
-                           port)))
+              port)))
        (let ((package (environment->package environment)))
          (if package
              (begin

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index cbf0e6a0f092fa4f80896b5b495e3338422902f2..1b0bfa99d4742b0b2b408ad2316757635c9bf6b3 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.187 1993/07/28 03:42:14 cph Exp $
+$Id: runtime.pkg,v 14.188 1993/07/31 03:11:55 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -221,7 +221,6 @@ MIT in each case. |#
   (files "infstr" "infutl")
   (parent ())
   (export ()
-         compiled-code-block/filename
          compiled-entry/block
          compiled-entry/dbg-object
          compiled-entry/filename
@@ -1782,11 +1781,12 @@ MIT in each case. |#
          cmdl-message/strings
          cmdl/base
          cmdl/driver
+         cmdl/level
          cmdl/operation
          cmdl/operation-names
-         cmdl/port
-         cmdl/level
          cmdl/parent
+         cmdl/port
+         cmdl/properties
          cmdl/start
          cmdl/state
          cmdl?
@@ -1847,6 +1847,8 @@ MIT in each case. |#
          hook/repl-eval)
   (export (runtime debugger)
          write-restarts)
+  (export (runtime working-directory)
+         cmdl/set-default-directory)
   (initialization (initialize-package!)))
 
 (define-package (runtime save/restore)
@@ -2423,6 +2425,8 @@ MIT in each case. |#
          set-working-directory-pathname!
          with-working-directory-pathname
          working-directory-pathname)
+  (export (runtime rep)
+         *working-directory-pathname*)
   (initialization (initialize-package!)))
 
 (define-package (runtime user-interface)
@@ -2438,7 +2442,7 @@ MIT in each case. |#
          port/set-default-environment
          port/set-default-syntax-table
          port/write-result)
-  (export (runtime working-directory)
+  (export (runtime rep)
          port/set-default-directory)
   (export (runtime debugger-command-loop)
          port/debugger-failure
@@ -2455,7 +2459,6 @@ MIT in each case. |#
   (files "thread")
   (parent ())
   (export ()
-         allow-thread-event-delivery
          block-thread-events
          condition-type:thread-dead
          condition-type:thread-deadlock

diff --git a/v7/src/runtime/wrkdir.scm b/v7/src/runtime/wrkdir.scm
index 483afc94e14989f9c64f9b48bfe1057ffd134064..1fb66a58540dea026a8984fdd394b55f33e1f1d6 100644 (file)
--- a/v7/src/runtime/wrkdir.scm
+++ b/v7/src/runtime/wrkdir.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/wrkdir.scm,v 14.6 1992/02/08 15:08:47 cph Exp $
+$Id: wrkdir.scm,v 14.7 1993/07/31 03:11:56 cph Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -65,9 +65,7 @@ MIT in each case. |#
       (set! *working-directory-pathname* pathname)
       (set! *default-pathname-defaults*
            (merge-pathnames pathname *default-pathname-defaults*))
-      ((ucode-primitive set-working-directory-pathname! 1)
-       (->namestring pathname))
-      (port/set-default-directory (nearest-cmdl/port) pathname)
+      (cmdl/set-default-directory (nearest-cmdl) pathname)
       pathname)))
 
 (define (with-working-directory-pathname name thunk)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index cbf0e6a0f092fa4f80896b5b495e3338422902f2..1b0bfa99d4742b0b2b408ad2316757635c9bf6b3 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.187 1993/07/28 03:42:14 cph Exp $
+$Id: runtime.pkg,v 14.188 1993/07/31 03:11:55 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -221,7 +221,6 @@ MIT in each case. |#
   (files "infstr" "infutl")
   (parent ())
   (export ()
-         compiled-code-block/filename
          compiled-entry/block
          compiled-entry/dbg-object
          compiled-entry/filename
@@ -1782,11 +1781,12 @@ MIT in each case. |#
          cmdl-message/strings
          cmdl/base
          cmdl/driver
+         cmdl/level
          cmdl/operation
          cmdl/operation-names
-         cmdl/port
-         cmdl/level
          cmdl/parent
+         cmdl/port
+         cmdl/properties
          cmdl/start
          cmdl/state
          cmdl?
@@ -1847,6 +1847,8 @@ MIT in each case. |#
          hook/repl-eval)
   (export (runtime debugger)
          write-restarts)
+  (export (runtime working-directory)
+         cmdl/set-default-directory)
   (initialization (initialize-package!)))
 
 (define-package (runtime save/restore)
@@ -2423,6 +2425,8 @@ MIT in each case. |#
          set-working-directory-pathname!
          with-working-directory-pathname
          working-directory-pathname)
+  (export (runtime rep)
+         *working-directory-pathname*)
   (initialization (initialize-package!)))
 
 (define-package (runtime user-interface)
@@ -2438,7 +2442,7 @@ MIT in each case. |#
          port/set-default-environment
          port/set-default-syntax-table
          port/write-result)
-  (export (runtime working-directory)
+  (export (runtime rep)
          port/set-default-directory)
   (export (runtime debugger-command-loop)
          port/debugger-failure
@@ -2455,7 +2459,6 @@ MIT in each case. |#
   (files "thread")
   (parent ())
   (export ()
-         allow-thread-event-delivery
          block-thread-events
          condition-type:thread-dead
          condition-type:thread-deadlock