From f8476e17a70ecc7d46c746480130477b7c35306b Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Tue, 5 Apr 2016 23:39:03 +0300
Subject: 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.
---
 emacs/guix-main.scm | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

(limited to 'emacs/guix-main.scm')

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 @@ (define (package-param package param)
 
 ;;; 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 @@ (define (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.
 
@@ -662,6 +680,8 @@ (define %patterns-makers
                                    (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 @@ (define %patterns-makers
        (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 @@ (define %patterns-makers
        (regexp           . ,regexp-proc)
        (license          . ,license-proc)
        (location         . ,location-proc)
+       (from-file        . ,file-proc)
        (all-available    . ,all-proc)
        (newest-available . ,newest-proc)))))
 
-- 
cgit v1.2.3