Add with-temporary-file (for tempfiles that are renamed into place).

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 886377c61292099f50a1cbd3a5f0c8e4f596855a..a2e62c6647badcdd9755f41d9152f58021f4829d 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -677,6 +677,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