Merge branch 'master' into core-updates

7 files changed, 258 insertions, 84 deletions

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index dae658ebfa..d720a87833 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -1,6 +1,6 @@
 ;;; guix-base.el --- Common definitions   -*- lexical-binding: t -*-
 
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
+;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
 
 ;; This file is part of GNU Guix.
 
@@ -91,14 +91,25 @@ For the meaning of location, see `guix-find-location'."
   "Return the file name of a PROFILE's GENERATION."
   (format "%s-%s-link" profile generation))
 
-(defun guix-manifest-file (profile &optional generation)
+(defun guix-packages-profile (profile &optional generation system?)
+  "Return a directory where packages are installed for the
+PROFILE's GENERATION.
+
+If SYSTEM? is non-nil, then PROFILE is considered to be a system
+profile.  Unlike usual profiles, for a system profile, packages
+are placed in 'profile' subdirectory."
+  (let ((profile (if generation
+                     (guix-generation-file profile generation)
+                   profile)))
+    (if system?
+        (expand-file-name "profile" profile)
+      profile)))
+
+(defun guix-manifest-file (profile &optional generation system?)
   "Return the file name of a PROFILE's manifest.
-If GENERATION number is specified, return manifest file name for
-this generation."
+See `guix-packages-profile'."
   (expand-file-name "manifest"
-                    (if generation
-                        (guix-generation-file profile generation)
-                      profile)))
+                    (guix-packages-profile profile generation system?)))
 
 ;;;###autoload
 (defun guix-edit (id-or-name)
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 8c38e7cae3..236c882e3c 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -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))
@@ -137,28 +138,26 @@ return two values: name and version.  For example, for SPEC
 (define (manifest-entries->package-specifications entries)
   (map manifest-entry->package-specification entries))
 
-(define (generation-package-specifications profile number)
-  "Return a list of package specifications for generation NUMBER."
-  (let ((manifest (profile-manifest
-                   (generation-file-name profile number))))
+(define (profile-package-specifications profile)
+  "Return a list of package specifications for PROFILE."
+  (let ((manifest (profile-manifest profile)))
     (manifest-entries->package-specifications
      (manifest-entries manifest))))
 
-(define (generation-package-specifications+paths profile number)
-  "Return a list of package specifications and paths for generation NUMBER.
+(define (profile->specifications+paths profile)
+  "Return a list of package specifications and paths for PROFILE.
 Each element of the list is a list of the package specification and its path."
-  (let ((manifest (profile-manifest
-                   (generation-file-name profile number))))
+  (let ((manifest (profile-manifest profile)))
     (map (lambda (entry)
            (list (manifest-entry->package-specification entry)
                  (manifest-entry-item entry)))
          (manifest-entries manifest))))
 
-(define (generation-difference profile number1 number2)
-  "Return a list of package specifications for outputs installed in generation
-NUMBER1 and not installed in generation NUMBER2."
-  (let ((specs1 (generation-package-specifications profile number1))
-        (specs2 (generation-package-specifications profile number2)))
+(define (profile-difference profile1 profile2)
+  "Return a list of package specifications for outputs installed in PROFILE1
+and not installed in PROFILE2."
+  (let ((specs1 (profile-package-specifications profile1))
+        (specs2 (profile-package-specifications profile2)))
     (lset-difference string=? specs1 specs2)))
 
 (define (manifest-entries->hash-table entries)
@@ -670,7 +669,6 @@ ENTRIES is a list of installed manifest entries."
        (id               . ,(apply-to-rest ids->package-patterns))
        (name             . ,(apply-to-rest specifications->package-patterns))
        (installed        . ,manifest-package-proc)
-       (generation       . ,manifest-package-proc)
        (obsolete         . ,(apply-to-first obsolete-package-patterns))
        (regexp           . ,regexp-proc)
        (all-available    . ,all-proc)
@@ -679,7 +677,6 @@ ENTRIES is a list of installed manifest entries."
        (id               . ,(apply-to-rest ids->output-patterns))
        (name             . ,(apply-to-rest specifications->output-patterns))
        (installed        . ,manifest-output-proc)
-       (generation       . ,manifest-output-proc)
        (obsolete         . ,(apply-to-first obsolete-output-patterns))
        (regexp           . ,regexp-proc)
        (all-available    . ,all-proc)
@@ -694,16 +691,13 @@ ENTRIES is a list of installed manifest entries."
                               search-type search-vals)
   "Return information about packages or package outputs.
 See 'entry-sexps' for details."
-  (let* ((profile (if (eq? search-type 'generation)
-                      (generation-file-name profile (car search-vals))
-                      profile))
-         (manifest (profile-manifest profile))
+  (let* ((manifest (profile-manifest profile))
          (patterns (if (and (eq? entry-type 'output)
-                            (eq? search-type 'generation-diff))
+                            (eq? search-type 'profile-diff))
                        (match search-vals
-                         ((g1 g2)
+                         ((p1 p2)
                           (map specification->output-pattern
-                               (generation-difference profile g1 g2)))
+                               (profile-difference p1 p2)))
                          (_ '()))
                        (apply (patterns-maker entry-type search-type)
                               manifest search-vals)))
@@ -765,6 +759,38 @@ See 'entry-sexps' for details."
                                     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).
 
@@ -809,6 +835,9 @@ parameter/value pairs."
     ((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))))
 
 
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
index eb2a76e216..c4f15dcac2 100644
--- a/emacs/guix-messages.el
+++ b/emacs/guix-messages.el
@@ -55,14 +55,7 @@
      (obsolete
       (0 "No obsolete packages in profile '%s'." profile)
       (1 "A single obsolete package in profile '%s'." profile)
-      (many "%d obsolete packages in profile '%s'." count profile))
-     (generation
-      (0 "No packages installed in generation %d of profile '%s'."
-         val profile)
-      (1 "A single package installed in generation %d of profile '%s'."
-         val profile)
-      (many "%d packages installed in generation %d of profile '%s'."
-            count val profile)))
+      (many "%d obsolete packages in profile '%s'." count profile)))
 
     (output
      (id
@@ -91,14 +84,7 @@
       (0 "No obsolete package outputs in profile '%s'." profile)
       (1 "A single obsolete package output in profile '%s'." profile)
       (many "%d obsolete package outputs in profile '%s'." count profile))
-     (generation
-      (0 "No package outputs installed in generation %d of profile '%s'."
-         val profile)
-      (1 "A single package output installed in generation %d of profile '%s'."
-         val profile)
-      (many "%d package outputs installed in generation %d of profile '%s'."
-            count val profile))
-     (generation-diff
+     (profile-diff
       guix-message-outputs-by-diff))
 
     (generation
@@ -183,25 +169,27 @@ Try \"M-x guix-search-by-name\"."
                      "matching time period '%s' - '%s'.")
              str-beg profile time-beg time-end)))
 
-(defun guix-message-outputs-by-diff (profile entries generations)
-  "Display a message for outputs searched by GENERATIONS difference."
+(defun guix-message-outputs-by-diff (_ entries profiles)
+  "Display a message for outputs searched by PROFILES difference."
   (let* ((count (length entries))
          (str-beg (guix-message-string-entries count 'output))
-         (gen1 (car  generations))
-         (gen2 (cadr generations)))
+         (profile1 (car  profiles))
+         (profile2 (cadr profiles)))
     (cl-multiple-value-bind (new old str-action)
-        (if (> gen1 gen2)
-            (list gen1 gen2 "added to")
-          (list gen2 gen1 "removed from"))
-      (message (concat "%s %s generation %d comparing with "
-                       "generation %d of profile '%s'.")
-               str-beg str-action new old profile))))
+        (if (string-lessp profile2 profile1)
+            (list profile1 profile2 "added to")
+          (list profile2 profile1 "removed from"))
+      (message "%s %s profile '%s' comparing with profile '%s'."
+               str-beg str-action new old))))
 
 (defun guix-result-message (profile entries entry-type
                             search-type search-vals)
   "Display an appropriate message after displaying ENTRIES."
   (let* ((type-spec (guix-assq-value guix-messages
-                                     entry-type search-type))
+                                     (if (eq entry-type 'system-generation)
+                                         'generation
+                                       entry-type)
+                                     search-type))
          (fun-or-count-spec (car type-spec)))
     (if (functionp fun-or-count-spec)
         (funcall fun-or-count-spec profile entries search-vals)
diff --git a/emacs/guix-profiles.el b/emacs/guix-profiles.el
index 2c1936864f..43ad1d42eb 100644
--- a/emacs/guix-profiles.el
+++ b/emacs/guix-profiles.el
@@ -1,6 +1,7 @@
 ;;; guix-profiles.el --- Guix profiles
 
-;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
+;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
 
 ;; This file is part of GNU Guix.
 
@@ -25,6 +26,10 @@
   (expand-file-name "~/.guix-profile")
   "User profile.")
 
+(defvar guix-system-profile
+  (concat guix-config-state-directory "/profiles/system")
+  "System profile.")
+
 (defvar guix-default-profile
   (concat guix-config-state-directory
           "/profiles/per-user/"
diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el
index aa71645b4e..4047850f23 100644
--- a/emacs/guix-ui-generation.el
+++ b/emacs/guix-ui-generation.el
@@ -1,6 +1,6 @@
 ;;; guix-ui-generation.el --- Interface for displaying generations  -*- lexical-binding: t -*-
 
-;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
+;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
 
 ;; This file is part of GNU Guix.
 
@@ -78,6 +78,18 @@ Each element from GENERATIONS is a generation number."
       'switch-to-generation* profile generation)
      operation-buffer)))
 
+(defun guix-system-generation? ()
+  "Return non-nil, if current generation is a system one."
+  (eq (guix-buffer-current-entry-type)
+      'system-generation))
+
+(defun guix-generation-current-packages-profile (&optional generation)
+  "Return a directory where packages are installed for the
+current profile's GENERATION."
+  (guix-packages-profile (guix-ui-current-profile)
+                         generation
+                         (guix-system-generation?)))
+
 
 ;;; Generation 'info'
 
@@ -115,8 +127,9 @@ Each element from GENERATIONS is a generation number."
    (lambda (btn)
      (guix-buffer-get-display-entries
       'list guix-package-list-type
-      (list (guix-ui-current-profile)
-            'generation (button-get btn 'number))
+      (list (guix-generation-current-packages-profile
+             (button-get btn 'number))
+            'installed)
       'add))
    "Show installed packages for this generation"
    'number number)
@@ -190,8 +203,8 @@ VAL is a boolean value."
   "List installed packages for the generation at point."
   (interactive)
   (guix-package-get-display
-   (guix-ui-current-profile)
-   'generation (guix-list-current-id)))
+   (guix-generation-current-packages-profile (guix-list-current-id))
+   'installed))
 
 (defun guix-generation-list-generations-to-compare ()
   "Return a sorted list of 2 marked generations for comparing."
@@ -200,6 +213,11 @@ VAL is a boolean value."
         (user-error "2 generations should be marked for comparing")
       (sort numbers #'<))))
 
+(defun guix-generation-list-profiles-to-compare ()
+  "Return a sorted list of 2 marked generation profiles for comparing."
+  (mapcar #'guix-generation-current-packages-profile
+          (guix-generation-list-generations-to-compare)))
+
 (defun guix-generation-list-show-added-packages ()
   "List package outputs added to the latest marked generation.
 If 2 generations are marked with \\[guix-list-mark], display
@@ -209,8 +227,8 @@ installed in the other one."
   (guix-buffer-get-display-entries
    'list 'output
    (cl-list* (guix-ui-current-profile)
-             'generation-diff
-             (reverse (guix-generation-list-generations-to-compare)))
+             'profile-diff
+             (reverse (guix-generation-list-profiles-to-compare)))
    'add))
 
 (defun guix-generation-list-show-removed-packages ()
@@ -222,8 +240,8 @@ installed in the other one."
   (guix-buffer-get-display-entries
    'list 'output
    (cl-list* (guix-ui-current-profile)
-             'generation-diff
-             (guix-generation-list-generations-to-compare))
+             'profile-diff
+             (guix-generation-list-profiles-to-compare))
    'add))
 
 (defun guix-generation-list-compare (diff-fun gen-fun)
@@ -324,14 +342,13 @@ performance."
   "Width of an output name \"column\".
 This variable is used in auxiliary buffers for comparing generations.")
 
-(defun guix-generation-packages (profile generation)
-  "Return a list of sorted packages installed in PROFILE's GENERATION.
+(defun guix-generation-packages (profile)
+  "Return a list of sorted packages installed in PROFILE.
 Each element of the list is a list of the package specification
 and its store path."
   (let ((names+paths (guix-eval-read
                       (guix-make-guile-expression
-                       'generation-package-specifications+paths
-                       profile generation))))
+                       'profile->specifications+paths profile))))
     (sort names+paths
           (lambda (a b)
             (string< (car a) (car b))))))
@@ -360,8 +377,8 @@ Use the full PROFILE file name."
   (indent-to guix-generation-output-name-width 2)
   (insert path "\n"))
 
-(defun guix-generation-insert-packages (buffer profile generation)
-  "Insert package outputs installed in PROFILE's GENERATION in BUFFER."
+(defun guix-generation-insert-packages (buffer profile)
+  "Insert package outputs installed in PROFILE in BUFFER."
   (with-current-buffer buffer
     (setq buffer-read-only nil
           indent-tabs-mode nil)
@@ -369,9 +386,9 @@ Use the full PROFILE file name."
     (mapc (lambda (name+path)
             (guix-generation-insert-package
              (car name+path) (cadr name+path)))
-          (guix-generation-packages profile generation))))
+          (guix-generation-packages profile))))
 
-(defun guix-generation-packages-buffer (profile generation)
+(defun guix-generation-packages-buffer (profile generation &optional system?)
   "Return buffer with package outputs installed in PROFILE's GENERATION.
 Create the buffer if needed."
   (let ((buf-name (guix-generation-packages-buffer-name
@@ -379,19 +396,24 @@ Create the buffer if needed."
     (or (and (null guix-generation-packages-update-buffer)
              (get-buffer buf-name))
         (let ((buf (get-buffer-create buf-name)))
-          (guix-generation-insert-packages buf profile generation)
+          (guix-generation-insert-packages
+           buf
+           (guix-packages-profile profile generation system?))
           buf))))
 
 (defun guix-profile-generation-manifest-file (generation)
   "Return the file name of a GENERATION's manifest.
 GENERATION is a generation number of the current profile."
-  (guix-manifest-file (guix-ui-current-profile) generation))
+  (guix-manifest-file (guix-ui-current-profile)
+                      generation
+                      (guix-system-generation?)))
 
 (defun guix-profile-generation-packages-buffer (generation)
   "Insert GENERATION's package outputs in a buffer and return it.
 GENERATION is a generation number of the current profile."
   (guix-generation-packages-buffer (guix-ui-current-profile)
-                                   generation))
+                                   generation
+                                   (guix-system-generation?)))
 
 
 ;;; Interactive commands
diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el
index 12bfaeef68..29514527ce 100644
--- a/emacs/guix-ui-package.el
+++ b/emacs/guix-ui-package.el
@@ -349,6 +349,10 @@ formatted with this string, an action button is inserted.")
                    'name (button-label btn))
              'add)))
 
+(define-button-type 'guix-package-heading
+  :supertype 'guix-package-name
+  'face 'guix-package-info-heading)
+
 (define-button-type 'guix-package-source
   :supertype 'guix
   'face 'guix-package-info-source
@@ -362,8 +366,7 @@ formatted with this string, an action button is inserted.")
   "Insert package ENTRY heading (name specification) at point."
   (guix-insert-button
    (guix-package-entry->name-specification entry)
-   'guix-package-name
-   'face 'guix-package-info-heading))
+   'guix-package-heading))
 
 (defun guix-package-info-insert-systems (systems entry)
   "Insert supported package SYSTEMS at point."
@@ -909,15 +912,15 @@ See `guix-package-info-type'."
   "A history of minibuffer prompts.")
 
 ;;;###autoload
-(defun guix-search-by-name (name &optional profile)
-  "Search for Guix packages by NAME.
+(defun guix-packages-by-name (name &optional profile)
+  "Display Guix packages with NAME.
 NAME is a string with name specification.  It may optionally contain
 a version number.  Examples: \"guile\", \"guile-2.0.11\".
 
 If PROFILE is nil, use `guix-current-profile'.
 Interactively with prefix, prompt for PROFILE."
   (interactive
-   (list (read-string "Package name: " nil 'guix-package-search-history)
+   (list (guix-read-package-name)
          (guix-ui-read-profile)))
   (guix-package-get-display profile 'name name))
 
@@ -936,6 +939,17 @@ Interactively with prefix, prompt for PROFILE."
                             (or params guix-package-search-params)))
 
 ;;;###autoload
+(defun guix-search-by-name (regexp &optional profile)
+  "Search for Guix packages matching REGEXP in a package name.
+If PROFILE is nil, use `guix-current-profile'.
+Interactively with prefix, prompt for PROFILE."
+  (interactive
+   (list (read-string "Package name by regexp: "
+                      nil 'guix-package-search-history)
+         (guix-ui-read-profile)))
+  (guix-search-by-regexp regexp '(name) profile))
+
+;;;###autoload
 (defun guix-installed-packages (&optional profile)
   "Display information about installed Guix packages.
 If PROFILE is nil, use `guix-current-profile'.
diff --git a/emacs/guix-ui-system-generation.el b/emacs/guix-ui-system-generation.el
new file mode 100644
index 0000000000..d79f3bceef
--- /dev/null
+++ b/emacs/guix-ui-system-generation.el
@@ -0,0 +1,105 @@
+;;; guix-ui-system-generation.el --- Interface for displaying system generations  -*- lexical-binding: t -*-
+
+;; 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 License as published by
+;; the Free Software Foundation, either version 3 of the License, 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 License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides an interface for displaying system generations
+;; in 'list' and 'info' buffers, and commands for working with them.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'guix-list)
+(require 'guix-ui)
+(require 'guix-ui-generation)
+(require 'guix-profiles)
+
+(guix-ui-define-entry-type system-generation)
+
+(defun guix-system-generation-get-display (search-type &rest search-values)
+  "Search for system generations and show results.
+See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and
+SEARCH-VALUES."
+  (apply #'guix-list-get-display-entries
+         'system-generation
+         guix-system-profile
+         search-type search-values))
+
+
+;;; System generation 'info'
+
+(guix-ui-info-define-interface system-generation
+  :buffer-name "*Guix Generation Info*"
+  :format '((number format guix-generation-info-insert-number)
+            (label format (format))
+            (prev-number format (format))
+            (current format guix-generation-info-insert-current)
+            (path format (format guix-file))
+            (time format (time))
+            (root-device format (format))
+            (kernel format (format guix-file)))
+  :titles guix-generation-info-titles)
+
+
+;;; System generation 'list'
+
+;; FIXME It is better to make `guix-generation-list-shared-map' with
+;; common keys for both usual and system generations.
+(defvar guix-system-generation-list-mode-map
+  (copy-keymap guix-generation-list-mode-map)
+  "Keymap for `guix-system-generation-list-mode' buffers.")
+
+(guix-ui-list-define-interface system-generation
+  :buffer-name "*Guix Generation List*"
+  :format '((number nil 5 guix-list-sort-numerically-0 :right-align t)
+            (current guix-generation-list-get-current 10 t)
+            (label nil 40 t)
+            (time guix-list-get-time 20 t)
+            (path guix-list-get-file-path 30 t))
+  :titles guix-generation-list-titles
+  :sort-key '(number . t)
+  :marks '((delete . ?D)))
+
+
+;;; Interactive commands
+
+;;;###autoload
+(defun guix-system-generations ()
+  "Display information about system generations."
+  (interactive)
+  (guix-system-generation-get-display 'all))
+
+;;;###autoload
+(defun guix-last-system-generations (number)
+  "Display information about last NUMBER of system generations."
+  (interactive "nThe number of last generations: ")
+  (guix-system-generation-get-display 'last number))
+
+;;;###autoload
+(defun guix-system-generations-by-time (from to)
+  "Display information about system generations created between FROM and TO."
+  (interactive
+   (list (guix-read-date "Find generations (from): ")
+         (guix-read-date "Find generations (to): ")))
+  (guix-system-generation-get-display
+   'time (float-time from) (float-time to)))
+
+(provide 'guix-ui-system-generation)
+
+;;; guix-ui-system-generation.el ends here