From 3b1cae64c9c9730a4ee0595433d1482edc09f7fc Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 24 Mar 2017 11:35:45 -0700 Subject: [PATCH] Add with-temporary-file (for tempfiles that are renamed into place). --- src/runtime/runtime.pkg | 1 + src/runtime/sfile.scm | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 886377c61..a2e62c664 100644 --- 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 619ed9888..0bca2af51 100644 --- 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 -- 2.25.1