>From f63e575bc765c26494baa6bb1ec06f65bb05d007 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sun, 2 Nov 2014 13:58:21 +0300 Subject: [PATCH] emacs: Add interface for comparing generations. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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-output-path-column): 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-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' messages. * 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. --- doc/emacs.texi | 15 +++++++++ emacs/guix-base.el | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++ emacs/guix-list.el | 85 ++++++++++++++++++++++++++++++++++++++++++++++++- emacs/guix-main.scm | 43 +++++++++++++++++++++++-- emacs/guix-messages.el | 18 ++++++++++- emacs/guix-utils.el | 10 ++++++ 6 files changed, 253 insertions(+), 4 deletions(-) diff --git a/doc/emacs.texi b/doc/emacs.texi index 17440e4..6459c7a 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -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. address@hidden e +Run Ediff (@pxref{Top,,, ediff, Ediff}) on package outputs installed in +the 2 marked generations. With prefix argument, run Ediff on manifests +of the marked generations. address@hidden D address@hidden = +Run Diff (@pxref{Diff Mode,,, emacs, GNU Emacs Manual}) on package +outputs installed in the 2 marked generations. With prefix argument, +run Diff on manifests of the marked generations. address@hidden + +List package outputs added to the latest marked generation comparing +with another marked generation. address@hidden - +List package outputs removed from the latest marked generation comparing +with another marked generation. @end table @node Emacs Info buffer diff --git a/emacs/guix-base.el b/emacs/guix-base.el index eb88f37..f16601c 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -650,6 +650,92 @@ This function will not update the information, use guix-search-type guix-search-vals)) +;;; Generations + +(defvar 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).") + +(defvar guix-output-path-column 30 + "Column at which an output path is inserted 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-path-column 2) + (insert path "\n")) + +(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 (get-buffer buf-name) + (let ((buf (get-buffer-create buf-name))) + (with-current-buffer buf + (mapc (lambda (name+path) + (guix-generation-insert-package + (car name+path) (cadr name+path))) + (guix-generation-packages 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 58c03b3..600f2bd 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 1dd57bb..62eeabb 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 c77b5c0..09556be 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -101,7 +101,23 @@ (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 + (0 ,(lambda (profile entries vals) + (message + (concat "No additional packages in generation %d " + "comparing with generation %d of profile '%s'.") + (car vals) (cadr vals) profile))) + (1 ,(lambda (profile entries vals) + (message + (concat "A single additional package output in generation %d " + "comparing with generation %d of profile '%s'.") + (car vals) (cadr vals) profile))) + (many ,(lambda (profile entries vals) + (message + (concat "%d additional package outputs in generation %d " + "comparing with generation %d of profile '%s'.") + (length entries) (car vals) (cadr vals) profile))))) (generation (id diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 8787814..77ccb67 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 -- 2.1.2