Measure progress time.

src/progress.scm

@@ -44,7 +44,8 @@
  (import scheme
 	 (chicken base)
 	 (chicken format)
-	 (chicken port))
+	 (chicken port)
+	 (chicken time))
 
  ;; Parameterized current progress string
  (define *current-progress* (make-parameter #f))
@@ -107,7 +108,10 @@
  (define *current-progress%-range* (make-parameter (cons 0 1)))
 
  ;; Unconditionally prints the current progress.
- (define (print-current-progress%)
+ (define (print-current-progress% . eols)
+   (let ((eol (if (null? eols)
+		  ""
+		  (car eols))))
      (when (and (*current-progress%*)
 		(*current-progress%-echo?*))
        (let* ((raw-value (*current-progress%-value*))
@@ -122,11 +126,12 @@
 			(* value (*progress%-width*)))))
 	      (swidth (- (*progress%-width*) bwidth)))
 	 (display
-	(sprintf "\r[~A~A] ~A% ~A"
+	  (sprintf "\r[~A~A] ~A% ~A~A"
 		   (make-string bwidth #\=)
 		   (make-string swidth #\space)
 		   ivalue%
-		 (*current-progress%*))))))
+		   (*current-progress%*)
+		   eol))))))
 
  ;; If the new value is different-enough from the current one, updates
  ;; it and re-prints the progress%
@@ -146,12 +151,14 @@
 		  (*current-progress%-value* 0)
 		  (*current-progress%-last-value* #f)
 		  (*current-progress%-range* (cons 0 1)))
+     (let ((start (current-milliseconds)))
        (print-current-progress%)
-     (let ((result (thunk)))
-       (print-current-progress%)
+       (let ((result (thunk))
+	     (stop (current-milliseconds)))
+	 (print-current-progress% (sprintf " ~A ms" (- stop start)))
 	 (when echo?
 	   (newline))
-       result)))
+	 result))))
 
  ;; Runs named progress%
  (define-syntax with-progress%