summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix/scripts/package.scm41
-rw-r--r--guix/scripts/system/search.scm44
-rw-r--r--guix/ui.scm50
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))))))))))
(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))
+
+;;;
+;;; 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))))
+
+
(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\"."
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-30 08:29:24 +0000