me
/
guix
Archived
1
0
Fork 0

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.
master
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
1 changed files with 17 additions and 26 deletions

View File

@ -285,8 +285,7 @@ interface (FFI) of Guile.")
#:select? select?)) #:select? select?))
(gexp->script "compute-guix-derivation" (gexp->script "compute-guix-derivation"
#~(begin #~(begin
(use-modules (ice-9 match) (use-modules (ice-9 match))
(ice-9 threads))
(eval-when (expand load eval) (eval-when (expand load eval)
;; (gnu packages …) modules are going to be looked up ;; (gnu packages …) modules are going to be looked up
@ -320,21 +319,6 @@ interface (FFI) of Guile.")
(guix derivations) (guix derivations)
(srfi srfi-1)) (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) (match (command-line)
((_ source system version protocol-version ((_ source system version protocol-version
build-output) build-output)
@ -352,10 +336,6 @@ interface (FFI) of Guile.")
#:version proto) #:version proto)
(open-connection))) (open-connection)))
(sock (socket AF_UNIX SOCK_STREAM 0))) (sock (socket AF_UNIX SOCK_STREAM 0)))
(call-with-new-thread
(lambda ()
(spin system)))
;; Connect to BUILD-OUTPUT and send it the raw ;; Connect to BUILD-OUTPUT and send it the raw
;; build output. ;; build output.
(connect sock AF_UNIX build-output) (connect sock AF_UNIX build-output)
@ -378,18 +358,26 @@ interface (FFI) of Guile.")
#:module-path (list source)))) #:module-path (list source))))
(define (proxy input output) (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) (setvbuf input 'block 16384)
(let loop () (let loop ((spin spin))
(match (select (list input) '() '()) (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. ;; Read from INPUT as much as can be read without blocking.
(let ((bv (get-bytevector-some input))) (let ((bv (get-bytevector-some input)))
(unless (eof-object? bv) (unless (eof-object? bv)
(put-bytevector output bv) (put-bytevector output bv)
(loop))))))) (loop spin)))))))
(define (call-with-clean-environment thunk) (define (call-with-clean-environment thunk)
(let ((env (environ))) (let ((env (environ)))
@ -472,6 +460,9 @@ files."
(logior major minor)) (logior major minor))
"none") "none")
node)))))) 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 ;; Wait for a connection on SOCK and proxy build output so it can be
;; processed according to the settings currently in effect (build ;; processed according to the settings currently in effect (build
;; traces, verbosity level, and so on). ;; traces, verbosity level, and so on).