* [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows'.
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
@ 2019-06-26 8:59 ` Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it Ludovic Courtès
1 sibling, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:59 UTC (permalink / raw)
To: 36390
* guix/build/syscalls.scm (terminal-dimension): New procedure.
(terminal-columns): Rewrite in terms of 'terminal-dimension'.
(terminal-rows): New procedure.
* tests/syscalls.scm ("terminal-rows"): New test.
---
guix/build/syscalls.scm | 37 +++++++++++++++++++++++++------------
tests/syscalls.scm | 5 ++++-
2 files changed, 29 insertions(+), 13 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5c2eb3c14d..eb045cbd1c 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -146,6 +146,7 @@
window-size-y-pixels
terminal-window-size
terminal-columns
+ terminal-rows
utmpx?
utmpx-login-type
@@ -1871,23 +1872,17 @@ corresponds to the TIOCGWINSZ ioctl."
(list (strerror err))
(list err)))))
-(define* (terminal-columns #:optional (port (current-output-port)))
- "Return the best approximation of the number of columns of the terminal at
-PORT, trying to guess a reasonable value if all else fails. The result is
-always a positive integer."
- (define (fall-back)
- (match (and=> (getenv "COLUMNS") string->number)
- (#f 80)
- ((? number? columns)
- (if (> columns 0) columns 80))))
-
+(define (terminal-dimension window-dimension port fall-back)
+ "Return the terminal dimension defined by WINDOW-DIMENSION, one of
+'window-size-columns' or 'window-size-rows' for PORT. If PORT does not
+correspond to a terminal, return the value returned by FALL-BACK."
(catch 'system-error
(lambda ()
(if (file-port? port)
- (match (window-size-columns (terminal-window-size port))
+ (match (window-dimension (terminal-window-size port))
;; Things like Emacs shell-mode return 0, which is unreasonable.
(0 (fall-back))
- ((? number? columns) columns))
+ ((? number? n) n))
(fall-back)))
(lambda args
(let ((errno (system-error-errno args)))
@@ -1900,6 +1895,24 @@ always a positive integer."
(fall-back)
(apply throw args))))))
+(define* (terminal-columns #:optional (port (current-output-port)))
+ "Return the best approximation of the number of columns of the terminal at
+PORT, trying to guess a reasonable value if all else fails. The result is
+always a positive integer."
+ (define (fall-back)
+ (match (and=> (getenv "COLUMNS") string->number)
+ (#f 80)
+ ((? number? columns)
+ (if (> columns 0) columns 80))))
+
+ (terminal-dimension window-size-columns port fall-back))
+
+(define* (terminal-rows #:optional (port (current-output-port)))
+ "Return the best approximation of the number of rows of the terminal at
+PORT, trying to guess a reasonable value if all else fails. The result is
+always a positive integer."
+ (terminal-dimension window-size-rows port (const 25)))
+
\f
;;;
;;; utmpx.
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 3e267c9f01..eeb223b950 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -538,6 +538,9 @@
(> (terminal-columns (open-input-string "Join us now, share the software!"))
0))
+(test-assert "terminal-rows"
+ (> (terminal-rows) 0))
+
(test-assert "utmpx-entries"
(match (utmpx-entries)
(((? utmpx? entries) ...)
--
2.22.0
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it.
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows' Ludovic Courtès
@ 2019-06-26 8:59 ` Ludovic Courtès
1 sibling, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:59 UTC (permalink / raw)
To: 36390
* guix/ui.scm (display-search-results): New procedure.
* guix/scripts/package.scm (find-packages-by-description): Remove
'unzip2' call and return a list of pairs.
(process-query): Change to use 'display-search-results'.
* guix/scripts/system/search.scm (find-service-types): Remove 'unzip2'
call and return a list of pairs.
(guix-system-search): Use 'display-search-results'.
---
guix/scripts/package.scm | 41 ++++++++++++----------------
guix/scripts/system/search.scm | 44 +++++++++++++-----------------
guix/ui.scm | 50 +++++++++++++++++++++++++++++++++-
3 files changed, 86 insertions(+), 49 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 5751123525..7b277b63f1 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
(define-module (guix scripts package)
#:use-module (guix ui)
#:use-module ((guix status) #:select (with-status-verbosity))
+ #:use-module ((guix build syscalls) #:select (terminal-rows))
#:use-module (guix store)
#:use-module (guix grafts)
#:use-module (guix derivations)
@@ -178,9 +179,9 @@ hooks\" run when building the profile."
;;;
(define (find-packages-by-description regexps)
- "Return two values: the list of packages whose name, synopsis, description,
-or output matches at least one of REGEXPS sorted by relevance, and the list of
-relevance scores."
+ "Return a list of pairs: packages whose name, synopsis, description,
+or output matches at least one of REGEXPS sorted by relevance, and its
+non-zero relevance score."
(let ((matches (fold-packages (lambda (package result)
(if (package-superseded package)
result
@@ -189,19 +190,19 @@ relevance scores."
((? zero?)
result)
(score
- (cons (list package score)
+ (cons (cons package score)
result)))))
'())))
- (unzip2 (sort matches
- (lambda (m1 m2)
- (match m1
- ((package1 score1)
- (match m2
- ((package2 score2)
- (if (= score1 score2)
- (string>? (package-full-name package1)
- (package-full-name package2))
- (> score1 score2)))))))))))
+ (sort matches
+ (lambda (m1 m2)
+ (match m1
+ ((package1 . score1)
+ (match m2
+ ((package2 . score2)
+ (if (= score1 score2)
+ (string>? (package-full-name package1)
+ (package-full-name package2))
+ (> score1 score2))))))))))
(define (transaction-upgrade-entry entry transaction)
"Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
@@ -755,16 +756,10 @@ processed, #f otherwise."
(('query 'search rx) rx)
(_ #f))
opts))
- (regexps (map (cut make-regexp* <> regexp/icase) patterns)))
+ (regexps (map (cut make-regexp* <> regexp/icase) patterns))
+ (matches (find-packages-by-description regexps)))
(leave-on-EPIPE
- (let-values (((packages scores)
- (find-packages-by-description regexps)))
- (for-each (lambda (package score)
- (package->recutils package (current-output-port)
- #:extra-fields
- `((relevance . ,score))))
- packages
- scores)))
+ (display-search-results matches (current-output-port)))
#t))
(('show requested-name)
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 955cdd1e95..5278062edd 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
@@ -139,9 +139,8 @@ columns."
. 1)))
(define (find-service-types regexps)
- "Return two values: the list of service types whose name or description
-matches at least one of REGEXPS sorted by relevance, and the list of relevance
-scores."
+ "Return a list of service type/score pairs: service types whose name or
+description matches REGEXPS sorted by relevance, and their score."
(let ((matches (fold-service-types
(lambda (type result)
(match (relevance type regexps
@@ -149,30 +148,25 @@ scores."
((? zero?)
result)
(score
- (cons (list type score) result))))
+ (cons (cons type score) result))))
'())))
- (unzip2 (sort matches
- (lambda (m1 m2)
- (match m1
- ((type1 score1)
- (match m2
- ((type2 score2)
- (if (= score1 score2)
- (string>? (service-type-name* type1)
- (service-type-name* type2))
- (> score1 score2)))))))))))
+ (sort matches
+ (lambda (m1 m2)
+ (match m1
+ ((type1 . score1)
+ (match m2
+ ((type2 . score2)
+ (if (= score1 score2)
+ (string>? (service-type-name* type1)
+ (service-type-name* type2))
+ (> score1 score2))))))))))
\f
(define (guix-system-search . args)
(with-error-handling
- (let ((regexps (map (cut make-regexp* <> regexp/icase) args)))
+ (let* ((regexps (map (cut make-regexp* <> regexp/icase) args))
+ (matches (find-service-types regexps)))
(leave-on-EPIPE
- (let-values (((services scores)
- (find-service-types regexps)))
- (for-each (lambda (service score)
- (service-type->recutils service
- (current-output-port)
- #:extra-fields
- `((relevance . ,score))))
- services
- scores))))))
+ (display-search-results matches (current-output-port)
+ #:print service-type->recutils
+ #:command "guix system search")))))
diff --git a/guix/ui.scm b/guix/ui.scm
index d9dbe4a652..363ef36dcd 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -46,7 +46,8 @@
#:use-module (guix serialization)
#:use-module ((guix licenses) #:select (license? license-name))
#:use-module ((guix build syscalls)
- #:select (free-disk-space terminal-columns))
+ #:select (free-disk-space terminal-columns
+ terminal-rows))
#:use-module ((guix build utils)
;; XXX: All we need are the bindings related to
;; '&invoke-error'. However, to work around the bug described
@@ -106,8 +107,11 @@
string->recutils
package->recutils
package-specification->name+version+output
+
relevance
package-relevance
+ display-search-results
+
string->generations
string->duration
matching-generations
@@ -1246,6 +1250,11 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
extra-fields)
(newline port))
+\f
+;;;
+;;; Searching.
+;;;
+
(define (relevance obj regexps metrics)
"Compute a \"relevance score\" for OBJ as a function of its number of
matches of REGEXPS and accordingly to METRICS. METRICS is list of
@@ -1315,6 +1324,45 @@ score, the more relevant OBJ is to REGEXPS."
zero means that PACKAGE does not match any of REGEXPS."
(relevance package regexps %package-metrics))
+(define* (display-search-results matches port
+ #:key
+ (command "guix search")
+ (print package->recutils))
+ "Display MATCHES, a list of object/score pairs, by calling PRINT on each of
+them. If PORT is a terminal, print at most a full screen of results."
+ (define first-line
+ (port-line port))
+
+ (define max-rows
+ (and first-line (isatty? port)
+ (terminal-rows port)))
+
+ (define (line-count str)
+ (string-count str #\newline))
+
+ (let loop ((matches matches))
+ (match matches
+ (((package . score) rest ...)
+ (let ((text (call-with-output-string
+ (lambda (port)
+ (print package port
+ #:extra-fields
+ `((relevance . ,score)))))))
+ (if (and 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))))
+
+\f
(define (string->generations str)
"Return the list of generations matching a pattern in STR. This function
accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."
--
2.22.0
^ permalink raw reply related [flat|nested] 6+ messages in thread