From 3cb50a240c86206f532f3c690ad200ac16aa3053 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 31 May 1998 03:20:22 +0000 Subject: [PATCH] Change TEMPORARY-FILE-PATHNAME to allow a directory to be specified. --- v7/src/runtime/dosprm.scm | 12 ++++++++---- v7/src/runtime/ntprm.scm | 18 ++++++++++-------- v7/src/runtime/os2prm.scm | 11 +++++++---- v7/src/runtime/unxprm.scm | 20 +++++++++++--------- 4 files changed, 36 insertions(+), 25 deletions(-) diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm index d8d78a613..2835ef3d1 100644 --- 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 db0d84ce8..c19388e57 100644 --- 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 ec149688f..43cdf2d43 100644 --- 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 a9bfcdbcf..6225e1ac9 100644 --- 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)) -- 2.25.1