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) | |
346 | (define-key map (kbd "m") 'guix-list-mark) | |
347 | (define-key map (kbd "*") 'guix-list-mark) | |
348 | (define-key map (kbd "M") 'guix-list-mark-all) | |
349 | (define-key map (kbd "u") 'guix-list-unmark) | |
457f60fa AK |
350 | (define-key map (kbd "DEL") 'guix-list-unmark-backward) |
351 | (define-key map [remap tabulated-list-sort] 'guix-list-sort) | |
352 | map) | |
353 | "Parent keymap for list buffers.") | |
354 | ||
355 | (define-derived-mode guix-list-mode tabulated-list-mode "Guix-List" | |
356 | "Parent mode for displaying information in list buffers." | |
357 | (setq tabulated-list-padding 2)) | |
358 | ||
359 | (defmacro guix-list-define-entry-type (entry-type &rest args) | |
360 | "Define common stuff for displaying ENTRY-TYPE entries in list buffers. | |
361 | ||
362 | Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The | |
363 | following keywords are available: | |
364 | ||
365 | - `:sort-key' - default sort key for the tabulated list buffer. | |
366 | ||
367 | - `:invert-sort' - if non-nil, invert initial sort. | |
368 | ||
369 | - `:marks' - default value for the defined | |
370 | `guix-ENTRY-TYPE-mark-alist' variable. | |
371 | ||
372 | This macro defines the following functions: | |
373 | ||
374 | - `guix-ENTRY-TYPE-describe' - display marked entries in info buffer. | |
375 | ||
376 | - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark | |
377 | specified in `:marks' argument." | |
378 | (let* ((entry-type-str (symbol-name entry-type)) | |
379 | (entry-str (concat entry-type-str " entries")) | |
380 | (prefix (concat "guix-" entry-type-str "-list")) | |
381 | (mode-str (concat prefix "-mode")) | |
382 | (init-fun (intern (concat prefix "-mode-initialize"))) | |
383 | (describe-fun (intern (concat prefix "-describe"))) | |
384 | (marks-var (intern (concat prefix "-mark-alist"))) | |
385 | (marks-val nil) | |
386 | (sort-key nil) | |
387 | (invert-sort nil)) | |
388 | ||
389 | ;; Process the keyword args. | |
390 | (while (keywordp (car args)) | |
391 | (pcase (pop args) | |
392 | (`:sort-key (setq sort-key (pop args))) | |
393 | (`:invert-sort (setq invert-sort (pop args))) | |
394 | (`:marks (setq marks-val (pop args))) | |
395 | (_ (pop args)))) | |
396 | ||
397 | `(progn | |
398 | (defvar ,marks-var ',marks-val | |
399 | ,(concat "Alist of additional marks for `" mode-str "'.\n" | |
400 | "Marks from this list are added to `guix-list-mark-alist'.")) | |
401 | ||
402 | ,@(mapcar (lambda (mark-spec) | |
403 | (let* ((mark-name (car mark-spec)) | |
404 | (mark-name-str (symbol-name mark-name))) | |
405 | `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () | |
406 | ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" | |
407 | "Also add the current entry to `guix-list-marked'.") | |
408 | (interactive) | |
409 | (guix-list-mark ',mark-name t)))) | |
410 | marks-val) | |
411 | ||
412 | (defun ,describe-fun (&optional arg) | |
413 | ,(concat "Describe " entry-str " marked with a general mark.\n" | |
414 | "If no entry is marked, describe the current " entry-type-str ".\n" | |
415 | "With prefix (if ARG is non-nil), describe the " entry-str "\n" | |
416 | "marked with any mark.") | |
417 | (interactive "P") | |
418 | (let* ((ids (or (apply #'guix-list-get-marked-id-list | |
419 | (unless arg '(general))) | |
420 | (list (guix-list-current-id)))) | |
421 | (count (length ids))) | |
422 | (when (or (<= count guix-list-describe-warning-count) | |
423 | (y-or-n-p (format "Do you really want to describe %d entries? " | |
424 | count))) | |
425 | (,(intern (concat "guix-" entry-type-str "-info-get-show")) | |
426 | 'id ids)))) | |
427 | ||
428 | (defun ,init-fun () | |
429 | ,(concat "Initial settings for `" mode-str "'.") | |
430 | ,(when sort-key | |
431 | `(setq tabulated-list-sort-key | |
432 | (guix-list-get-sort-key | |
433 | ',entry-type ',sort-key ,invert-sort))) | |
434 | (setq tabulated-list-format | |
435 | (guix-list-get-list-format ',entry-type)) | |
436 | (setq-local guix-list-mark-alist | |
437 | (append guix-list-mark-alist ,marks-var)) | |
438 | (tabulated-list-init-header))))) | |
439 | ||
440 | (put 'guix-list-define-entry-type 'lisp-indent-function 'defun) | |
441 | ||
442 | \f | |
443 | ;;; Displaying packages | |
444 | ||
445 | (guix-define-buffer-type list package) | |
446 | ||
447 | (guix-list-define-entry-type package | |
448 | :sort-key name | |
449 | :marks ((install . ?I) | |
450 | (upgrade . ?U) | |
451 | (delete . ?D))) | |
452 | ||
8ed08c76 AK |
453 | (defface guix-package-list-installed |
454 | '((t :inherit guix-package-info-installed-outputs)) | |
455 | "Face used if there are installed outputs for the current package." | |
456 | :group 'guix-package-list) | |
457 | ||
457f60fa AK |
458 | (defface guix-package-list-obsolete |
459 | '((t :inherit guix-package-info-obsolete)) | |
460 | "Face used if a package is obsolete." | |
461 | :group 'guix-package-list) | |
462 | ||
463 | (defcustom guix-package-list-generation-marking-enabled nil | |
464 | "If non-nil, allow putting marks in a list with 'generation packages'. | |
465 | ||
466 | By default this is disabled, because it may be confusing. For | |
467 | example a package is installed in some generation, so a user can | |
468 | mark it for deletion in the list of packages from this | |
469 | generation, but the package may not be installed in the latest | |
470 | generation, so actually it cannot be deleted. | |
471 | ||
472 | If you managed to understand the explanation above or if you | |
473 | really know what you do or if you just don't care, you can set | |
474 | this variable to t. It should not do much harm anyway (most | |
475 | likely)." | |
476 | :type 'boolean | |
477 | :group 'guix-package-list) | |
478 | ||
479 | (let ((map guix-package-list-mode-map)) | |
480 | (define-key map (kbd "RET") 'guix-package-list-describe) | |
481 | (define-key map (kbd "x") 'guix-package-list-execute) | |
482 | (define-key map (kbd "i") 'guix-package-list-mark-install) | |
91cc37a1 AK |
483 | (define-key map (kbd "d") 'guix-package-list-mark-delete) |
484 | (define-key map (kbd "U") 'guix-package-list-mark-upgrade) | |
485 | (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) | |
457f60fa AK |
486 | |
487 | (defun guix-package-list-get-name (name entry) | |
488 | "Return NAME of the package ENTRY. | |
8ed08c76 AK |
489 | Colorize it with `guix-package-list-installed' or |
490 | `guix-package-list-obsolete' if needed." | |
457f60fa | 491 | (guix-get-string name |
8ed08c76 AK |
492 | (cond ((guix-get-key-val entry 'obsolete) |
493 | 'guix-package-list-obsolete) | |
494 | ((guix-get-key-val entry 'installed) | |
495 | 'guix-package-list-installed)))) | |
457f60fa AK |
496 | |
497 | (defun guix-package-list-get-installed-outputs (installed &optional _) | |
498 | "Return string with outputs from INSTALLED entries." | |
499 | (guix-get-string | |
500 | (mapcar (lambda (entry) | |
501 | (guix-get-key-val entry 'output)) | |
502 | installed))) | |
503 | ||
504 | (defun guix-package-list-marking-check () | |
505 | "Signal an error if marking is disabled for the current buffer." | |
506 | (when (and (not guix-package-list-generation-marking-enabled) | |
507 | (derived-mode-p 'guix-package-list-mode) | |
508 | (eq guix-search-type 'generation)) | |
509 | (error "Action marks are disabled for lists of 'generation packages'"))) | |
510 | ||
91cc37a1 AK |
511 | (defun guix-package-list-mark-outputs (mark default |
512 | &optional prompt available) | |
513 | "Mark the current package with MARK and move to the next line. | |
514 | If PROMPT is non-nil, use it to ask a user for outputs from | |
515 | AVAILABLE list, otherwise mark all DEFAULT outputs." | |
516 | (let ((outputs (if prompt | |
517 | (guix-completing-read-multiple | |
518 | prompt available nil t) | |
519 | default))) | |
520 | (apply #'guix-list-mark mark t outputs))) | |
521 | ||
457f60fa AK |
522 | (defun guix-package-list-mark-install (&optional arg) |
523 | "Mark the current package for installation and move to the next line. | |
524 | With ARG, prompt for the outputs to install (several outputs may | |
525 | be separated with \",\")." | |
526 | (interactive "P") | |
527 | (guix-package-list-marking-check) | |
91cc37a1 AK |
528 | (let* ((entry (guix-list-current-entry)) |
529 | (all (guix-get-key-val entry 'outputs)) | |
457f60fa | 530 | (installed (guix-get-installed-outputs entry)) |
91cc37a1 AK |
531 | (available (cl-set-difference all installed :test #'string=))) |
532 | (or available | |
533 | (user-error "This package is already installed")) | |
534 | (guix-package-list-mark-outputs | |
535 | 'install '("out") | |
536 | (and arg "Output(s) to install: ") | |
537 | available))) | |
457f60fa AK |
538 | |
539 | (defun guix-package-list-mark-delete (&optional arg) | |
540 | "Mark the current package for deletion and move to the next line. | |
541 | With ARG, prompt for the outputs to delete (several outputs may | |
542 | be separated with \",\")." | |
543 | (interactive "P") | |
544 | (guix-package-list-marking-check) | |
545 | (let* ((entry (guix-list-current-entry)) | |
546 | (installed (guix-get-installed-outputs entry))) | |
547 | (or installed | |
548 | (user-error "This package is not installed")) | |
91cc37a1 AK |
549 | (guix-package-list-mark-outputs |
550 | 'delete installed | |
551 | (and arg "Output(s) to delete: ") | |
552 | installed))) | |
553 | ||
554 | (defun guix-package-list-mark-upgrade (&optional arg) | |
555 | "Mark the current package for upgrading and move to the next line. | |
556 | With ARG, prompt for the outputs to upgrade (several outputs may | |
557 | be separated with \",\")." | |
558 | (interactive "P") | |
457f60fa | 559 | (guix-package-list-marking-check) |
91cc37a1 AK |
560 | (let* ((entry (guix-list-current-entry)) |
561 | (installed (guix-get-installed-outputs entry))) | |
562 | (or installed | |
457f60fa AK |
563 | (user-error "This package is not installed")) |
564 | (when (or (guix-get-key-val entry 'obsolete) | |
565 | (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) | |
91cc37a1 AK |
566 | (guix-package-list-mark-outputs |
567 | 'upgrade installed | |
568 | (and arg "Output(s) to upgrade: ") | |
569 | installed)))) | |
570 | ||
571 | (defun guix-package-list-mark-upgrades () | |
572 | "Mark all obsolete packages for upgrading." | |
573 | (interactive) | |
574 | (guix-package-list-marking-check) | |
575 | (let ((obsolete (cl-remove-if-not | |
576 | (lambda (entry) | |
577 | (guix-get-key-val entry 'obsolete)) | |
578 | guix-entries))) | |
579 | (guix-list-for-each-line | |
580 | (lambda () | |
581 | (let* ((id (guix-list-current-id)) | |
582 | (entry (cl-find-if | |
583 | (lambda (entry) | |
584 | (equal id (guix-get-key-val entry 'id))) | |
585 | obsolete))) | |
586 | (when entry | |
587 | (apply #'guix-list-mark | |
588 | 'upgrade nil | |
589 | (guix-get-installed-outputs entry)))))))) | |
457f60fa AK |
590 | |
591 | (defun guix-package-list-execute () | |
592 | "Perform actions on the marked packages." | |
593 | (interactive) | |
594 | (let ((actions (delq nil | |
595 | (mapcar #'guix-package-list-make-action | |
596 | '(install delete upgrade))))) | |
597 | (if actions | |
598 | (apply #'guix-process-package-actions actions) | |
599 | (user-error "No operations specified")))) | |
600 | ||
601 | (defun guix-package-list-make-action (action-type) | |
602 | "Return action specification for the packages marked with ACTION-TYPE. | |
603 | Return nil, if there are no packages marked with ACTION-TYPE. | |
604 | The specification is suitable for `guix-process-package-actions'." | |
605 | (let ((specs (guix-list-get-marked-args action-type))) | |
606 | (and specs (cons action-type specs)))) | |
607 | ||
608 | \f | |
609 | ;;; Displaying generations | |
610 | ||
611 | (guix-define-buffer-type list generation) | |
612 | ||
613 | (guix-list-define-entry-type generation | |
614 | :sort-key number | |
615 | :invert-sort t | |
616 | :marks ((delete . ?D))) | |
617 | ||
618 | (let ((map guix-generation-list-mode-map)) | |
619 | (define-key map (kbd "RET") 'guix-generation-list-show-packages) | |
620 | (define-key map (kbd "i") 'guix-generation-list-describe) | |
621 | (define-key map (kbd "d") 'guix-generation-list-mark-delete-simple)) | |
622 | ||
623 | (defun guix-generation-list-show-packages () | |
624 | "List installed packages for the generation at point." | |
625 | (interactive) | |
626 | (guix-package-list-get-show 'generation (guix-list-current-id))) | |
627 | ||
628 | (provide 'guix-list) | |
629 | ||
630 | ;;; guix-list.el ends here |