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