From a81a19930b2cbe1327e1e82d6210f80846ce2898 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 30 Mar 2021 16:35:05 +0200 Subject: build-self: Take care of the spinner in the parent process. This simplifies code and mostly ensures we don't print a spinner while there's build activity going on. * build-aux/build-self.scm (build-program): Remove 'spin' and 'call-with-new-thread' call from "compute-guix-derivation" body. Remove "Computing Guix derivation" message. (proxy): Pass extra argument to 'select'. Display a spinner when 'select' returns empty lists. (build): Print "Computing Guix derivation" message here. --- build-aux/build-self.scm | 43 +++++++++++++++++-------------------------- 1 file changed, 17 insertions(+), 26 deletions(-) diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 3e057ca5d2..853a2f328f 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -285,8 +285,7 @@ (define fake-git #:select? select?)) (gexp->script "compute-guix-derivation" #~(begin - (use-modules (ice-9 match) - (ice-9 threads)) + (use-modules (ice-9 match)) (eval-when (expand load eval) ;; (gnu packages …) modules are going to be looked up @@ -320,21 +319,6 @@ (define fake-git (guix derivations) (srfi srfi-1)) - (define (spin system) - (define spin - (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/")) - - (format (current-error-port) - "Computing Guix derivation for '~a'... " - system) - (when (isatty? (current-error-port)) - (let loop ((spin spin)) - (display (string-append "\b" (car spin)) - (current-error-port)) - (force-output (current-error-port)) - (sleep 1) - (loop (cdr spin))))) - (match (command-line) ((_ source system version protocol-version build-output) @@ -352,10 +336,6 @@ (define spin #:version proto) (open-connection))) (sock (socket AF_UNIX SOCK_STREAM 0))) - (call-with-new-thread - (lambda () - (spin system))) - ;; Connect to BUILD-OUTPUT and send it the raw ;; build output. (connect sock AF_UNIX build-output) @@ -378,18 +358,26 @@ (define spin #:module-path (list source)))) (define (proxy input output) - "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT." + "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT. +Display a spinner when nothing happens." + (define spin + (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/")) + (setvbuf input 'block 16384) - (let loop () - (match (select (list input) '() '()) + (let loop ((spin spin)) + (match (select (list input) '() '() 1) ((() () ()) - (loop)) + (when (isatty? (current-error-port)) + (display (string-append "\b" (car spin)) + (current-error-port)) + (force-output (current-error-port))) + (loop (cdr spin))) (((_) () ()) ;; Read from INPUT as much as can be read without blocking. (let ((bv (get-bytevector-some input))) (unless (eof-object? bv) (put-bytevector output bv) - (loop))))))) + (loop spin))))))) (define (call-with-clean-environment thunk) (let ((env (environ))) @@ -472,6 +460,9 @@ (define* (build source (logior major minor)) "none") node)))))) + (format (current-error-port) "Computing Guix derivation for '~a'... " + system) + ;; Wait for a connection on SOCK and proxy build output so it can be ;; processed according to the settings currently in effect (build ;; traces, verbosity level, and so on). -- cgit v1.2.3