emacs: Add 'guix-packages-by-location' command.

* 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 <ludo@gnu.org>
This commit is contained in:
Alex Kost 2016-04-01 00:07:33 +03:00
parent 9bb46c155b
commit b4ea535a9f
5 changed files with 72 additions and 1 deletions

View file

@ -160,6 +160,11 @@ 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) located in the specified file. These files usually
have the following form: @file{gnu/packages/emacs.scm}, but don't type
them manually! Press @key{TAB} to complete the file name.
@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

View file

@ -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)))))

View file

@ -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))

View file

@ -62,6 +62,12 @@
"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-location-files))
#'string<))
;;; Readers
@ -131,6 +137,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

View file

@ -1,6 +1,6 @@
;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*-
;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
@ -969,6 +969,16 @@ Interactively with prefix, prompt for PROFILE."
(guix-ui-read-profile)))
(guix-package-get-display profile 'license license))
;;;###autoload
(defun guix-packages-by-location (location &optional profile)
"Display Guix packages placed in LOCATION file.
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.