From 990340ded923b75a47d8a11f2885731fd6cf56dd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Tue, 11 Apr 2023 21:22:21 +0200
Subject: [PATCH] Support for quieting progresses.

---
 src/progress.scm | 64 ++++++++++++++++++++++++++++--------------------
 1 file changed, 37 insertions(+), 27 deletions(-)

diff --git a/src/progress.scm b/src/progress.scm
index 3842ced..af605da 100644
--- a/src/progress.scm
+++ b/src/progress.scm
@@ -28,6 +28,8 @@
 (module
  progress
  (
+  *progress-quiet*
+  
   run-with-progress
   progress-advance
   with-progress
@@ -47,13 +49,17 @@
 	 (chicken port)
 	 util-time)
 
+ ;; Suppress all output if #t
+ (define *progress-quiet* (make-parameter #f))
+
  ;; Parameterized current progress string
  (define *current-progress* (make-parameter #f))
 
  ;; Prints current progress.
  (define (print-current-progress . args)
    (let ((cp (*current-progress*)))
-     (when cp
+     (when (and cp
+		(not (*progress-quiet*)))
        (display (sprintf "\r\x1b[K~A" cp)))))
 
  ;; Adds something to current progress and refreshes the display.
@@ -71,13 +77,15 @@
      (print-current-progress)
      (let ((result (thunk)))
        (print-current-progress)
-       (when echo?
+       (when (and echo?
+		  (not (*progress-quiet*)))
 	 (print post-msg))
        result)))
 
  ;; Allows printing output when progress is advancing.
  (define (run-progress-break thunk)
-   (when (*current-progress*)
+   (when (and (*current-progress*)
+	      (not (*progress-quiet*)))
      (display "\r\x1b[K"))
    (thunk)
    (print-current-progress))
@@ -109,29 +117,30 @@
 
  ;; Unconditionally prints the 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*))
-	      (range (*current-progress%-range*))
-	      (value (+ (car range)
-			(* raw-value
-			   (- (cdr range) (car range)))))
-	      (value% (* 100 value))
-	      (ivalue% (inexact->exact (round value%)))
-	      (bwidth (inexact->exact
-		       (round
-			(* value (*progress%-width*)))))
-	      (swidth (- (*progress%-width*) bwidth)))
-	 (display
-	  (sprintf "\r[~A~A] ~A% ~A~A"
-		   (make-string bwidth #\=)
-		   (make-string swidth #\space)
-		   ivalue%
-		   (*current-progress%*)
-		   eol))))))
+   (when (not (*progress-quiet*))
+     (let ((eol (if (null? eols)
+		    ""
+		    (car eols))))
+       (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%)))
+		(bwidth (inexact->exact
+			 (round
+			  (* value (*progress%-width*)))))
+		(swidth (- (*progress%-width*) bwidth)))
+	   (display
+	    (sprintf "\r[~A~A] ~A% ~A~A"
+		     (make-string bwidth #\=)
+		     (make-string swidth #\space)
+		     ivalue%
+		     (*current-progress%*)
+		     eol)))))))
 
  ;; If the new value is different-enough from the current one, updates
  ;; it and re-prints the progress%
@@ -156,7 +165,8 @@
        (let ((result (thunk))
 	     (stop (current-util-milliseconds)))
 	 (print-current-progress% (sprintf " ~A ms" (- stop start)))
-	 (when echo?
+	 (when (and echo?
+		    (not (*progress-quiet*)))
 	   (newline))
 	 result))))