From: "Ludovic Courtès" <ludo@gnu.org>
To: 29509@debbugs.gnu.org
Subject: [bug#29509] [PATCH 3/6] progress: Add 'progress-reporter/bar'.
Date: Thu, 30 Nov 2017 14:56:59 +0100 [thread overview]
Message-ID: <20171130135702.4321-3-ludo@gnu.org> (raw)
In-Reply-To: <20171130135702.4321-1-ludo@gnu.org>
* guix/progress.scm (progress-reporter/bar): New procedure.
---
guix/progress.scm | 35 +++++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
diff --git a/guix/progress.scm b/guix/progress.scm
index ba7944214..1ee7ec319 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,6 +33,7 @@
progress-reporter/silent
progress-reporter/file
+ progress-reporter/bar
byte-count->string
current-terminal-columns
@@ -212,6 +214,39 @@ ABBREVIATION used to shorten FILE for display."
;; Don't miss the last report.
(stop render))))
+(define* (progress-reporter/bar total
+ #:optional
+ (prefix "")
+ (port (current-error-port)))
+ "Return a reporter that shows a progress bar every time one of the TOTAL
+tasks is performed. Write PREFIX at the beginning of the line."
+ (define done 0)
+
+ (define (report-progress)
+ (set! done (+ 1 done))
+ (unless (> done total)
+ (let* ((ratio (* 100. (/ done total))))
+ (erase-in-line port)
+ (if (string-null? prefix)
+ (display (progress-bar ratio (current-terminal-columns)) port)
+ (let ((width (- (current-terminal-columns)
+ (string-length prefix) 3)))
+ (display prefix port)
+ (display " " port)
+ (display (progress-bar ratio width) port)))
+ (force-output port))))
+
+ (progress-reporter
+ (start (lambda ()
+ (set! done 0)))
+ (report report-progress)
+ (stop (lambda ()
+ (erase-in-line port)
+ (unless (string-null? prefix)
+ (display prefix port)
+ (newline port))
+ (force-output port)))))
+
;; TODO: replace '(@ (guix build utils) dump-port))'.
(define* (dump-port* in out
#:key (buffer-size 16384)
--
2.15.0
next prev parent reply other threads:[~2017-11-30 13:58 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-11-30 13:46 [bug#29509] [PATCH 0/6] Display progress bar in 'guix system init' Ludovic Courtès
2017-11-30 13:56 ` [bug#29509] [PATCH 1/6] progress: Factorize erase-in-line Ludovic Courtès
2017-11-30 13:56 ` [bug#29509] [PATCH 2/6] progress: 'progress-bar' accounts for brackets Ludovic Courtès
2017-12-14 22:03 ` Danny Milosavljevic
2017-11-30 13:56 ` Ludovic Courtès [this message]
2017-11-30 13:57 ` [bug#29509] [PATCH 4/6] weather: Use (guix progress) for progress report Ludovic Courtès
2017-11-30 13:57 ` [bug#29509] [PATCH 5/6] guix system: Simplify closure copy Ludovic Courtès
2017-11-30 13:57 ` [bug#29509] [PATCH 6/6] guix system: 'init' displays a progress bar while copying Ludovic Courtès
2017-12-14 22:01 ` [bug#29509] [PATCH 1/6] progress: Factorize erase-in-line Danny Milosavljevic
2017-12-15 9:47 ` Ludovic Courtès
2017-12-01 15:03 ` bug#29509: [PATCH 0/6] Display progress bar in 'guix system init' Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20171130135702.4321-3-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=29509@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).