Use progress-advance.

Makefile

@@ -130,7 +130,8 @@ command-line.import.scm: $(COMMAND-LINE-SOURCES)
 MEMBERS-BASE-SOURCES=members-base.scm testing.import.scm		\
 	utils.import.scm dictionary.import.scm member-file.import.scm	\
 	primes.import.scm member-record.import.scm ansi.import.scm	\
-	period.import.scm month.import.scm configuration.import.scm
+	period.import.scm month.import.scm configuration.import.scm	\
+	progress.import.scm
 
 members-base.so: members-base.o
 members-base.o: members-base.import.scm

members-base.scm

@@ -58,8 +58,9 @@
 	 ansi
 	 period
 	 month
-	 configuration)
+	 configuration
-
+	 progress)
+ 
  ;; Gets all files and symbolic links from given directory. The
  ;; symbolic links are represented by cons cells with car being the
  ;; name and cdr the link target.
@@ -172,30 +173,28 @@
  (define (load-members dn . opts)
    (let ((progress? (and (not (null? opts))
 			 (car opts))))
-     (when progress?
+     (with-progress
-       (display "Loading members "))
+      progress? "Loading-members " " ok."
-     (let* ((fss (files-dictionary-filter-4digit-symbols
+      (let* ((fss (files-dictionary-filter-4digit-symbols
-		  (files+symlinks->files-dictionary
+		   (files+symlinks->files-dictionary
-		   (get-files+symlinks dn))))
+		    (get-files+symlinks dn))))
-	    (mb0 (dict-map
+	     (mb0 (dict-map
-		  (lambda (symfn symlinks)
+		   (lambda (symfn symlinks)
-		    (when progress?
+		     (when progress?
-		      (display "."))
+		       (progress-advance "."))
-		    (members-base-load-member dn
+		     (members-base-load-member dn
-					      symfn
+					       symfn
-					      symlinks))
+					       symlinks))
-		  fss))
+		   fss))
-	    (mb1 (dict-reduce (make-dict)
+	     (mb1 (dict-reduce (make-dict)
-			      (lambda (acc symfn mr)
+			       (lambda (acc symfn mr)
-				(dict-set acc (dict-ref mr 'id) mr))
+				 (dict-set acc (dict-ref mr 'id) mr))
-			      mb0))
+			       mb0))
-	    (mb (dict-reduce '()
+	     (mb (dict-reduce '()
-			     (lambda (acc id mr)
+			      (lambda (acc id mr)
-			       (cons mr acc))
+				(cons mr acc))
-			     mb1)))
+			      mb1)))
-       (when progress?
+	mb))))
-	 (print " ok."))
-       mb)))
 
  ;; Gets member based by generic predicate
  (define (find-member-by-predicate mb pred)

progress.scm

@@ -23,7 +23,7 @@
 ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 ;;
 
-(declare (unit configuration))
+(declare (unit progress))
 
 (module
  progress
@@ -43,26 +43,31 @@
 
  ;; Prints current progress.
  (define (print-current-progress . args)
-   (display (sprintf "\r\x1b[K~A" (*current-progress*))))
+   (let ((cp (*current-progress*)))
+     (when cp
+       (display (sprintf "\r\x1b[K~A" cp)))))
 
  ;; Adds something to current progress and refreshes the display.
  (define (progress-advance str)
-   (*current-progress* (string-append (*current-progress*) (sprintf "~A" str)))
+   (when (*current-progress*)
-   (print-current-progress))
+     (*current-progress* (string-append (*current-progress*) (sprintf "~A" str)))
+     (print-current-progress)))
 
  ;; Runs given procedure within progress environment
- (define (run-with-progress pre-msg post-msg thunk)
+ (define (run-with-progress echo? pre-msg post-msg thunk)
-   (parameterize ((*current-progress* pre-msg))
+   (parameterize ((*current-progress* (if echo? pre-msg #f)))
      (print-current-progress)
-     (thunk)
+     (let ((result (thunk)))
-     (print-current-progress)
+       (print-current-progress)
-     (print post-msg)))
+       (when echo?
+	 (print post-msg))
+       result)))
 
  ;; Friendly syntax wrapper.
  (define-syntax with-progress
    (syntax-rules ()
-     ((_ pre post body ...)
+     ((_ echo? pre post body ...)
-      (run-with-progress pre post (lambda () body ...)))))
+      (run-with-progress echo? pre post (lambda () body ...)))))
 
  ;; If the program uses progress module, disable buffering
  (set-buffering-mode! (current-output-port) #:none)