brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Finish partial wrapper.

Browse source
This commit is contained in:
Dominik Pantůček 2023-06-23 22:47:15 +02:00
parent c808852fb2
commit 77bb7b9caa
1 changed files with 11 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

27
src/progress.scm
View file

@ -44,8 +44,6 @@
run-with-progresses% run-with-progresses%
with-progresses% with-progresses%
run-with-partial-progress%
with-partial-progress%
) )
(import scheme (import scheme
@ -120,6 +118,12 @@
(define *current-progress%-last-value* (make-parameter #f)) (define *current-progress%-last-value* (make-parameter #f))
(define *current-progress%-range* (make-parameter (cons 0 1))) (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. ;; Unconditionally prints the current progress.
(define (print-current-progress% . eols) (define (print-current-progress% . eols)
(when (not (*progress-quiet*)) (when (not (*progress-quiet*))
@ -185,7 +189,11 @@
;; Runs multiple partial progresses ;; Runs multiple partial progresses
(define (run-with-progresses% echo? name count proc) (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 ;; Syntax wrapper
(define-syntax with-progresses% (define-syntax with-progresses%
@ -195,19 +203,6 @@
echo? name count echo? name count
(lambda () body ...))))) (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 ;; If the program uses progress module, disable buffering
(set-buffering-mode! (current-output-port) #:none) (set-buffering-mode! (current-output-port) #:none)