diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-about.el | 37 | ||||
| -rw-r--r-- | emacs/guix-config.el.in | 8 | ||||
| -rw-r--r-- | emacs/guix-guile.el | 2 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 96 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 7 | ||||
| -rw-r--r-- | emacs/guix-ui-package.el | 33 | ||||
| -rw-r--r-- | emacs/local.mk | 1 |
7 files changed, 124 insertions, 60 deletions
diff --git a/emacs/guix-about.el b/emacs/guix-about.el new file mode 100644 index 0000000000..27a79fe162 --- /dev/null +++ b/emacs/guix-about.el @@ -0,0 +1,37 @@ +;;; guix-about.el --- Various info about Guix + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; This file is part of GNU Guix. + +;; GNU Guix is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public Location as published by +;; the Free Software Foundation, either version 3 of the Location, or +;; (at your option) any later version. + +;; GNU Guix is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public Location for more details. + +;; You should have received a copy of the GNU General Public Location +;; along with this program. If not, see <http://www.gnu.org/locations/>. + +;;; Commentary: + +;; This file provides the code to display various info about Guix (e.g., its +;; version). + +;;; Code: + +(require 'guix-config) + +;;;###autoload +(defun guix-version () + "Display Guix version in the echo area." + (interactive) + (message "%s %s" guix-config-name guix-config-version)) + +(provide 'guix-about) + +;;; guix-about.el ends here diff --git a/emacs/guix-config.el.in b/emacs/guix-config.el.in index d03df9ce63..c09c2fe86a 100644 --- a/emacs/guix-config.el.in +++ b/emacs/guix-config.el.in @@ -1,7 +1,7 @@ ;;; guix-config.el --- Compile-time configuration of Guix. ;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> -;; Copyright © 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -20,6 +20,12 @@ ;;; Code: +(defconst guix-config-name "@PACKAGE_NAME@" + "Guix full name.") + +(defconst guix-config-version "@PACKAGE_VERSION@" + "Guix version.") + (defconst guix-config-emacs-interface-directory (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")) diff --git a/emacs/guix-guile.el b/emacs/guix-guile.el index cd6c54d87e..792f825ca5 100644 --- a/emacs/guix-guile.el +++ b/emacs/guix-guile.el @@ -57,7 +57,7 @@ Return nil, if current buffer does not define a module." (defun guix-guile-boolean (arg) "Return a string with guile boolean value. Transform elisp ARG (nil or non-nil) to the guile boolean (#f or #t)." - (concat "#" (prin1-to-string (if arg 't 'f)))) + (if arg "#t" "#f")) (defun guix-guile-keyword-regexp (keyword) "Return regexp to find guile KEYWORD." diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 5358f3bfa4..e645a85e7d 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -32,14 +32,6 @@ ;; still "name-version" string. So ‘id’ package parameter in the code ;; below is either an object-address number or a full-name string. -;; To speed-up the process of getting information, the following -;; auxiliary variables are used: -;; -;; - `%packages' - VHash of "package address"/"package" pairs. -;; -;; - `%package-table' - Hash table of -;; "name+version key"/"list of packages" pairs. - ;;; Code: (use-modules @@ -52,6 +44,7 @@ (srfi srfi-19) (srfi srfi-26) (guix) + (guix combinators) (guix git-download) (guix packages) (guix profiles) @@ -100,38 +93,6 @@ return two values: name and version. For example, for SPEC (string-append full-name ":" output) full-name))) -(define name+version->key cons) -(define key->name+version car+cdr) - -(define %package-vhash - (delay - (fold-packages (lambda (pkg res) - (vhash-consq (object-address pkg) pkg res)) - vlist-null))) - -(define (package-vhash) - "Return vhash of 'package ID (address)'/'package' pairs." - (force %package-vhash)) - -(define %package-table - (delay - (let ((table (make-hash-table (vlist-length (package-vhash))))) - (vlist-for-each - (lambda (elem) - (match elem - ((address . pkg) - (let* ((key (name+version->key (package-name pkg) - (package-version pkg))) - (ref (hash-ref table key))) - (hash-set! table key - (if ref (cons pkg ref) (list pkg))))))) - (package-vhash)) - table))) - -(define (package-table) - "Return hash table of 'name+version key'/'list of packages' pairs." - (force %package-table)) - (define (manifest-entry->name+version+output entry) (values (manifest-entry-name entry) @@ -339,15 +300,39 @@ Example: ;;; Finding packages. -(define (package-by-address address) - (match (vhash-assq address (package-vhash)) - ((_ . package) package) - (_ #f))) - -(define (packages-by-name+version name version) - (or (hash-ref (package-table) - (name+version->key name version)) - '())) +(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))) + (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 + (lambda (package table) + (let ((file (location-file + (package-location package)))) + (vhash-cons (cons (package-name package) + (package-version package)) + package table))) + vlist-null)))) + (lambda (name version) + "Return packages matching NAME and VERSION." + (vhash-fold* cons '() (cons name version) (force table))))) (define (packages-by-full-name full-name) (call-with-values @@ -434,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. @@ -686,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 @@ -696,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 @@ -706,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. diff --git a/emacs/local.mk b/emacs/local.mk index 62e33e4fd2..f83063cf5f 100644 --- a/emacs/local.mk +++ b/emacs/local.mk @@ -20,6 +20,7 @@ AUTOLOADS = emacs/guix-autoloads.el ELFILES = \ + emacs/guix-about.el \ emacs/guix-backend.el \ emacs/guix-base.el \ emacs/guix-build-log.el \ |