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.
This commit is contained in:
Alex Kost
parent
62f261d88c
commit
d38bd08c74
6 changed files with 278 additions and 4 deletions
|
|
@ -239,6 +239,21 @@ Mark the current generation for deletion (with prefix, mark all
|
|||
generations).
|
||||
@item x
|
||||
Execute actions on the marked generations---i.e., delete generations.
|
||||
@item e
|
||||
Run Ediff (@pxref{Top,,, ediff, The Ediff Manual}) on package outputs
|
||||
installed in the 2 marked generations. With prefix argument, run Ediff
|
||||
on manifests of the marked generations.
|
||||
@item D
|
||||
@itemx =
|
||||
Run Diff (@pxref{Diff Mode,,, emacs, The GNU Emacs Manual}) on package
|
||||
outputs installed in the 2 marked generations. With prefix argument,
|
||||
run Diff on manifests of the marked generations.
|
||||
@item +
|
||||
List package outputs added to the latest marked generation comparing
|
||||
with another marked generation.
|
||||
@item -
|
||||
List package outputs removed from the latest marked generation comparing
|
||||
with another marked generation.
|
||||
@end table
|
||||
|
||||
@node Emacs Info buffer
|
||||
|
|
|
|||
|
|
@ -649,6 +649,117 @@ This function will not update the information, use
|
|||
(guix-result-message guix-profile guix-entries guix-entry-type
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Reference in a new issue