Add progress% skeleton.

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)