emacs/guix-info.el

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