summaryrefslogtreecommitdiff
path: root/emacs
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2016-04-05 23:39:03 +0300
committerAlex Kost <alezost@gmail.com>2016-05-10 12:05:53 +0300
commitf8476e17a70ecc7d46c746480130477b7c35306b (patch)
tree155ea4146af6c6a6a416eca3a31fa822fab96c23 /emacs
parent3be33289272beda681afa9a48d52fa9a84bcd049 (diff)
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.
Diffstat (limited to 'emacs')
-rw-r--r--emacs/guix-main.scm34
-rw-r--r--emacs/guix-messages.el7
-rw-r--r--emacs/guix-ui-package.el33
3 files changed, 59 insertions, 15 deletions
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 5d7df2a7f9..e645a85e7d 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -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)))))
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
index 7ebe7e8b5c..52436af9e4 100644
--- a/emacs/guix-messages.el
+++ b/emacs/guix-messages.el
@@ -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)
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
index 38f0c08fc7..edc36486fc 100644
--- a/emacs/guix-ui-package.el
+++ b/emacs/guix-ui-package.el
@@ -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."
@@ -1001,6 +1003,19 @@ Interactively with prefix, prompt for 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.
PARAMS are package parameters that should be searched.