* emacs/guix-main.scm (%package-location-table): New variable. (package-location-table, package-locations, packages-by-location): 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. --- doc/emacs.texi | 3 +++ emacs/guix-main.scm | 38 ++++++++++++++++++++++++++++++++++++++ emacs/guix-messages.el | 15 +++++++++++++++ emacs/guix-read.el | 10 ++++++++++ emacs/guix-ui-package.el | 12 +++++++++++- 5 files changed, 77 insertions(+), 1 deletion(-)
diff --git a/doc/emacs.texi b/doc/emacs.texi index c4fdfff..16ff4d5 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -160,6 +160,9 @@ Display package(s) with the specified name. @item M-x guix-packages-by-license Display package(s) with the specified license. +@item M-x guix-packages-by-location +Display package(s) placed in the specified location. + @item M-x guix-search-by-regexp Search for packages by a specified regexp. By default ``name'', ``synopsis'' and ``description'' of the packages will be searched. This diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c620440..9950cad 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -39,6 +39,9 @@ ;; ;; - `%package-table' - Hash table of ;; "name+version key"/"list of packages" pairs. +;; +;; - `%location-table' - Hash table of +;; "package location"/"list of packages" pairs. ;;; Code: @@ -684,6 +687,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 location))) (all-proc (lambda _ (all-available-packages))) (newest-proc (lambda _ (newest-available-packages)))) `((package @@ -693,6 +698,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 +708,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 +1104,34 @@ 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 %package-location-table + (delay + (let ((table (make-hash-table + ;; Rough guess about a number of locations: it is + ;; about 10 times less than the number of packages. + (euclidean/ (vlist-length (package-vhash)) 10)))) + ;; XXX Actually, 'for-each-package' is needed but there is no such yet. + (fold-packages + (lambda (package _) + (let* ((location (location-file (package-location package))) + (packages (or (hash-ref table location) '()))) + (hash-set! table location (cons package packages)))) + #f) + table))) + +(define (package-location-table) + "Return hash table of 'location'/'list of packages' pairs." + (force %package-location-table)) + +(define (package-locations) + "Return a list of available package locations." + (hash-map->list (lambda (location _) location) + (package-location-table))) + +(define (packages-by-location location) + "Return a list of packages placed in LOCATION." + (hash-ref (package-location-table) location)) diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index de0331f..7ebe7e8 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -40,6 +40,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'package licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'package locations))) (regexp (0 "No packages matching '%s'." val) (1 "A single package matching '%s'." val) @@ -72,6 +76,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'output licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'output locations))) (regexp (0 "No package outputs matching '%s'." val) (1 "A single package output matching '%s'." val) @@ -174,6 +182,13 @@ Try \"M-x guix-search-by-name\"." (str-end (format "with license '%s'" license))) (message "%s %s." str-beg str-end))) +(defun guix-message-packages-by-location (entries entry-type location) + "Display a message for packages or outputs searched by LOCATION." + (let* ((count (length entries)) + (str-beg (guix-message-string-entries count entry-type)) + (str-end (format "placed in '%s'" location))) + (message "%s %s." str-beg str-end))) + (defun guix-message-generations-by-time (profile entries times) "Display a message for generations searched by TIMES." (let* ((count (length entries)) diff --git a/emacs/guix-read.el b/emacs/guix-read.el index a1a6b86..0551af9 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -62,6 +62,11 @@ "Return a list of names of available licenses." (guix-eval-read (guix-make-guile-expression 'license-names))) +(guix-memoized-defun guix-package-locations () + "Return a list of available package locations." + (sort (guix-eval-read (guix-make-guile-expression 'package-locations)) + #'string<)) + ;;; Readers @@ -131,6 +136,11 @@ :single-reader guix-read-license-name :single-prompt "License: ") +(guix-define-readers + :completions-getter guix-package-locations + :single-reader guix-read-package-location + :single-prompt "Location: ") + (provide 'guix-read) ;;; guix-read.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index df5f8d1..ecabae1 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -1,6 +1,6 @@ ;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alez...@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alez...@gmail.com> ;; This file is part of GNU Guix. @@ -970,6 +970,16 @@ Interactively with prefix, prompt for PROFILE." (guix-package-get-display profile 'license license)) ;;;###autoload +(defun guix-packages-by-location (location &optional profile) + "Display Guix packages placed in LOCATION. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-package-location) + (guix-ui-read-profile))) + (guix-package-get-display profile 'location location)) + +;;;###autoload (defun guix-search-by-regexp (regexp &optional params profile) "Search for Guix packages by REGEXP. PARAMS are package parameters that should be searched. -- 2.7.3