diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2017-10-01 19:59:55 +0300 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2017-10-01 22:16:22 +0300 |
commit | 64df08f0cfac8f7a329002afa3461fd62a4b229c (patch) | |
tree | 019909423138ceb49cdd86f1af48d366503db68f /guix/utils.scm | |
parent | b83ad3ace56c65a367e8f58c7b78323cf251b94b (diff) | |
parent | 0ef1c223071869488c35b72b7407234c11425589 (diff) | |
download | guix-patches-64df08f0cfac8f7a329002afa3461fd62a4b229c.tar guix-patches-64df08f0cfac8f7a329002afa3461fd62a4b229c.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'guix/utils.scm')
-rw-r--r-- | guix/utils.scm | 36 |
1 files changed, 33 insertions, 3 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index ab43ed4008..de4aa65319 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -33,6 +33,7 @@ #:autoload (rnrs io ports) (make-custom-binary-input-port) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module (guix memoization) + #:use-module (guix records) #:use-module ((guix build utils) #:select (dump-port mkdir-p)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module (ice-9 format) @@ -94,7 +95,13 @@ call-with-decompressed-port compressed-output-port call-with-compressed-output-port - canonical-newline-port)) + canonical-newline-port + + <progress-reporter> + progress-reporter + make-progress-reporter + progress-reporter? + call-with-progress-reporter)) ;;; @@ -700,7 +707,7 @@ failure." be determined." (syntax-case s () ((_) - (match (assq 'filename (syntax-source s)) + (match (assq 'filename (or (syntax-source s) '())) (('filename . (? string? file-name)) ;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME ;; can be relative. In that case, we try to find out at run time @@ -713,7 +720,7 @@ be determined." (dirname file-name)) (else #`(absolute-dirname #,file-name)))) - (_ + (#f #f)))))) ;; A source location. @@ -747,3 +754,26 @@ a location object." `((line . ,(and=> (location-line loc) 1-)) (column . ,(location-column loc)) (filename . ,(location-file loc)))) + + +;;; +;;; Progress reporter. +;;; + +(define-record-type* <progress-reporter> + progress-reporter make-progress-reporter progress-reporter? + (start progress-reporter-start) ; thunk + (report progress-reporter-report) ; procedure + (stop progress-reporter-stop)) ; thunk + +(define (call-with-progress-reporter reporter proc) + "Start REPORTER for progress reporting, and call @code{(@var{proc} report)} +with the resulting report procedure. When @var{proc} returns, the REPORTER is +stopped." + (match reporter + (($ <progress-reporter> start report stop) + (dynamic-wind start (lambda () (proc report)) stop)))) + +;;; Local Variables: +;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1) +;;; End: |