Merge branch 'master' into core-updates

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			\