Re: [PATCH] emacs: Add support for deleting generations.

[Alex Kost <alezost@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2204 bytes --]

Ludovic Courtès (2014-10-05 17:14 +0400) wrote:

> Alex Kost <alezost@gmail.com> skribis:
>
>> Ludovic Courtès (2014-10-05 00:23 +0400) wrote:
>
> [...]
>
>>> To sum up, I would imagine two followups to this:
>>>
>>>   1. Move these procedures to (guix profiles).
>>>   2. Convert them to monadic style.
>>>
>>> WDYT?
>>
>> I like the idea of using monads there, but as I said I'm too week (I
>> mean "month" (I mean "weak")) for writing that.
>
> Heh.  :-)  No problem, that can come later.
>
>> Also those followups would make my commit totally redundant, no?
>> Wouldn't it be better to make a commit for adding the monadic functions
>> to (guix profiles) directly?
>
> I think it’s fine to make changes incrementally.

OK.

>> However if you still allow me to push this commit,
>
> Sure!

Done, thanks.

[...]

>> +@item x
>> +Execute actions on the marked generations (i.e.@: delete generations).
>
> I would make it:
>
>   Execute actions on the marked generations---i.e., delete generations.
>
> Or possibly a comma before “i.e.”.  Certainly a comma after it.
>
>> --- a/emacs/guix-main.scm
>> +++ b/emacs/guix-main.scm
>> @@ -815,3 +815,9 @@ OUTPUTS is a list of package outputs (may be an empty list)."
>>                                    "~a packages in profile~%"
>>                                    count)
>>                             count)))))))))
>> +
>> +(define (delete-generations* profile generations)
>> +  "Delete GENERATIONS from PROFILE.
>> +GENERATIONS is a list of generation numbers."
>> +  (let ((store (open-connection)))
>> +    (delete-generations store profile generations)))
>
> Rather:
>
>   (with-store store
>     (delete-generations store profile generations))
>
> That will take care of closing ‘store’ when the dynamic extent of the
> body is left.

Thanks for the comments, the updated patch is attached.  I also fixed
another “i.e.” thing there and used ‘with-store’ in
‘process-package-actions’ procedure as well.  Is it OK to make these
changes in this commit (the ‘with-store’ change is small but many lines
were changed because of the new indentation)?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-emacs-Add-support-for-deleting-generations.patch --]
[-- Type: text/x-diff, Size: 7915 bytes --]

From 1334eb7272068dfd0b17d07e00c87ef0068d68a0 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
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).
+@item d
+Mark the current generation for deletion (with prefix, mark all
+generations).
+@item 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