diff --git a/progress.scm b/progress.scm index edec25b..fc74044 100644 --- a/progress.scm +++ b/progress.scm @@ -33,6 +33,12 @@ with-progress run-progress-break progress-break + + *progress%-width* + *progress%-step* + run-with-progress% + with-progress% + progress%-advance ) (import scheme @@ -87,6 +93,46 @@ ((_ body ...) (run-progress-break (lambda () body ...))))) + ;; Progress% visual configuration + (define *progress%-width* (make-parameter 40)) + + ;; Progress% time step configuration + (define *progress%-step* (make-parameter 0.01)) + + ;; Tracking the progress via set of parameters + (define *current-progress%* (make-parameter #f)) + (define *current-progress%-echo?* (make-parameter #f)) + (define *current-progress%-value* (make-parameter #f)) + + ;; Unconditionally prints the current progress. + (define (print-current-progress%) + (when (*current-progress%-echo?*) + #f)) + + ;; If the new value is different-enough from the current one, updates + ;; it and re-prints the progress% + (define (progress%-advance new-value) + (let ((old-value (*current-progress%-value*))) + #f)) + + ;; Procedure realizing the actual progress tracking + (define (run-with-progress% echo? name thunk) + (parameterize ((*current-progress%* name) + (*current-progress%-echo?* echo?) + (*current-progress%-value* 0)) + (print-current-progress%) + (let ((result (thunk))) + (print-current-progress%) + result))) + + ;; Runs named progress% + (define-syntax with-progress% + (syntax-rules () + ((_ echo? name body ...) + (run-with-progress% + echo? name + (lambda () body ...))))) + ;; If the program uses progress module, disable buffering (set-buffering-mode! (current-output-port) #:none)