1 ;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
3 ;; Copyright © 2014 Alex Kost <alezost@gmail.com>
5 ;; This file is part of GNU Guix.
7 ;; GNU Guix is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Guix is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ;; This file provides a list-like buffer for displaying information
23 ;; about Guix packages and generations.
28 (require 'tabulated-list
)
33 (defgroup guix-list nil
34 "General settings for list buffers."
38 (defface guix-list-file-path
39 '((t :inherit guix-info-file-path
))
40 "Face used for file paths."
43 (defcustom guix-list-describe-warning-count
10
44 "The maximum number of entries for describing without a warning.
45 If a user wants to describe more than this number of marked
46 entries, he will be prompted for confirmation."
50 (defvar guix-list-column-format
65 ,(lambda (a b
) (guix-list-sort-numerically 0 a b
))
70 "Columns displayed in list buffers.
71 Each element of the list has a form:
73 (ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...))
75 PARAM is the name of an entry parameter of ENTRY-TYPE. For the
76 meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
78 (defvar guix-list-column-titles
81 "Column titles for list buffers.
82 Has the same structure as `guix-param-titles', but titles from
83 this list have a priority.")
85 (defvar guix-list-column-value-methods
87 (name . guix-package-list-get-name
)
88 (synopsis . guix-list-get-one-line
)
89 (description . guix-list-get-one-line
)
90 (installed . guix-package-list-get-installed-outputs
))
92 (name . guix-package-list-get-name
)
93 (synopsis . guix-list-get-one-line
)
94 (description . guix-list-get-one-line
))
96 (current . guix-generation-list-get-current
)
97 (time . guix-list-get-time
)
98 (path . guix-list-get-file-path
)))
99 "Methods for inserting parameter values in columns.
100 Each element of the list has a form:
102 (ENTRY-TYPE . ((PARAM . FUN) ...))
104 PARAM is the name of an entry parameter of ENTRY-TYPE.
106 FUN is a function returning a value that will be inserted. The
107 function is called with 2 arguments: the first one is the value
108 of the parameter; the second argument is an entry info (alist of
109 parameters and their values).")
111 (defun guix-list-get-param-title (entry-type param
)
112 "Return title of an ENTRY-TYPE entry parameter PARAM."
113 (or (guix-get-key-val guix-list-column-titles
115 (guix-get-param-title entry-type param
)))
117 (defun guix-list-get-column-format (entry-type)
118 "Return column format for ENTRY-TYPE."
119 (guix-get-key-val guix-list-column-format entry-type
))
121 (defun guix-list-get-displayed-params (entry-type)
122 "Return list of parameters of ENTRY-TYPE that should be displayed."
124 (guix-list-get-column-format entry-type
)))
126 (defun guix-list-get-sort-key (entry-type param
&optional invert
)
127 "Return suitable sort key for `tabulated-list-sort-key'.
128 Define column title by ENTRY-TYPE and PARAM. If INVERT is
129 non-nil, invert the sort."
130 (when (memq param
(guix-list-get-displayed-params entry-type
))
131 (cons (guix-list-get-param-title entry-type param
) invert
)))
133 (defun guix-list-sort-numerically (column a b
)
134 "Compare COLUMN of tabulated entries A and B numerically.
135 It is a sort predicate for `tabulated-list-format'.
136 Return non-nil, if B is bigger than A."
137 (cl-flet ((num (entry)
138 (string-to-number (aref (cadr entry
) column
))))
139 (> (num b
) (num a
))))
141 (defun guix-list-make-tabulated-vector (entry-type fun
)
142 "Call FUN on each column specification for ENTRY-TYPE.
144 FUN is called with 2 argument: parameter name and column
145 specification (see `guix-list-column-format').
147 Return a vector made of values of FUN calls."
149 (mapcar (lambda (col-spec)
150 (funcall fun
(car col-spec
) (cdr col-spec
)))
151 (guix-list-get-column-format entry-type
))))
153 (defun guix-list-get-list-format (entry-type)
154 "Return ENTRY-TYPE list specification for `tabulated-list-format'."
155 (guix-list-make-tabulated-vector
158 (cons (guix-list-get-param-title entry-type param
)
161 (defun guix-list-insert-entries (entries entry-type
)
162 "Display ENTRIES of ENTRY-TYPE in the current list buffer.
163 ENTRIES should have a form of `guix-entries'."
164 (setq tabulated-list-entries
165 (guix-list-get-tabulated-entries entries entry-type
))
166 (tabulated-list-print))
168 (defun guix-list-get-tabulated-entries (entries entry-type
)
169 "Return list of values of ENTRY-TYPE for `tabulated-list-entries'.
170 Values are taken from ENTRIES which should have the form of
172 (mapcar (lambda (entry)
173 (list (guix-get-key-val entry
'id
)
174 (guix-list-get-tabulated-entry entry entry-type
)))
177 (defun guix-list-get-tabulated-entry (entry entry-type
)
178 "Return array of values for `tabulated-list-entries'.
179 Parameters are taken from ENTRY of ENTRY-TYPE."
180 (guix-list-make-tabulated-vector
183 (let ((val (guix-get-key-val entry param
))
184 (fun (guix-get-key-val guix-list-column-value-methods
187 (funcall fun val entry
)
188 (guix-get-string val
))))))
190 (defun guix-list-get-one-line (val &optional _
)
191 "Return one-line string from a multi-line string VAL.
194 (guix-get-one-line val
)
195 (guix-get-string nil
)))
197 (defun guix-list-get-time (seconds &optional _
)
198 "Return formatted time string from SECONDS."
199 (guix-get-time-string seconds
))
201 (defun guix-list-get-file-path (path &optional _
)
202 "Return PATH button specification for `tabulated-list-entries'."
204 'face
'guix-list-file-path
205 'action
(lambda (btn) (find-file (button-label btn
)))
207 'help-echo
"Find file"))
209 (defun guix-list-current-id ()
210 "Return ID of the current entry."
211 (or (tabulated-list-get-id)
212 (user-error "No entry here")))
214 (defun guix-list-current-entry ()
215 "Return alist of the current entry info."
216 (guix-get-entry-by-id (guix-list-current-id) guix-entries
))
218 (defun guix-list-for-each-line (fun &rest args
)
219 "Call FUN with ARGS for each entry line."
220 (or (derived-mode-p 'guix-list-mode
)
221 (error "The current buffer is not in Guix List mode"))
223 (goto-char (point-min))
228 (defun guix-list-fold-lines (fun init
)
229 "Fold over entry lines in the current list buffer.
230 Call FUN with RESULT as argument for each line, using INIT as
231 the initial value of RESULT. Return the final result."
233 (guix-list-for-each-line
234 (lambda () (setq res
(funcall fun res
))))
238 ;;; Marking and sorting
240 (defvar-local guix-list-marked nil
241 "List of the marked entries.
242 Each element of the list has a form:
244 (ID MARK-NAME . ARGS)
247 MARK-NAME is a symbol from `guix-list-mark-alist'.
248 ARGS is a list of additional values.")
250 (defvar guix-list-mark-alist
253 "Alist of available mark names and mark characters.")
255 (defsubst guix-list-get-mark
(name)
256 "Return mark character by its NAME."
257 (or (guix-get-key-val guix-list-mark-alist name
)
258 (error "Mark '%S' not found" name
)))
260 (defsubst guix-list-get-mark-string
(name)
261 "Return mark string by its NAME."
262 (string (guix-list-get-mark name
)))
264 (defun guix-list-current-mark ()
265 "Return mark character of the current line."
266 (char-after (line-beginning-position)))
268 (defun guix-list-get-marked (&rest mark-names
)
269 "Return list of specs of entries marked with any mark from MARK-NAMES.
270 Entry specs are elements from `guix-list-marked' list.
271 If MARK-NAMES are not specified, use all marks from
272 `guix-list-mark-alist' except the `empty' one."
276 (mapcar #'car guix-list-mark-alist
))))
277 (cl-remove-if-not (lambda (assoc)
278 (memq (cadr assoc
) mark-names
))
281 (defun guix-list-get-marked-args (mark-name)
282 "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
283 See `guix-list-marked' for the meaning of ARGS."
284 (mapcar (lambda (spec)
285 (let ((id (car spec
))
288 (guix-list-get-marked mark-name
)))
290 (defun guix-list-get-marked-id-list (&rest mark-names
)
291 "Return list of IDs of entries marked with any mark from MARK-NAMES.
292 See `guix-list-get-marked' for details."
293 (mapcar #'car
(apply #'guix-list-get-marked mark-names
)))
295 (defun guix-list--mark (mark-name &optional advance
&rest args
)
296 "Put a mark on the current line.
297 Also add the current entry to `guix-list-marked' using its ID and ARGS.
298 MARK-NAME is a symbol from `guix-list-mark-alist'.
299 If ADVANCE is non-nil, move forward by one line after marking."
300 (let ((id (guix-list-current-id)))
301 (if (eq mark-name
'empty
)
302 (setq guix-list-marked
(assq-delete-all id guix-list-marked
))
303 (let ((assoc (assq id guix-list-marked
))
304 (val (cons mark-name args
)))
307 (push (cons id val
) guix-list-marked
)))))
308 (tabulated-list-put-tag (guix-list-get-mark-string mark-name
)
311 (defun guix-list-mark (&optional arg
)
312 "Mark the current line and move to the next line.
313 With ARG, mark all lines."
317 (guix-list--mark 'general t
)))
319 (defun guix-list-mark-all (&optional mark-name
)
320 "Mark all lines with MARK-NAME mark.
321 MARK-NAME is a symbol from `guix-list-mark-alist'.
322 Interactively, put a general mark on all lines."
324 (or mark-name
(setq mark-name
'general
))
325 (guix-list-for-each-line #'guix-list--mark mark-name
))
327 (defun guix-list-unmark (&optional arg
)
328 "Unmark the current line and move to the next line.
329 With ARG, unmark all lines."
332 (guix-list-unmark-all)
333 (guix-list--mark 'empty t
)))
335 (defun guix-list-unmark-backward ()
336 "Move up one line and unmark it."
339 (guix-list--mark 'empty
))
341 (defun guix-list-unmark-all ()
344 (guix-list-mark-all 'empty
))
346 (defun guix-list-restore-marks ()
347 "Put marks according to `guix-list-mark-alist'."
348 (guix-list-for-each-line
350 (let ((mark-name (car (guix-get-key-val guix-list-marked
351 (guix-list-current-id)))))
352 (tabulated-list-put-tag
353 (guix-list-get-mark-string (or mark-name
'empty
)))))))
355 (defun guix-list-sort (&optional n
)
356 "Sort guix list entries by the column at point.
357 With a numeric prefix argument N, sort the Nth column.
358 Same as `tabulated-list-sort', but also restore marks after sorting."
360 (tabulated-list-sort n
)
361 (guix-list-restore-marks))
364 (defvar guix-list-mode-map
365 (let ((map (make-sparse-keymap)))
366 (set-keymap-parent map tabulated-list-mode-map
)
367 (define-key map
(kbd "RET") 'guix-list-describe
)
368 (define-key map
(kbd "m") 'guix-list-mark
)
369 (define-key map
(kbd "*") 'guix-list-mark
)
370 (define-key map
(kbd "u") 'guix-list-unmark
)
371 (define-key map
(kbd "DEL") 'guix-list-unmark-backward
)
372 (define-key map
[remap tabulated-list-sort
] 'guix-list-sort
)
374 "Parent keymap for list buffers.")
376 (define-derived-mode guix-list-mode tabulated-list-mode
"Guix-List"
377 "Parent mode for displaying information in list buffers."
378 (setq tabulated-list-padding
2))
380 (defmacro guix-list-define-entry-type
(entry-type &rest args
)
381 "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
383 Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
384 following keywords are available:
386 - `:sort-key' - default sort key for the tabulated list buffer.
388 - `:invert-sort' - if non-nil, invert initial sort.
390 - `:marks' - default value for the defined
391 `guix-ENTRY-TYPE-mark-alist' variable.
393 This macro defines the following functions:
395 - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
396 specified in `:marks' argument."
397 (let* ((entry-type-str (symbol-name entry-type
))
398 (prefix (concat "guix-" entry-type-str
"-list"))
399 (mode-str (concat prefix
"-mode"))
400 (init-fun (intern (concat prefix
"-mode-initialize")))
401 (marks-var (intern (concat prefix
"-mark-alist")))
406 ;; Process the keyword args.
407 (while (keywordp (car args
))
409 (`:sort-key
(setq sort-key
(pop args
)))
410 (`:invert-sort
(setq invert-sort
(pop args
)))
411 (`:marks
(setq marks-val
(pop args
)))
415 (defvar ,marks-var
',marks-val
416 ,(concat "Alist of additional marks for `" mode-str
"'.\n"
417 "Marks from this list are added to `guix-list-mark-alist'."))
419 ,@(mapcar (lambda (mark-spec)
420 (let* ((mark-name (car mark-spec
))
421 (mark-name-str (symbol-name mark-name
)))
422 `(defun ,(intern (concat prefix
"-mark-" mark-name-str
"-simple")) ()
423 ,(concat "Put '" mark-name-str
"' mark and move to the next line.\n"
424 "Also add the current entry to `guix-list-marked'.")
426 (guix-list--mark ',mark-name t
))))
430 ,(concat "Initial settings for `" mode-str
"'.")
432 `(setq tabulated-list-sort-key
433 (guix-list-get-sort-key
434 ',entry-type
',sort-key
,invert-sort
)))
435 (setq tabulated-list-format
436 (guix-list-get-list-format ',entry-type
))
437 (setq-local guix-list-mark-alist
438 (append guix-list-mark-alist
,marks-var
))
439 (tabulated-list-init-header)))))
441 (put 'guix-list-define-entry-type
'lisp-indent-function
'defun
)
443 (defun guix-list-describe-maybe (entry-type ids
)
444 "Describe ENTRY-TYPE entries in info buffer using list of IDS."
445 (let ((count (length ids
)))
446 (when (or (<= count guix-list-describe-warning-count
)
447 (y-or-n-p (format "Do you really want to describe %d entries? "
449 (apply #'guix-get-show-entries
450 guix-profile
'info entry-type
'id ids
))))
452 (defun guix-list-describe (&optional arg
)
453 "Describe entries marked with a general mark.
454 If no entries are marked, describe the current entry.
455 With prefix (if ARG is non-nil), describe entries marked with any mark."
457 (let ((ids (or (apply #'guix-list-get-marked-id-list
458 (unless arg
'(general)))
459 (list (guix-list-current-id)))))
460 (guix-list-describe-maybe guix-entry-type ids
)))
463 ;;; Displaying packages
465 (guix-define-buffer-type list package
)
467 (guix-list-define-entry-type package
469 :marks
((install . ?I
)
473 (defface guix-package-list-installed
474 '((t :inherit guix-package-info-installed-outputs
))
475 "Face used if there are installed outputs for the current package."
476 :group
'guix-package-list
)
478 (defface guix-package-list-obsolete
479 '((t :inherit guix-package-info-obsolete
))
480 "Face used if a package is obsolete."
481 :group
'guix-package-list
)
483 (defcustom guix-package-list-generation-marking-enabled nil
484 "If non-nil, allow putting marks in a list with 'generation packages'.
486 By default this is disabled, because it may be confusing. For
487 example a package is installed in some generation, so a user can
488 mark it for deletion in the list of packages from this
489 generation, but the package may not be installed in the latest
490 generation, so actually it cannot be deleted.
492 If you managed to understand the explanation above or if you
493 really know what you do or if you just don't care, you can set
494 this variable to t. It should not do much harm anyway (most
497 :group
'guix-package-list
)
499 (let ((map guix-package-list-mode-map
))
500 (define-key map
(kbd "x") 'guix-package-list-execute
)
501 (define-key map
(kbd "i") 'guix-package-list-mark-install
)
502 (define-key map
(kbd "d") 'guix-package-list-mark-delete
)
503 (define-key map
(kbd "U") 'guix-package-list-mark-upgrade
)
504 (define-key map
(kbd "^") 'guix-package-list-mark-upgrades
))
506 (defun guix-package-list-get-name (name entry
)
507 "Return NAME of the package ENTRY.
508 Colorize it with `guix-package-list-installed' or
509 `guix-package-list-obsolete' if needed."
510 (guix-get-string name
511 (cond ((guix-get-key-val entry
'obsolete
)
512 'guix-package-list-obsolete
)
513 ((guix-get-key-val entry
'installed
)
514 'guix-package-list-installed
))))
516 (defun guix-package-list-get-installed-outputs (installed &optional _
)
517 "Return string with outputs from INSTALLED entries."
519 (mapcar (lambda (entry)
520 (guix-get-key-val entry
'output
))
523 (defun guix-package-list-marking-check ()
524 "Signal an error if marking is disabled for the current buffer."
525 (when (and (not guix-package-list-generation-marking-enabled
)
526 (or (derived-mode-p 'guix-package-list-mode
)
527 (derived-mode-p 'guix-output-list-mode
))
528 (eq guix-search-type
'generation
))
529 (error "Action marks are disabled for lists of 'generation packages'")))
531 (defun guix-package-list-mark-outputs (mark default
532 &optional prompt available
)
533 "Mark the current package with MARK and move to the next line.
534 If PROMPT is non-nil, use it to ask a user for outputs from
535 AVAILABLE list, otherwise mark all DEFAULT outputs."
536 (let ((outputs (if prompt
537 (guix-completing-read-multiple
538 prompt available nil t
)
540 (apply #'guix-list--mark mark t outputs
)))
542 (defun guix-package-list-mark-install (&optional arg
)
543 "Mark the current package for installation and move to the next line.
544 With ARG, prompt for the outputs to install (several outputs may
545 be separated with \",\")."
547 (guix-package-list-marking-check)
548 (let* ((entry (guix-list-current-entry))
549 (all (guix-get-key-val entry
'outputs
))
550 (installed (guix-get-installed-outputs entry
))
551 (available (cl-set-difference all installed
:test
#'string
=)))
553 (user-error "This package is already installed"))
554 (guix-package-list-mark-outputs
556 (and arg
"Output(s) to install: ")
559 (defun guix-package-list-mark-delete (&optional arg
)
560 "Mark the current package for deletion and move to the next line.
561 With ARG, prompt for the outputs to delete (several outputs may
562 be separated with \",\")."
564 (guix-package-list-marking-check)
565 (let* ((entry (guix-list-current-entry))
566 (installed (guix-get-installed-outputs entry
)))
568 (user-error "This package is not installed"))
569 (guix-package-list-mark-outputs
571 (and arg
"Output(s) to delete: ")
574 (defun guix-package-list-mark-upgrade (&optional arg
)
575 "Mark the current package for upgrading and move to the next line.
576 With ARG, prompt for the outputs to upgrade (several outputs may
577 be separated with \",\")."
579 (guix-package-list-marking-check)
580 (let* ((entry (guix-list-current-entry))
581 (installed (guix-get-installed-outputs entry
)))
583 (user-error "This package is not installed"))
584 (when (or (guix-get-key-val entry
'obsolete
)
585 (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
586 (guix-package-list-mark-outputs
588 (and arg
"Output(s) to upgrade: ")
591 (defun guix-list-mark-package-upgrades (fun)
592 "Mark all obsolete packages for upgrading.
593 Use FUN to perform marking of the current line. FUN should
594 accept an entry as argument."
595 (guix-package-list-marking-check)
596 (let ((obsolete (cl-remove-if-not
598 (guix-get-key-val entry
'obsolete
))
600 (guix-list-for-each-line
602 (let* ((id (guix-list-current-id))
605 (equal id
(guix-get-key-val entry
'id
)))
608 (funcall fun entry
)))))))
610 (defun guix-package-list-mark-upgrades ()
611 "Mark all obsolete packages for upgrading."
613 (guix-list-mark-package-upgrades
615 (apply #'guix-list--mark
617 (guix-get-installed-outputs entry
)))))
619 (defun guix-list-execute-package-actions (fun)
620 "Perform actions on the marked packages.
621 Use FUN to define actions suitable for `guix-process-package-actions'.
622 FUN should accept action-type as argument."
623 (let ((actions (delq nil
624 (mapcar fun
'(install delete upgrade
)))))
626 (guix-process-package-actions
627 guix-profile actions
(current-buffer))
628 (user-error "No operations specified"))))
630 (defun guix-package-list-execute ()
631 "Perform actions on the marked packages."
633 (guix-list-execute-package-actions #'guix-package-list-make-action
))
635 (defun guix-package-list-make-action (action-type)
636 "Return action specification for the packages marked with ACTION-TYPE.
637 Return nil, if there are no packages marked with ACTION-TYPE.
638 The specification is suitable for `guix-process-package-actions'."
639 (let ((specs (guix-list-get-marked-args action-type
)))
640 (and specs
(cons action-type specs
))))
643 ;;; Displaying outputs
645 (guix-define-buffer-type list output
646 :buffer-name
"*Guix Package List*")
648 (guix-list-define-entry-type output
650 :marks
((install . ?I
)
654 (let ((map guix-output-list-mode-map
))
655 (define-key map
(kbd "RET") 'guix-output-list-describe
)
656 (define-key map
(kbd "x") 'guix-output-list-execute
)
657 (define-key map
(kbd "i") 'guix-output-list-mark-install
)
658 (define-key map
(kbd "d") 'guix-output-list-mark-delete
)
659 (define-key map
(kbd "U") 'guix-output-list-mark-upgrade
)
660 (define-key map
(kbd "^") 'guix-output-list-mark-upgrades
))
662 (defun guix-output-list-mark-install ()
663 "Mark the current output for installation and move to the next line."
665 (guix-package-list-marking-check)
666 (let* ((entry (guix-list-current-entry))
667 (installed (guix-get-key-val entry
'installed
)))
669 (user-error "This output is already installed")
670 (guix-list--mark 'install t
))))
672 (defun guix-output-list-mark-delete ()
673 "Mark the current output for deletion and move to the next line."
675 (guix-package-list-marking-check)
676 (let* ((entry (guix-list-current-entry))
677 (installed (guix-get-key-val entry
'installed
)))
679 (guix-list--mark 'delete t
)
680 (user-error "This output is not installed"))))
682 (defun guix-output-list-mark-upgrade ()
683 "Mark the current output for deletion and move to the next line."
685 (guix-package-list-marking-check)
686 (let* ((entry (guix-list-current-entry))
687 (installed (guix-get-key-val entry
'installed
)))
689 (user-error "This output is not installed"))
690 (when (or (guix-get-key-val entry
'obsolete
)
691 (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
692 (guix-list--mark 'upgrade t
))))
694 (defun guix-output-list-mark-upgrades ()
695 "Mark all obsolete package outputs for upgrading."
697 (guix-list-mark-package-upgrades
698 (lambda (_) (guix-list--mark 'upgrade
))))
700 (defun guix-output-list-execute ()
701 "Perform actions on the marked outputs."
703 (guix-list-execute-package-actions #'guix-output-list-make-action
))
705 (defun guix-output-list-make-action (action-type)
706 "Return action specification for the outputs marked with ACTION-TYPE.
707 Return nil, if there are no outputs marked with ACTION-TYPE.
708 The specification is suitable for `guix-process-output-actions'."
709 (let ((ids (guix-list-get-marked-id-list action-type
)))
710 (and ids
(cons action-type
711 (mapcar #'guix-get-package-id-and-output-by-output-id
714 (defun guix-output-list-describe (&optional arg
)
715 "Describe outputs or packages marked with a general mark.
716 If no entries are marked, describe the current output or package.
717 With prefix (if ARG is non-nil), describe entries marked with any mark.
718 Also see `guix-package-info-type'."
720 (if (eq guix-package-info-type
'output
)
721 (guix-list-describe arg
)
722 (let* ((oids (or (apply #'guix-list-get-marked-id-list
723 (unless arg
'(general)))
724 (list (guix-list-current-id))))
725 (pids (mapcar (lambda (oid)
726 (car (guix-get-package-id-and-output-by-output-id
729 (guix-list-describe-maybe 'package
(cl-remove-duplicates pids
)))))
732 ;;; Displaying generations
734 (guix-define-buffer-type list generation
)
736 (guix-list-define-entry-type generation
739 :marks
((delete . ?D
)))
741 (let ((map guix-generation-list-mode-map
))
742 (define-key map
(kbd "RET") 'guix-generation-list-show-packages
)
743 (define-key map
(kbd "+") 'guix-generation-list-show-added-packages
)
744 (define-key map
(kbd "-") 'guix-generation-list-show-removed-packages
)
745 (define-key map
(kbd "=") 'guix-generation-list-diff
)
746 (define-key map
(kbd "D") 'guix-generation-list-diff
)
747 (define-key map
(kbd "e") 'guix-generation-list-ediff
)
748 (define-key map
(kbd "x") 'guix-generation-list-execute
)
749 (define-key map
(kbd "i") 'guix-list-describe
)
750 (define-key map
(kbd "s") 'guix-generation-list-switch
)
751 (define-key map
(kbd "d") 'guix-generation-list-mark-delete
))
753 (defun guix-generation-list-get-current (val &optional _
)
754 "Return string from VAL showing whether this generation is current.
755 VAL is a boolean value."
756 (if val
"(current)" ""))
758 (defun guix-generation-list-switch ()
759 "Switch current profile to the generation at point."
761 (let* ((entry (guix-list-current-entry))
762 (current (guix-get-key-val entry
'current
))
763 (number (guix-get-key-val entry
'number
)))
765 (user-error "This generation is already the current one")
766 (guix-switch-to-generation guix-profile number
(current-buffer)))))
768 (defun guix-generation-list-show-packages ()
769 "List installed packages for the generation at point."
771 (guix-get-show-entries guix-profile
'list guix-package-list-type
772 'generation
(guix-list-current-id)))
774 (defun guix-generation-list-generations-to-compare ()
775 "Return a sorted list of 2 marked generations for comparing."
776 (let ((numbers (guix-list-get-marked-id-list 'general
)))
777 (if (/= (length numbers
) 2)
778 (user-error "2 generations should be marked for comparing")
779 (sort numbers
#'<))))
781 (defun guix-generation-list-show-added-packages ()
782 "List package outputs added to the latest marked generation.
783 If 2 generations are marked with \\[guix-list-mark], display
784 outputs installed in the latest marked generation that were not
785 installed in the other one."
787 (apply #'guix-get-show-entries
788 guix-profile
'list
'output
'generation-diff
789 (reverse (guix-generation-list-generations-to-compare))))
791 (defun guix-generation-list-show-removed-packages ()
792 "List package outputs removed from the latest marked generation.
793 If 2 generations are marked with \\[guix-list-mark], display
794 outputs not installed in the latest marked generation that were
795 installed in the other one."
797 (apply #'guix-get-show-entries
798 guix-profile
'list
'output
'generation-diff
799 (guix-generation-list-generations-to-compare)))
801 (defun guix-generation-list-compare (diff-fun gen-fun
)
802 "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results."
803 (cl-multiple-value-bind (gen1 gen2
)
804 (guix-generation-list-generations-to-compare)
806 (funcall gen-fun gen1
)
807 (funcall gen-fun gen2
))))
809 (defun guix-generation-list-ediff-manifests ()
810 "Run Ediff on manifests of the 2 marked generations."
812 (guix-generation-list-compare
814 #'guix-profile-generation-manifest-file
))
816 (defun guix-generation-list-diff-manifests ()
817 "Run Diff on manifests of the 2 marked generations."
819 (guix-generation-list-compare
821 #'guix-profile-generation-manifest-file
))
823 (defun guix-generation-list-ediff-packages ()
824 "Run Ediff on package outputs installed in the 2 marked generations."
826 (guix-generation-list-compare
828 #'guix-profile-generation-packages-buffer
))
830 (defun guix-generation-list-diff-packages ()
831 "Run Diff on package outputs installed in the 2 marked generations."
833 (guix-generation-list-compare
835 #'guix-profile-generation-packages-buffer
))
837 (defun guix-generation-list-ediff (arg)
838 "Run Ediff on package outputs installed in the 2 marked generations.
839 With ARG, run Ediff on manifests of the marked generations."
842 (guix-generation-list-ediff-manifests)
843 (guix-generation-list-ediff-packages)))
845 (defun guix-generation-list-diff (arg)
846 "Run Diff on package outputs installed in the 2 marked generations.
847 With ARG, run Diff on manifests of the marked generations."
850 (guix-generation-list-diff-manifests)
851 (guix-generation-list-diff-packages)))
853 (defun guix-generation-list-mark-delete (&optional arg
)
854 "Mark the current generation for deletion and move to the next line.
855 With ARG, mark all generations for deletion."
858 (guix-list-mark-all 'delete
)
859 (guix-list--mark 'delete t
)))
861 (defun guix-generation-list-execute ()
862 "Delete marked generations."
864 (let ((marked (guix-list-get-marked-id-list 'delete
)))
866 (user-error "No generations marked for deletion"))
867 (guix-delete-generations guix-profile marked
(current-buffer))))
871 ;;; guix-list.el ends here