emacs: Add interface for comparing generations.

Suggested by Ludovic Courtès.

* doc/emacs.texi (Emacs List buffer): Document new key bindings.
* emacs/guix-base.el (guix-generation-packages-buffer-name-function,
  guix-generation-packages-update-buffer, guix-output-name-width): New
  variables.
  (guix-generation-file, guix-manifest-file, guix-generation-packages,
  guix-generation-packages-buffer-name-default,
  guix-generation-packages-buffer-name-long,
  guix-generation-packages-buffer-name, guix-generation-packages-buffer,
  guix-generation-insert-package, guix-generation-insert-packages,
  guix-profile-generation-manifest-file,
  guix-profile-generation-packages-buffer): New procedures.
* emacs/guix-list.el: Add key bindings for comparing generations.
  (guix-generation-list-generations-to-compare,
  guix-generation-list-show-added-packages,
  guix-generation-list-show-removed-packages, guix-generation-list-compare,
  guix-generation-list-ediff-manifests, guix-generation-list-diff-manifests,
  guix-generation-list-ediff-packages, guix-generation-list-diff-packages,
  guix-generation-list-ediff, guix-generation-list-diff): New procedures.
* emacs/guix-messages.el (guix-messages): Add 'generation-diff' search type.
  (guix-message-outputs-by-diff): New procedure.
* emacs/guix-utils.el (guix-diff-switches): New variable.
  (guix-diff): New procedure.
* emacs/guix-main.scm (package/output-sexps): Handle 'generation-diff' search
  type.
  (manifest-entry->package-specification,
  manifest-entries->package-specifications, generation-package-specifications,
  generation-package-specifications+paths, generation-difference): New
  procedures.

5 files changed, 263 insertions, 4 deletions

diff --git a/emacs/guix-base.el b/emacs/guix-base.el
index eb88f37140..3dda938065 100644
--- a/emacs/guix-base.el
+++ b/emacs/guix-base.el
@@ -650,6 +650,117 @@ This function will not update the information, use
                        guix-search-type guix-search-vals))
 
 
+;;; Generations
+
+(defcustom guix-generation-packages-buffer-name-function
+  #'guix-generation-packages-buffer-name-default
+  "Function used to define name of a buffer with generation packages.
+This function is called with 2 arguments: PROFILE (string) and
+GENERATION (number)."
+  :type '(choice (function-item guix-generation-packages-buffer-name-default)
+                 (function-item guix-generation-packages-buffer-name-long)
+                 (function :tag "Other function"))
+  :group 'guix)
+
+(defcustom guix-generation-packages-update-buffer t
+  "If non-nil, always update list of packages during comparing generations.
+If nil, generation packages are received only once.  So when you
+compare generation 1 and generation 2, the packages for both
+generations will be received.  Then if you compare generation 1
+and generation 3, only the packages for generation 3 will be
+received.  Thus if you use comparing of different generations a
+lot, you may set this variable to nil to improve the
+performance."
+  :type 'boolean
+  :group 'guix)
+
+(defvar guix-output-name-width 30
+  "Width of an output name \"column\".
+This variable is used in auxiliary buffers for comparing generations.")
+
+(defun guix-generation-file (profile generation)
+  "Return the file name of a PROFILE's GENERATION."
+  (format "%s-%s-link" profile generation))
+
+(defun guix-manifest-file (profile &optional generation)
+  "Return the file name of a PROFILE's manifest.
+If GENERATION number is specified, return manifest file name for
+this generation."
+  (expand-file-name "manifest"
+                    (if generation
+                        (guix-generation-file profile generation)
+                      profile)))
+
+(defun guix-generation-packages (profile generation)
+  "Return a list of sorted packages installed in PROFILE's GENERATION.
+Each element of the list is a list of the package specification and its path."
+  (let ((names+paths (guix-eval-read
+                      (guix-make-guile-expression
+                       'generation-package-specifications+paths
+                       profile generation))))
+    (sort names+paths
+          (lambda (a b)
+            (string< (car a) (car b))))))
+
+(defun guix-generation-packages-buffer-name-default (profile generation)
+  "Return name of a buffer for displaying GENERATION's package outputs.
+Use base name of PROFILE path."
+  (let ((profile-name (file-name-base (directory-file-name profile))))
+    (format "*Guix %s: generation %s*"
+            profile-name generation)))
+
+(defun guix-generation-packages-buffer-name-long (profile generation)
+  "Return name of a buffer for displaying GENERATION's package outputs.
+Use the full PROFILE path."
+  (format "*Guix generation %s (%s)*"
+          generation profile))
+
+(defun guix-generation-packages-buffer-name (profile generation)
+  "Return name of a buffer for displaying GENERATION's package outputs."
+  (let ((fun (if (functionp guix-generation-packages-buffer-name-function)
+                 guix-generation-packages-buffer-name-function
+               #'guix-generation-packages-buffer-name-default)))
+    (funcall fun profile generation)))
+
+(defun guix-generation-insert-package (name path)
+  "Insert package output NAME and PATH at point."
+  (insert name)
+  (indent-to guix-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."
+  (with-current-buffer buffer
+    (setq buffer-read-only nil
+          indent-tabs-mode nil)
+    (erase-buffer)
+    (mapc (lambda (name+path)
+            (guix-generation-insert-package
+             (car name+path) (cadr name+path)))
+          (guix-generation-packages profile generation))))
+
+(defun guix-generation-packages-buffer (profile generation)
+  "Return buffer with package outputs installed in PROFILE's GENERATION.
+Create the buffer if needed."
+  (let ((buf-name (guix-generation-packages-buffer-name
+                   profile generation)))
+    (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)
+          buf))))
+
+(defun guix-profile-generation-manifest-file (generation)
+  "Return the file name of a GENERATION's manifest.
+GENERATION is a generation number of `guix-profile' profile."
+  (guix-manifest-file guix-profile 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 `guix-profile' profile."
+  (guix-generation-packages-buffer guix-profile generation))
+
+
 ;;; Actions on packages and generations
 
 (defface guix-operation-option-key
diff --git a/emacs/guix-list.el b/emacs/guix-list.el
index 58c03b37a9..600f2bd9bd 100644
--- a/emacs/guix-list.el
+++ b/emacs/guix-list.el
@@ -27,7 +27,6 @@
 (require 'cl-lib)
 (require 'tabulated-list)
 (require 'guix-info)
-(require 'guix-history)
 (require 'guix-base)
 (require 'guix-utils)
 
@@ -735,6 +734,11 @@ Also see `guix-package-info-type'."
 
 (let ((map guix-generation-list-mode-map))
   (define-key map (kbd "RET") 'guix-generation-list-show-packages)
+  (define-key map (kbd "+")   'guix-generation-list-show-added-packages)
+  (define-key map (kbd "-")   'guix-generation-list-show-removed-packages)
+  (define-key map (kbd "=")   'guix-generation-list-diff)
+  (define-key map (kbd "D")   'guix-generation-list-diff)
+  (define-key map (kbd "e")   'guix-generation-list-ediff)
   (define-key map (kbd "x")   'guix-generation-list-execute)
   (define-key map (kbd "i")   'guix-list-describe)
   (define-key map (kbd "s")   'guix-generation-list-switch)
@@ -761,6 +765,85 @@ VAL is a boolean value."
   (guix-get-show-entries guix-profile 'list guix-package-list-type
                          'generation (guix-list-current-id)))
 
+(defun guix-generation-list-generations-to-compare ()
+  "Return a sorted list of 2 marked generations for comparing."
+  (let ((numbers (guix-list-get-marked-id-list 'general)))
+    (if (/= (length numbers) 2)
+        (user-error "2 generations should be marked for comparing")
+      (sort numbers #'<))))
+
+(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
+outputs installed in the latest marked generation that were not
+installed in the other one."
+  (interactive)
+  (apply #'guix-get-show-entries
+         guix-profile 'list 'output 'generation-diff
+         (reverse (guix-generation-list-generations-to-compare))))
+
+(defun guix-generation-list-show-removed-packages ()
+  "List package outputs removed from the latest marked generation.
+If 2 generations are marked with \\[guix-list-mark], display
+outputs not installed in the latest marked generation that were
+installed in the other one."
+  (interactive)
+  (apply #'guix-get-show-entries
+         guix-profile 'list 'output 'generation-diff
+         (guix-generation-list-generations-to-compare)))
+
+(defun guix-generation-list-compare (diff-fun gen-fun)
+  "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
+  (cl-multiple-value-bind (gen1 gen2)
+      (guix-generation-list-generations-to-compare)
+    (funcall diff-fun
+             (funcall gen-fun gen1)
+             (funcall gen-fun gen2))))
+
+(defun guix-generation-list-ediff-manifests ()
+  "Run Ediff on manifests of the 2 marked generations."
+  (interactive)
+  (guix-generation-list-compare
+   #'ediff-files
+   #'guix-profile-generation-manifest-file))
+
+(defun guix-generation-list-diff-manifests ()
+  "Run Diff on manifests of the 2 marked generations."
+  (interactive)
+  (guix-generation-list-compare
+   #'guix-diff
+   #'guix-profile-generation-manifest-file))
+
+(defun guix-generation-list-ediff-packages ()
+  "Run Ediff on package outputs installed in the 2 marked generations."
+  (interactive)
+  (guix-generation-list-compare
+   #'ediff-buffers
+   #'guix-profile-generation-packages-buffer))
+
+(defun guix-generation-list-diff-packages ()
+  "Run Diff on package outputs installed in the 2 marked generations."
+  (interactive)
+  (guix-generation-list-compare
+   #'guix-diff
+   #'guix-profile-generation-packages-buffer))
+
+(defun guix-generation-list-ediff (arg)
+  "Run Ediff on package outputs installed in the 2 marked generations.
+With ARG, run Ediff on manifests of the marked generations."
+  (interactive "P")
+  (if arg
+      (guix-generation-list-ediff-manifests)
+    (guix-generation-list-ediff-packages)))
+
+(defun guix-generation-list-diff (arg)
+  "Run Diff on package outputs installed in the 2 marked generations.
+With ARG, run Diff on manifests of the marked generations."
+  (interactive "P")
+  (if arg
+      (guix-generation-list-diff-manifests)
+    (guix-generation-list-diff-packages)))
+
 (defun guix-generation-list-mark-delete (&optional arg)
   "Mark the current generation for deletion and move to the next line.
 With ARG, mark all generations for deletion."
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 1dd57bb71a..62eeabba1e 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -106,6 +106,38 @@
    (manifest-entry-version entry)
    (manifest-entry-output  entry)))
 
+(define (manifest-entry->package-specification entry)
+  (call-with-values
+      (lambda () (manifest-entry->name+version+output entry))
+    make-package-specification))
+
+(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))))
+    (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.
+Each element of the list is a list of the package specification and its path."
+  (let ((manifest (profile-manifest
+                   (generation-file-name profile number))))
+    (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)))
+    (lset-difference string=? specs1 specs2)))
+
 (define (manifest-entries->hash-table entries)
   "Return a hash table of name keys and lists of matching manifest ENTRIES."
   (let ((table (make-hash-table (length entries))))
@@ -625,8 +657,15 @@ See 'entry-sexps' for details."
                       (generation-file-name profile (car search-vals))
                       profile))
          (manifest (profile-manifest profile))
-         (patterns (apply (patterns-maker entry-type search-type)
-                          manifest search-vals))
+         (patterns (if (and (eq? entry-type 'output)
+                            (eq? search-type 'generation-diff))
+                       (match search-vals
+                         ((g1 g2)
+                          (map specification->output-pattern
+                               (generation-difference profile g1 g2)))
+                         (_ '()))
+                       (apply (patterns-maker entry-type search-type)
+                              manifest search-vals)))
          (->sexps ((pattern-transformer entry-type) manifest params)))
     (append-map ->sexps patterns)))
 
diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el
index 7a0b493ac7..bd985a0670 100644
--- a/emacs/guix-messages.el
+++ b/emacs/guix-messages.el
@@ -99,7 +99,9 @@
       (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)))
+            count val profile))
+     (generation-diff
+      guix-message-outputs-by-diff))
 
     (generation
      (id
@@ -167,6 +169,20 @@
                      "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."
+  (let* ((count (length entries))
+         (str-beg (guix-message-string-entries count 'output))
+         (gen1 (car  generations))
+         (gen2 (cadr generations)))
+    (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))))
+
 (defun guix-result-message (profile entries entry-type
                             search-type search-vals)
   "Display an appropriate message after displaying ENTRIES."
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index 878781489e..77ccb67532 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -154,6 +154,16 @@ accessed with KEYS."
     (dolist (key keys val)
       (setq val (cdr (assq key val))))))
 
+
+;;; Diff
+
+(defvar guix-diff-switches "-u"
+  "A string or list of strings specifying switches to be passed to diff.")
+
+(defun guix-diff (old new &optional switches no-async)
+  "Same as `diff', but use `guix-diff-switches' as default."
+  (diff old new (or switches guix-diff-switches) no-async))
+
 (provide 'guix-utils)
 
 ;;; guix-utils.el ends here