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

status: Spin only on TTYs.

Browse source 
* guix/status.scm (isatty?*): New procedure.
(spin!): Do nothing when port matches ISATTY?*.
(color-output?): Use ISATTY?*.
This commit is contained in:
Ludovic Courtès 2019-01-15 11:47:25 +01:00
parent 35225dc579
commit 0c1bc5ecbe
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
guix/status.scm
View file

@ -27,6 +27,7 @@ (define-module (guix status)
#:select (nar-uri-abbreviation)) #:select (nar-uri-abbreviation))
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix memoization)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
@ -229,22 +230,27 @@ (define (multiplexed-output-supported?)
(and (current-store-protocol-version) (and (current-store-protocol-version)
(>= (current-store-protocol-version) #x163))) (>= (current-store-protocol-version) #x163)))
(define isatty?*
(mlambdaq (port)
(isatty? port)))
(define spin! (define spin!
(let ((steps (circular-list "\\" "|" "/" "-"))) (let ((steps (circular-list "\\" "|" "/" "-")))
(lambda (port) (lambda (port)
"Display a spinner on PORT." "Display a spinner on PORT."
(match steps (when (isatty?* port)
((first . rest) (match steps
(set! steps rest) ((first . rest)
(display "\r\x1b[K" port) (set! steps rest)
(display first port) (display "\r\x1b[K" port)
(force-output port)))))) (display first port)
(force-output port)))))))
(define (color-output? port) (define (color-output? port)
"Return true if we should write colored output to PORT." "Return true if we should write colored output to PORT."
(and (not (getenv "INSIDE_EMACS")) (and (not (getenv "INSIDE_EMACS"))
(not (getenv "NO_COLOR")) (not (getenv "NO_COLOR"))
(isatty? port))) (isatty?* port)))
(define-syntax color-rules (define-syntax color-rules
(syntax-rules () (syntax-rules ()