emacs: Use package/output type variables where needed.
[jackhill/guix/guix.git] / emacs / guix-list.el
CommitLineData
457f60fa
AK
1;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*-
2
3;; Copyright © 2014 Alex Kost <alezost@gmail.com>
4
5;; This file is part of GNU Guix.
6
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.
11
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.
16
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/>.
19
20;;; Commentary:
21
22;; This file provides a list-like buffer for displaying information
23;; about Guix packages and generations.
24
25;;; Code:
26
27(require 'cl-lib)
28(require 'tabulated-list)
29(require 'guix-info)
30(require 'guix-history)
31(require 'guix-base)
32(require 'guix-utils)
33
34(defgroup guix-list nil
35 "General settings for list buffers."
36 :prefix "guix-list-"
37 :group 'guix)
38
39(defface guix-list-file-path
40 '((t :inherit guix-info-file-path))
41 "Face used for file paths."
42 :group 'guix-list)
43
44(defcustom guix-list-describe-warning-count 10
45 "The maximum number of entries for describing without a warning.
46If a user wants to describe more than this number of marked
47entries, he will be prompted for confirmation."
48 :type 'integer
49 :group 'guix-list)
50
51(defvar guix-list-column-format
52 `((package
53 (name 20 t)
54 (version 10 nil)
55 (outputs 13 t)
56 (installed 13 t)
57 (synopsis 30 nil))
a54a237b
AK
58 (output
59 (name 20 t)
60 (version 10 nil)
61 (output 9 t)
62 (installed 12 t)
63 (synopsis 30 nil))
457f60fa
AK
64 (generation
65 (number 5
66 ,(lambda (a b) (guix-list-sort-numerically 0 a b))
67 :right-align t)
68 (time 20 t)
69 (path 30 t)))
70 "Columns displayed in list buffers.
71Each element of the list has a form:
72
73 (ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...))
74
75PARAM is the name of an entry parameter of ENTRY-TYPE. For the
76meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.")
77
78(defvar guix-list-column-titles
79 '((generation
80 (number . "N.")))
81 "Column titles for list buffers.
82Has the same structure as `guix-param-titles', but titles from
83this list have a priority.")
84
85(defvar guix-list-column-value-methods
86 '((package
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))
a54a237b
AK
91 (output
92 (name . guix-package-list-get-name)
93 (synopsis . guix-list-get-one-line)
94 (description . guix-list-get-one-line))
457f60fa
AK
95 (generation
96 (time . guix-list-get-time)
97 (path . guix-list-get-file-path)))
98 "Methods for inserting parameter values in columns.
99Each element of the list has a form:
100
101 (ENTRY-TYPE . ((PARAM . FUN) ...))
102
103PARAM is the name of an entry parameter of ENTRY-TYPE.
104
105FUN is a function returning a value that will be inserted. The
106function is called with 2 arguments: the first one is the value
107of the parameter; the second argument is an entry info (alist of
108parameters and their values).")
109
110(defun guix-list-get-param-title (entry-type param)
111 "Return title of an ENTRY-TYPE entry parameter PARAM."
112 (or (guix-get-key-val guix-list-column-titles
113 entry-type param)
114 (guix-get-param-title entry-type param)))
115
116(defun guix-list-get-column-format (entry-type)
117 "Return column format for ENTRY-TYPE."
118 (guix-get-key-val guix-list-column-format entry-type))
119
120(defun guix-list-get-displayed-params (entry-type)
121 "Return list of parameters of ENTRY-TYPE that should be displayed."
122 (mapcar #'car
123 (guix-list-get-column-format entry-type)))
124
125(defun guix-list-get-sort-key (entry-type param &optional invert)
126 "Return suitable sort key for `tabulated-list-sort-key'.
127Define column title by ENTRY-TYPE and PARAM. If INVERT is
128non-nil, invert the sort."
129 (when (memq param (guix-list-get-displayed-params entry-type))
130 (cons (guix-list-get-param-title entry-type param) invert)))
131
132(defun guix-list-sort-numerically (column a b)
133 "Compare COLUMN of tabulated entries A and B numerically.
134It is a sort predicate for `tabulated-list-format'.
135Return non-nil, if B is bigger than A."
136 (cl-flet ((num (entry)
137 (string-to-number (aref (cadr entry) column))))
138 (> (num b) (num a))))
139
140(defun guix-list-make-tabulated-vector (entry-type fun)
141 "Call FUN on each column specification for ENTRY-TYPE.
142
143FUN is called with 2 argument: parameter name and column
144specification (see `guix-list-column-format').
145
146Return a vector made of values of FUN calls."
147 (apply #'vector
148 (mapcar (lambda (col-spec)
149 (funcall fun (car col-spec) (cdr col-spec)))
150 (guix-list-get-column-format entry-type))))
151
152(defun guix-list-get-list-format (entry-type)
153 "Return ENTRY-TYPE list specification for `tabulated-list-format'."
154 (guix-list-make-tabulated-vector
155 entry-type
156 (lambda (param spec)
157 (cons (guix-list-get-param-title entry-type param)
158 spec))))
159
160(defun guix-list-insert-entries (entries entry-type)
161 "Display ENTRIES of ENTRY-TYPE in the current list buffer.
162ENTRIES should have a form of `guix-entries'."
163 (setq tabulated-list-entries
164 (guix-list-get-tabulated-entries entries entry-type))
165 (tabulated-list-print))
166
167(defun guix-list-get-tabulated-entries (entries entry-type)
168 "Return list of values of ENTRY-TYPE for `tabulated-list-entries'.
169Values are taken from ENTRIES which should have the form of
170`guix-entries'."
171 (mapcar (lambda (entry)
172 (list (guix-get-key-val entry 'id)
173 (guix-list-get-tabulated-entry entry entry-type)))
174 entries))
175
176(defun guix-list-get-tabulated-entry (entry entry-type)
177 "Return array of values for `tabulated-list-entries'.
178Parameters are taken from ENTRY of ENTRY-TYPE."
179 (guix-list-make-tabulated-vector
180 entry-type
181 (lambda (param _)
182 (let ((val (guix-get-key-val entry param))
183 (fun (guix-get-key-val guix-list-column-value-methods
184 entry-type param)))
185 (if (and val fun)
186 (funcall fun val entry)
187 (guix-get-string val))))))
188
189(defun guix-list-get-one-line (str &optional _)
190 "Return one-line string from a multi-line STR."
191 (guix-get-one-line str))
192
193(defun guix-list-get-time (seconds &optional _)
194 "Return formatted time string from SECONDS."
195 (guix-get-time-string seconds))
196
197(defun guix-list-get-file-path (path &optional _)
198 "Return PATH button specification for `tabulated-list-entries'."
199 (list path
200 'face 'guix-list-file-path
201 'action (lambda (btn) (find-file (button-label btn)))
202 'follow-link t
203 'help-echo "Find file"))
204
205(defun guix-list-current-id ()
206 "Return ID of the current entry."
207 (or (tabulated-list-get-id)
208 (user-error "No entry here")))
209
210(defun guix-list-current-entry ()
211 "Return alist of the current entry info."
212 (guix-get-entry-by-id (guix-list-current-id) guix-entries))
213
214(defun guix-list-for-each-line (fun &rest args)
215 "Call FUN with ARGS for each entry line."
216 (or (derived-mode-p 'guix-list-mode)
217 (error "The current buffer is not in Guix List mode"))
218 (save-excursion
219 (goto-char (point-min))
220 (while (not (eobp))
221 (apply fun args)
222 (forward-line))))
223
224(defun guix-list-fold-lines (fun init)
225 "Fold over entry lines in the current list buffer.
226Call FUN with RESULT as argument for each line, using INIT as
227the initial value of RESULT. Return the final result."
228 (let ((res init))
229 (guix-list-for-each-line
230 (lambda () (setq res (funcall fun res))))
231 res))
232
233\f
234;;; Marking and sorting
235
236(defvar-local guix-list-marked nil
237 "List of the marked entries.
238Each element of the list has a form:
239
240 (ID MARK-NAME . ARGS)
241
242ID is an entry ID.
243MARK-NAME is a symbol from `guix-list-mark-alist'.
244ARGS is a list of additional values.")
245
246(defvar guix-list-mark-alist
247 '((empty . ?\s)
248 (general . ?*))
249 "Alist of available mark names and mark characters.")
250
251(defsubst guix-list-get-mark (name)
252 "Return mark character by its NAME."
253 (or (guix-get-key-val guix-list-mark-alist name)
254 (error "Mark '%S' not found" name)))
255
256(defsubst guix-list-get-mark-string (name)
257 "Return mark string by its NAME."
258 (string (guix-list-get-mark name)))
259
260(defun guix-list-current-mark ()
261 "Return mark character of the current line."
262 (char-after (line-beginning-position)))
263
264(defun guix-list-get-marked (&rest mark-names)
265 "Return list of specs of entries marked with any mark from MARK-NAMES.
266Entry specs are elements from `guix-list-marked' list.
267If MARK-NAMES are not specified, use all marks from
268`guix-list-mark-alist' except the `empty' one."
269 (or mark-names
270 (setq mark-names
271 (delq 'empty
272 (mapcar #'car guix-list-mark-alist))))
273 (cl-remove-if-not (lambda (assoc)
274 (memq (cadr assoc) mark-names))
275 guix-list-marked))
276
277(defun guix-list-get-marked-args (mark-name)
278 "Return list of (ID . ARGS) elements from lines marked with MARK-NAME.
279See `guix-list-marked' for the meaning of ARGS."
280 (mapcar (lambda (spec)
281 (let ((id (car spec))
282 (args (cddr spec)))
283 (cons id args)))
284 (guix-list-get-marked mark-name)))
285
286(defun guix-list-get-marked-id-list (&rest mark-names)
287 "Return list of IDs of entries marked with any mark from MARK-NAMES.
288See `guix-list-get-marked' for details."
289 (mapcar #'car (apply #'guix-list-get-marked mark-names)))
290
291(defun guix-list-mark (mark-name &optional advance &rest args)
292 "Put a mark on the current line.
293Also add the current entry to `guix-list-marked' using its ID and ARGS.
294MARK-NAME is a symbol from `guix-list-mark-alist'.
295If ADVANCE is non-nil, move forward by one line after marking.
296Interactively, put a general mark and move to the next line."
297 (interactive '(general t))
298 (let ((id (guix-list-current-id)))
299 (if (eq mark-name 'empty)
300 (setq guix-list-marked (assq-delete-all id guix-list-marked))
301 (let ((assoc (assq id guix-list-marked))
302 (val (cons mark-name args)))
303 (if assoc
304 (setcdr assoc val)
305 (push (cons id val) guix-list-marked)))))
306 (tabulated-list-put-tag (guix-list-get-mark-string mark-name)
307 advance))
308
309(defun guix-list-mark-all (mark-name)
310 "Mark all lines with MARK-NAME mark.
311MARK-NAME is a symbol from `guix-list-mark-alist'.
312Interactively, put a general mark on all lines."
313 (interactive '(general))
314 (guix-list-for-each-line #'guix-list-mark mark-name))
315
91cc37a1
AK
316(defun guix-list-unmark (&optional arg)
317 "Unmark the current line and move to the next line.
318With ARG, unmark all lines."
319 (interactive "P")
320 (if arg
321 (guix-list-unmark-all)
322 (guix-list-mark 'empty t)))
457f60fa
AK
323
324(defun guix-list-unmark-backward ()
325 "Move up one line and unmark it."
326 (interactive)
327 (forward-line -1)
328 (guix-list-mark 'empty))
329
330(defun guix-list-unmark-all ()
331 "Unmark all lines."
332 (interactive)
333 (guix-list-mark-all 'empty))
334
335(defun guix-list-restore-marks ()
336 "Put marks according to `guix-list-mark-alist'."
337 (guix-list-for-each-line
338 (lambda ()
339 (let ((mark-name (car (guix-get-key-val guix-list-marked
340 (guix-list-current-id)))))
341 (tabulated-list-put-tag
342 (guix-list-get-mark-string (or mark-name 'empty)))))))
343
344(defun guix-list-sort (&optional n)
345 "Sort guix list entries by the column at point.
346With a numeric prefix argument N, sort the Nth column.
347Same as `tabulated-list-sort', but also restore marks after sorting."
348 (interactive "P")
349 (tabulated-list-sort n)
350 (guix-list-restore-marks))
351
352\f
353(defvar guix-list-mode-map
354 (let ((map (make-sparse-keymap)))
355 (set-keymap-parent map tabulated-list-mode-map)
dfeb0239 356 (define-key map (kbd "RET") 'guix-list-describe)
457f60fa
AK
357 (define-key map (kbd "m") 'guix-list-mark)
358 (define-key map (kbd "*") 'guix-list-mark)
359 (define-key map (kbd "M") 'guix-list-mark-all)
360 (define-key map (kbd "u") 'guix-list-unmark)
457f60fa
AK
361 (define-key map (kbd "DEL") 'guix-list-unmark-backward)
362 (define-key map [remap tabulated-list-sort] 'guix-list-sort)
363 map)
364 "Parent keymap for list buffers.")
365
366(define-derived-mode guix-list-mode tabulated-list-mode "Guix-List"
367 "Parent mode for displaying information in list buffers."
368 (setq tabulated-list-padding 2))
369
370(defmacro guix-list-define-entry-type (entry-type &rest args)
371 "Define common stuff for displaying ENTRY-TYPE entries in list buffers.
372
373Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The
374following keywords are available:
375
376 - `:sort-key' - default sort key for the tabulated list buffer.
377
378 - `:invert-sort' - if non-nil, invert initial sort.
379
380 - `:marks' - default value for the defined
381 `guix-ENTRY-TYPE-mark-alist' variable.
382
383This macro defines the following functions:
384
457f60fa
AK
385 - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark
386 specified in `:marks' argument."
387 (let* ((entry-type-str (symbol-name entry-type))
457f60fa
AK
388 (prefix (concat "guix-" entry-type-str "-list"))
389 (mode-str (concat prefix "-mode"))
390 (init-fun (intern (concat prefix "-mode-initialize")))
457f60fa
AK
391 (marks-var (intern (concat prefix "-mark-alist")))
392 (marks-val nil)
393 (sort-key nil)
394 (invert-sort nil))
395
396 ;; Process the keyword args.
397 (while (keywordp (car args))
398 (pcase (pop args)
399 (`:sort-key (setq sort-key (pop args)))
400 (`:invert-sort (setq invert-sort (pop args)))
401 (`:marks (setq marks-val (pop args)))
402 (_ (pop args))))
403
404 `(progn
405 (defvar ,marks-var ',marks-val
406 ,(concat "Alist of additional marks for `" mode-str "'.\n"
407 "Marks from this list are added to `guix-list-mark-alist'."))
408
409 ,@(mapcar (lambda (mark-spec)
410 (let* ((mark-name (car mark-spec))
411 (mark-name-str (symbol-name mark-name)))
412 `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) ()
413 ,(concat "Put '" mark-name-str "' mark and move to the next line.\n"
414 "Also add the current entry to `guix-list-marked'.")
415 (interactive)
416 (guix-list-mark ',mark-name t))))
417 marks-val)
418
457f60fa
AK
419 (defun ,init-fun ()
420 ,(concat "Initial settings for `" mode-str "'.")
421 ,(when sort-key
422 `(setq tabulated-list-sort-key
423 (guix-list-get-sort-key
424 ',entry-type ',sort-key ,invert-sort)))
425 (setq tabulated-list-format
426 (guix-list-get-list-format ',entry-type))
427 (setq-local guix-list-mark-alist
428 (append guix-list-mark-alist ,marks-var))
429 (tabulated-list-init-header)))))
430
431(put 'guix-list-define-entry-type 'lisp-indent-function 'defun)
432
a54a237b
AK
433(defun guix-list-describe-maybe (entry-type ids)
434 "Describe ENTRY-TYPE entries in info buffer using list of IDS."
435 (let ((count (length ids)))
436 (when (or (<= count guix-list-describe-warning-count)
437 (y-or-n-p (format "Do you really want to describe %d entries? "
438 count)))
439 (apply #'guix-get-show-entries 'info entry-type 'id ids))))
440
dfeb0239
AK
441(defun guix-list-describe (&optional arg)
442 "Describe entries marked with a general mark.
443If no entries are marked, describe the current entry.
444With prefix (if ARG is non-nil), describe entries marked with any mark."
445 (interactive "P")
a54a237b
AK
446 (let ((ids (or (apply #'guix-list-get-marked-id-list
447 (unless arg '(general)))
448 (list (guix-list-current-id)))))
449 (guix-list-describe-maybe guix-entry-type ids)))
dfeb0239 450
457f60fa
AK
451\f
452;;; Displaying packages
453
454(guix-define-buffer-type list package)
455
456(guix-list-define-entry-type package
457 :sort-key name
458 :marks ((install . ?I)
459 (upgrade . ?U)
460 (delete . ?D)))
461
8ed08c76
AK
462(defface guix-package-list-installed
463 '((t :inherit guix-package-info-installed-outputs))
464 "Face used if there are installed outputs for the current package."
465 :group 'guix-package-list)
466
457f60fa
AK
467(defface guix-package-list-obsolete
468 '((t :inherit guix-package-info-obsolete))
469 "Face used if a package is obsolete."
470 :group 'guix-package-list)
471
472(defcustom guix-package-list-generation-marking-enabled nil
473 "If non-nil, allow putting marks in a list with 'generation packages'.
474
475By default this is disabled, because it may be confusing. For
476example a package is installed in some generation, so a user can
477mark it for deletion in the list of packages from this
478generation, but the package may not be installed in the latest
479generation, so actually it cannot be deleted.
480
481If you managed to understand the explanation above or if you
482really know what you do or if you just don't care, you can set
483this variable to t. It should not do much harm anyway (most
484likely)."
485 :type 'boolean
486 :group 'guix-package-list)
487
488(let ((map guix-package-list-mode-map))
457f60fa
AK
489 (define-key map (kbd "x") 'guix-package-list-execute)
490 (define-key map (kbd "i") 'guix-package-list-mark-install)
91cc37a1
AK
491 (define-key map (kbd "d") 'guix-package-list-mark-delete)
492 (define-key map (kbd "U") 'guix-package-list-mark-upgrade)
493 (define-key map (kbd "^") 'guix-package-list-mark-upgrades))
457f60fa
AK
494
495(defun guix-package-list-get-name (name entry)
496 "Return NAME of the package ENTRY.
8ed08c76
AK
497Colorize it with `guix-package-list-installed' or
498`guix-package-list-obsolete' if needed."
457f60fa 499 (guix-get-string name
8ed08c76
AK
500 (cond ((guix-get-key-val entry 'obsolete)
501 'guix-package-list-obsolete)
502 ((guix-get-key-val entry 'installed)
503 'guix-package-list-installed))))
457f60fa
AK
504
505(defun guix-package-list-get-installed-outputs (installed &optional _)
506 "Return string with outputs from INSTALLED entries."
507 (guix-get-string
508 (mapcar (lambda (entry)
509 (guix-get-key-val entry 'output))
510 installed)))
511
512(defun guix-package-list-marking-check ()
513 "Signal an error if marking is disabled for the current buffer."
514 (when (and (not guix-package-list-generation-marking-enabled)
a54a237b
AK
515 (or (derived-mode-p 'guix-package-list-mode)
516 (derived-mode-p 'guix-output-list-mode))
457f60fa
AK
517 (eq guix-search-type 'generation))
518 (error "Action marks are disabled for lists of 'generation packages'")))
519
91cc37a1
AK
520(defun guix-package-list-mark-outputs (mark default
521 &optional prompt available)
522 "Mark the current package with MARK and move to the next line.
523If PROMPT is non-nil, use it to ask a user for outputs from
524AVAILABLE list, otherwise mark all DEFAULT outputs."
525 (let ((outputs (if prompt
526 (guix-completing-read-multiple
527 prompt available nil t)
528 default)))
529 (apply #'guix-list-mark mark t outputs)))
530
457f60fa
AK
531(defun guix-package-list-mark-install (&optional arg)
532 "Mark the current package for installation and move to the next line.
533With ARG, prompt for the outputs to install (several outputs may
534be separated with \",\")."
535 (interactive "P")
536 (guix-package-list-marking-check)
91cc37a1
AK
537 (let* ((entry (guix-list-current-entry))
538 (all (guix-get-key-val entry 'outputs))
457f60fa 539 (installed (guix-get-installed-outputs entry))
91cc37a1
AK
540 (available (cl-set-difference all installed :test #'string=)))
541 (or available
542 (user-error "This package is already installed"))
543 (guix-package-list-mark-outputs
544 'install '("out")
545 (and arg "Output(s) to install: ")
546 available)))
457f60fa
AK
547
548(defun guix-package-list-mark-delete (&optional arg)
549 "Mark the current package for deletion and move to the next line.
550With ARG, prompt for the outputs to delete (several outputs may
551be separated with \",\")."
552 (interactive "P")
553 (guix-package-list-marking-check)
554 (let* ((entry (guix-list-current-entry))
555 (installed (guix-get-installed-outputs entry)))
556 (or installed
557 (user-error "This package is not installed"))
91cc37a1
AK
558 (guix-package-list-mark-outputs
559 'delete installed
560 (and arg "Output(s) to delete: ")
561 installed)))
562
563(defun guix-package-list-mark-upgrade (&optional arg)
564 "Mark the current package for upgrading and move to the next line.
565With ARG, prompt for the outputs to upgrade (several outputs may
566be separated with \",\")."
567 (interactive "P")
457f60fa 568 (guix-package-list-marking-check)
91cc37a1
AK
569 (let* ((entry (guix-list-current-entry))
570 (installed (guix-get-installed-outputs entry)))
571 (or installed
457f60fa
AK
572 (user-error "This package is not installed"))
573 (when (or (guix-get-key-val entry 'obsolete)
574 (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? "))
91cc37a1
AK
575 (guix-package-list-mark-outputs
576 'upgrade installed
577 (and arg "Output(s) to upgrade: ")
578 installed))))
579
a54a237b
AK
580(defun guix-list-mark-package-upgrades (fun)
581 "Mark all obsolete packages for upgrading.
582Use FUN to perform marking of the current line. FUN should
583accept an entry as argument."
91cc37a1
AK
584 (guix-package-list-marking-check)
585 (let ((obsolete (cl-remove-if-not
586 (lambda (entry)
587 (guix-get-key-val entry 'obsolete))
588 guix-entries)))
589 (guix-list-for-each-line
590 (lambda ()
591 (let* ((id (guix-list-current-id))
592 (entry (cl-find-if
593 (lambda (entry)
594 (equal id (guix-get-key-val entry 'id)))
595 obsolete)))
596 (when entry
a54a237b 597 (funcall fun entry)))))))
457f60fa 598
a54a237b
AK
599(defun guix-package-list-mark-upgrades ()
600 "Mark all obsolete packages for upgrading."
457f60fa 601 (interactive)
a54a237b
AK
602 (guix-list-mark-package-upgrades
603 (lambda (entry)
604 (apply #'guix-list-mark
605 'upgrade nil
606 (guix-get-installed-outputs entry)))))
607
608(defun guix-list-execute-package-actions (fun)
609 "Perform actions on the marked packages.
610Use FUN to define actions suitable for `guix-process-package-actions'.
611FUN should accept action-type as argument."
457f60fa 612 (let ((actions (delq nil
a54a237b 613 (mapcar fun '(install delete upgrade)))))
457f60fa
AK
614 (if actions
615 (apply #'guix-process-package-actions actions)
616 (user-error "No operations specified"))))
617
a54a237b
AK
618(defun guix-package-list-execute ()
619 "Perform actions on the marked packages."
620 (interactive)
621 (guix-list-execute-package-actions #'guix-package-list-make-action))
622
457f60fa
AK
623(defun guix-package-list-make-action (action-type)
624 "Return action specification for the packages marked with ACTION-TYPE.
625Return nil, if there are no packages marked with ACTION-TYPE.
626The specification is suitable for `guix-process-package-actions'."
627 (let ((specs (guix-list-get-marked-args action-type)))
628 (and specs (cons action-type specs))))
629
630\f
a54a237b
AK
631;;; Displaying outputs
632
633(guix-define-buffer-type list output
634 :buffer-name "*Guix Package List*")
635
636(guix-list-define-entry-type output
637 :sort-key name
638 :marks ((install . ?I)
639 (upgrade . ?U)
640 (delete . ?D)))
641
a54a237b
AK
642(let ((map guix-output-list-mode-map))
643 (define-key map (kbd "RET") 'guix-output-list-describe)
644 (define-key map (kbd "x") 'guix-output-list-execute)
645 (define-key map (kbd "i") 'guix-output-list-mark-install)
646 (define-key map (kbd "d") 'guix-output-list-mark-delete)
647 (define-key map (kbd "U") 'guix-output-list-mark-upgrade)
648 (define-key map (kbd "^") 'guix-output-list-mark-upgrades))
649
650(defun guix-output-list-mark-install ()
651 "Mark the current output for installation and move to the next line."
652 (interactive)
653 (guix-package-list-marking-check)
654 (let* ((entry (guix-list-current-entry))
655 (installed (guix-get-key-val entry 'installed)))
656 (if installed
657 (user-error "This output is already installed")
658 (guix-list-mark 'install t))))
659
660(defun guix-output-list-mark-delete ()
661 "Mark the current output for deletion and move to the next line."
662 (interactive)
663 (guix-package-list-marking-check)
664 (let* ((entry (guix-list-current-entry))
665 (installed (guix-get-key-val entry 'installed)))
666 (if installed
667 (guix-list-mark 'delete t)
668 (user-error "This output is not installed"))))
669
670(defun guix-output-list-mark-upgrade ()
671 "Mark the current output for deletion and move to the next line."
672 (interactive)
673 (guix-package-list-marking-check)
674 (let* ((entry (guix-list-current-entry))
675 (installed (guix-get-key-val entry 'installed)))
676 (or installed
677 (user-error "This output is not installed"))
678 (when (or (guix-get-key-val entry 'obsolete)
679 (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? "))
680 (guix-list-mark 'upgrade t))))
681
682(defun guix-output-list-mark-upgrades ()
683 "Mark all obsolete package outputs for upgrading."
684 (interactive)
685 (guix-list-mark-package-upgrades
686 (lambda (_) (guix-list-mark 'upgrade))))
687
688(defun guix-output-list-execute ()
689 "Perform actions on the marked outputs."
690 (interactive)
691 (guix-list-execute-package-actions #'guix-output-list-make-action))
692
693(defun guix-output-list-make-action (action-type)
694 "Return action specification for the outputs marked with ACTION-TYPE.
695Return nil, if there are no outputs marked with ACTION-TYPE.
696The specification is suitable for `guix-process-output-actions'."
697 (let ((ids (guix-list-get-marked-id-list action-type)))
698 (and ids (cons action-type
699 (mapcar #'guix-get-package-id-and-output-by-output-id
700 ids)))))
701
702(defun guix-output-list-describe (&optional arg)
703 "Describe outputs or packages marked with a general mark.
704If no entries are marked, describe the current output or package.
705With prefix (if ARG is non-nil), describe entries marked with any mark.
3472bb20 706Also see `guix-package-info-type'."
a54a237b 707 (interactive "P")
3472bb20 708 (if (eq guix-package-info-type 'output)
a54a237b
AK
709 (guix-list-describe arg)
710 (let* ((oids (or (apply #'guix-list-get-marked-id-list
711 (unless arg '(general)))
712 (list (guix-list-current-id))))
713 (pids (mapcar (lambda (oid)
714 (car (guix-get-package-id-and-output-by-output-id
715 oid)))
716 oids)))
717 (guix-list-describe-maybe 'package (cl-remove-duplicates pids)))))
718
719\f
457f60fa
AK
720;;; Displaying generations
721
722(guix-define-buffer-type list generation)
723
724(guix-list-define-entry-type generation
725 :sort-key number
726 :invert-sort t
727 :marks ((delete . ?D)))
728
729(let ((map guix-generation-list-mode-map))
730 (define-key map (kbd "RET") 'guix-generation-list-show-packages)
dfeb0239 731 (define-key map (kbd "i") 'guix-list-describe)
457f60fa
AK
732 (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple))
733
734(defun guix-generation-list-show-packages ()
735 "List installed packages for the generation at point."
736 (interactive)
a54a237b 737 (guix-get-show-entries 'list guix-package-list-type 'generation
dfeb0239 738 (guix-list-current-id)))
457f60fa
AK
739
740(provide 'guix-list)
741
742;;; guix-list.el ends here