futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: Improve pager selection logic when less is not installed.

Browse Source 
* guix/ui.scm (find-available-pager): New procedure.
(call-with-paginated-output-port): Use it.
* guix/utils.scm (call-with-environment-variables): Allow clearing of
specified environment variables.
* tests/ui.scm (make-empty-file, assert-equals-find-available-pager):
New procedures.
("find-available-pager, GUIX_PAGER takes precedence")
("find-available-pager, PAGER takes precedence")
("find-available-pager, 'less' takes precedence")
("find-available-pager, 'more' takes precedence")
("find-available-pager, no pager"): New tests.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Taiju HIGASHI 2022-06-08 18:50:28 +09:00 committed by Ludovic Courtès
parent a88de093fb
commit c8803d89fe
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 82 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
guix/ui.scm
View File

@ -17,6 +17,7 @@
;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1672,11 +1673,18 @@ return the underlying port. Otherwise return #f."
(_
#f)))
(define (find-available-pager)
"Return the program name of an available pager or the empty string if none is
available."
(or (getenv "GUIX_PAGER")
(getenv "PAGER")
(which "less")
(which "more")
""))
(define* (call-with-paginated-output-port proc
#:key (less-options "FrX"))
(let ((pager-command-line (or (getenv "GUIX_PAGER")
(getenv "PAGER")
"less")))
(let ((pager-command-line (find-available-pager)))
;; Setting PAGER to the empty string conventionally disables paging.
(if (and (not (string-null? pager-command-line))
(isatty?* (current-output-port)))

3
guix/utils.scm
View File

@ -13,6 +13,7 @@
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; This file is part of GNU Guix.
;;;
@ -158,6 +159,8 @@
(dynamic-wind
(lambda ()
(for-each (match-lambda
((variable #false)
(unsetenv variable))
((variable value)
(setenv variable value)))
variables))

68
tests/ui.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,6 +25,7 @@
#:use-module (guix derivations)
#:use-module ((gnu packages) #:select (specification->package))
#:use-module (guix tests)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
@ -292,4 +294,70 @@ Second line" 24))
(>0 (package-relevance libb2
(map rx '("crypto" "library")))))))
(define (make-empty-file directory file)
;; Create FILE in DIRECTORY.
(close-port (open-output-file (in-vicinity directory file))))
(define (assert-equals-find-available-pager expected)
;; Use 'with-paginated-output-port' and return true if it invoked EXPECTED.
(define used-command "")
(mock ((ice-9 popen) open-pipe*
(lambda (mode command . args)
(unless (string-null? used-command)
(error "open-pipe* should only be called once"))
(set! used-command command)
(%make-void-port "")))
(mock ((ice-9 popen) close-pipe (const 'ok))
(mock ((guix colors) isatty?* (const #t))
(with-paginated-output-port port 'ok)
(string=? expected used-command)))))
(test-assert "find-available-pager, GUIX_PAGER takes precedence"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables `(("PATH" ,dir)
("GUIX_PAGER" "guix-pager")
("PAGER" "pager"))
(make-empty-file dir "less")
(make-empty-file dir "more")
(assert-equals-find-available-pager "guix-pager")))))
(test-assert "find-available-pager, PAGER takes precedence"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables `(("PATH" ,dir)
("GUIX_PAGER" #false)
("PAGER" "pager"))
(make-empty-file dir "less")
(make-empty-file dir "more")
(assert-equals-find-available-pager "pager")))))
(test-assert "find-available-pager, 'less' takes precedence"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables `(("PATH" ,dir)
("GUIX_PAGER" #false)
("PAGER" #false))
(make-empty-file dir "less")
(make-empty-file dir "more")
(assert-equals-find-available-pager (in-vicinity dir "less"))))))
(test-assert "find-available-pager, 'more' takes precedence"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables `(("PATH" ,dir)
("GUIX_PAGER" #false)
("PAGER" #false))
(make-empty-file dir "more")
(assert-equals-find-available-pager (in-vicinity dir "more"))))))
(test-assert "find-available-pager, no pager"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables `(("PATH" ,dir)
("GUIX_PAGER" #false)
("PAGER" #false))
(assert-equals-find-available-pager "")))))
(test-end "ui")