aboutsummaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-03-30 16:35:05 +0200
committerLudovic Courtès <ludo@gnu.org>2021-04-01 14:58:55 +0200
commita81a19930b2cbe1327e1e82d6210f80846ce2898 (patch)
treebb9cf7defeaccc7bed0958b8502891822be8bd4b /build-aux
parent1c10c2751a9075db5ab70fd102f0cc5ef2375720 (diff)
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.
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/build-self.scm43
1 files 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 @@ interface (FFI) of Guile.")
#: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 @@ interface (FFI) of Guile.")
(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 @@ interface (FFI) of Guile.")
#: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 @@ interface (FFI) of Guile.")
#: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 @@ files."
(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).