From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:59430) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBGN-0006fI-2U for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:03 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.90_1) (envelope-from ) id 1jTBGM-0007mC-Kh for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54936) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jTBGM-0007kj-7E for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jTBGM-0000xu-3E for guix-patches@gnu.org; Mon, 27 Apr 2020 17:26:02 -0400 Subject: [bug#40911] =?UTF-8?Q?=E2=80=98guix_?= =?UTF-8?Q?search=E2=80=99?= and $PAGER Resent-Message-ID: Received: from eggs.gnu.org ([2001:470:142:3::10]:59320) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBFK-0006LR-IA for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:59 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:44847) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jTBFK-0005jz-9s for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:58 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=54508 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jTBFJ-0003NG-DI for guix-patches@gnu.org; Mon, 27 Apr 2020 17:24:57 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Mon, 27 Apr 2020 23:24:55 +0200 Message-ID: <87wo60vcyg.fsf@inria.fr> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 40911@debbugs.gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Guix! There seems to be consensus on getting =E2=80=98guix search=E2=80=99 to aut= omatically invoke $PAGER (I don=E2=80=99t think there=E2=80=99s a bug report, though). Below is a first stab at it that=E2=80=99s (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 =E2=80=98supports-hyperlinks?=E2=80=99 call is passed the wrong port, = typically the actual stdout (a terminal) instead of the pager. Pagers typically don=E2=80=99t support hyperlinks, it seems. Is there another way to do that? Should we just invoke the pager unconditionally? 2. What if =E2=80=98less=E2=80=99 or $PAGER doesn=E2=80=99t exists or exi= ts with non-zero? What do others do? Feedback & alternative patches more than welcome! Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: 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) --=-=-=--