From 67cedc4ba69ec90b2d9d94646b861ba6821f342d Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Thu, 7 Jan 2016 23:01:26 +0300
Subject: emacs: Add interface for system generations.

* emacs/guix-main.scm (system-generation-boot-parameters)
(system-generation-param-alist, system-generation-sexps): New procedures.
(entries): Add 'system-generation' entry type.
* emacs/guix-messages.el (guix-result-message): Use the same messages
  for 'generation' and 'system-generation' entry types.
* emacs/guix-ui-system-generation.el: New file.
* emacs.am (ELFILES): Add it.
* doc/emacs.texi (Emacs Commands): Document new commands.
* NEWS: Mention new interface.
---
 emacs/guix-main.scm | 38 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

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

diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 1199679975..236c882e3c 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -61,7 +61,8 @@
  (guix scripts lint)
  (guix scripts package)
  (guix scripts pull)
- (gnu packages))
+ (gnu packages)
+ (gnu system))
 
 (define-syntax-rule (first-or-false lst)
   (and (not (null? lst))
@@ -758,6 +759,38 @@ (define (generation-sexps profile params search-type search-vals)
                                     params)))
     (map ->sexp generations)))
 
+(define system-generation-boot-parameters
+  (memoize
+   (lambda (profile generation)
+     "Return boot parameters for PROFILE's system GENERATION."
+     (let* ((gen-file   (generation-file-name profile generation))
+            (param-file (string-append gen-file "/parameters")))
+       (call-with-input-file param-file read-boot-parameters)))))
+
+(define (system-generation-param-alist profile)
+  "Return an alist of system generation parameters and procedures for
+PROFILE."
+  (append (generation-param-alist profile)
+          `((label       . ,(lambda (gen)
+                              (boot-parameters-label
+                               (system-generation-boot-parameters
+                                profile gen))))
+            (root-device . ,(lambda (gen)
+                              (boot-parameters-root-device
+                               (system-generation-boot-parameters
+                                profile gen))))
+            (kernel      . ,(lambda (gen)
+                              (boot-parameters-kernel
+                               (system-generation-boot-parameters
+                                profile gen)))))))
+
+(define (system-generation-sexps profile params search-type search-vals)
+  "Return an alist with information about system generations."
+  (let ((generations (find-generations profile search-type search-vals))
+        (->sexp (object-transformer (system-generation-param-alist profile)
+                                    params)))
+    (map ->sexp generations)))
+
 
 ;;; Getting package/output/generation entries (alists).
 
@@ -802,6 +835,9 @@ (define (entries profile params entry-type search-type search-vals)
     ((generation)
      (generation-sexps profile params
                        search-type search-vals))
+    ((system-generation)
+     (system-generation-sexps profile params
+                              search-type search-vals))
     (else (entry-type-error entry-type))))
 
 
-- 
cgit v1.2.3