emacs: Add 'guix-package-from-file' command.

* emacs/guix-main.scm (register-package, packages-from-file): New procedures.
(%patterns-makers): Add 'from-file' search type.
* emacs/guix-messages.el (guix-messages): Add messages for it.
* emacs/guix-ui-package.el (guix-package-from-file): New command.
(guix-package-info-insert-location): Adjust for 'from-file' type.
* doc/emacs.texi (Emacs Commands): Document it.
This commit is contained in:
Alex Kost 2016-04-05 23:39:03 +03:00
parent 3be3328927
commit f8476e17a7
4 changed files with 64 additions and 15 deletions

View File

@ -166,6 +166,11 @@ 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-package-from-file
Display package that the code within the specified file evaluates to.
@xref{Invoking guix package, @code{--install-from-file}}, for an example
of what such a file may look like.
@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

@ -300,17 +300,26 @@ Example:
;;; Finding packages.
(define package-by-address
(define-values (package-by-address
register-package)
(let ((table (delay (fold-packages
(lambda (package table)
(vhash-consq (object-address package)
package table))
vlist-null))))
(lambda (address)
"Return package by its object ADDRESS."
(match (vhash-assq address (force table))
((_ . package) package)
(_ #f)))))
(values
(lambda (address)
"Return package by its object ADDRESS."
(match (vhash-assq address (force table))
((_ . package) package)
(_ #f)))
(lambda (package)
"Register PACKAGE by its 'object-address', so that later
'package-by-address' can be used to access it."
(let ((table* (force table)))
(set! table
(delay (vhash-consq (object-address package)
package table*))))))))
(define packages-by-name+version
(let ((table (delay (fold-packages
@ -410,6 +419,15 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
'()
(find-newest-available-packages)))
(define (packages-from-file file)
"Return a list of packages from FILE."
(let ((package (load (canonicalize-path file))))
(if (package? package)
(begin
(register-package package)
(list package))
'())))
;;; Making package/output patterns.
@ -662,6 +680,8 @@ ENTRIES is a list of installed manifest entries."
(lookup-license license-name))))
(location-proc (lambda (_ location)
(packages-by-location-file location)))
(file-proc (lambda (_ file)
(packages-from-file file)))
(all-proc (lambda _ (all-available-packages)))
(newest-proc (lambda _ (newest-available-packages))))
`((package
@ -672,6 +692,7 @@ ENTRIES is a list of installed manifest entries."
(regexp . ,regexp-proc)
(license . ,license-proc)
(location . ,location-proc)
(from-file . ,file-proc)
(all-available . ,all-proc)
(newest-available . ,newest-proc))
(output
@ -682,6 +703,7 @@ ENTRIES is a list of installed manifest entries."
(regexp . ,regexp-proc)
(license . ,license-proc)
(location . ,location-proc)
(from-file . ,file-proc)
(all-available . ,all-proc)
(newest-available . ,newest-proc)))))

View File

@ -44,6 +44,9 @@
,(lambda (_ entries locations)
(apply #'guix-message-packages-by-location
entries 'package locations)))
(from-file
(0 "No package in file '%s'." val)
(1 "Package from file '%s'." val))
(regexp
(0 "No packages matching '%s'." val)
(1 "A single package matching '%s'." val)
@ -80,6 +83,10 @@
,(lambda (_ entries locations)
(apply #'guix-message-packages-by-location
entries 'output locations)))
(from-file
(0 "No package in file '%s'." val)
(1 "Package from file '%s'." val)
(many "Package outputs from file '%s'." val))
(regexp
(0 "No package outputs matching '%s'." val)
(1 "A single package output matching '%s'." val)

View File

@ -393,15 +393,17 @@ formatted with this string, an action button is inserted.")
(guix-format-insert nil)
(let ((location-file (car (split-string location ":"))))
(guix-info-insert-value-indent location 'guix-package-location)
(guix-info-insert-indent)
(guix-info-insert-action-button
"Packages"
(lambda (btn)
(guix-package-get-display (guix-ui-current-profile)
'location
(button-get btn 'location)))
(format "Display packages from location '%s'" location-file)
'location location-file))))
;; Do not show "Packages" button if a package 'from file' is displayed.
(unless (eq (guix-ui-current-search-type) 'from-file)
(guix-info-insert-indent)
(guix-info-insert-action-button
"Packages"
(lambda (btn)
(guix-package-get-display (guix-ui-current-profile)
'location
(button-get btn 'location)))
(format "Display packages from location '%s'" location-file)
'location location-file)))))
(defun guix-package-info-insert-systems (systems entry)
"Insert supported package SYSTEMS at point."
@ -1000,6 +1002,19 @@ Interactively with prefix, prompt for PROFILE."
(guix-ui-read-profile)))
(guix-package-get-display profile 'location location))
;;;###autoload
(defun guix-package-from-file (file &optional profile)
"Display Guix package that the code from FILE evaluates to.
If PROFILE is nil, use `guix-current-profile'.
Interactively with prefix, prompt for PROFILE."
(interactive
(list (read-file-name "File with package: ")
(guix-ui-read-profile)))
(guix-buffer-get-display-entries
'info 'package
(list (or profile guix-current-profile) 'from-file file)
'add))
;;;###autoload
(defun guix-search-by-regexp (regexp &optional params profile)
"Search for Guix packages by REGEXP.