From acc084669c01b254f2a12f9f43a8c1b5d16094c1 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Mon, 28 Jan 2013 06:29:10 +0000
Subject: guix-package: Add '--search'.

* guix-package.in (find-packages-by-description): New procedure.
  (show-help, %options): Add '--search'.
  (guix-package)[process-query]: Add support for '--search'.
* doc/guix.texi (Invoking guix-package): Document it.
* tests/guix-package.sh: Add tests.
---
 guix-package.in | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

(limited to 'guix-package.in')

diff --git a/guix-package.in b/guix-package.in
index 46d8d66d2e..913872c925 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -235,6 +235,31 @@ both when LINK already exists and when it does not."
              (switch-link)))
           (else (switch-link)))))                 ; anything else
 
+(define (find-packages-by-description rx)
+  "Search in SYNOPSIS and DESCRIPTION using RX.  Return a list of
+matching packages."
+  (define (same-location? p1 p2)
+    ;; Compare locations of two packages.
+    (equal? (package-location p1) (package-location p2)))
+
+  (delete-duplicates
+   (sort
+    (fold-packages (lambda (package result)
+                     (define matches?
+                       (cut regexp-exec rx <>))
+
+                     (if (or (and=> (package-synopsis package)
+                                    (compose matches? gettext))
+                             (and=> (package-description package)
+                                    (compose matches? gettext)))
+                         (cons package result)
+                         result))
+                   '())
+    (lambda (p1 p2)
+      (string<? (package-name p1)
+                (package-name p2))))
+   same-location?))
+
 
 ;;;
 ;;; Command-line options.
@@ -266,6 +291,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       --verbose          produce verbose output"))
   (newline)
   (display (_ "
+  -s, --search=REGEXP    search in synopsis and description using REGEXP"))
+  (display (_ "
   -I, --list-installed[=REGEXP]
                          list installed packages matching REGEXP"))
   (display (_ "
@@ -311,6 +338,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (option '("verbose") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verbose? #t result)))
+        (option '(#\s "search") #t #f
+                (lambda (opt name arg result)
+                  (cons `(query search ,(or arg ""))
+                        result)))
         (option '(#\I "list-installed") #f #t
                 (lambda (opt name arg result)
                   (cons `(query list-installed ,(or arg ""))
@@ -532,6 +563,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                  name (or version "?") output path))))
                      installed)
            #t))
+
         (('list-available regexp)
          (let* ((regexp    (and regexp (make-regexp regexp)))
                 (available (fold-packages
@@ -554,6 +586,16 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                              (string<? (package-name p1)
                                        (package-name p2)))))
            #t))
+
+        (('search regexp)
+         (let ((regexp (and regexp (make-regexp regexp))))
+           (for-each (lambda (p)
+                       (format #t "~a\t~a\t~a~%"
+                               (package-name p)
+                               (package-version p)
+                               (location->string (package-location p))))
+                     (find-packages-by-description regexp))
+           #t))
         (_ #f))))
 
   (setlocale LC_ALL "")
-- 
cgit v1.2.3