From 64fc89b6ec0928f7bbd7011d6a8dc325d63f4fe5 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 19 Nov 2012 23:02:59 +0100
Subject: guix-package: Add `--list-available'.

* guix-package.in (show-help, %options): Add `--list-available'.
  (guix-package)[process-query]: Add support for `--list-available'.
* doc/guix.texi (Invoking guix-package): Document it.
* tests/guix-package.sh: Add test.

* guix/ui.scm (location->string): New procedure.
* guix/utils.scm: Export <location>.
---
 doc/guix.texi         |  9 +++++++++
 guix-package.in       | 33 +++++++++++++++++++++++++++++++--
 guix/ui.scm           | 11 ++++++++++-
 guix/utils.scm        |  1 +
 tests/guix-package.sh |  3 +++
 5 files changed, 54 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a93510ee23..d09bbf1acf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -257,6 +257,15 @@ is installed (for instance, @code{out} for the default output,
 @code{include} for its headers, etc.), and the path of this package in
 the store.
 
+@item --list-available[=@var{regexp}]
+@itemx -A [@var{regexp}]
+List packages currently available in the software distribution.  When
+@var{regexp} is specified, list only installed packages whose name
+matches @var{regexp}.
+
+For each package, print the following items separated by tabs: its name,
+its version string, and the source location of its definition.
+
 @end table
 
 
diff --git a/guix-package.in b/guix-package.in
index ba07eb7c2e..4e66dccdc0 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -44,7 +44,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
-  #:autoload   (distro) (find-packages-by-name)
+  #:use-module (distro)
   #:use-module (distro packages guile)
   #:export (guix-package))
 
@@ -204,6 +204,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
   -I, --list-installed[=REGEXP]
                          list installed packages matching REGEXP"))
+  (display (_ "
+  -A, --list-available[=REGEXP]
+                         list available packages matching REGEXP"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -242,6 +245,10 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
         (option '(#\I "list-installed") #f #t
                 (lambda (opt name arg result)
                   (cons `(query list-installed ,(or arg ""))
+                        result)))
+        (option '(#\A "list-available") #f #t
+                (lambda (opt name arg result)
+                  (cons `(query list-available ,(or arg ""))
                         result)))))
 
 
@@ -385,7 +392,29 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
                                  (regexp-exec regexp name))
                          (format #t "~a\t~a\t~a\t~a~%"
                                  name (or version "?") output path))))
-                     installed)))
+                     installed)
+           #t))
+        (('list-available regexp)
+         (let* ((regexp    (and regexp (make-regexp regexp)))
+                (available (fold-packages
+                            (lambda (p r)
+                              (let ((n (package-name p)))
+                                (if regexp
+                                    (if (regexp-exec regexp n)
+                                        (cons p r)
+                                        r)
+                                    (cons p r))))
+                            '())))
+           (for-each (lambda (p)
+                       (format #t "~a\t~a\t~a~%"
+                               (package-name p)
+                               (package-version p)
+                               (location->string (package-location p))))
+                     (sort available
+                           (lambda (p1 p2)
+                             (string<? (package-name p1)
+                                       (package-name p2)))))
+           #t))
         (_ #f))))
 
   (setlocale LC_ALL "")
diff --git a/guix/ui.scm b/guix/ui.scm
index 447c3a9a9f..4fc0dd089a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -23,12 +23,14 @@
   #:use-module (guix packages)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (ice-9 match)
   #:export (_
             N_
             leave
             show-version-and-exit
             call-with-error-handling
-            with-error-handling))
+            with-error-handling
+            location->string))
 
 ;;; Commentary:
 ;;;
@@ -80,4 +82,11 @@
       (lambda ()
         body ...)))))
 
+(define (location->string loc)
+  "Return a human-friendly, GNU-standard representation of LOC."
+  (match loc
+    (#f (_ "<unknown location>"))
+    (($ <location> file line column)
+     (format #f "~a:~a:~a" file line column))))
+
 ;;; ui.scm ends here
diff --git a/guix/utils.scm b/guix/utils.scm
index ff8730aa63..5ec8f3736d 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -47,6 +47,7 @@
             default-keyword-arguments
             substitute-keyword-arguments
 
+            <location>
             location
             location?
             location-file
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 6c457ffd4b..c47ebe6fe7 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -57,4 +57,7 @@ test -f "$profile/bin/make" && ! test -f "$profile/bin/guile"
 # Make sure the `:' syntax works.
 guix-package -b -i "libsigsegv:lib" -n
 
+# Check whether `--list-available' returns something sensible.
+guix-package -A 'gui.*e' | grep guile
+
 rm "$profile" "$profile-"[0-9]*
-- 
cgit v1.2.3