GNU bug report logs -
#40911
‘guix search’ and $PAGER
Previous Next
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Mon, 27 Apr 2020 21:26:01 UTC
Severity: normal
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Full log
View this message in rfc822 format
[Message part 1 (text/plain, inline)]
Your bug report
#40911: ‘guix search’ and $PAGER
which was filed against the guix-patches package, has been closed.
The explanation is attached below, along with your original report.
If you require more details, please reply to 40911 <at> debbugs.gnu.org.
--
40911: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=40911
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
Ludovic Courtès <ludo <at> gnu.org> skribis:
> There seems to be consensus on getting ‘guix search’ to automatically
> invoke $PAGER (I don’t think there’s a bug report, though).
I ended up pushing a much simpler version, having learned about all the
options of ‘less’:
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=c39693d76099c159df856ffb5b2c43765fd6f2dd
Enjoy the pager! :-)
Ludo’.
[Message part 3 (message/rfc822, inline)]
[Message part 4 (text/plain, inline)]
Hello Guix!
There seems to be consensus on getting ‘guix search’ to automatically
invoke $PAGER (I don’t think there’s a bug report, though).
Below is a first stab at it that’s (almost) functional but raises
questions:
1. This patch arranges to invoke the pager only if we output a
screenful of text. However, that means that the
‘supports-hyperlinks?’ call is passed the wrong port, typically the
actual stdout (a terminal) instead of the pager. Pagers typically
don’t support hyperlinks, it seems.
Is there another way to do that? Should we just invoke the pager
unconditionally?
2. What if ‘less’ or $PAGER doesn’t exists or exits with non-zero?
What do others do?
Feedback & alternative patches more than welcome!
Ludo’.
[Message part 5 (text/x-patch, inline)]
diff --git a/.dir-locals.el b/.dir-locals.el
index ce305602f2..2f5d31f632 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -96,6 +96,8 @@
(eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
(eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
+ (eval . (put 'with-paged-output-port 'scheme-indent-function 2))
+
;; This notably allows '(' in Paredit to not insert a space when the
;; preceding symbol is one of these.
(eval . (modify-syntax-entry ?~ "'"))
diff --git a/guix/ui.scm b/guix/ui.scm
index ea5f460865..45c8923c99 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -69,6 +69,11 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
+ #:autoload (ice-9 popen) (open-pipe* close-pipe)
+ #:use-module ((ice-9 binary-ports)
+ #:select (make-custom-binary-output-port
+ put-bytevector))
+ #:use-module (rnrs bytevectors)
#:autoload (system base compile) (compile-file)
#:autoload (system repl repl) (start-repl)
#:autoload (system repl debug) (make-debug stack->vector)
@@ -1557,6 +1562,77 @@ score, the more relevant OBJ is to REGEXPS."
zero means that PACKAGE does not match any of REGEXPS."
(relevance package regexps %package-metrics))
+(define (paged-output-port port)
+ (define max-rows
+ (and (isatty?* port) (terminal-rows port)))
+
+ (define lines 1)
+ (define pipe #f)
+ (define buffer '())
+ (define pager (or (getenv "PAGER") "less"))
+
+ (define (newline-count bv start count)
+ (define end (+ start count))
+ (let loop ((index start)
+ (newlines 0))
+ (if (< index end)
+ (loop (+ 1 index)
+ (match (bytevector-u8-ref bv index)
+ (10 (+ newlines 1))
+ (_ newlines)))
+ newlines)))
+
+ (define (flush)
+ (for-each (cut put-bytevector port <>) (reverse buffer))
+ (set! buffer '()))
+
+ (define (write! bv start count)
+ (cond (pipe
+ ;; Pager is running, write BV to it.
+ (if (zero? count) ;EOF
+ (begin
+ (close-pipe pipe)
+ (set! pipe #f)
+ 0)
+ (begin
+ (put-bytevector pipe bv start count)
+ count)))
+ ((zero? count) ;EOF, no pager
+ (flush)
+ 0)
+ ((<= lines max-rows)
+ ;; We're below the threshold, so buffer BV.
+ (set! lines (+ lines (newline-count bv start count)))
+ (set! buffer
+ (let ((copy (make-bytevector count)))
+ (bytevector-copy! bv start copy 0 count)
+ (cons copy buffer)))
+ count)
+ (else
+ ;; We've reached the threshold: spawn a pager and write to it.
+ (set! pipe (open-pipe* OPEN_WRITE pager))
+ (flush)
+ (setvbuf pipe 'none)
+ (write! bv start count))))
+
+ (if max-rows
+ (let ((proxy (make-custom-binary-output-port "paged-output-port"
+ write! #f #f flush)))
+ (set-port-encoding! proxy (port-encoding port))
+ proxy)
+ port))
+
+(define (call-with-paged-output-port port proc)
+ (let* ((paged (paged-output-port port))
+ (close (if (eq? paged port) (const #t) close-port)))
+ (dynamic-wind
+ (const #t)
+ (lambda () (proc paged))
+ (lambda () (close paged)))))
+
+(define-syntax-rule (with-paged-output-port proxied port exp ...)
+ (call-with-paged-output-port proxied (lambda (port) exp ...)))
+
(define* (display-search-results matches port
#:key
(command "guix search")
@@ -1573,30 +1649,17 @@ them. If PORT is a terminal, print at most a full screen of results."
(define (line-count str)
(string-count str #\newline))
- (let loop ((matches matches))
- (match matches
- (((package . score) rest ...)
- (let* ((links? (supports-hyperlinks? port))
- (text (call-with-output-string
- (lambda (port)
- (print package port
- #:hyperlinks? links?
- #:extra-fields
- `((relevance . ,score)))))))
- (if (and (not (getenv "INSIDE_EMACS"))
- max-rows
- (> (port-line port) first-line) ;print at least one result
- (> (+ 4 (line-count text) (port-line port))
- max-rows))
- (unless (null? rest)
- (display-hint (format #f (G_ "Run @code{~a ... | less} \
-to view all the results.")
- command)))
- (begin
- (display text port)
- (loop rest)))))
- (()
- #t))))
+ (with-paged-output-port port paged
+ (let loop ((matches matches))
+ (match matches
+ (((package . score) rest ...)
+ (let* ((links? (supports-hyperlinks? port)))
+ (print package paged
+ #:hyperlinks? links?
+ #:extra-fields `((relevance . ,score)))
+ (loop rest)))
+ (()
+ #t)))))
(define (string->generations str)
This bug report was last modified 5 years and 63 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.