>From 1334eb7272068dfd0b17d07e00c87ef0068d68a0 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sun, 5 Oct 2014 12:31:23 +0400 Subject: [PATCH] emacs: Add support for deleting generations. * doc/emacs.texi (emacs List buffer): Mention new key bindings. * emacs/guix-base.el (guix-delete-generations): New procedure. * emacs/guix-info.el (guix-generation-info-insert-number): Use it. * emacs/guix-list.el (guix-generation-list-mark-delete, guix-generation-list-execute): New procedures. * emacs/guix-main.scm (delete-generations*): New procedure. --- doc/emacs.texi | 9 +++++++-- emacs/guix-base.el | 14 ++++++++++++++ emacs/guix-info.el | 6 ++++-- emacs/guix-list.el | 19 +++++++++++++++++- emacs/guix-main.scm | 56 +++++++++++++++++++++++++++++------------------------ 5 files changed, 74 insertions(+), 30 deletions(-) diff --git a/doc/emacs.texi b/doc/emacs.texi index 3c5698f..2e6b60e 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -105,8 +105,8 @@ many last generations. @end table By default commands for displaying packages display each output on a -separate line. If you prefer to see a list of packages (i.e.@: a list -with a package per line), use the following setting: +separate line. If you prefer to see a list of packages---i.e., a list +with a package per line, use the following setting: @example (setq guix-package-list-type 'package) @@ -205,6 +205,11 @@ List packages installed in the current generation. @item i Describe marked generations (display available information in a ``generation-info'' buffer). address@hidden d +Mark the current generation for deletion (with prefix, mark all +generations). address@hidden x +Execute actions on the marked generations---i.e., delete generations. @end table @node emacs Info buffer diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 8da7835..d31fb79 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -801,6 +801,20 @@ Return non-nil, if the operation should be continued; nil otherwise." guix-operation-option-separator))) (force-mode-line-update)) +(defun guix-delete-generations (&rest generations) + "Delete GENERATIONS. +Each element from GENERATIONS is a generation number." + (when (or (not guix-operation-confirm) + (y-or-n-p + (let ((count (length generations))) + (if (> count 1) + (format "Delete %d generations? " count) + (format "Delete generation number %d? " + (car generations)))))) + (guix-eval-in-repl + (guix-make-guile-expression + 'delete-generations* guix-current-profile generations)))) + (provide 'guix-base) ;;; guix-base.el ends here diff --git a/emacs/guix-info.el b/emacs/guix-info.el index d0a320f..d5226b1 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -627,8 +627,10 @@ ENTRY is an alist with package info." (guix-info-insert-indent) (guix-info-insert-action-button "Delete" - (lambda (btn) (error "Sorry, not implemented yet")) - "Delete this generation")) + (lambda (btn) + (guix-delete-generations (button-get btn 'number))) + "Delete this generation" + 'number number)) (provide 'guix-info) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 6a4cdfc..4b4b9c5 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -728,8 +728,9 @@ 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 "x") 'guix-generation-list-execute) (define-key map (kbd "i") 'guix-list-describe) - (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple)) + (define-key map (kbd "d") 'guix-generation-list-mark-delete)) (defun guix-generation-list-show-packages () "List installed packages for the generation at point." @@ -737,6 +738,22 @@ Also see `guix-package-info-type'." (guix-get-show-entries 'list guix-package-list-type 'generation (guix-list-current-id))) +(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." + (interactive "P") + (if arg + (guix-list-mark-all 'delete) + (guix-list-mark 'delete t))) + +(defun guix-generation-list-execute () + "Delete marked generations." + (interactive) + (let ((marked (guix-list-get-marked-id-list 'delete))) + (or marked + (user-error "No generations marked for deletion")) + (apply #'guix-delete-generations marked))) + (provide 'guix-list) ;;; guix-list.el ends here diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 026a9e9..b85bb5c 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -790,28 +790,34 @@ OUTPUTS is a list of package outputs (may be an empty list)." (new-manifest (manifest-perform-transaction manifest transaction))) (unless (and (null? install) (null? remove)) - (let* ((store (open-connection)) - (derivation (run-with-store - store (profile-derivation new-manifest))) - (derivations (list derivation)) - (new-profile (derivation->output-path derivation))) - (set-build-options store - #:use-substitutes? use-substitutes?) - (manifest-show-transaction store manifest transaction - #:dry-run? dry-run?) - (show-what-to-build store derivations - #:use-substitutes? use-substitutes? - #:dry-run? dry-run?) - (unless dry-run? - (let ((name (generation-file-name - profile - (+ 1 (generation-number profile))))) - (and (build-derivations store derivations) - (let* ((entries (manifest-entries new-manifest)) - (count (length entries))) - (switch-symlinks name new-profile) - (switch-symlinks profile name) - (format #t (N_ "~a package in profile~%" - "~a packages in profile~%" - count) - count))))))))) + (with-store store + (let* ((derivation (run-with-store store + (profile-derivation new-manifest))) + (derivations (list derivation)) + (new-profile (derivation->output-path derivation))) + (set-build-options store + #:use-substitutes? use-substitutes?) + (manifest-show-transaction store manifest transaction + #:dry-run? dry-run?) + (show-what-to-build store derivations + #:use-substitutes? use-substitutes? + #:dry-run? dry-run?) + (unless dry-run? + (let ((name (generation-file-name + profile + (+ 1 (generation-number profile))))) + (and (build-derivations store derivations) + (let* ((entries (manifest-entries new-manifest)) + (count (length entries))) + (switch-symlinks name new-profile) + (switch-symlinks profile name) + (format #t (N_ "~a package in profile~%" + "~a packages in profile~%" + count) + count)))))))))) + +(define (delete-generations* profile generations) + "Delete GENERATIONS from PROFILE. +GENERATIONS is a list of generation numbers." + (with-store store + (delete-generations store profile generations))) -- 2.1.2