--- guix-package-orig	2013-01-20 16:43:13.000000000 +0000
+++ guix-package	2013-01-20 20:47:38.000000000 +0000
@@ -230,6 +230,32 @@
            (leave (_ "error: no previous profile; not rolling back~%")))
           (else (switch-link)))))
 
+(define (sd-search rx)
+  "Search in SYNOPSIS and DESCRIPTION using RX.  Return a list of
+matching packages."
+  (define psd-list
+    ;; Return a list of lists (each inner list contains PACKAGE-NAME,
+    ;; SYNOPSIS, and DESCRIPTION of every package).
+    (map (lambda (x)
+           (list x (package-synopsis x) (package-description x)))
+         (fold-packages cons '())))
+
+  (define (matcher str)
+    ;; Match RX against STR.  Return the result or #f if nothing was
+    ;; found.
+    (false-if-exception (match:substring (regexp-exec rx str) 0)))
+
+  (define (package? lst)
+    ;; Return PACKAGE wrapped in a list or '() if match failed.
+    (if (any (cut matcher <>) (list (cadr lst) (caddr lst)))
+        (list (car lst))
+        '()))
+
+  (sort (append-map package? psd-list)
+        (lambda (p1 p2)
+          (string<? (package-name p1)
+                    (package-name p2)))))
+
 
 ;;;
 ;;; Command-line options.
@@ -261,6 +287,8 @@
       --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 (_ "
@@ -306,6 +334,10 @@
         (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 ""))
@@ -526,6 +558,7 @@
                                  name (or version "?") output path))))
                      installed)
            #t))
+
         (('list-available regexp)
          (let* ((regexp    (and regexp (make-regexp regexp)))
                 (available (fold-packages
@@ -548,6 +581,16 @@
                              (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))))
+                     (sd-search regexp))
+           #t))
         (_ #f))))
 
   (setlocale LC_ALL "")