diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-12-29 15:51:07 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-12-29 15:57:24 +0100 |
commit | 04d4c8a439c035cf41296eafc23a5dfe196c24db (patch) | |
tree | 736ab6b704b451d821989fc599576673bf308ce8 | |
parent | 9501d7745eca2c6c5b18f7b573c08398c3ffa4d8 (diff) | |
download | guix-04d4c8a439c035cf41296eafc23a5dfe196c24db.tar.gz |
Move 'with-atomic-file-output' to (guix utils).
* guix/scripts/substitute-binary.scm (with-atomic-file-output): Move to... * guix/utils.scm (with-atomic-file-output): ... here.
-rw-r--r-- | .dir-locals.el | 1 | ||||
-rwxr-xr-x | guix/scripts/substitute-binary.scm | 16 | ||||
-rw-r--r-- | guix/utils.scm | 16 |
3 files changed, 17 insertions, 16 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index bb4e964dd5..87cdaae807 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -20,6 +20,7 @@ (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) (eval . (put 'with-error-handling 'scheme-indent-function 0)) (eval . (put 'with-mutex 'scheme-indent-function 1)) + (eval . (put 'with-atomic-file-output 'scheme-indent-function 1)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1)) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 0da29d435b..901b3fb064 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -72,21 +72,6 @@ ;; How often we want to remove files corresponding to expired cache entries. (* 7 24 3600)) -(define (with-atomic-file-output file proc) - "Call PROC with an output port for the file that is going to replace FILE. -Upon success, FILE is atomically replaced by what has been written to the -output port, and PROC's result is returned." - (let* ((template (string-append file ".XXXXXX")) - (out (mkstemp! template))) - (with-throw-handler #t - (lambda () - (let ((result (proc out))) - (close out) - (rename-file template file) - result)) - (lambda (key . args) - (false-if-exception (delete-file template)))))) - ;; In Guile 2.0.9, `regexp-exec' is thread-unsafe, so work around it. ;; See <http://bugs.gnu.org/14404>. (set! regexp-exec @@ -594,7 +579,6 @@ Internal tool to substitute a pre-built binary to a local build.\n")) ;;; Local Variables: -;;; eval: (put 'with-atomic-file-output 'scheme-indent-function 1) ;;; eval: (put 'with-timeout 'scheme-indent-function 1) ;;; End: diff --git a/guix/utils.scm b/guix/utils.scm index b730340eda..04a74ee29a 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -67,6 +67,7 @@ file-extension file-sans-extension call-with-temporary-output-file + with-atomic-file-output fold2 filtered-port)) @@ -426,6 +427,21 @@ call." (false-if-exception (close out)) (false-if-exception (delete-file template)))))) +(define (with-atomic-file-output file proc) + "Call PROC with an output port for the file that is going to replace FILE. +Upon success, FILE is atomically replaced by what has been written to the +output port, and PROC's result is returned." + (let* ((template (string-append file ".XXXXXX")) + (out (mkstemp! template))) + (with-throw-handler #t + (lambda () + (let ((result (proc out))) + (close out) + (rename-file template file) + result)) + (lambda (key . args) + (false-if-exception (delete-file template)))))) + (define fold2 (case-lambda ((proc seed1 seed2 lst) |