From 35cd17eaf85cce47d64f0ce322f91ea88e85ba93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 27 Apr 2020 23:24:55 +0200 Subject: =?UTF-8?q?=E2=80=98guix=20search=E2=80=99=20and=20$PAGER?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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’. --- .dir-locals.el | 2 ++ guix/ui.scm | 111 ++++++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 89 insertions(+), 24 deletions(-) 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) -- cgit v1.2.3