Change TEMPORARY-FILE-PATHNAME to allow a directory to be specified.

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index d8d78a6134b8fe11167aaa66512a65c2a73efef4..2835ef3d1cbbc0eeffa02c50d9053ef47dcc4459 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.39 1996/10/07 18:13:47 cph Exp $
+$Id: dosprm.scm,v 1.40 1998/05/31 03:19:31 cph Exp $
 
-Copyright (c) 1992-96 Massachusetts Institute of Technology
+Copyright (c) 1992-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -74,8 +74,12 @@ MIT in each case. |#
                (directory-namestring pathname)
                2))))))
 
-(define (temporary-file-pathname)
-  (let ((root (merge-pathnames "_scm_tmp" (temporary-directory-pathname))))
+(define (temporary-file-pathname #!optional directory)
+  (let ((root
+        (merge-pathnames "_scm_tmp"
+                         (if (or (default-object? directory) (not directory))
+                             (temporary-directory-pathname)
+                             (pathname-as-directory directory)))))
     (let loop ((ext 0))
       (let ((pathname (pathname-new-type root (number->string ext))))
        (if (allocate-temporary-file pathname)

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index db0d84ce89f23a099cfa80ee005f9cba4e8e8547..c19388e575d0d66d8c2a5a73dc12595ab2db2fb2 100644 (file)
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.21 1998/01/08 05:56:11 cph Exp $
+$Id: ntprm.scm,v 1.22 1998/05/31 03:19:56 cph Exp $
 
 Copyright (c) 1992-98 Massachusetts Institute of Technology
 
@@ -46,8 +46,7 @@ MIT in each case. |#
   false)
 
 (define (file-modes filename)
-  ((ucode-primitive file-modes 1)
-   (->namestring (merge-pathnames filename))))
+  ((ucode-primitive file-modes 1) (->namestring (merge-pathnames filename))))
 
 (define (set-file-modes! filename modes)
   ((ucode-primitive set-file-modes! 2)
@@ -64,9 +63,8 @@ MIT in each case. |#
 (define-integrable nt-file-mode/compressed #x800)
 
 (define (file-access filename amode)
-  ((ucode-primitive file-access 2)
-   (->namestring (merge-pathnames filename))
-   amode))
+  ((ucode-primitive file-access 2) (->namestring (merge-pathnames filename))
+                                  amode))
 
 ;; upwards compatability
 (define dos/file-access file-access)
@@ -83,8 +81,12 @@ MIT in each case. |#
                (directory-namestring pathname)
                2))))))
 
-(define (temporary-file-pathname)
-  (let ((root (merge-pathnames "_scm_tmp" (temporary-directory-pathname))))
+(define (temporary-file-pathname #!optional directory)
+  (let ((root
+        (merge-pathnames "_scm_tmp"
+                         (if (or (default-object? directory) (not directory))
+                             (temporary-directory-pathname)
+                             (pathname-as-directory directory)))))
     (let loop ((ext 0))
       (let ((pathname (pathname-new-type root (number->string ext))))
        (if (allocate-temporary-file pathname)

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index ec149688ffc029aef2e5b4c14fbbfb2773f22a14..43cdf2d436233a0341da2e9e2261dde521124329 100644 (file)
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.35 1997/11/12 22:58:53 cph Exp $
+$Id: os2prm.scm,v 1.36 1998/05/31 03:20:22 cph Exp $
 
-Copyright (c) 1994-97 Massachusetts Institute of Technology
+Copyright (c) 1994-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -162,9 +162,12 @@ MIT in each case. |#
 (define (get-environment-variable name)
   ((ucode-primitive get-environment-variable 1) name))
 
-(define (temporary-file-pathname)
+(define (temporary-file-pathname #!optional directory)
   (let ((root
-        (let ((directory (temporary-directory-pathname)))
+        (let ((directory
+               (if (or (default-object? directory) (not directory))
+                   (temporary-directory-pathname)
+                   (pathname-as-directory directory))))
           (merge-pathnames
            (if (dos/fs-long-filenames? directory)
                (string-append

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index a9bfcdbcff98c2d46fdb95e7ef079a00185d06b9..6225e1ac94a13d66b9c7ace588b6e67116d05524 100644 (file)
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.48 1997/10/22 07:26:34 cph Exp $
+$Id: unxprm.scm,v 1.49 1998/05/31 03:20:10 cph Exp $
 
-Copyright (c) 1988-97 Massachusetts Institute of Technology
+Copyright (c) 1988-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -76,14 +76,16 @@ MIT in each case. |#
 (define (file-executable? filename)
   (file-access filename 1))
 
-(define (temporary-file-pathname)
+(define (temporary-file-pathname #!optional directory)
   (let ((root-string
-        (string-append "sch"
-                       (string-pad-left (number->string (unix/current-pid))
-                                        6
-                                        #\0)
-                       "_"))
-       (directory (temporary-directory-pathname)))
+        (string-append
+         "sch"
+         (string-pad-left (number->string (unix/current-pid)) 6 #\0)
+         "_"))
+       (directory
+        (if (or (default-object? directory) (not directory))
+            (temporary-directory-pathname)
+            (pathname-as-directory directory))))
     (let loop ((ext 0))
       (let ((pathname
             (merge-pathnames (string-append root-string (number->string ext))