From 77bb7b9caac4849ebaf55d1a81d9b2058ceaa34c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 23 Jun 2023 22:47:15 +0200 Subject: [PATCH] Finish partial wrapper. --- src/progress.scm | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/src/progress.scm b/src/progress.scm index aa69406..1f66874 100644 --- a/src/progress.scm +++ b/src/progress.scm @@ -44,8 +44,6 @@ run-with-progresses% with-progresses% - run-with-partial-progress% - with-partial-progress% ) (import scheme @@ -120,6 +118,12 @@ (define *current-progress%-last-value* (make-parameter #f)) (define *current-progress%-range* (make-parameter (cons 0 1))) + ;; Special handling of coalesced progresses + (define *current-partial-progress%* (make-parameter #f)) + (define *current-total-count%* (make-parameter 1)) + (define *current-partial-progress%-number* (make-parameter #f)) + (define *current-partial-echo?* (make-parameter #f)) + ;; Unconditionally prints the current progress. (define (print-current-progress% . eols) (when (not (*progress-quiet*)) @@ -185,7 +189,11 @@ ;; Runs multiple partial progresses (define (run-with-progresses% echo? name count proc) - (proc)) + (parameterize ((*current-partial-progress%* name) + (*current-total-count%* count) + (*current-partial-echo?* echo?) + (*current-partial-progress%-number* 0)) + (proc))) ;; Syntax wrapper (define-syntax with-progresses% @@ -195,19 +203,6 @@ echo? name count (lambda () body ...))))) - ;; Adds name to list of partial progress names, uses the same - ;; parameters as run-with-progress% - (define (run-with-partial-progress% name proc) - (proc)) - - ;; Syntax wrapper - (define-syntax with-partial-progress% - (syntax-rules () - ((_ name body ...) - (run-with-partial-progress% - name - (lambda () body ...))))) - ;; If the program uses progress module, disable buffering (set-buffering-mode! (current-output-port) #:none)