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
parent
3be3328927
commit
f8476e17a7
@ -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
|
||||
|
||||
@ -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))))
|
||||
(values
|
||||
(lambda (address)
|
||||
"Return package by its object ADDRESS."
|
||||
(match (vhash-assq address (force table))
|
||||
((_ . package) package)
|
||||
(_ #f)))))
|
||||
(_ #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)))))
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -393,6 +393,8 @@ 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)
|
||||
;; 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"
|
||||
@ -401,7 +403,7 @@ formatted with this string, an action button is inserted.")
|
||||
'location
|
||||
(button-get btn 'location)))
|
||||
(format "Display packages from location '%s'" location-file)
|
||||
'location 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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user