Finish partial wrapper.

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)