substitute: Honor the number of columns of the client terminal.
* guix/store.scm (set-build-options): Add #:terminal-columns parameter and honor it. * guix/scripts/substitute.scm (client-terminal-columns): New procedure. (guix-substitute): Use it to parameterize 'current-terminal-columns'.
This commit is contained in:
parent
cc44fbb8d9
commit
b0a6a97130
|
@ -31,7 +31,8 @@
|
||||||
#:use-module (guix pki)
|
#:use-module (guix pki)
|
||||||
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
|
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
|
||||||
#:use-module ((guix build download)
|
#:use-module ((guix build download)
|
||||||
#:select (progress-proc uri-abbreviation
|
#:select (current-terminal-columns
|
||||||
|
progress-proc uri-abbreviation
|
||||||
open-connection-for-uri
|
open-connection-for-uri
|
||||||
close-connection
|
close-connection
|
||||||
store-path-abbreviation byte-count->string))
|
store-path-abbreviation byte-count->string))
|
||||||
|
@ -973,6 +974,14 @@ found."
|
||||||
;; daemon.
|
;; daemon.
|
||||||
'("http://hydra.gnu.org"))))
|
'("http://hydra.gnu.org"))))
|
||||||
|
|
||||||
|
(define (client-terminal-columns)
|
||||||
|
"Return the number of columns in the client's terminal, if it is known, or a
|
||||||
|
default value."
|
||||||
|
(or (and=> (or (find-daemon-option "untrusted-terminal-columns")
|
||||||
|
(find-daemon-option "terminal-columns"))
|
||||||
|
string->number)
|
||||||
|
80))
|
||||||
|
|
||||||
(define (guix-substitute . args)
|
(define (guix-substitute . args)
|
||||||
"Implement the build daemon's substituter protocol."
|
"Implement the build daemon's substituter protocol."
|
||||||
(mkdir-p %narinfo-cache-directory)
|
(mkdir-p %narinfo-cache-directory)
|
||||||
|
@ -1003,9 +1012,12 @@ found."
|
||||||
(loop (read-line)))))))
|
(loop (read-line)))))))
|
||||||
(("--substitute" store-path destination)
|
(("--substitute" store-path destination)
|
||||||
;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
|
;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
|
||||||
(process-substitution store-path destination
|
;; Specify the number of columns of the terminal so the progress
|
||||||
#:cache-urls %cache-urls
|
;; report displays nicely.
|
||||||
#:acl (current-acl)))
|
(parameterize ((current-terminal-columns (client-terminal-columns)))
|
||||||
|
(process-substitution store-path destination
|
||||||
|
#:cache-urls %cache-urls
|
||||||
|
#:acl (current-acl))))
|
||||||
(("--version")
|
(("--version")
|
||||||
(show-version-and-exit "guix substitute"))
|
(show-version-and-exit "guix substitute"))
|
||||||
(("--help")
|
(("--help")
|
||||||
|
|
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (guix serialization)
|
#:use-module (guix serialization)
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
#:autoload (guix base32) (bytevector->base32-string)
|
#:autoload (guix base32) (bytevector->base32-string)
|
||||||
|
#:autoload (guix build syscalls) (terminal-columns)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -530,7 +531,10 @@ encoding conversion errors."
|
||||||
;; the daemon's settings are used. Otherwise, it
|
;; the daemon's settings are used. Otherwise, it
|
||||||
;; overrides the daemons settings; see 'guix
|
;; overrides the daemons settings; see 'guix
|
||||||
;; substitute'.
|
;; substitute'.
|
||||||
(substitute-urls #f))
|
(substitute-urls #f)
|
||||||
|
|
||||||
|
;; Number of columns in the client's terminal.
|
||||||
|
(terminal-columns (terminal-columns)))
|
||||||
;; Must be called after `open-connection'.
|
;; Must be called after `open-connection'.
|
||||||
|
|
||||||
(define socket
|
(define socket
|
||||||
|
@ -565,6 +569,10 @@ encoding conversion errors."
|
||||||
,@(if rounds
|
,@(if rounds
|
||||||
`(("build-repeat"
|
`(("build-repeat"
|
||||||
. ,(number->string (max 0 (1- rounds)))))
|
. ,(number->string (max 0 (1- rounds)))))
|
||||||
|
'())
|
||||||
|
,@(if terminal-columns
|
||||||
|
`(("terminal-columns"
|
||||||
|
. ,(number->string terminal-columns)))
|
||||||
'()))))
|
'()))))
|
||||||
(send (string-pairs pairs))))
|
(send (string-pairs pairs))))
|
||||||
(let loop ((done? (process-stderr server)))
|
(let loop ((done? (process-stderr server)))
|
||||||
|
|
Loading…
Reference in New Issue