emacs/guix-info.el

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