diff options
| -rw-r--r-- | doc/emacs.texi | 15 | ||||
| -rw-r--r-- | emacs/guix-base.el | 111 | ||||
| -rw-r--r-- | emacs/guix-list.el | 85 | ||||
| -rw-r--r-- | emacs/guix-main.scm | 43 | ||||
| -rw-r--r-- | emacs/guix-messages.el | 18 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 10 |
6 files changed, 278 insertions, 4 deletions
diff --git a/doc/emacs.texi b/doc/emacs.texi index 17440e4b46..1b134d7e47 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. +@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 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 |