1 ;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*-
3 ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
4 ;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
6 ;; This file is part of GNU Guix.
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.
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.
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/>.
23 ;; This file provides a help-like buffer for displaying information
24 ;; about Guix packages and generations.
31 (defgroup guix-info nil
32 "General settings for info buffers."
36 (defgroup guix-info-faces nil
37 "Faces for info buffers."
41 (defface guix-info-param-title
42 '((t :inherit font-lock-type-face
))
43 "Face used for titles of parameters."
44 :group
'guix-info-faces
)
46 (defface guix-info-file-path
48 "Face used for file paths."
49 :group
'guix-info-faces
)
51 (defface guix-info-url
54 :group
'guix-info-faces
)
56 (defface guix-info-time
57 '((t :inherit font-lock-constant-face
))
58 "Face used for timestamps."
59 :group
'guix-info-faces
)
61 (defface guix-info-action-button
62 '((((type x w32 ns
) (class color
))
63 :box
(:line-width
2 :style released-button
)
64 :background
"lightgrey" :foreground
"black")
66 "Face used for action buttons."
67 :group
'guix-info-faces
)
69 (defface guix-info-action-button-mouse
70 '((((type x w32 ns
) (class color
))
71 :box
(:line-width
2 :style released-button
)
72 :background
"grey90" :foreground
"black")
73 (t :inherit highlight
))
74 "Mouse face used for action buttons."
75 :group
'guix-info-faces
)
77 (defcustom guix-info-ignore-empty-vals nil
78 "If non-nil, do not display parameters with nil values."
82 (defvar guix-info-param-title-format
"%-18s: "
83 "String used to format a title of a parameter.
84 It should be a '%s'-sequence. After inserting a title formatted
85 with this string, a value of the parameter is inserted.
86 This string is used by `guix-info-insert-title-default'.")
88 (defvar guix-info-multiline-prefix
(make-string 20 ?\s
)
89 "String used to format multi-line parameter values.
90 If a value occupies more than one line, this string is inserted
91 in the beginning of each line after the first one.
92 This string is used by `guix-info-insert-val-default'.")
94 (defvar guix-info-indent
2
95 "Number of spaces used to indent various parts of inserted text.")
97 (defvar guix-info-fill-column
60
98 "Column used for filling (word wrapping) parameters with long lines.
99 If a value is not multi-line and it occupies more than this
100 number of characters, it will be split into several lines.")
102 (defvar guix-info-delimiter
"\n\f\n"
103 "String used to separate entries.")
105 (defvar guix-info-insert-methods
107 (name guix-package-info-name
)
108 (version guix-package-info-version
)
109 (license guix-package-info-license
)
110 (synopsis guix-package-info-synopsis
)
111 (description guix-package-info-insert-description
112 guix-info-insert-title-simple
)
113 (outputs guix-package-info-insert-outputs
114 guix-info-insert-title-simple
)
115 (source guix-package-info-insert-source
116 guix-info-insert-title-simple
)
117 (home-url guix-info-insert-url
)
118 (inputs guix-package-info-insert-inputs
)
119 (native-inputs guix-package-info-insert-native-inputs
)
120 (propagated-inputs guix-package-info-insert-propagated-inputs
)
121 (location guix-package-info-insert-location
))
123 (path guix-package-info-insert-output-path
124 guix-info-insert-title-simple
)
125 (dependencies guix-package-info-insert-output-dependencies
126 guix-info-insert-title-simple
))
128 (name guix-package-info-name
)
129 (version guix-output-info-insert-version
)
130 (output guix-output-info-insert-output
)
131 (source guix-package-info-insert-source
132 guix-info-insert-title-simple
)
133 (path guix-package-info-insert-output-path
134 guix-info-insert-title-simple
)
135 (dependencies guix-package-info-insert-output-dependencies
136 guix-info-insert-title-simple
)
137 (license guix-package-info-license
)
138 (synopsis guix-package-info-synopsis
)
139 (description guix-package-info-insert-description
140 guix-info-insert-title-simple
)
141 (home-url guix-info-insert-url
)
142 (inputs guix-package-info-insert-inputs
)
143 (native-inputs guix-package-info-insert-native-inputs
)
144 (propagated-inputs guix-package-info-insert-propagated-inputs
)
145 (location guix-package-info-insert-location
))
147 (number guix-generation-info-insert-number
)
148 (current guix-generation-info-insert-current
)
149 (path guix-info-insert-file-path
)
150 (time guix-info-insert-time
)))
151 "Methods for inserting parameter values.
152 Each element of the list should have a form:
154 (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...))
156 INSERT-VALUE may be either nil, a face name or a function. If it
157 is nil or a face, `guix-info-insert-val-default' function is
158 called with parameter value and INSERT-VALUE as arguments. If it
159 is a function, this function is called with parameter value and
160 entry info (alist of parameters and their values) as arguments.
162 INSERT-TITLE may be either nil, a face name or a function. If it
163 is nil or a face, `guix-info-insert-title-default' function is
164 called with parameter title and INSERT-TITLE as arguments. If it
165 is a function, this function is called with parameter title as
168 (defvar guix-info-displayed-params
169 '((package name version synopsis outputs source location home-url
170 license inputs native-inputs propagated-inputs description
)
171 (output name version output synopsis source path dependencies location
172 home-url license inputs native-inputs propagated-inputs
174 (installed path dependencies
)
175 (generation number prev-number current time path
))
176 "List of displayed entry parameters.
177 Each element of the list should have a form:
179 (ENTRY-TYPE . (PARAM ...))
181 The order of displayed parameters is the same as in this list.")
183 (defun guix-info-get-insert-methods (entry-type param
)
184 "Return list of insert methods for parameter PARAM of ENTRY-TYPE.
185 See `guix-info-insert-methods' for details."
186 (guix-assq-value guix-info-insert-methods
189 (defun guix-info-get-displayed-params (entry-type)
190 "Return parameters of ENTRY-TYPE that should be displayed."
191 (guix-assq-value guix-info-displayed-params
194 (defun guix-info-get-indent (&optional level
)
195 "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
196 LEVEL is 1 by default."
197 (make-string (* guix-info-indent
(or level
1)) ?\s
))
199 (defun guix-info-insert-indent (&optional level
)
200 "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
201 (insert (guix-info-get-indent level
)))
203 (defun guix-info-insert-entries (entries entry-type
)
204 "Display ENTRIES of ENTRY-TYPE in the current info buffer.
205 ENTRIES should have a form of `guix-entries'."
206 (guix-mapinsert (lambda (entry)
207 (guix-info-insert-entry entry entry-type
))
209 guix-info-delimiter
))
211 (defun guix-info-insert-entry-default (entry entry-type
212 &optional indent-level
)
213 "Insert ENTRY of ENTRY-TYPE into the current info buffer.
214 If INDENT-LEVEL is non-nil, indent displayed information by this
215 number of `guix-info-indent' spaces."
216 (let ((region-beg (point)))
217 (mapc (lambda (param)
218 (guix-info-insert-param param entry entry-type
))
219 (guix-info-get-displayed-params entry-type
))
221 (indent-rigidly region-beg
(point)
222 (* indent-level guix-info-indent
)))))
224 (defun guix-info-insert-entry (entry entry-type
&optional indent-level
)
225 "Insert ENTRY of ENTRY-TYPE into the current info buffer.
226 Use `guix-info-insert-ENTRY-TYPE-function' or
227 `guix-info-insert-entry-default' if it is nil."
228 (let* ((var (intern (concat "guix-info-insert-"
229 (symbol-name entry-type
)
231 (fun (symbol-value var
)))
234 (guix-info-insert-entry-default entry entry-type indent-level
))))
236 (defun guix-info-insert-param (param entry entry-type
)
237 "Insert title and value of a PARAM at point.
238 ENTRY is alist with parameters and their values.
239 ENTRY-TYPE is a type of ENTRY."
240 (let ((val (guix-assq-value entry param
)))
241 (unless (and guix-info-ignore-empty-vals
(null val
))
242 (let* ((title (guix-get-param-title entry-type param
))
243 (insert-methods (guix-info-get-insert-methods entry-type param
))
244 (val-method (car insert-methods
))
245 (title-method (cadr insert-methods
)))
246 (guix-info-method-funcall title title-method
247 #'guix-info-insert-title-default
)
248 (guix-info-method-funcall val val-method
249 #'guix-info-insert-val-default
253 (defun guix-info-method-funcall (val method default-fun
&rest args
)
254 "Call METHOD or DEFAULT-FUN.
256 If METHOD is a function and VAL is non-nil, call this
257 function by applying it to VAL and ARGS.
259 If METHOD is a face, propertize inserted VAL with this face."
260 (cond ((or (null method
)
262 (funcall default-fun val method
))
264 (apply method val args
))
265 (t (error "Unknown method '%S'" method
))))
267 (defun guix-info-insert-title-default (title &optional face format
)
268 "Insert TITLE formatted with `guix-info-param-title-format' at point."
269 (guix-format-insert title
270 (or face
'guix-info-param-title
)
271 (or format guix-info-param-title-format
)))
273 (defun guix-info-insert-title-simple (title &optional face
)
274 "Insert TITLE at point."
275 (guix-info-insert-title-default title face
"%s:"))
277 (defun guix-info-insert-val-default (val &optional face
)
278 "Format and insert parameter value VAL at point.
280 This function is intended to be called after
281 `guix-info-insert-title-default'.
283 If VAL is a one-line string longer than `guix-info-fill-column',
284 split it into several short lines. See also
285 `guix-info-multiline-prefix'.
287 If FACE is non-nil, propertize inserted line(s) with this FACE."
288 (guix-split-insert val face
289 guix-info-fill-column
290 (concat "\n" guix-info-multiline-prefix
)))
292 (defun guix-info-insert-val-simple (val &optional face-or-fun
)
293 "Format and insert parameter value VAL at point.
295 This function is intended to be called after
296 `guix-info-insert-title-simple'.
298 If VAL is a one-line string longer than `guix-info-fill-column',
299 split it into several short lines and indent each line with
300 `guix-info-indent' spaces.
302 If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE.
304 If FACE-OR-FUN is a function, call it with VAL as argument. If
305 VAL is a list, call the function on each element of this list."
307 (progn (guix-info-insert-indent)
308 (guix-format-insert nil
))
309 (let ((prefix (concat "\n" (guix-info-get-indent))))
311 (if (functionp face-or-fun
)
312 (guix-mapinsert face-or-fun
313 (if (listp val
) val
(list val
))
315 (guix-split-insert val face-or-fun
316 guix-info-fill-column prefix
)))))
318 (defun guix-info-insert-time (seconds &optional _
)
319 "Insert formatted time string using SECONDS at point."
320 (guix-info-insert-val-default (guix-get-time-string seconds
)
326 (defvar guix-info-button-map
327 (let ((map (make-sparse-keymap)))
328 (set-keymap-parent map button-map
)
329 (define-key map
(kbd "c") 'guix-info-button-copy-label
)
331 "Keymap for buttons in info buffers.")
333 (define-button-type 'guix
334 'keymap guix-info-button-map
337 (define-button-type 'guix-action
339 'face
'guix-info-action-button
340 'mouse-face
'guix-info-action-button-mouse
)
342 (define-button-type 'guix-file
344 'face
'guix-info-file-path
345 'help-echo
"Find file"
346 'action
(lambda (btn)
347 (guix-find-file (button-label btn
))))
349 (define-button-type 'guix-url
352 'help-echo
"Browse URL"
353 'action
(lambda (btn)
354 (browse-url (button-label btn
))))
356 (define-button-type 'guix-package-location
358 'face
'guix-package-info-location
359 'help-echo
"Find location of this package"
360 'action
(lambda (btn)
361 (guix-find-location (button-label btn
))))
363 (define-button-type 'guix-package-name
365 'face
'guix-package-info-name-button
366 'help-echo
"Describe this package"
367 'action
(lambda (btn)
368 (guix-get-show-entries guix-profile
'info guix-package-info-type
369 'name
(button-label btn
))))
371 (defun guix-info-button-copy-label (&optional pos
)
372 "Copy a label of the button at POS into kill ring.
373 If POS is nil, use the current point position."
375 (let ((button (button-at (or pos
(point)))))
377 (kill-new (button-label button
)))))
379 (defun guix-info-insert-action-button (label action
&optional message
381 "Make action button with LABEL and insert it at point.
382 ACTION is a function called when the button is pressed. It
383 should accept button as the argument.
384 MESSAGE is a button message.
385 See `insert-text-button' for the meaning of PROPERTIES."
386 (apply #'guix-insert-button
392 (defun guix-info-insert-file-path (path &optional _
)
393 "Make button from file PATH and insert it at point."
394 (guix-insert-button path
'guix-file
))
396 (defun guix-info-insert-url (url &optional _
)
397 "Make button from URL and insert it at point."
398 (guix-insert-button url
'guix-url
))
401 (defvar guix-info-mode-map
402 (let ((map (make-sparse-keymap)))
404 map
(make-composed-keymap (list guix-root-map button-buffer-map
)
407 "Parent keymap for info buffers.")
409 (define-derived-mode guix-info-mode special-mode
"Guix-Info"
410 "Parent mode for displaying information in info buffers.")
413 ;;; Displaying packages
415 (guix-define-buffer-type info package
416 :required
(id installed non-unique
))
418 (defface guix-package-info-heading
419 '((((type tty pc
) (class color
)) :weight bold
)
420 (t :height
1.6 :weight bold
:inherit variable-pitch
))
421 "Face for package name and version headings."
422 :group
'guix-package-info-faces
)
424 (defface guix-package-info-name
425 '((t :inherit font-lock-keyword-face
))
426 "Face used for a name of a package."
427 :group
'guix-package-info-faces
)
429 (defface guix-package-info-name-button
430 '((t :inherit button
))
431 "Face used for a full name that can be used to describe a package."
432 :group
'guix-package-info-faces
)
434 (defface guix-package-info-version
435 '((t :inherit font-lock-builtin-face
))
436 "Face used for a version of a package."
437 :group
'guix-package-info-faces
)
439 (defface guix-package-info-synopsis
440 '((((type tty pc
) (class color
)) :weight bold
)
441 (t :height
1.1 :weight bold
:inherit variable-pitch
))
442 "Face used for a synopsis of a package."
443 :group
'guix-package-info-faces
)
445 (defface guix-package-info-description
447 "Face used for a description of a package."
448 :group
'guix-package-info-faces
)
450 (defface guix-package-info-license
451 '((t :inherit font-lock-string-face
))
452 "Face used for a license of a package."
453 :group
'guix-package-info-faces
)
455 (defface guix-package-info-location
457 "Face used for a location of a package."
458 :group
'guix-package-info-faces
)
460 (defface guix-package-info-installed-outputs
461 '((default :weight bold
)
462 (((class color
) (min-colors 88) (background light
))
463 :foreground
"ForestGreen")
464 (((class color
) (min-colors 88) (background dark
))
465 :foreground
"PaleGreen")
466 (((class color
) (min-colors 8))
469 "Face used for installed outputs of a package."
470 :group
'guix-package-info-faces
)
472 (defface guix-package-info-uninstalled-outputs
474 "Face used for uninstalled outputs of a package."
475 :group
'guix-package-info-faces
)
477 (defface guix-package-info-obsolete
478 '((t :inherit error
))
479 "Face used if a package is obsolete."
480 :group
'guix-package-info-faces
)
482 (defvar guix-info-insert-package-function
483 #'guix-package-info-insert-with-heading
484 "Function used to insert a package information.
485 It is called with a single argument - alist of package parameters.
486 If nil, insert package in a default way.")
488 (defvar guix-package-info-heading-params
'(synopsis description
)
489 "List of parameters displayed in a heading along with name and version.")
491 (defcustom guix-package-info-fill-heading t
492 "If nil, insert heading parameters in a raw form, without
493 filling them to fit the window."
495 :group
'guix-package-info
)
497 (defun guix-package-info-insert-heading (entry)
498 "Insert the heading for package ENTRY.
499 Show package name, version, and `guix-package-info-heading-params'."
500 (guix-format-insert (concat (guix-assq-value entry
'name
) " "
501 (guix-assq-value entry
'version
))
502 'guix-package-info-heading
)
504 (mapc (lambda (param)
505 (let ((val (guix-assq-value entry param
))
506 (face (guix-get-symbol (symbol-name param
)
509 (let* ((col (min (window-width) fill-column
))
510 (val (if guix-package-info-fill-heading
511 (guix-get-filled-string val col
)
513 (guix-format-insert val
(and (facep face
) face
))
515 guix-package-info-heading-params
))
517 (defun guix-package-info-insert-with-heading (entry)
518 "Insert package ENTRY with its heading at point."
519 (guix-package-info-insert-heading entry
)
520 (mapc (lambda (param)
521 (unless (or (memq param
'(name version
))
522 (memq param guix-package-info-heading-params
))
523 (guix-info-insert-param param entry
'package
)))
524 (guix-info-get-displayed-params 'package
)))
526 (defun guix-package-info-insert-description (desc &optional _
)
527 "Insert description DESC at point."
528 (guix-info-insert-val-simple desc
'guix-package-info-description
))
530 (defun guix-package-info-insert-location (location &optional _
)
531 "Make button from file LOCATION and insert it at point."
532 (guix-insert-button location
'guix-package-location
))
534 (defmacro guix-package-info-define-insert-inputs
(&optional type
)
535 "Define a face and a function for inserting package inputs.
536 TYPE is a type of inputs.
537 Function name is `guix-package-info-insert-TYPE-inputs'.
538 Face name is `guix-package-info-TYPE-inputs'."
539 (let* ((type-str (symbol-name type
))
540 (type-name (and type
(concat type-str
"-")))
541 (type-desc (and type
(concat type-str
" ")))
542 (face (intern (concat "guix-package-info-" type-name
"inputs")))
543 (btn (intern (concat "guix-package-" type-name
"input")))
544 (fun (intern (concat "guix-package-info-insert-" type-name
"inputs"))))
547 '((t :inherit guix-package-info-name-button
))
548 ,(concat "Face used for " type-desc
"inputs of a package.")
549 :group
'guix-package-info-faces
)
551 (define-button-type ',btn
552 :supertype
'guix-package-name
555 (defun ,fun
(inputs &optional _
)
556 ,(concat "Make buttons from " type-desc
"INPUTS and insert them at point.")
557 (guix-package-info-insert-full-names inputs
',btn
)))))
559 (guix-package-info-define-insert-inputs)
560 (guix-package-info-define-insert-inputs native
)
561 (guix-package-info-define-insert-inputs propagated
)
563 (defun guix-package-info-insert-full-names (names button-type
)
564 "Make BUTTON-TYPE buttons from package NAMES and insert them at point.
565 NAMES is a list of strings."
567 (guix-info-insert-val-default
569 (guix-mapinsert (lambda (name)
570 (guix-insert-button name button-type
))
573 (buffer-substring (point-min) (point-max))))
574 (guix-format-insert nil
)))
577 ;;; Inserting outputs and installed parameters
579 (defvar guix-package-info-output-format
"%-10s"
580 "String used to format output names of the packages.
581 It should be a '%s'-sequence. After inserting an output name
582 formatted with this string, an action button is inserted.")
584 (defvar guix-package-info-obsolete-string
"(This package is obsolete)"
585 "String used if a package is obsolete.")
587 (defvar guix-info-insert-installed-function nil
588 "Function used to insert an installed information.
589 It is called with a single argument - alist of installed
590 parameters (`output', `path', `dependencies').
591 If nil, insert installed info in a default way.")
593 (defun guix-package-info-insert-outputs (outputs entry
)
594 "Insert OUTPUTS from package ENTRY at point."
595 (and (guix-assq-value entry
'obsolete
)
596 (guix-package-info-insert-obsolete-text))
597 (and (guix-assq-value entry
'non-unique
)
598 (guix-assq-value entry
'installed
)
599 (guix-package-info-insert-non-unique-text
600 (guix-get-full-name entry
)))
602 (mapc (lambda (output)
603 (guix-package-info-insert-output output entry
))
606 (defun guix-package-info-insert-obsolete-text ()
607 "Insert a message about obsolete package at point."
608 (guix-info-insert-indent)
609 (guix-format-insert guix-package-info-obsolete-string
610 'guix-package-info-obsolete
))
612 (defun guix-package-info-insert-non-unique-text (full-name)
613 "Insert a message about non-unique package with FULL-NAME at point."
615 (guix-info-insert-indent)
616 (insert "Installed outputs are displayed for a non-unique ")
617 (guix-insert-button full-name
'guix-package-name
)
618 (insert " package."))
620 (defun guix-package-info-insert-output (output entry
)
621 "Insert OUTPUT at point.
622 Make some fancy text with buttons and additional stuff if the
623 current OUTPUT is installed (if there is such output in
624 `installed' parameter of a package ENTRY)."
625 (let* ((installed (guix-assq-value entry
'installed
))
626 (obsolete (guix-assq-value entry
'obsolete
))
627 (installed-entry (cl-find-if
629 (string= (guix-assq-value entry
'output
)
632 (action-type (if installed-entry
'delete
'install
)))
633 (guix-info-insert-indent)
634 (guix-format-insert output
636 'guix-package-info-installed-outputs
637 'guix-package-info-uninstalled-outputs
)
638 guix-package-info-output-format
)
639 (guix-package-info-insert-action-button action-type entry output
)
641 (guix-info-insert-indent)
642 (guix-package-info-insert-action-button 'upgrade entry output
))
644 (when installed-entry
645 (guix-info-insert-entry installed-entry
'installed
2))))
647 (defun guix-package-info-insert-action-button (type entry output
)
648 "Insert button to process an action on a package OUTPUT at point.
649 TYPE is one of the following symbols: `install', `delete', `upgrade'.
650 ENTRY is an alist with package info."
651 (let ((type-str (capitalize (symbol-name type
)))
652 (full-name (guix-get-full-name entry output
)))
653 (guix-info-insert-action-button
656 (guix-process-package-actions
658 `((,(button-get btn
'action-type
) (,(button-get btn
'id
)
659 ,(button-get btn
'output
))))
661 (concat type-str
" '" full-name
"'")
663 'id
(or (guix-assq-value entry
'package-id
)
664 (guix-assq-value entry
'id
))
667 (defun guix-package-info-insert-output-path (path &optional _
)
668 "Insert PATH of the installed output."
669 (guix-info-insert-val-simple path
#'guix-info-insert-file-path
))
671 (defalias 'guix-package-info-insert-output-dependencies
672 'guix-package-info-insert-output-path
)
675 ;;; Inserting a source
677 (defface guix-package-info-source
678 '((t :inherit link
:underline nil
))
679 "Face used for a source URL of a package."
680 :group
'guix-package-info-faces
)
682 (defcustom guix-package-info-auto-find-source nil
683 "If non-nil, find a source file after pressing a \"Show\" button.
684 If nil, just display the source file path without finding."
686 :group
'guix-package-info
)
688 (defcustom guix-package-info-auto-download-source t
689 "If nil, do not automatically download a source file if it doesn't exist.
690 After pressing a \"Show\" button, a derivation of the package
691 source is calculated and a store file path is displayed. If this
692 variable is non-nil and the source file does not exist in the
693 store, it will be automatically downloaded (with a possible
694 prompt depending on `guix-operation-confirm' variable)."
696 :group
'guix-package-info
)
698 (defvar guix-package-info-download-buffer nil
699 "Buffer from which a current download operation was performed.")
701 (define-button-type 'guix-package-source
703 'face
'guix-package-info-source
706 ;; As a source may not be a real URL (e.g., "mirror://..."),
707 ;; no action is bound to a source button.
708 (message "Yes, this is the source URL. What did you expect?")))
710 (defun guix-package-info-insert-source-url (url &optional _
)
711 "Make button from source URL and insert it at point."
712 (guix-insert-button url
'guix-package-source
))
714 (defun guix-package-info-show-source (entry-id package-id
)
715 "Show file name of a package source in the current info buffer.
716 Find the file if needed (see `guix-package-info-auto-find-source').
717 ENTRY-ID is an ID of the current entry (package or output).
718 PACKAGE-ID is an ID of the package which source to show."
719 (let* ((entry (guix-get-entry-by-id entry-id guix-entries
))
720 (file (guix-package-source-path package-id
)))
722 (error "Couldn't define file path of the package source"))
723 (let* ((new-entry (cons (cons 'source-file file
)
725 (entries (cl-substitute-if
728 (equal (guix-assq-value entry
'id
)
732 (guix-redisplay-buffer :entries entries
)
733 (if (file-exists-p file
)
734 (if guix-package-info-auto-find-source
735 (guix-find-file file
)
736 (message "The source store path is displayed."))
737 (if guix-package-info-auto-download-source
738 (guix-package-info-download-source package-id
)
739 (message "The source does not exist in the store."))))))
741 (defun guix-package-info-download-source (package-id)
742 "Download a source of the package PACKAGE-ID."
743 (setq guix-package-info-download-buffer
(current-buffer))
744 (guix-package-source-build-derivation
746 "The source does not exist in the store. Download it?"))
748 (defun guix-package-info-insert-source (source entry
)
749 "Insert SOURCE from package ENTRY at point.
750 SOURCE is a list of URLs."
751 (guix-info-insert-indent)
753 (guix-format-insert nil
)
754 (let* ((source-file (guix-assq-value entry
'source-file
))
755 (entry-id (guix-assq-value entry
'id
))
756 (package-id (or (guix-assq-value entry
'package-id
)
758 (if (null source-file
)
759 (guix-info-insert-action-button
762 (guix-package-info-show-source (button-get btn
'entry-id
)
763 (button-get btn
'package-id
)))
764 "Show the source store path of the current package"
766 'package-id package-id
)
767 (unless (file-exists-p source-file
)
768 (guix-info-insert-action-button
771 (guix-package-info-download-source
772 (button-get btn
'package-id
)))
773 "Download the source into the store"
774 'package-id package-id
))
775 (guix-info-insert-val-simple source-file
776 #'guix-info-insert-file-path
))
777 (guix-info-insert-val-simple source
778 #'guix-package-info-insert-source-url
))))
780 (defun guix-package-info-redisplay-after-download ()
781 "Redisplay an 'info' buffer after downloading the package source.
782 This function is used to hide a \"Download\" button if needed."
783 (when (buffer-live-p guix-package-info-download-buffer
)
784 (guix-redisplay-buffer :buffer guix-package-info-download-buffer
)
785 (setq guix-package-info-download-buffer nil
)))
787 (add-hook 'guix-after-source-download-hook
788 'guix-package-info-redisplay-after-download
)
791 ;;; Displaying outputs
793 (guix-define-buffer-type info output
794 :buffer-name
"*Guix Package Info*"
795 :required
(id package-id installed non-unique
))
797 (defvar guix-info-insert-output-function nil
798 "Function used to insert an output information.
799 It is called with a single argument - alist of output parameters.
800 If nil, insert output in a default way.")
802 (defun guix-output-info-insert-version (version entry
)
803 "Insert output VERSION and obsolete text if needed at point."
804 (guix-info-insert-val-default version
805 'guix-package-info-version
)
806 (and (guix-assq-value entry
'obsolete
)
807 (guix-package-info-insert-obsolete-text)))
809 (defun guix-output-info-insert-output (output entry
)
810 "Insert OUTPUT and action buttons at point."
811 (let* ((installed (guix-assq-value entry
'installed
))
812 (obsolete (guix-assq-value entry
'obsolete
))
813 (action-type (if installed
'delete
'install
)))
814 (guix-info-insert-val-default
817 'guix-package-info-installed-outputs
818 'guix-package-info-uninstalled-outputs
))
819 (guix-info-insert-indent)
820 (guix-package-info-insert-action-button action-type entry output
)
822 (guix-info-insert-indent)
823 (guix-package-info-insert-action-button 'upgrade entry output
))))
826 ;;; Displaying generations
828 (guix-define-buffer-type info generation
)
830 (defface guix-generation-info-number
831 '((t :inherit font-lock-keyword-face
))
832 "Face used for a number of a generation."
833 :group
'guix-generation-info-faces
)
835 (defface guix-generation-info-current
836 '((t :inherit guix-package-info-installed-outputs
))
837 "Face used if a generation is the current one."
838 :group
'guix-generation-info-faces
)
840 (defface guix-generation-info-not-current
842 "Face used if a generation is not the current one."
843 :group
'guix-generation-info-faces
)
845 (defvar guix-info-insert-generation-function nil
846 "Function used to insert a generation information.
847 It is called with a single argument - alist of generation parameters.
848 If nil, insert generation in a default way.")
850 (defun guix-generation-info-insert-number (number &optional _
)
851 "Insert generation NUMBER and action buttons."
852 (guix-info-insert-val-default number
'guix-generation-info-number
)
853 (guix-info-insert-indent)
854 (guix-info-insert-action-button
857 (guix-get-show-entries guix-profile
'list guix-package-list-type
858 'generation
(button-get btn
'number
)))
859 "Show installed packages for this generation"
861 (guix-info-insert-indent)
862 (guix-info-insert-action-button
865 (guix-delete-generations guix-profile
(list (button-get btn
'number
))
867 "Delete this generation"
870 (defun guix-generation-info-insert-current (val entry
)
871 "Insert boolean value VAL showing whether this generation is current."
873 (guix-info-insert-val-default "Yes" 'guix-generation-info-current
)
874 (guix-info-insert-val-default "No" 'guix-generation-info-not-current
)
875 (guix-info-insert-indent)
876 (guix-info-insert-action-button
879 (guix-switch-to-generation guix-profile
(button-get btn
'number
)
881 "Switch to this generation (make it the current one)"
882 'number
(guix-assq-value entry
'number
))))
886 ;;; guix-info.el ends here