03/03: installer: Print progress bars and such as soon as \r is read.

[guix-commits]

civodul pushed a commit to branch version-1.4.0
in repository guix.

commit 591af24ade1021d91a3e7c62fcc7a8c90f00d4bb
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Dec 9 17:47:08 2022 +0100

    installer: Print progress bars and such as soon as \r is read.
    
    Fixes <https://issues.guix.gnu.org/59922>.
    
    Previously progress bars and related things would be buffered by
    'run-external-command-with-line-hooks' until \n is read.
    
    * gnu/installer/utils.scm (run-external-command-with-line-hooks): Use
    'read-delimited' rather than 'get-line'.  Pass 'concat as the last
    argument.
    (%display-line-hook): Remove.
    (run-command): Use 'display' instead of '%display-line-hook'.
    (%syslog-line-hook): Add "\n" when LINE doesn't end in \n.
    (%installer-log-line-hook): Do not add an extra newline.
    (installer-log-line): Add an extra newline.
---
 gnu/installer/newt.scm  |  2 +-
 gnu/installer/utils.scm | 26 ++++++++++++++------------
 2 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 798ff53af2..e1c4453168 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -116,7 +116,7 @@ report it by email to ~a.") uploaded-name 
%guix-bug-report-address)
   (define command-output "")
   (define (line-accumulator line)
     (set! command-output
-          (string-append/shared command-output line "\n")))
+          (string-append/shared command-output line)))
   (define result (run-external-command-with-line-hooks (list line-accumulator)
                                                        args))
   (define exit-val (status:exit-val result))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 061493e6a7..6838410166 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -159,7 +159,9 @@ COMMAND will be run in a pseudoterminal.  Returns the 
integer status value of
 the child process as returned by waitpid."
   (define (handler input)
     (and
-     (and=> (get-line input)
+     ;; Lines for progress bars etc. end in \r; treat is as a line ending so
+     ;; those lines are printed right away.
+     (and=> (read-delimited "\r\n" input 'concat)
             (lambda (line)
               (if (eof-object? line)
                   #f
@@ -186,7 +188,7 @@ in a pseudoterminal."
 
   (installer-log-line "running command ~s" command)
   (define result (run-external-command-with-line-hooks
-                  (list %display-line-hook) command
+                  (list display) command
                   #:tty? tty?))
   (define exit-val (status:exit-val result))
   (define term-sig (status:term-sig result))
@@ -264,7 +266,10 @@ values."
       (or port (%make-void-port "w")))))
 
 (define (%syslog-line-hook line)
-  (format (syslog-port) "installer[~d]: ~a~%" (getpid) line))
+  (let ((line (if (string-suffix? "\r" line)
+                  (string-append (string-drop-right line 1) "\n")
+                  line)))
+    (format (syslog-port) "installer[~d]: ~a" (getpid) line)))
 
 (define-syntax syslog
   (lambda (s)
@@ -293,11 +298,7 @@ values."
       port)))
 
 (define (%installer-log-line-hook line)
-  (format (installer-log-port) "~a~%" line))
-
-(define (%display-line-hook line)
-  (display line)
-  (newline))
+  (display line (installer-log-port)))
 
 (define %default-installer-line-hooks
   (list %syslog-line-hook
@@ -309,9 +310,10 @@ values."
     (syntax-case s ()
       ((_ fmt args ...)
        (string? (syntax->datum #'fmt))
-       #'(let ((formatted (format #f fmt args ...)))
-               (for-each (lambda (f) (f formatted))
-                         %default-installer-line-hooks))))))
+       (with-syntax ((fmt (string-append (syntax->datum #'fmt) "\n")))
+         #'(let ((formatted (format #f fmt args ...)))
+             (for-each (lambda (f) (f formatted))
+                       %default-installer-line-hooks)))))))
 
 
 ;;;