| Message ID | 87fskexiyc.fsf@taiju.info |
|---|---|
| State | Accepted |
| Headers | show |
| Series | [bug#55845,1/1] ui: Improve pager selection logic when less is not installed. | expand |
| Context | Check | Description |
|---|---|---|
| cbaines/comparison | success | View comparision |
| cbaines/git branch | success | View Git branch |
| cbaines/applying patch | fail | View Laminar job |
| cbaines/issue | success | View issue |
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(-) diff --git a/guix/ui.scm b/guix/ui.scm index cb68a07c6c..93707a7a4b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -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))) diff --git a/tests/ui.scm b/tests/ui.scm index 3dc6952e1f..41de3c63da 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -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