Progress% ranges.

members-base.scm

@@ -64,13 +64,15 @@
  (define (load-members dn . opts)
    (let ((progress? (and (not (null? opts))
 			 (car opts))))
-     (with-progress
-      progress? "Loading-members " " ok."
+     (with-progress%
+      progress? "members"
       (let* ((fss (load-members-dir dn))
+	     (tot (sub1 (length (dict-keys fss))))
+	     (prg 0)
 	     (mb0 (dict-map
 		   (lambda (symfn symlinks)
-		     (when progress?
-		       (progress-advance "."))
+		     (set! prg (add1 prg))
+		     (progress%-advance (/ prg tot))
 		     (members-dir-load-member dn
 					      symfn
 					      symlinks))

progress.scm

@@ -103,26 +103,42 @@
  (define *current-progress%* (make-parameter #f))
  (define *current-progress%-echo?* (make-parameter #f))
  (define *current-progress%-value* (make-parameter #f))
+ (define *current-progress%-range* (make-parameter (cons 0 1)))
 
  ;; Unconditionally prints the current progress.
  (define (print-current-progress%)
-   (when (*current-progress%-echo?*)
-     #f))
+   (when (and (*current-progress%*)
+	      (*current-progress%-echo?*))
+     (let* ((raw-value (*current-progress%-value*))
+	    (range (*current-progress%-range*))
+	    (value (+ (car range)
+		      (* raw-value
+			 (- (cdr range) (car range)))))
+	    (value% (* 100 value))
+	    (ivalue% (inexact->exact (round value%))))
+       (display
+	(sprintf "\r[]~A%" ivalue%)))))
 
  ;; 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))
+   (when (*current-progress%*)
+     (let ((old-value (*current-progress%-value*)))
+       (when (>= (abs (- new-value old-value)) (*progress%-step*))
+	 (*current-progress%-value* new-value)
+	 (print-current-progress%)))))
 
  ;; 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))
+		  (*current-progress%-value* 0)
+		  (*current-progress%-range* (cons 0 1)))
      (print-current-progress%)
      (let ((result (thunk)))
        (print-current-progress%)
+       (when echo?
+	 (newline))
        result)))
 
  ;; Runs named progress%