diff options
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: |