summaryrefslogtreecommitdiff
path: root/emacs/guix-main.scm
diff options
context:
space:
mode:
Diffstat (limited to 'emacs/guix-main.scm')
-rw-r--r--emacs/guix-main.scm42
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)))