Commit | Line | Data |
---|---|---|
0b0fbf0c | 1 | ;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*- |
457f60fa | 2 | |
dbe422ab LC |
3 | ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> |
4 | ;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> | |
457f60fa AK |
5 | |
6 | ;; This file is part of GNU Guix. | |
7 | ||
8 | ;; GNU Guix is free software; you can redistribute it and/or modify | |
9 | ;; it under the terms of the GNU General Public License as published by | |
10 | ;; the Free Software Foundation, either version 3 of the License, or | |
11 | ;; (at your option) any later version. | |
12 | ||
13 | ;; GNU Guix is distributed in the hope that it will be useful, | |
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;; GNU General Public License for more details. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
19 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | ;;; Commentary: | |
22 | ||
23 | ;; This file provides a help-like buffer for displaying information | |
24 | ;; about Guix packages and generations. | |
25 | ||
26 | ;;; Code: | |
27 | ||
457f60fa AK |
28 | (require 'guix-base) |
29 | (require 'guix-utils) | |
30 | ||
31 | (defgroup guix-info nil | |
32 | "General settings for info buffers." | |
33 | :prefix "guix-info-" | |
34 | :group 'guix) | |
35 | ||
36 | (defface guix-info-param-title | |
37 | '((t :inherit font-lock-type-face)) | |
38 | "Face used for titles of parameters." | |
39 | :group 'guix-info) | |
40 | ||
41 | (defface guix-info-file-path | |
42 | '((t :inherit link)) | |
43 | "Face used for file paths." | |
44 | :group 'guix-info) | |
45 | ||
46 | (defface guix-info-url | |
47 | '((t :inherit link)) | |
48 | "Face used for URLs." | |
49 | :group 'guix-info) | |
50 | ||
51 | (defface guix-info-time | |
52 | '((t :inherit font-lock-constant-face)) | |
53 | "Face used for timestamps." | |
54 | :group 'guix-info) | |
55 | ||
56 | (defface guix-info-action-button | |
57 | '((((type x w32 ns) (class color)) | |
58 | :box (:line-width 2 :style released-button) | |
59 | :background "lightgrey" :foreground "black") | |
60 | (t :inherit button)) | |
61 | "Face used for action buttons." | |
62 | :group 'guix-info) | |
63 | ||
64 | (defface guix-info-action-button-mouse | |
65 | '((((type x w32 ns) (class color)) | |
66 | :box (:line-width 2 :style released-button) | |
67 | :background "grey90" :foreground "black") | |
68 | (t :inherit highlight)) | |
69 | "Mouse face used for action buttons." | |
70 | :group 'guix-info) | |
71 | ||
72 | (defcustom guix-info-ignore-empty-vals nil | |
73 | "If non-nil, do not display parameters with nil values." | |
74 | :type 'boolean | |
75 | :group 'guix-info) | |
76 | ||
77 | (defvar guix-info-param-title-format "%-18s: " | |
78 | "String used to format a title of a parameter. | |
79 | It should be a '%s'-sequence. After inserting a title formatted | |
80 | with this string, a value of the parameter is inserted. | |
81 | This string is used by `guix-info-insert-title-default'.") | |
82 | ||
83 | (defvar guix-info-multiline-prefix (make-string 20 ?\s) | |
84 | "String used to format multi-line parameter values. | |
85 | If a value occupies more than one line, this string is inserted | |
86 | in the beginning of each line after the first one. | |
87 | This string is used by `guix-info-insert-val-default'.") | |
88 | ||
89 | (defvar guix-info-indent 2 | |
90 | "Number of spaces used to indent various parts of inserted text.") | |
91 | ||
92 | (defvar guix-info-fill-column 60 | |
93 | "Column used for filling (word wrapping) parameters with long lines. | |
94 | If a value is not multi-line and it occupies more than this | |
95 | number of characters, it will be split into several lines.") | |
96 | ||
97 | (defvar guix-info-delimiter "\n\f\n" | |
98 | "String used to separate entries.") | |
99 | ||
100 | (defvar guix-info-insert-methods | |
101 | '((package | |
102 | (name guix-package-info-name) | |
103 | (version guix-package-info-version) | |
104 | (license guix-package-info-license) | |
105 | (synopsis guix-package-info-synopsis) | |
106 | (description guix-package-info-insert-description | |
107 | guix-info-insert-title-simple) | |
108 | (outputs guix-package-info-insert-outputs | |
109 | guix-info-insert-title-simple) | |
0b0fbf0c AK |
110 | (source guix-package-info-insert-source |
111 | guix-info-insert-title-simple) | |
457f60fa AK |
112 | (home-url guix-info-insert-url) |
113 | (inputs guix-package-info-insert-inputs) | |
114 | (native-inputs guix-package-info-insert-native-inputs) | |
115 | (propagated-inputs guix-package-info-insert-propagated-inputs) | |
116 | (location guix-package-info-insert-location)) | |
117 | (installed | |
118 | (path guix-package-info-insert-output-path | |
119 | guix-info-insert-title-simple) | |
120 | (dependencies guix-package-info-insert-output-dependencies | |
121 | guix-info-insert-title-simple)) | |
a54a237b AK |
122 | (output |
123 | (name guix-package-info-name) | |
124 | (version guix-output-info-insert-version) | |
125 | (output guix-output-info-insert-output) | |
0b0fbf0c AK |
126 | (source guix-package-info-insert-source |
127 | guix-info-insert-title-simple) | |
a54a237b AK |
128 | (path guix-package-info-insert-output-path |
129 | guix-info-insert-title-simple) | |
130 | (dependencies guix-package-info-insert-output-dependencies | |
131 | guix-info-insert-title-simple) | |
132 | (license guix-package-info-license) | |
133 | (synopsis guix-package-info-synopsis) | |
134 | (description guix-package-info-insert-description | |
135 | guix-info-insert-title-simple) | |
136 | (home-url guix-info-insert-url) | |
137 | (inputs guix-package-info-insert-inputs) | |
138 | (native-inputs guix-package-info-insert-native-inputs) | |
139 | (propagated-inputs guix-package-info-insert-propagated-inputs) | |
140 | (location guix-package-info-insert-location)) | |
457f60fa AK |
141 | (generation |
142 | (number guix-generation-info-insert-number) | |
c2379b3c | 143 | (current guix-generation-info-insert-current) |
457f60fa AK |
144 | (path guix-info-insert-file-path) |
145 | (time guix-info-insert-time))) | |
146 | "Methods for inserting parameter values. | |
147 | Each element of the list should have a form: | |
148 | ||
149 | (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...)) | |
150 | ||
151 | INSERT-VALUE may be either nil, a face name or a function. If it | |
152 | is nil or a face, `guix-info-insert-val-default' function is | |
153 | called with parameter value and INSERT-VALUE as arguments. If it | |
154 | is a function, this function is called with parameter value and | |
155 | entry info (alist of parameters and their values) as arguments. | |
156 | ||
157 | INSERT-TITLE may be either nil, a face name or a function. If it | |
158 | is nil or a face, `guix-info-insert-title-default' function is | |
159 | called with parameter title and INSERT-TITLE as arguments. If it | |
160 | is a function, this function is called with parameter title as | |
161 | argument.") | |
162 | ||
163 | (defvar guix-info-displayed-params | |
0b0fbf0c | 164 | '((package name version synopsis outputs source location home-url |
457f60fa | 165 | license inputs native-inputs propagated-inputs description) |
0b0fbf0c AK |
166 | (output name version output synopsis source path dependencies location |
167 | home-url license inputs native-inputs propagated-inputs | |
168 | description) | |
457f60fa | 169 | (installed path dependencies) |
c2379b3c | 170 | (generation number prev-number current time path)) |
457f60fa AK |
171 | "List of displayed entry parameters. |
172 | Each element of the list should have a form: | |
173 | ||
174 | (ENTRY-TYPE . (PARAM ...)) | |
175 | ||
176 | The order of displayed parameters is the same as in this list.") | |
177 | ||
178 | (defun guix-info-get-insert-methods (entry-type param) | |
179 | "Return list of insert methods for parameter PARAM of ENTRY-TYPE. | |
180 | See `guix-info-insert-methods' for details." | |
181 | (guix-get-key-val guix-info-insert-methods | |
182 | entry-type param)) | |
183 | ||
184 | (defun guix-info-get-displayed-params (entry-type) | |
185 | "Return parameters of ENTRY-TYPE that should be displayed." | |
186 | (guix-get-key-val guix-info-displayed-params | |
187 | entry-type)) | |
188 | ||
189 | (defun guix-info-get-indent (&optional level) | |
190 | "Return `guix-info-indent' \"multiplied\" by LEVEL spaces. | |
191 | LEVEL is 1 by default." | |
192 | (make-string (* guix-info-indent (or level 1)) ?\s)) | |
193 | ||
194 | (defun guix-info-insert-indent (&optional level) | |
195 | "Insert `guix-info-indent' spaces LEVEL times (1 by default)." | |
196 | (insert (guix-info-get-indent level))) | |
197 | ||
198 | (defun guix-info-insert-entries (entries entry-type) | |
199 | "Display ENTRIES of ENTRY-TYPE in the current info buffer. | |
200 | ENTRIES should have a form of `guix-entries'." | |
201 | (guix-mapinsert (lambda (entry) | |
202 | (guix-info-insert-entry entry entry-type)) | |
203 | entries | |
204 | guix-info-delimiter)) | |
205 | ||
833fdac0 AK |
206 | (defun guix-info-insert-entry-default (entry entry-type |
207 | &optional indent-level) | |
457f60fa AK |
208 | "Insert ENTRY of ENTRY-TYPE into the current info buffer. |
209 | If INDENT-LEVEL is non-nil, indent displayed information by this | |
210 | number of `guix-info-indent' spaces." | |
211 | (let ((region-beg (point))) | |
212 | (mapc (lambda (param) | |
213 | (guix-info-insert-param param entry entry-type)) | |
214 | (guix-info-get-displayed-params entry-type)) | |
215 | (when indent-level | |
216 | (indent-rigidly region-beg (point) | |
217 | (* indent-level guix-info-indent))))) | |
218 | ||
833fdac0 AK |
219 | (defun guix-info-insert-entry (entry entry-type &optional indent-level) |
220 | "Insert ENTRY of ENTRY-TYPE into the current info buffer. | |
221 | Use `guix-info-insert-ENTRY-TYPE-function' or | |
222 | `guix-info-insert-entry-default' if it is nil." | |
223 | (let* ((var (intern (concat "guix-info-insert-" | |
224 | (symbol-name entry-type) | |
225 | "-function"))) | |
226 | (fun (symbol-value var))) | |
227 | (if (functionp fun) | |
228 | (funcall fun entry) | |
229 | (guix-info-insert-entry-default entry entry-type indent-level)))) | |
230 | ||
457f60fa AK |
231 | (defun guix-info-insert-param (param entry entry-type) |
232 | "Insert title and value of a PARAM at point. | |
233 | ENTRY is alist with parameters and their values. | |
234 | ENTRY-TYPE is a type of ENTRY." | |
235 | (let ((val (guix-get-key-val entry param))) | |
236 | (unless (and guix-info-ignore-empty-vals (null val)) | |
237 | (let* ((title (guix-get-param-title entry-type param)) | |
238 | (insert-methods (guix-info-get-insert-methods entry-type param)) | |
239 | (val-method (car insert-methods)) | |
240 | (title-method (cadr insert-methods))) | |
241 | (guix-info-method-funcall title title-method | |
242 | #'guix-info-insert-title-default) | |
243 | (guix-info-method-funcall val val-method | |
244 | #'guix-info-insert-val-default | |
245 | entry) | |
246 | (insert "\n"))))) | |
247 | ||
248 | (defun guix-info-method-funcall (val method default-fun &rest args) | |
249 | "Call METHOD or DEFAULT-FUN. | |
250 | ||
251 | If METHOD is a function and VAL is non-nil, call this | |
252 | function by applying it to VAL and ARGS. | |
253 | ||
254 | If METHOD is a face, propertize inserted VAL with this face." | |
255 | (cond ((or (null method) | |
256 | (facep method)) | |
257 | (funcall default-fun val method)) | |
258 | ((functionp method) | |
259 | (apply method val args)) | |
260 | (t (error "Unknown method '%S'" method)))) | |
261 | ||
262 | (defun guix-info-insert-title-default (title &optional face format) | |
263 | "Insert TITLE formatted with `guix-info-param-title-format' at point." | |
264 | (guix-format-insert title | |
265 | (or face 'guix-info-param-title) | |
266 | (or format guix-info-param-title-format))) | |
267 | ||
268 | (defun guix-info-insert-title-simple (title &optional face) | |
269 | "Insert TITLE at point." | |
270 | (guix-info-insert-title-default title face "%s:")) | |
271 | ||
272 | (defun guix-info-insert-val-default (val &optional face) | |
273 | "Format and insert parameter value VAL at point. | |
274 | ||
275 | This function is intended to be called after | |
276 | `guix-info-insert-title-default'. | |
277 | ||
278 | If VAL is a one-line string longer than `guix-info-fill-column', | |
279 | split it into several short lines. See also | |
280 | `guix-info-multiline-prefix'. | |
281 | ||
282 | If FACE is non-nil, propertize inserted line(s) with this FACE." | |
283 | (guix-split-insert val face | |
284 | guix-info-fill-column | |
285 | (concat "\n" guix-info-multiline-prefix))) | |
286 | ||
287 | (defun guix-info-insert-val-simple (val &optional face-or-fun) | |
288 | "Format and insert parameter value VAL at point. | |
289 | ||
290 | This function is intended to be called after | |
291 | `guix-info-insert-title-simple'. | |
292 | ||
293 | If VAL is a one-line string longer than `guix-info-fill-column', | |
294 | split it into several short lines and indent each line with | |
295 | `guix-info-indent' spaces. | |
296 | ||
297 | If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE. | |
298 | ||
299 | If FACE-OR-FUN is a function, call it with VAL as argument. If | |
300 | VAL is a list, call the function on each element of this list." | |
301 | (if (null val) | |
302 | (progn (guix-info-insert-indent) | |
303 | (guix-format-insert nil)) | |
304 | (let ((prefix (concat "\n" (guix-info-get-indent)))) | |
305 | (insert prefix) | |
306 | (if (functionp face-or-fun) | |
307 | (guix-mapinsert face-or-fun | |
308 | (if (listp val) val (list val)) | |
309 | prefix) | |
310 | (guix-split-insert val face-or-fun | |
311 | guix-info-fill-column prefix))))) | |
312 | ||
2e269860 AK |
313 | (defun guix-info-insert-time (seconds &optional _) |
314 | "Insert formatted time string using SECONDS at point." | |
315 | (guix-info-insert-val-default (guix-get-time-string seconds) | |
316 | 'guix-info-time)) | |
317 | ||
318 | \f | |
319 | ;;; Buttons | |
320 | ||
56149217 AK |
321 | (defvar guix-info-button-map |
322 | (let ((map (make-sparse-keymap))) | |
323 | (set-keymap-parent map button-map) | |
324 | (define-key map (kbd "c") 'guix-info-button-copy-label) | |
325 | map) | |
326 | "Keymap for buttons in info buffers.") | |
327 | ||
2e269860 | 328 | (define-button-type 'guix |
56149217 | 329 | 'keymap guix-info-button-map |
2e269860 AK |
330 | 'follow-link t) |
331 | ||
332 | (define-button-type 'guix-action | |
333 | :supertype 'guix | |
334 | 'face 'guix-info-action-button | |
335 | 'mouse-face 'guix-info-action-button-mouse) | |
336 | ||
337 | (define-button-type 'guix-file | |
338 | :supertype 'guix | |
339 | 'face 'guix-info-file-path | |
340 | 'help-echo "Find file" | |
341 | 'action (lambda (btn) | |
e718f6cc | 342 | (guix-find-file (button-label btn)))) |
2e269860 AK |
343 | |
344 | (define-button-type 'guix-url | |
345 | :supertype 'guix | |
346 | 'face 'guix-info-url | |
347 | 'help-echo "Browse URL" | |
348 | 'action (lambda (btn) | |
349 | (browse-url (button-label btn)))) | |
350 | ||
351 | (define-button-type 'guix-package-location | |
352 | :supertype 'guix | |
353 | 'face 'guix-package-info-location | |
354 | 'help-echo "Find location of this package" | |
355 | 'action (lambda (btn) | |
356 | (guix-find-location (button-label btn)))) | |
357 | ||
358 | (define-button-type 'guix-package-name | |
359 | :supertype 'guix | |
360 | 'face 'guix-package-info-name-button | |
361 | 'help-echo "Describe this package" | |
362 | 'action (lambda (btn) | |
23459fa5 AK |
363 | (guix-get-show-entries guix-profile 'info guix-package-info-type |
364 | 'name (button-label btn)))) | |
2e269860 | 365 | |
56149217 AK |
366 | (defun guix-info-button-copy-label (&optional pos) |
367 | "Copy a label of the button at POS into kill ring. | |
368 | If POS is nil, use the current point position." | |
369 | (interactive) | |
370 | (let ((button (button-at (or pos (point))))) | |
371 | (when button | |
372 | (kill-new (button-label button))))) | |
373 | ||
457f60fa AK |
374 | (defun guix-info-insert-action-button (label action &optional message |
375 | &rest properties) | |
376 | "Make action button with LABEL and insert it at point. | |
2e269860 AK |
377 | ACTION is a function called when the button is pressed. It |
378 | should accept button as the argument. | |
379 | MESSAGE is a button message. | |
380 | See `insert-text-button' for the meaning of PROPERTIES." | |
457f60fa | 381 | (apply #'guix-insert-button |
2e269860 AK |
382 | label 'guix-action |
383 | 'action action | |
384 | 'help-echo message | |
457f60fa AK |
385 | properties)) |
386 | ||
387 | (defun guix-info-insert-file-path (path &optional _) | |
388 | "Make button from file PATH and insert it at point." | |
2e269860 | 389 | (guix-insert-button path 'guix-file)) |
457f60fa AK |
390 | |
391 | (defun guix-info-insert-url (url &optional _) | |
392 | "Make button from URL and insert it at point." | |
2e269860 | 393 | (guix-insert-button url 'guix-url)) |
457f60fa AK |
394 | |
395 | \f | |
396 | (defvar guix-info-mode-map | |
397 | (let ((map (make-sparse-keymap))) | |
398 | (set-keymap-parent | |
74cc6737 | 399 | map (make-composed-keymap (list guix-root-map button-buffer-map) |
457f60fa AK |
400 | special-mode-map)) |
401 | map) | |
402 | "Parent keymap for info buffers.") | |
403 | ||
404 | (define-derived-mode guix-info-mode special-mode "Guix-Info" | |
405 | "Parent mode for displaying information in info buffers.") | |
406 | ||
407 | \f | |
408 | ;;; Displaying packages | |
409 | ||
410 | (guix-define-buffer-type info package | |
411 | :required (id installed non-unique)) | |
412 | ||
833fdac0 AK |
413 | (defface guix-package-info-heading |
414 | '((((type tty pc) (class color)) :weight bold) | |
415 | (t :height 1.6 :weight bold :inherit variable-pitch)) | |
416 | "Face for package name and version headings." | |
417 | :group 'guix-package-info) | |
418 | ||
457f60fa AK |
419 | (defface guix-package-info-name |
420 | '((t :inherit font-lock-keyword-face)) | |
421 | "Face used for a name of a package." | |
422 | :group 'guix-package-info) | |
423 | ||
2e269860 AK |
424 | (defface guix-package-info-name-button |
425 | '((t :inherit button)) | |
426 | "Face used for a full name that can be used to describe a package." | |
427 | :group 'guix-package-info) | |
428 | ||
457f60fa AK |
429 | (defface guix-package-info-version |
430 | '((t :inherit font-lock-builtin-face)) | |
431 | "Face used for a version of a package." | |
432 | :group 'guix-package-info) | |
433 | ||
434 | (defface guix-package-info-synopsis | |
833fdac0 AK |
435 | '((((type tty pc) (class color)) :weight bold) |
436 | (t :height 1.1 :weight bold :inherit variable-pitch)) | |
457f60fa AK |
437 | "Face used for a synopsis of a package." |
438 | :group 'guix-package-info) | |
439 | ||
440 | (defface guix-package-info-description | |
441 | '((t)) | |
442 | "Face used for a description of a package." | |
443 | :group 'guix-package-info) | |
444 | ||
445 | (defface guix-package-info-license | |
446 | '((t :inherit font-lock-string-face)) | |
447 | "Face used for a license of a package." | |
448 | :group 'guix-package-info) | |
449 | ||
450 | (defface guix-package-info-location | |
451 | '((t :inherit link)) | |
452 | "Face used for a location of a package." | |
453 | :group 'guix-package-info) | |
454 | ||
455 | (defface guix-package-info-installed-outputs | |
456 | '((default :weight bold) | |
457 | (((class color) (min-colors 88) (background light)) | |
458 | :foreground "ForestGreen") | |
459 | (((class color) (min-colors 88) (background dark)) | |
460 | :foreground "PaleGreen") | |
461 | (((class color) (min-colors 8)) | |
462 | :foreground "green") | |
463 | (t :underline t)) | |
464 | "Face used for installed outputs of a package." | |
465 | :group 'guix-package-info) | |
466 | ||
467 | (defface guix-package-info-uninstalled-outputs | |
468 | '((t :weight bold)) | |
469 | "Face used for uninstalled outputs of a package." | |
470 | :group 'guix-package-info) | |
471 | ||
472 | (defface guix-package-info-obsolete | |
473 | '((t :inherit error)) | |
474 | "Face used if a package is obsolete." | |
475 | :group 'guix-package-info) | |
476 | ||
833fdac0 AK |
477 | (defvar guix-info-insert-package-function |
478 | #'guix-package-info-insert-with-heading | |
479 | "Function used to insert a package information. | |
480 | It is called with a single argument - alist of package parameters. | |
481 | If nil, insert package in a default way.") | |
482 | ||
483 | (defvar guix-package-info-heading-params '(synopsis description) | |
484 | "List of parameters displayed in a heading along with name and version.") | |
485 | ||
dbe422ab LC |
486 | (defcustom guix-package-info-fill-heading t |
487 | "If nil, insert heading parameters in a raw form, without | |
488 | filling them to fit the window." | |
489 | :type 'boolean | |
490 | :group 'guix-package-info) | |
491 | ||
833fdac0 AK |
492 | (defun guix-package-info-insert-heading (entry) |
493 | "Insert the heading for package ENTRY. | |
494 | Show package name, version, and `guix-package-info-heading-params'." | |
495 | (guix-format-insert (concat (guix-get-key-val entry 'name) " " | |
496 | (guix-get-key-val entry 'version)) | |
497 | 'guix-package-info-heading) | |
498 | (insert "\n\n") | |
499 | (mapc (lambda (param) | |
500 | (let ((val (guix-get-key-val entry param)) | |
501 | (face (guix-get-symbol (symbol-name param) | |
502 | 'info 'package))) | |
503 | (when val | |
dbe422ab LC |
504 | (let* ((col (min (window-width) fill-column)) |
505 | (val (if guix-package-info-fill-heading | |
506 | (guix-get-filled-string val col) | |
507 | val))) | |
508 | (guix-format-insert val (and (facep face) face)) | |
509 | (insert "\n\n"))))) | |
833fdac0 AK |
510 | guix-package-info-heading-params)) |
511 | ||
512 | (defun guix-package-info-insert-with-heading (entry) | |
513 | "Insert package ENTRY with its heading at point." | |
514 | (guix-package-info-insert-heading entry) | |
515 | (mapc (lambda (param) | |
516 | (unless (or (memq param '(name version)) | |
517 | (memq param guix-package-info-heading-params)) | |
518 | (guix-info-insert-param param entry 'package))) | |
519 | (guix-info-get-displayed-params 'package))) | |
520 | ||
457f60fa AK |
521 | (defun guix-package-info-insert-description (desc &optional _) |
522 | "Insert description DESC at point." | |
523 | (guix-info-insert-val-simple desc 'guix-package-info-description)) | |
524 | ||
525 | (defun guix-package-info-insert-location (location &optional _) | |
526 | "Make button from file LOCATION and insert it at point." | |
2e269860 | 527 | (guix-insert-button location 'guix-package-location)) |
457f60fa AK |
528 | |
529 | (defmacro guix-package-info-define-insert-inputs (&optional type) | |
530 | "Define a face and a function for inserting package inputs. | |
531 | TYPE is a type of inputs. | |
532 | Function name is `guix-package-info-insert-TYPE-inputs'. | |
533 | Face name is `guix-package-info-TYPE-inputs'." | |
534 | (let* ((type-str (symbol-name type)) | |
535 | (type-name (and type (concat type-str "-"))) | |
536 | (type-desc (and type (concat type-str " "))) | |
537 | (face (intern (concat "guix-package-info-" type-name "inputs"))) | |
2e269860 | 538 | (btn (intern (concat "guix-package-" type-name "input"))) |
457f60fa AK |
539 | (fun (intern (concat "guix-package-info-insert-" type-name "inputs")))) |
540 | `(progn | |
541 | (defface ,face | |
2e269860 | 542 | '((t :inherit guix-package-info-name-button)) |
457f60fa AK |
543 | ,(concat "Face used for " type-desc "inputs of a package.") |
544 | :group 'guix-package-info) | |
545 | ||
2e269860 AK |
546 | (define-button-type ',btn |
547 | :supertype 'guix-package-name | |
548 | 'face ',face) | |
549 | ||
457f60fa AK |
550 | (defun ,fun (inputs &optional _) |
551 | ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.") | |
2e269860 | 552 | (guix-package-info-insert-full-names inputs ',btn))))) |
457f60fa AK |
553 | |
554 | (guix-package-info-define-insert-inputs) | |
555 | (guix-package-info-define-insert-inputs native) | |
556 | (guix-package-info-define-insert-inputs propagated) | |
557 | ||
2e269860 AK |
558 | (defun guix-package-info-insert-full-names (names button-type) |
559 | "Make BUTTON-TYPE buttons from package NAMES and insert them at point. | |
560 | NAMES is a list of strings." | |
457f60fa AK |
561 | (if names |
562 | (guix-info-insert-val-default | |
563 | (with-temp-buffer | |
564 | (guix-mapinsert (lambda (name) | |
2e269860 | 565 | (guix-insert-button name button-type)) |
457f60fa AK |
566 | names |
567 | guix-list-separator) | |
568 | (buffer-substring (point-min) (point-max)))) | |
569 | (guix-format-insert nil))) | |
570 | ||
457f60fa AK |
571 | \f |
572 | ;;; Inserting outputs and installed parameters | |
573 | ||
574 | (defvar guix-package-info-output-format "%-10s" | |
575 | "String used to format output names of the packages. | |
576 | It should be a '%s'-sequence. After inserting an output name | |
577 | formatted with this string, an action button is inserted.") | |
578 | ||
579 | (defvar guix-package-info-obsolete-string "(This package is obsolete)" | |
580 | "String used if a package is obsolete.") | |
581 | ||
833fdac0 AK |
582 | (defvar guix-info-insert-installed-function nil |
583 | "Function used to insert an installed information. | |
584 | It is called with a single argument - alist of installed | |
585 | parameters (`output', `path', `dependencies'). | |
586 | If nil, insert installed info in a default way.") | |
587 | ||
457f60fa AK |
588 | (defun guix-package-info-insert-outputs (outputs entry) |
589 | "Insert OUTPUTS from package ENTRY at point." | |
590 | (and (guix-get-key-val entry 'obsolete) | |
591 | (guix-package-info-insert-obsolete-text)) | |
592 | (and (guix-get-key-val entry 'non-unique) | |
593 | (guix-get-key-val entry 'installed) | |
594 | (guix-package-info-insert-non-unique-text | |
595 | (guix-get-full-name entry))) | |
596 | (insert "\n") | |
597 | (mapc (lambda (output) | |
598 | (guix-package-info-insert-output output entry)) | |
599 | outputs)) | |
600 | ||
601 | (defun guix-package-info-insert-obsolete-text () | |
602 | "Insert a message about obsolete package at point." | |
603 | (guix-info-insert-indent) | |
604 | (guix-format-insert guix-package-info-obsolete-string | |
605 | 'guix-package-info-obsolete)) | |
606 | ||
607 | (defun guix-package-info-insert-non-unique-text (full-name) | |
608 | "Insert a message about non-unique package with FULL-NAME at point." | |
609 | (insert "\n") | |
610 | (guix-info-insert-indent) | |
611 | (insert "Installed outputs are displayed for a non-unique ") | |
2e269860 | 612 | (guix-insert-button full-name 'guix-package-name) |
457f60fa AK |
613 | (insert " package.")) |
614 | ||
615 | (defun guix-package-info-insert-output (output entry) | |
616 | "Insert OUTPUT at point. | |
617 | Make some fancy text with buttons and additional stuff if the | |
618 | current OUTPUT is installed (if there is such output in | |
619 | `installed' parameter of a package ENTRY)." | |
620 | (let* ((installed (guix-get-key-val entry 'installed)) | |
621 | (obsolete (guix-get-key-val entry 'obsolete)) | |
622 | (installed-entry (cl-find-if | |
623 | (lambda (entry) | |
624 | (string= (guix-get-key-val entry 'output) | |
625 | output)) | |
626 | installed)) | |
627 | (action-type (if installed-entry 'delete 'install))) | |
628 | (guix-info-insert-indent) | |
629 | (guix-format-insert output | |
630 | (if installed-entry | |
631 | 'guix-package-info-installed-outputs | |
632 | 'guix-package-info-uninstalled-outputs) | |
633 | guix-package-info-output-format) | |
634 | (guix-package-info-insert-action-button action-type entry output) | |
635 | (when obsolete | |
636 | (guix-info-insert-indent) | |
637 | (guix-package-info-insert-action-button 'upgrade entry output)) | |
638 | (insert "\n") | |
639 | (when installed-entry | |
640 | (guix-info-insert-entry installed-entry 'installed 2)))) | |
641 | ||
642 | (defun guix-package-info-insert-action-button (type entry output) | |
643 | "Insert button to process an action on a package OUTPUT at point. | |
644 | TYPE is one of the following symbols: `install', `delete', `upgrade'. | |
645 | ENTRY is an alist with package info." | |
646 | (let ((type-str (capitalize (symbol-name type))) | |
647 | (full-name (guix-get-full-name entry output))) | |
648 | (guix-info-insert-action-button | |
649 | type-str | |
650 | (lambda (btn) | |
651 | (guix-process-package-actions | |
23459fa5 | 652 | guix-profile |
49d758d2 AK |
653 | `((,(button-get btn 'action-type) (,(button-get btn 'id) |
654 | ,(button-get btn 'output)))) | |
655 | (current-buffer))) | |
457f60fa AK |
656 | (concat type-str " '" full-name "'") |
657 | 'action-type type | |
81b339fe AK |
658 | 'id (or (guix-get-key-val entry 'package-id) |
659 | (guix-get-key-val entry 'id)) | |
457f60fa AK |
660 | 'output output))) |
661 | ||
662 | (defun guix-package-info-insert-output-path (path &optional _) | |
663 | "Insert PATH of the installed output." | |
664 | (guix-info-insert-val-simple path #'guix-info-insert-file-path)) | |
665 | ||
a54a237b AK |
666 | (defalias 'guix-package-info-insert-output-dependencies |
667 | 'guix-package-info-insert-output-path) | |
668 | ||
669 | \f | |
0b0fbf0c AK |
670 | ;;; Inserting a source |
671 | ||
672 | (defface guix-package-info-source | |
673 | '((t :inherit link :underline nil)) | |
674 | "Face used for a source URL of a package." | |
675 | :group 'guix-package-info) | |
676 | ||
677 | (defcustom guix-package-info-auto-find-source nil | |
678 | "If non-nil, find a source file after pressing a \"Show\" button. | |
679 | If nil, just display the source file path without finding." | |
680 | :type 'boolean | |
681 | :group 'guix-package-info) | |
682 | ||
683 | (defcustom guix-package-info-auto-download-source t | |
684 | "If nil, do not automatically download a source file if it doesn't exist. | |
685 | After pressing a \"Show\" button, a derivation of the package | |
686 | source is calculated and a store file path is displayed. If this | |
687 | variable is non-nil and the source file does not exist in the | |
688 | store, it will be automatically downloaded (with a possible | |
689 | prompt depending on `guix-operation-confirm' variable)." | |
690 | :type 'boolean | |
691 | :group 'guix-package-info) | |
692 | ||
693 | (defvar guix-package-info-download-buffer nil | |
694 | "Buffer from which a current download operation was performed.") | |
695 | ||
696 | (define-button-type 'guix-package-source | |
697 | :supertype 'guix | |
698 | 'face 'guix-package-info-source | |
699 | 'help-echo "" | |
700 | 'action (lambda (_) | |
701 | ;; As a source may not be a real URL (e.g., "mirror://..."), | |
702 | ;; no action is bound to a source button. | |
703 | (message "Yes, this is the source URL. What did you expect?"))) | |
704 | ||
705 | (defun guix-package-info-insert-source-url (url &optional _) | |
706 | "Make button from source URL and insert it at point." | |
707 | (guix-insert-button url 'guix-package-source)) | |
708 | ||
709 | (defun guix-package-info-show-source (entry-id package-id) | |
710 | "Show file name of a package source in the current info buffer. | |
711 | Find the file if needed (see `guix-package-info-auto-find-source'). | |
712 | ENTRY-ID is an ID of the current entry (package or output). | |
713 | PACKAGE-ID is an ID of the package which source to show." | |
714 | (let* ((entry (guix-get-entry-by-id entry-id guix-entries)) | |
715 | (file (guix-package-source-path package-id))) | |
716 | (or file | |
717 | (error "Couldn't define file path of the package source")) | |
718 | (let* ((new-entry (cons (cons 'source-file file) | |
719 | entry)) | |
720 | (entries (cl-substitute-if | |
721 | new-entry | |
722 | (lambda (entry) | |
723 | (equal (guix-get-key-val entry 'id) | |
724 | entry-id)) | |
725 | guix-entries | |
726 | :count 1))) | |
727 | (guix-redisplay-buffer :entries entries) | |
728 | (if (file-exists-p file) | |
729 | (if guix-package-info-auto-find-source | |
730 | (guix-find-file file) | |
731 | (message "The source store path is displayed.")) | |
732 | (if guix-package-info-auto-download-source | |
733 | (guix-package-info-download-source package-id) | |
734 | (message "The source does not exist in the store.")))))) | |
735 | ||
736 | (defun guix-package-info-download-source (package-id) | |
737 | "Download a source of the package PACKAGE-ID." | |
738 | (setq guix-package-info-download-buffer (current-buffer)) | |
739 | (guix-package-source-build-derivation | |
740 | package-id | |
741 | "The source does not exist in the store. Download it?")) | |
742 | ||
743 | (defun guix-package-info-insert-source (source entry) | |
744 | "Insert SOURCE from package ENTRY at point. | |
745 | SOURCE is a list of URLs." | |
746 | (guix-info-insert-indent) | |
747 | (if (null source) | |
748 | (guix-format-insert nil) | |
749 | (let* ((source-file (guix-get-key-val entry 'source-file)) | |
750 | (entry-id (guix-get-key-val entry 'id)) | |
751 | (package-id (or (guix-get-key-val entry 'package-id) | |
752 | entry-id))) | |
753 | (if (null source-file) | |
754 | (guix-info-insert-action-button | |
755 | "Show" | |
756 | (lambda (btn) | |
757 | (guix-package-info-show-source (button-get btn 'entry-id) | |
758 | (button-get btn 'package-id))) | |
759 | "Show the source store path of the current package" | |
760 | 'entry-id entry-id | |
761 | 'package-id package-id) | |
762 | (unless (file-exists-p source-file) | |
763 | (guix-info-insert-action-button | |
764 | "Download" | |
765 | (lambda (btn) | |
766 | (guix-package-info-download-source | |
767 | (button-get btn 'package-id))) | |
768 | "Download the source into the store" | |
769 | 'package-id package-id)) | |
770 | (guix-info-insert-val-simple source-file | |
771 | #'guix-info-insert-file-path)) | |
772 | (guix-info-insert-val-simple source | |
773 | #'guix-package-info-insert-source-url)))) | |
774 | ||
775 | (defun guix-package-info-redisplay-after-download () | |
776 | "Redisplay an 'info' buffer after downloading the package source. | |
777 | This function is used to hide a \"Download\" button if needed." | |
778 | (when (buffer-live-p guix-package-info-download-buffer) | |
779 | (guix-redisplay-buffer :buffer guix-package-info-download-buffer) | |
780 | (setq guix-package-info-download-buffer nil))) | |
781 | ||
782 | (add-hook 'guix-after-source-download-hook | |
783 | 'guix-package-info-redisplay-after-download) | |
784 | ||
785 | \f | |
a54a237b AK |
786 | ;;; Displaying outputs |
787 | ||
788 | (guix-define-buffer-type info output | |
789 | :buffer-name "*Guix Package Info*" | |
790 | :required (id package-id installed non-unique)) | |
791 | ||
833fdac0 AK |
792 | (defvar guix-info-insert-output-function nil |
793 | "Function used to insert an output information. | |
794 | It is called with a single argument - alist of output parameters. | |
795 | If nil, insert output in a default way.") | |
796 | ||
a54a237b AK |
797 | (defun guix-output-info-insert-version (version entry) |
798 | "Insert output VERSION and obsolete text if needed at point." | |
799 | (guix-info-insert-val-default version | |
800 | 'guix-package-info-version) | |
801 | (and (guix-get-key-val entry 'obsolete) | |
802 | (guix-package-info-insert-obsolete-text))) | |
803 | ||
804 | (defun guix-output-info-insert-output (output entry) | |
805 | "Insert OUTPUT and action buttons at point." | |
806 | (let* ((installed (guix-get-key-val entry 'installed)) | |
807 | (obsolete (guix-get-key-val entry 'obsolete)) | |
808 | (action-type (if installed 'delete 'install))) | |
809 | (guix-info-insert-val-default | |
810 | output | |
811 | (if installed | |
812 | 'guix-package-info-installed-outputs | |
813 | 'guix-package-info-uninstalled-outputs)) | |
814 | (guix-info-insert-indent) | |
815 | (guix-package-info-insert-action-button action-type entry output) | |
816 | (when obsolete | |
817 | (guix-info-insert-indent) | |
818 | (guix-package-info-insert-action-button 'upgrade entry output)))) | |
457f60fa AK |
819 | |
820 | \f | |
821 | ;;; Displaying generations | |
822 | ||
823 | (guix-define-buffer-type info generation) | |
824 | ||
825 | (defface guix-generation-info-number | |
826 | '((t :inherit font-lock-keyword-face)) | |
827 | "Face used for a number of a generation." | |
828 | :group 'guix-generation-info) | |
829 | ||
c2379b3c AK |
830 | (defface guix-generation-info-current |
831 | '((t :inherit guix-package-info-installed-outputs)) | |
832 | "Face used if a generation is the current one." | |
833 | :group 'guix-generation-info) | |
834 | ||
835 | (defface guix-generation-info-not-current | |
836 | '((t nil)) | |
837 | "Face used if a generation is not the current one." | |
838 | :group 'guix-generation-info) | |
839 | ||
833fdac0 AK |
840 | (defvar guix-info-insert-generation-function nil |
841 | "Function used to insert a generation information. | |
842 | It is called with a single argument - alist of generation parameters. | |
843 | If nil, insert generation in a default way.") | |
844 | ||
457f60fa AK |
845 | (defun guix-generation-info-insert-number (number &optional _) |
846 | "Insert generation NUMBER and action buttons." | |
847 | (guix-info-insert-val-default number 'guix-generation-info-number) | |
848 | (guix-info-insert-indent) | |
849 | (guix-info-insert-action-button | |
850 | "Packages" | |
851 | (lambda (btn) | |
23459fa5 AK |
852 | (guix-get-show-entries guix-profile 'list guix-package-list-type |
853 | 'generation (button-get btn 'number))) | |
457f60fa AK |
854 | "Show installed packages for this generation" |
855 | 'number number) | |
856 | (guix-info-insert-indent) | |
857 | (guix-info-insert-action-button | |
858 | "Delete" | |
cb6a5c71 | 859 | (lambda (btn) |
23459fa5 | 860 | (guix-delete-generations guix-profile (list (button-get btn 'number)) |
49d758d2 | 861 | (current-buffer))) |
cb6a5c71 AK |
862 | "Delete this generation" |
863 | 'number number)) | |
457f60fa | 864 | |
c2379b3c AK |
865 | (defun guix-generation-info-insert-current (val entry) |
866 | "Insert boolean value VAL showing whether this generation is current." | |
867 | (if val | |
868 | (guix-info-insert-val-default "Yes" 'guix-generation-info-current) | |
af874238 AK |
869 | (guix-info-insert-val-default "No" 'guix-generation-info-not-current) |
870 | (guix-info-insert-indent) | |
871 | (guix-info-insert-action-button | |
872 | "Switch" | |
873 | (lambda (btn) | |
23459fa5 | 874 | (guix-switch-to-generation guix-profile (button-get btn 'number) |
49d758d2 | 875 | (current-buffer))) |
af874238 AK |
876 | "Switch to this generation (make it the current one)" |
877 | 'number (guix-get-key-val entry 'number)))) | |
c2379b3c | 878 | |
457f60fa AK |
879 | (provide 'guix-info) |
880 | ||
881 | ;;; guix-info.el ends here |