Add with-temporary-file.

This is basically call-with-temporary-file-pathname except it takes
the pathname and does not touch the file (allowing e.g. open-
exclusive-output-file to create it).  Also, optimize deallocate-
temporary-file for the case when the temporary file is already gone
(e.g. renamed into place).

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5082e5c46e7ce2c46ec0ddb930e9d4a106e4ddda..95bc2391364cc99508c1dcde90c15d7432c274c4 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -675,6 +675,7 @@ USA.
          string->mime-type
          string-is-mime-token?
          string-is-mime-type?
+         with-temporary-file
          write-mime-type)
   (initialization (initialize-package!)))
 

diff --git a/src/runtime/sfile.scm b/src/runtime/sfile.scm
index 619ed9888b6fe24708babc13b58efe364928c372..0bca2af51b750e62dfcab38d2ac6059175d8c1f1 100644 (file)
--- a/src/runtime/sfile.scm
+++ b/src/runtime/sfile.scm
@@ -206,6 +206,17 @@ USA.
      (lambda () (receiver pathname))
      (lambda () (deallocate-temporary-file pathname)))))
 
+(define (with-temporary-file pathname thunk)
+  (dynamic-wind
+   (lambda ()
+     (let ((updater (fixed-objects-updater 'files-to-delete))
+          (string (string-for-primitive (->namestring pathname))))
+       (with-files-to-delete-locked
+       (lambda ()
+         (updater (lambda (filenames) (cons string filenames)))))))
+   thunk
+   (lambda () (deallocate-temporary-file pathname))))
+
 (define files-to-delete-mutex)
 
 (define (with-files-to-delete-locked thunk)
@@ -226,7 +237,8 @@ USA.
                   #t)))))))
 
 (define (deallocate-temporary-file pathname)
-  (delete-file-no-errors pathname)
+  (if (file-exists? pathname)
+      (delete-file-no-errors pathname))
   (let ((updater (fixed-objects-updater 'files-to-delete))
        (filename (string-for-primitive (->namestring pathname))))
     (with-files-to-delete-locked