Merge branch 'master' into core-updates

1 files changed, 42 insertions, 0 deletions

diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index c62044056f..5358f3bfa4 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -684,6 +684,8 @@ ENTRIES is a list of installed manifest entries."
          (license-proc          (lambda (_ license-name)
                                   (packages-by-license
                                    (lookup-license license-name))))
+         (location-proc         (lambda (_ location)
+                                  (packages-by-location-file location)))
          (all-proc              (lambda _ (all-available-packages)))
          (newest-proc           (lambda _ (newest-available-packages))))
     `((package
@@ -693,6 +695,7 @@ ENTRIES is a list of installed manifest entries."
        (obsolete         . ,(apply-to-first obsolete-package-patterns))
        (regexp           . ,regexp-proc)
        (license          . ,license-proc)
+       (location         . ,location-proc)
        (all-available    . ,all-proc)
        (newest-available . ,newest-proc))
       (output
@@ -702,6 +705,7 @@ ENTRIES is a list of installed manifest entries."
        (obsolete         . ,(apply-to-first obsolete-output-patterns))
        (regexp           . ,regexp-proc)
        (license          . ,license-proc)
+       (location         . ,location-proc)
        (all-available    . ,all-proc)
        (newest-available . ,newest-proc)))))
 
@@ -1097,3 +1101,41 @@ Return #t if the shell command was executed successfully."
 (define (license-entries search-type . search-values)
   (map license->sexp
        (apply find-licenses search-type search-values)))
+
+
+;;; Package locations
+
+(define-values (packages-by-location-file
+                package-location-files)
+  (let* ((table (delay (fold-packages
+                        (lambda (package table)
+                          (let ((file (location-file
+                                       (package-location package))))
+                            (vhash-cons file package table)))
+                        vlist-null)))
+         (files (delay (vhash-fold
+                        (lambda (file _ result)
+                          (if (member file result)
+                              result
+                              (cons file result)))
+                        '()
+                        (force table)))))
+    (values
+     (lambda (file)
+       "Return the (possibly empty) list of packages defined in location FILE."
+       (vhash-fold* cons '() file (force table)))
+     (lambda ()
+       "Return the list of file names of all package locations."
+       (force files)))))
+
+(define %package-location-param-alist
+  `((id       . ,identity)
+    (location . ,identity)
+    (number-of-packages . ,(lambda (location)
+                             (length (packages-by-location-file location))))))
+
+(define package-location->sexp
+  (object-transformer %package-location-param-alist))
+
+(define (package-location-entries)
+  (map package-location->sexp (package-location-files)))