ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-self: Take care of the spinner in the parent process.

Browse source 
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
1 changed files with 17 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
build-aux/build-self.scm
View file

@ -285,8 +285,7 @@ (define fake-git
#: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 @@ (define fake-git
(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 @@ (define spin
#: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 @@ (define spin
#: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 @@ (define* (build source
(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).