[bug#55845,1/1] ui: Improve pager selection logic when less is not installed.
Commit Message
Hi,
I have created a v2 patch and have attached it to this email and also
added a unit test for the find-available-pager.
Please check it out.
Regards,
Comments
Hi Maxime,
I tried to mock open-pipe* and isatty?* using the mock macro and also
add a test to inspect the program coming across to open-pipe*, but gave
up because I could not get the return value of the
with-paginated-output-port macro.
I think we are one step closer, but it is not working.
I will share a piece of code in the process of verification just in
case.
(test-equal "with-paginated-output-port"
"less"
(call-with-temporary-directory
(lambda (dir)
(with-environment-variables
`(("PATH" ,dir))
(make-dummy-executable-file dir "less")
(mock ((ice-9 popen) open-pipe*
(lambda (mode command . args)
(current-output-port)))
(mock ((guix colors) isatty?* (const #t))
(with-paginated-output-port paginated
"less")))))))
I have debugged that the return value of dynamic-wind is "less", but I
could not successfully use it for assertions.
I also tried to inspect the value of the command argument using
test-equal in the open-pipe* mock replacement function, but it did not
work.
Is there a better way to do this?
Thanks,
Taiju HIGASHI schreef op do 09-06-2022 om 19:23 [+0900]:
> Hi Maxime,
>
> I tried to mock open-pipe* and isatty?* using the mock macro and also
> add a test to inspect the program coming across to open-pipe*, but gave
> up because I could not get the return value of the
> with-paginated-output-port macro.
The return value of 'with-paginated-output-port' is just whatever the
last expression put in that macro evaluates to. Also 'close-pipe'
needs to be mocked, otherwise an error will result.
Try:
(test-assert "with-paginated-output-port: finds less in PATH"
(call-with-temporary-directory
(lambda (dir)
(define used-command #false)
(with-environment-variables
`(("PATH" ,dir))
(make-dummy-executable-file dir "less")
(mock ((ice-9 popen) open-pipe*
(lambda (mode command . args)
(when used-command ; <--- an extra test
(error "open-pipe* should only be called once"))
(set! used-command command) ; <--- this captures the passed command
(%make-void-port ""))) ; return a dummy port
(mock ((ice-9 popen) close-pipe (const 'ok))
(mock ((guix colors) isatty?* (const #t))
(with-paginated-output-port port 'ok)))))
(and (pk 'used-command used-command dir) ; <-- fails on my computer because a non-absolute path is passed and I haven't applied our patch
(string=? (in-vicinity dir "less") used-command)))))
Greetings,
Maxime.
This is off-topic.
I feel I have a limited vocabulary available to me in Guile or Scheme
(as well as in English...) , but functions like pk were not included in
Guile's reference or Scheme's reference, so I thought my chances of
knowing them were quite limited. (I didn't know about in-vicinity
either, but now that I know it is in SRFI.)
Are these the kind of things you learn by reading the source?
Taiju HIGASHI schreef op vr 10-06-2022 om 09:55 [+0900]:
> I feel I have a limited vocabulary available to me in Guile or Scheme
> (as well as in English...) , but functions like pk were not included in
> Guile's reference or Scheme's reference, so I thought my chances of
> knowing them were quite limited. (I didn't know about in-vicinity
> either, but now that I know it is in SRFI.)
Didn't know it was part of a SRFI.
> Are these the kind of things you learn by reading the source?
Yes, some things aren't documented. Though if interested, feel free to
doucment them.
Greetings,
Maxime.
> Taiju HIGASHI schreef op vr 10-06-2022 om 09:55 [+0900]:
>> I feel I have a limited vocabulary available to me in Guile or Scheme
>> (as well as in English...) , but functions like pk were not included in
>> Guile's reference or Scheme's reference, so I thought my chances of
>> knowing them were quite limited. (I didn't know about in-vicinity
>> either, but now that I know it is in SRFI.)
>
> Didn't know it was part of a SRFI.
Yes, but in Guile it behaves in a way that makes it useful for
constructing path strings, but when I checked the SRFI specification[0],
the behavior seems to be different from that of the SRFI specification.
(in-vicinity = string-append)
I wonder if this is a subtle specification, since Gauche, which
implements many SRFIs, did not have it either...
>> Are these the kind of things you learn by reading the source?
>
> Yes, some things aren't documented. Though if interested, feel free to
> doucment them.
Thank you!
This is not a complaint about the documentation. I just wanted to know
how people as proficient in Guile as you guys learned Guile.
I am glad to know that I can learn by getting suggestions for better
code implementation through code reviews, etc.
But, I thought it would be a good idea to include functions like pk in
the documentation, since the efficiency of development depends on
knowing them.
[0]: https://srfi.schemers.org/srfi-59/srfi-59.html
Thanks,
From a65818b99ea1b327313fea08cf2db229c55e4b21 Mon Sep 17 00:00:00 2001
From: Taiju HIGASHI <higashi@taiju.info>
Date: Wed, 8 Jun 2022 18:50:28 +0900
Subject: [PATCH v2] ui: Improve pager selection logic when less is not
installed.
* guix/ui.scm (find-available-pager): New procedure. Return a available pager.
(call-with-paginated-output-port): Change to use find-available-pager to
select pager.
* tests/ui.scm: Add tests for find-available-pager.
---
guix/ui.scm | 16 ++++++++++++---
tests/ui.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 71 insertions(+), 3 deletions(-)
@@ -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,20 @@ (define* (pager-wrapped-port #:optional (port (current-output-port)))
(_
#f)))
+(define (find-available-pager)
+ "Returns the program name or path of an available pager.
+If neither less nor more is installed, return an empty string so that
+call-with-paginated-output-port will not call pager."
+ (or (getenv "GUIX_PAGER")
+ (getenv "PAGER")
+ (which "less")
+ (which "more")
+ "" ;; Returns an empty string so that call-with-paginated-output-port does not call pager.
+ ))
+
(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)))
@@ -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 @@ (define-module (test-ui)
#: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,60 @@ (define guile-2.0.9
(>0 (package-relevance libb2
(map rx '("crypto" "library")))))))
+(define make-dummy-file
+ (compose
+ close-port
+ open-output-file
+ (cut string-append <> "/" <>)))
+
+(test-equal "find-available-pager, All environment variables are specified and both less and more are installed"
+ "guix-pager"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("GUIX_PAGER" "guix-pager")
+ ("PAGER" "pager"))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ ((@@ (guix ui) find-available-pager))))))
+
+(test-equal "find-available-pager, GUIX_PAGER is not specified"
+ "pager"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir)
+ ("PAGER" "pager"))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ ((@@ (guix ui) find-available-pager))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and both less and more are installed"
+ "less"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir))
+ (make-dummy-file dir "less")
+ (make-dummy-file dir "more")
+ (basename ((@@ (guix ui) find-available-pager)))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and more is installed"
+ "more"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir))
+ (make-dummy-file dir "more")
+ (basename ((@@ (guix ui) find-available-pager)))))))
+
+(test-equal "find-available-pager, All environment variables are not specified and both less and more are not installed"
+ ""
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables
+ `(("PATH" ,dir))
+ ((@@ (guix ui) find-available-pager))))))
+
(test-end "ui")
--
2.36.1