From 591af24ade1021d91a3e7c62fcc7a8c90f00d4bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 9 Dec 2022 17:47:08 +0100 Subject: installer: Print progress bars and such as soon as \r is read. Fixes . 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(-) (limited to 'gnu/installer') 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 -;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2019, 2020, 2022 Ludovic Courtès ;;; ;;; 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))))))) ;;; -- cgit v1.2.3