From a81a19930b2cbe1327e1e82d6210f80846ce2898 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 30 Mar 2021 16:35:05 +0200
Subject: [PATCH] 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).