summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-29 15:51:07 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-29 15:57:24 +0100
commit04d4c8a439c035cf41296eafc23a5dfe196c24db (patch)
tree736ab6b704b451d821989fc599576673bf308ce8
parent9501d7745eca2c6c5b18f7b573c08398c3ffa4d8 (diff)
downloadpatches-04d4c8a439c035cf41296eafc23a5dfe196c24db.tar
patches-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.el1
-rwxr-xr-xguix/scripts/substitute-binary.scm16
-rw-r--r--guix/utils.scm16
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)