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.
This commit is contained in:
Ludovic Courtès 2021-03-30 16:35:05 +02:00
parent 1c10c2751a
commit a81a19930b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -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).