From 8a43dd715cba67ccdf08e3247697fa4e94879cf7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 6 Apr 2023 20:22:01 +0200 Subject: [PATCH] Show mls progress. --- src/mailman.scm | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/mailman.scm b/src/mailman.scm index b40b77f..8f362b0 100644 --- a/src/mailman.scm +++ b/src/mailman.scm @@ -91,13 +91,18 @@ (define (load-mailman-lists) (with-progress% #t "Mailman" - (let loop ((lsts (list-mailman-lists)) - (res '())) - (if (null? lsts) - res - (let ((mln (car lsts))) - (loop (cdr lsts) - (cons res (load-mailman-list mln)))))))) + (let* ((lists (list-mailman-lists)) + (total (length lists))) + (let loop ((lsts lists) + (res '()) + (idx 0)) + (if (null? lsts) + res + (let ((mln (car lsts))) + (progress%-advance (/ idx total)) + (loop (cdr lsts) + (cons res (load-mailman-list mln)) + (add1 idx)))))))) ;; List of lists, returns the whole list record (including name) (define (find-mailman-list lsts name)