From a365d7f796d0db711bb67902f65826af9e951d06 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <address@hidden>
Date: Wed, 23 Jan 2013 15:22:34 +0000
Subject: [PATCH] guix-package: Add '--search'.

* guix-package.in (find-packages-by-description): New procedure.
  (show-help): Add '--search'.
  (%options): Likewise.
  (guix-package)[process-query]: Add support for '--search'.
---
 guix-package.in |   50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 50 insertions(+), 0 deletions(-)

diff --git a/guix-package.in b/guix-package.in
index 85ac358..16a268b 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -229,6 +229,39 @@ all of PACKAGES, a list of name/version/output/path tuples."
            (leave (_ "error: no previous profile; not rolling back~%")))
           (else (switch-link)))))
 
+(define (find-packages-by-description rx)
+  "Search in SYNOPSIS and DESCRIPTION using RX.  Return a list of
+matching packages."
+  (define (remove-duplicates pred lst)
+    ;; Remove duplicates from sorted LST using PRED.
+    (cond ((null-list? lst)   lst)
+          ((= (length lst) 1) lst)
+          ((= (length lst) 2)
+           (if (pred (first lst) (second lst)) (cdr lst) lst))
+          ((pred (first lst) (second lst))
+           (remove-duplicates pred (cdr lst)))
+          (else (cons (first lst) (remove-duplicates pred (cdr lst))))))
+
+  (define (same-location? p1 p2)
+    ;; Compare locations of two packages.
+    (eq? (package-location p1) (package-location p2)))
+
+  (remove-duplicates
+   same-location?
+   (stable-sort
+    (fold-packages
+     (lambda (package result)
+       (if (or (false-if-exception
+                (regexp-exec rx (gettext (package-synopsis package))))
+               (false-if-exception
+                (regexp-exec rx (gettext (package-description package)))))
+           (cons package result)
+           result))
+     '())
+    (lambda (p1 p2)
+      (string<? (package-name p1)
+                (package-name p2))))))
+

 ;;;
 ;;; Command-line options.
@@ -251,6 +284,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       --roll-back        roll back to the previous generation"))
   (newline)
   (display (_ "
+  -s, --search=REGEXP    search in synopsis and description using REGEXP"))
+  (display (_ "
   -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
   (display (_ "
   -n, --dry-run          show what would be done without actually doing it"))
@@ -305,6 +340,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 ""))
@@ -525,6 +564,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
@@ -547,6 +587,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 "")
-- 
1.7.5.4