mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
3be3328927
commit
f8476e17a7
4 changed files with 64 additions and 15 deletions
|
@ -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
|
have the following form: @file{gnu/packages/emacs.scm}, but don't type
|
||||||
them manually! Press @key{TAB} to complete the file name.
|
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
|
@item M-x guix-search-by-regexp
|
||||||
Search for packages by a specified regexp. By default ``name'',
|
Search for packages by a specified regexp. By default ``name'',
|
||||||
``synopsis'' and ``description'' of the packages will be searched. This
|
``synopsis'' and ``description'' of the packages will be searched. This
|
||||||
|
|
|
@ -300,17 +300,26 @@ (define (package-param package param)
|
||||||
|
|
||||||
;;; Finding packages.
|
;;; Finding packages.
|
||||||
|
|
||||||
(define package-by-address
|
(define-values (package-by-address
|
||||||
|
register-package)
|
||||||
(let ((table (delay (fold-packages
|
(let ((table (delay (fold-packages
|
||||||
(lambda (package table)
|
(lambda (package table)
|
||||||
(vhash-consq (object-address package)
|
(vhash-consq (object-address package)
|
||||||
package table))
|
package table))
|
||||||
vlist-null))))
|
vlist-null))))
|
||||||
|
(values
|
||||||
(lambda (address)
|
(lambda (address)
|
||||||
"Return package by its object ADDRESS."
|
"Return package by its object ADDRESS."
|
||||||
(match (vhash-assq address (force table))
|
(match (vhash-assq address (force table))
|
||||||
((_ . package) package)
|
((_ . 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
|
(define packages-by-name+version
|
||||||
(let ((table (delay (fold-packages
|
(let ((table (delay (fold-packages
|
||||||
|
@ -410,6 +419,15 @@ (define (newest-available-packages)
|
||||||
'()
|
'()
|
||||||
(find-newest-available-packages)))
|
(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.
|
;;; Making package/output patterns.
|
||||||
|
|
||||||
|
@ -662,6 +680,8 @@ (define %patterns-makers
|
||||||
(lookup-license license-name))))
|
(lookup-license license-name))))
|
||||||
(location-proc (lambda (_ location)
|
(location-proc (lambda (_ location)
|
||||||
(packages-by-location-file location)))
|
(packages-by-location-file location)))
|
||||||
|
(file-proc (lambda (_ file)
|
||||||
|
(packages-from-file file)))
|
||||||
(all-proc (lambda _ (all-available-packages)))
|
(all-proc (lambda _ (all-available-packages)))
|
||||||
(newest-proc (lambda _ (newest-available-packages))))
|
(newest-proc (lambda _ (newest-available-packages))))
|
||||||
`((package
|
`((package
|
||||||
|
@ -672,6 +692,7 @@ (define %patterns-makers
|
||||||
(regexp . ,regexp-proc)
|
(regexp . ,regexp-proc)
|
||||||
(license . ,license-proc)
|
(license . ,license-proc)
|
||||||
(location . ,location-proc)
|
(location . ,location-proc)
|
||||||
|
(from-file . ,file-proc)
|
||||||
(all-available . ,all-proc)
|
(all-available . ,all-proc)
|
||||||
(newest-available . ,newest-proc))
|
(newest-available . ,newest-proc))
|
||||||
(output
|
(output
|
||||||
|
@ -682,6 +703,7 @@ (define %patterns-makers
|
||||||
(regexp . ,regexp-proc)
|
(regexp . ,regexp-proc)
|
||||||
(license . ,license-proc)
|
(license . ,license-proc)
|
||||||
(location . ,location-proc)
|
(location . ,location-proc)
|
||||||
|
(from-file . ,file-proc)
|
||||||
(all-available . ,all-proc)
|
(all-available . ,all-proc)
|
||||||
(newest-available . ,newest-proc)))))
|
(newest-available . ,newest-proc)))))
|
||||||
|
|
||||||
|
|
|
@ -44,6 +44,9 @@
|
||||||
,(lambda (_ entries locations)
|
,(lambda (_ entries locations)
|
||||||
(apply #'guix-message-packages-by-location
|
(apply #'guix-message-packages-by-location
|
||||||
entries 'package locations)))
|
entries 'package locations)))
|
||||||
|
(from-file
|
||||||
|
(0 "No package in file '%s'." val)
|
||||||
|
(1 "Package from file '%s'." val))
|
||||||
(regexp
|
(regexp
|
||||||
(0 "No packages matching '%s'." val)
|
(0 "No packages matching '%s'." val)
|
||||||
(1 "A single package matching '%s'." val)
|
(1 "A single package matching '%s'." val)
|
||||||
|
@ -80,6 +83,10 @@
|
||||||
,(lambda (_ entries locations)
|
,(lambda (_ entries locations)
|
||||||
(apply #'guix-message-packages-by-location
|
(apply #'guix-message-packages-by-location
|
||||||
entries 'output locations)))
|
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
|
(regexp
|
||||||
(0 "No package outputs matching '%s'." val)
|
(0 "No package outputs matching '%s'." val)
|
||||||
(1 "A single package output 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)
|
(guix-format-insert nil)
|
||||||
(let ((location-file (car (split-string location ":"))))
|
(let ((location-file (car (split-string location ":"))))
|
||||||
(guix-info-insert-value-indent location 'guix-package-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-indent)
|
||||||
(guix-info-insert-action-button
|
(guix-info-insert-action-button
|
||||||
"Packages"
|
"Packages"
|
||||||
|
@ -401,7 +403,7 @@ formatted with this string, an action button is inserted.")
|
||||||
'location
|
'location
|
||||||
(button-get btn 'location)))
|
(button-get btn 'location)))
|
||||||
(format "Display packages from location '%s'" location-file)
|
(format "Display packages from location '%s'" location-file)
|
||||||
'location location-file))))
|
'location location-file)))))
|
||||||
|
|
||||||
(defun guix-package-info-insert-systems (systems entry)
|
(defun guix-package-info-insert-systems (systems entry)
|
||||||
"Insert supported package SYSTEMS at point."
|
"Insert supported package SYSTEMS at point."
|
||||||
|
@ -1000,6 +1002,19 @@ Interactively with prefix, prompt for PROFILE."
|
||||||
(guix-ui-read-profile)))
|
(guix-ui-read-profile)))
|
||||||
(guix-package-get-display profile 'location location))
|
(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
|
;;;###autoload
|
||||||
(defun guix-search-by-regexp (regexp &optional params profile)
|
(defun guix-search-by-regexp (regexp &optional params profile)
|
||||||
"Search for Guix packages by REGEXP.
|
"Search for Guix packages by REGEXP.
|
||||||
|
|
Loading…
Reference in a new issue