unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 38518@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#38518] [PATCH 5/7] progress: Add 'progress-report-port'.
Date: Sun,  8 Dec 2019 12:26:35 +0100	[thread overview]
Message-ID: <20191208112637.5534-5-ludo@gnu.org> (raw)
In-Reply-To: <20191208112637.5534-1-ludo@gnu.org>

* guix/scripts/substitute.scm (progress-report-port): Move to...
* guix/progress.scm (progress-report-port): ... here.  New procedure.
---
 guix/progress.scm           | 31 +++++++++++++++++++++++++++++++
 guix/scripts/substitute.scm | 29 -----------------------------
 2 files changed, 31 insertions(+), 29 deletions(-)

diff --git a/guix/progress.scm b/guix/progress.scm
index 349637dbcf..c7567a35fd 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -40,6 +40,7 @@
             progress-reporter/file
             progress-reporter/bar
             progress-reporter/trace
+            progress-report-port
 
             display-download-progress
             erase-current-line
@@ -342,3 +343,33 @@ should be a <progress-reporter> object."
               (put-bytevector out buffer 0 bytes)
               (report total)
               (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
+
+(define (progress-report-port reporter port)
+  "Return a port that continuously reports the bytes read from PORT using
+REPORTER, which should be a <progress-reporter> object."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (let* ((total 0)
+            (read! (lambda (bv start count)
+                     (let ((n (match (get-bytevector-n! port bv start count)
+                                ((? eof-object?) 0)
+                                (x x))))
+                       (set! total (+ total n))
+                       (report total)
+                       n))))
+       (start)
+       (make-custom-binary-input-port "progress-port-proc"
+                                      read! #f #f
+                                      (lambda ()
+                                        ;; XXX: Kludge!  When used through
+                                        ;; 'decompressed-port', this port ends
+                                        ;; up being closed twice: once in a
+                                        ;; child process early on, and at the
+                                        ;; end in the parent process.  Ignore
+                                        ;; the early close so we don't output
+                                        ;; a spurious "download-succeeded"
+                                        ;; trace.
+                                        (unless (zero? total)
+                                          (stop))
+                                        (close-port port)))))))
+
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 4802fbd1fe..7eca2c6874 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -823,35 +823,6 @@ was found."
                                 (= (string-length file) 32)))))
               (narinfo-cache-directories directory)))
 
-(define (progress-report-port reporter port)
-  "Return a port that continuously reports the bytes read from PORT using
-REPORTER, which should be a <progress-reporter> object."
-  (match reporter
-    (($ <progress-reporter> start report stop)
-     (let* ((total 0)
-            (read! (lambda (bv start count)
-                     (let ((n (match (get-bytevector-n! port bv start count)
-                                ((? eof-object?) 0)
-                                (x x))))
-                       (set! total (+ total n))
-                       (report total)
-                       n))))
-       (start)
-       (make-custom-binary-input-port "progress-port-proc"
-                                      read! #f #f
-                                      (lambda ()
-                                        ;; XXX: Kludge!  When used through
-                                        ;; 'decompressed-port', this port ends
-                                        ;; up being closed twice: once in a
-                                        ;; child process early on, and at the
-                                        ;; end in the parent process.  Ignore
-                                        ;; the early close so we don't output
-                                        ;; a spurious "download-succeeded"
-                                        ;; trace.
-                                        (unless (zero? total)
-                                          (stop))
-                                        (close-port port)))))))
-
 (define-syntax with-networking
   (syntax-rules ()
     "Catch DNS lookup errors and TLS errors and gracefully exit."
-- 
2.24.0

  parent reply	other threads:[~2019-12-08 11:28 UTC|newest]

Thread overview: 12+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-12-07 21:42 [bug#38518] [PATCH 0/7] 'guix challenge' can diff archives directly Ludovic Courtès
2019-12-08 11:20 ` zimoun
2019-12-08 11:34   ` Ludovic Courtès
2019-12-08 11:48     ` zimoun
2019-12-08 11:26 ` [bug#38518] [PATCH 1/7] serialization: Add 'fold-archive' Ludovic Courtès
2019-12-08 11:26   ` [bug#38518] [PATCH 2/7] guix archive: Add '--list' Ludovic Courtès
2019-12-08 11:26   ` [bug#38518] [PATCH 3/7] challenge: Report the best narinfo URI Ludovic Courtès
2019-12-08 11:26   ` [bug#38518] [PATCH 4/7] serialization: Remove unused procedure Ludovic Courtès
2019-12-08 11:26   ` Ludovic Courtès [this message]
2019-12-08 11:26   ` [bug#38518] [PATCH 6/7] challenge: Add "--diff" Ludovic Courtès
2019-12-08 11:26   ` [bug#38518] [PATCH 7/7] challenge: Support "--diff=diffoscope" Ludovic Courtès
2019-12-12 17:21 ` bug#38518: [PATCH 0/7] 'guix challenge' can diff archives directly 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=20191208112637.5534-5-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=38518@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).