From b4ea535a9f0382f3575fdeb3b2eb1cc7cfc37cd4 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 1 Apr 2016 00:07:33 +0300 Subject: emacs: Add 'guix-packages-by-location' command. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * emacs/guix-main.scm (packages-by-location-file, package-location-files): New procedures. (%patterns-makers): Add 'location' search type. * emacs/guix-messages.el (guix-message-packages-by-location): New procedure. (guix-messages): Use it. * emacs/guix-read.el (guix-package-locations) (guix-read-package-location): New procedures. * emacs/guix-ui-package.el (guix-packages-by-location): New command. * doc/emacs.texi (Emacs Commands): Document it. Co-authored-by: Ludovic Courtès --- emacs/guix-main.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'emacs/guix-main.scm') diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c62044056f..4780cced96 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -684,6 +684,8 @@ (define %patterns-makers (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 @@ (define %patterns-makers (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 @@ (define %patterns-makers (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,29 @@ (define (find-licenses search-type . search-values) (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))))) -- cgit v1.2.3