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-get-param-title 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-root-map button-buffer-map)
 405                                special-mode-map))
 406     map)
 407   "Parent keymap for info buffers.")
 408
 409 (define-derived-mode guix-info-mode special-mode "Guix-Info"
 410   "Parent mode for displaying information in info buffers.")
 411
 412 (defmacro guix-info-define-interface (entry-type &rest args)
 413   "Define 'info' interface for displaying ENTRY-TYPE entries.
 414 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 415
 416 Required keywords:
 417
 418   - `:format' - default value of the generated
 419     `guix-ENTRY-TYPE-info-format' variable.
 420
 421 The rest keyword arguments are passed to
 422 `guix-buffer-define-interface' macro."
 423   (declare (indent 1))
 424   (let* ((entry-type-str     (symbol-name entry-type))
 425          (prefix             (concat "guix-" entry-type-str "-info"))
 426          (group              (intern prefix))
 427          (format-var         (intern (concat prefix "-format"))))
 428     (guix-keyword-args-let args
 429         ((format-val         :format))
 430       `(progn
 431          (defcustom ,format-var ,format-val
 432            ,(format "\
 433 List of methods for inserting '%s' entry.
 434 Each METHOD should be either a function or should have the
 435 following form:
 436
 437   (PARAM INSERT-TITLE INSERT-VALUE)
 438
 439 If METHOD is a function, it is called with an entry as argument.
 440
 441 PARAM is a name of '%s' entry parameter.
 442
 443 INSERT-TITLE may be either a symbol or a list.  If it is a
 444 symbol, it should be a function or an alias from
 445 `guix-info-title-aliases', in which case it is called with title
 446 as argument.  If it is a list, it should have a
 447 form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
 448 called with title and ARGS as arguments.
 449
 450 INSERT-VALUE may be either a symbol or a list.  If it is a
 451 symbol, it should be a function or an alias from
 452 `guix-info-value-aliases', in which case it is called with value
 453 and entry as arguments.  If it is a list, it should have a
 454 form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
 455 called with value and ARGS as arguments.
 456
 457 Parameters are inserted in the same order as defined by this list.
 458 After calling each METHOD, a new line is inserted."
 459                     entry-type-str entry-type-str)
 460            :type 'sexp
 461            :group ',group)
 462
 463          (guix-alist-put!
 464           '((format . ,format-var))
 465           'guix-info-data ',entry-type)
 466
 467          (guix-buffer-define-interface info ,entry-type
 468            ,@%foreign-args)))))
 469
 470 \f
 471 ;;; Displaying packages
 472
 473 (guix-ui-info-define-interface package
 474   :format '(guix-package-info-insert-heading
 475             ignore
 476             (synopsis ignore (simple guix-package-info-synopsis))
 477             ignore
 478             (description ignore (simple guix-package-info-description))
 479             ignore
 480             (outputs simple guix-package-info-insert-outputs)
 481             (source simple guix-package-info-insert-source)
 482             (location format (format guix-package-location))
 483             (home-url format (format guix-url))
 484             (license format (format guix-package-info-license))
 485             (inputs format (format guix-package-input))
 486             (native-inputs format (format guix-package-native-input))
 487             (propagated-inputs format
 488                                (format guix-package-propagated-input)))
 489   :required '(id name version installed non-unique))
 490
 491 (guix-info-define-interface installed-output
 492   :format '((path simple (indent guix-file))
 493             (dependencies simple (indent guix-file)))
 494   :reduced? t)
 495
 496 (defface guix-package-info-heading
 497   '((t :inherit guix-info-heading))
 498   "Face for package name and version headings."
 499   :group 'guix-package-info-faces)
 500
 501 (defface guix-package-info-name
 502   '((t :inherit font-lock-keyword-face))
 503   "Face used for a name of a package."
 504   :group 'guix-package-info-faces)
 505
 506 (defface guix-package-info-name-button
 507   '((t :inherit button))
 508   "Face used for a full name that can be used to describe a package."
 509   :group 'guix-package-info-faces)
 510
 511 (defface guix-package-info-version
 512   '((t :inherit font-lock-builtin-face))
 513   "Face used for a version of a package."
 514   :group 'guix-package-info-faces)
 515
 516 (defface guix-package-info-synopsis
 517   '((((type tty pc) (class color)) :weight bold)
 518     (t :height 1.1 :weight bold :inherit variable-pitch))
 519   "Face used for a synopsis of a package."
 520   :group 'guix-package-info-faces)
 521
 522 (defface guix-package-info-description
 523   '((t))
 524   "Face used for a description of a package."
 525   :group 'guix-package-info-faces)
 526
 527 (defface guix-package-info-license
 528   '((t :inherit font-lock-string-face))
 529   "Face used for a license of a package."
 530   :group 'guix-package-info-faces)
 531
 532 (defface guix-package-info-location
 533   '((t :inherit link))
 534   "Face used for a location of a package."
 535   :group 'guix-package-info-faces)
 536
 537 (defface guix-package-info-installed-outputs
 538   '((default :weight bold)
 539     (((class color) (min-colors 88) (background light))
 540      :foreground "ForestGreen")
 541     (((class color) (min-colors 88) (background dark))
 542      :foreground "PaleGreen")
 543     (((class color) (min-colors 8))
 544      :foreground "green")
 545     (t :underline t))
 546   "Face used for installed outputs of a package."
 547   :group 'guix-package-info-faces)
 548
 549 (defface guix-package-info-uninstalled-outputs
 550   '((t :weight bold))
 551   "Face used for uninstalled outputs of a package."
 552   :group 'guix-package-info-faces)
 553
 554 (defface guix-package-info-obsolete
 555   '((t :inherit error))
 556   "Face used if a package is obsolete."
 557   :group 'guix-package-info-faces)
 558
 559 (defun guix-package-info-insert-heading (entry)
 560   "Insert package ENTRY heading (name specification) at point."
 561   (guix-format-insert (concat (guix-entry-value entry 'name) " "
 562                               (guix-entry-value entry 'version))
 563                       'guix-package-info-heading))
 564
 565 (defmacro guix-package-info-define-insert-inputs (&optional type)
 566   "Define a face and a function for inserting package inputs.
 567 TYPE is a type of inputs.
 568 Function name is `guix-package-info-insert-TYPE-inputs'.
 569 Face name is `guix-package-info-TYPE-inputs'."
 570   (let* ((type-str (symbol-name type))
 571          (type-name (and type (concat type-str "-")))
 572          (type-desc (and type (concat type-str " ")))
 573          (face (intern (concat "guix-package-info-" type-name "inputs")))
 574          (btn  (intern (concat "guix-package-" type-name "input"))))
 575     `(progn
 576        (defface ,face
 577          '((t :inherit guix-package-info-name-button))
 578          ,(concat "Face used for " type-desc "inputs of a package.")
 579          :group 'guix-package-info-faces)
 580
 581        (define-button-type ',btn
 582          :supertype 'guix-package-name
 583          'face ',face))))
 584
 585 (guix-package-info-define-insert-inputs)
 586 (guix-package-info-define-insert-inputs native)
 587 (guix-package-info-define-insert-inputs propagated)
 588
 589 \f
 590 ;;; Inserting outputs and installed parameters
 591
 592 (defvar guix-package-info-output-format "%-10s"
 593   "String used to format output names of the packages.
 594 It should be a '%s'-sequence.  After inserting an output name
 595 formatted with this string, an action button is inserted.")
 596
 597 (defvar guix-package-info-obsolete-string "(This package is obsolete)"
 598   "String used if a package is obsolete.")
 599
 600 (defun guix-package-info-insert-outputs (outputs entry)
 601   "Insert OUTPUTS from package ENTRY at point."
 602   (and (guix-entry-value entry 'obsolete)
 603        (guix-package-info-insert-obsolete-text))
 604   (and (guix-entry-value entry 'non-unique)
 605        (guix-entry-value entry 'installed)
 606        (guix-package-info-insert-non-unique-text
 607         (guix-package-entry->name-specification entry)))
 608   (insert "\n")
 609   (mapc (lambda (output)
 610           (guix-package-info-insert-output output entry))
 611         outputs))
 612
 613 (defun guix-package-info-insert-obsolete-text ()
 614   "Insert a message about obsolete package at point."
 615   (guix-info-insert-indent)
 616   (guix-format-insert guix-package-info-obsolete-string
 617                       'guix-package-info-obsolete))
 618
 619 (defun guix-package-info-insert-non-unique-text (full-name)
 620   "Insert a message about non-unique package with FULL-NAME at point."
 621   (insert "\n")
 622   (guix-info-insert-indent)
 623   (insert "Installed outputs are displayed for a non-unique ")
 624   (guix-insert-button full-name 'guix-package-name)
 625   (insert " package."))
 626
 627 (defun guix-package-info-insert-output (output entry)
 628   "Insert OUTPUT at point.
 629 Make some fancy text with buttons and additional stuff if the
 630 current OUTPUT is installed (if there is such output in
 631 `installed' parameter of a package ENTRY)."
 632   (let* ((installed (guix-entry-value entry 'installed))
 633          (obsolete  (guix-entry-value entry 'obsolete))
 634          (installed-entry (cl-find-if
 635                            (lambda (entry)
 636                              (string= (guix-entry-value entry 'output)
 637                                       output))
 638                            installed))
 639          (action-type (if installed-entry 'delete 'install)))
 640     (guix-info-insert-indent)
 641     (guix-format-insert output
 642                         (if installed-entry
 643                             'guix-package-info-installed-outputs
 644                           'guix-package-info-uninstalled-outputs)
 645                         guix-package-info-output-format)
 646     (guix-package-info-insert-action-button action-type entry output)
 647     (when obsolete
 648       (guix-info-insert-indent)
 649       (guix-package-info-insert-action-button 'upgrade entry output))
 650     (insert "\n")
 651     (when installed-entry
 652       (guix-info-insert-entry installed-entry 'installed-output 2))))
 653
 654 (defun guix-package-info-insert-action-button (type entry output)
 655   "Insert button to process an action on a package OUTPUT at point.
 656 TYPE is one of the following symbols: `install', `delete', `upgrade'.
 657 ENTRY is an alist with package info."
 658   (let ((type-str (capitalize (symbol-name type)))
 659         (full-name (guix-package-entry->name-specification entry output)))
 660     (guix-info-insert-action-button
 661      type-str
 662      (lambda (btn)
 663        (guix-process-package-actions
 664         guix-profile
 665         `((,(button-get btn 'action-type) (,(button-get btn 'id)
 666                                            ,(button-get btn 'output))))
 667         (current-buffer)))
 668      (concat type-str " '" full-name "'")
 669      'action-type type
 670      'id (or (guix-entry-value entry 'package-id)
 671              (guix-entry-id entry))
 672      'output output)))
 673
 674 \f
 675 ;;; Inserting a source
 676
 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)
 681
 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."
 685   :type 'boolean
 686   :group 'guix-package-info)
 687
 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)."
 695   :type 'boolean
 696   :group 'guix-package-info)
 697
 698 (defvar guix-package-info-download-buffer nil
 699   "Buffer from which a current download operation was performed.")
 700
 701 (define-button-type 'guix-package-source
 702   :supertype 'guix
 703   'face 'guix-package-info-source
 704   'help-echo ""
 705   'action (lambda (_)
 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?")))
 709
 710 (defun guix-package-info-show-source (entry-id package-id)
 711   "Show file name of a package source in the current info buffer.
 712 Find the file if needed (see `guix-package-info-auto-find-source').
 713 ENTRY-ID is an ID of the current entry (package or output).
 714 PACKAGE-ID is an ID of the package which source to show."
 715   (let* ((entry (guix-entry-by-id entry-id guix-entries))
 716          (file  (guix-package-source-path package-id)))
 717     (or file
 718         (error "Couldn't define file path of the package source"))
 719     (let* ((new-entry (cons (cons 'source-file file)
 720                             entry))
 721            (entries (guix-replace-entry entry-id new-entry guix-entries)))
 722       (guix-redisplay-buffer :entries entries)
 723       (if (file-exists-p file)
 724           (if guix-package-info-auto-find-source
 725               (guix-find-file file)
 726             (message "The source store path is displayed."))
 727         (if guix-package-info-auto-download-source
 728             (guix-package-info-download-source package-id)
 729           (message "The source does not exist in the store."))))))
 730
 731 (defun guix-package-info-download-source (package-id)
 732   "Download a source of the package PACKAGE-ID."
 733   (setq guix-package-info-download-buffer (current-buffer))
 734   (guix-package-source-build-derivation
 735    package-id
 736    "The source does not exist in the store. Download it?"))
 737
 738 (defun guix-package-info-insert-source (source entry)
 739   "Insert SOURCE from package ENTRY at point.
 740 SOURCE is a list of URLs."
 741   (if (null source)
 742       (guix-format-insert nil)
 743     (let* ((source-file (guix-entry-value entry 'source-file))
 744            (entry-id    (guix-entry-id entry))
 745            (package-id  (or (guix-entry-value entry 'package-id)
 746                             entry-id)))
 747       (if (null source-file)
 748           (guix-info-insert-action-button
 749            "Show"
 750            (lambda (btn)
 751              (guix-package-info-show-source (button-get btn 'entry-id)
 752                                             (button-get btn 'package-id)))
 753            "Show the source store directory of the current package"
 754            'entry-id entry-id
 755            'package-id package-id)
 756         (unless (file-exists-p source-file)
 757           (guix-info-insert-action-button
 758            "Download"
 759            (lambda (btn)
 760              (guix-package-info-download-source
 761               (button-get btn 'package-id)))
 762            "Download the source into the store"
 763            'package-id package-id))
 764         (guix-info-insert-value-indent source-file 'guix-file))
 765       (guix-info-insert-value-indent source 'guix-package-source))))
 766
 767 (defun guix-package-info-redisplay-after-download ()
 768   "Redisplay an 'info' buffer after downloading the package source.
 769 This function is used to hide a \"Download\" button if needed."
 770   (when (buffer-live-p guix-package-info-download-buffer)
 771     (guix-redisplay-buffer :buffer guix-package-info-download-buffer)
 772     (setq guix-package-info-download-buffer nil)))
 773
 774 (add-hook 'guix-after-source-download-hook
 775           'guix-package-info-redisplay-after-download)
 776
 777 \f
 778 ;;; Displaying outputs
 779
 780 (guix-ui-info-define-interface output
 781   :buffer-name "*Guix Package Info*"
 782   :format '((name format (format guix-package-info-name))
 783             (version format guix-output-info-insert-version)
 784             (output format guix-output-info-insert-output)
 785             (synopsis simple (indent guix-package-info-synopsis))
 786             (source simple guix-package-info-insert-source)
 787             (path simple (indent guix-file))
 788             (dependencies simple (indent guix-file))
 789             (location format (format guix-package-location))
 790             (home-url format (format guix-url))
 791             (license format (format guix-package-info-license))
 792             (inputs format (format guix-package-input))
 793             (native-inputs format (format guix-package-native-input))
 794             (propagated-inputs format
 795                                (format guix-package-propagated-input))
 796             (description simple (indent guix-package-info-description)))
 797   :required '(id package-id installed non-unique))
 798
 799 (defun guix-output-info-insert-version (version entry)
 800   "Insert output VERSION and obsolete text if needed at point."
 801   (guix-info-insert-value-format version
 802                                  'guix-package-info-version)
 803   (and (guix-entry-value entry 'obsolete)
 804        (guix-package-info-insert-obsolete-text)))
 805
 806 (defun guix-output-info-insert-output (output entry)
 807   "Insert OUTPUT and action buttons at point."
 808   (let* ((installed (guix-entry-value entry 'installed))
 809          (obsolete  (guix-entry-value entry 'obsolete))
 810          (action-type (if installed 'delete 'install)))
 811     (guix-info-insert-value-format
 812      output
 813      (if installed
 814          'guix-package-info-installed-outputs
 815        'guix-package-info-uninstalled-outputs))
 816     (guix-info-insert-indent)
 817     (guix-package-info-insert-action-button action-type entry output)
 818     (when obsolete
 819       (guix-info-insert-indent)
 820       (guix-package-info-insert-action-button 'upgrade entry output))))
 821
 822 \f
 823 ;;; Displaying generations
 824
 825 (guix-ui-info-define-interface generation
 826   :format '((number format guix-generation-info-insert-number)
 827             (prev-number format (format))
 828             (current format guix-generation-info-insert-current)
 829             (path simple (indent guix-file))
 830             (time format (time))))
 831
 832 (defface guix-generation-info-number
 833   '((t :inherit font-lock-keyword-face))
 834   "Face used for a number of a generation."
 835   :group 'guix-generation-info-faces)
 836
 837 (defface guix-generation-info-current
 838   '((t :inherit guix-package-info-installed-outputs))
 839   "Face used if a generation is the current one."
 840   :group 'guix-generation-info-faces)
 841
 842 (defface guix-generation-info-not-current
 843   '((t nil))
 844   "Face used if a generation is not the current one."
 845   :group 'guix-generation-info-faces)
 846
 847 (defun guix-generation-info-insert-number (number &optional _)
 848   "Insert generation NUMBER and action buttons."
 849   (guix-info-insert-value-format number 'guix-generation-info-number)
 850   (guix-info-insert-indent)
 851   (guix-info-insert-action-button
 852    "Packages"
 853    (lambda (btn)
 854      (guix-get-show-entries guix-profile 'list guix-package-list-type
 855                             'generation (button-get btn 'number)))
 856    "Show installed packages for this generation"
 857    'number number)
 858   (guix-info-insert-indent)
 859   (guix-info-insert-action-button
 860    "Delete"
 861    (lambda (btn)
 862      (guix-delete-generations guix-profile (list (button-get btn 'number))
 863                               (current-buffer)))
 864    "Delete this generation"
 865    'number number))
 866
 867 (defun guix-generation-info-insert-current (val entry)
 868   "Insert boolean value VAL showing whether this generation is current."
 869   (if val
 870       (guix-info-insert-value-format "Yes" 'guix-generation-info-current)
 871     (guix-info-insert-value-format "No" 'guix-generation-info-not-current)
 872     (guix-info-insert-indent)
 873     (guix-info-insert-action-button
 874      "Switch"
 875      (lambda (btn)
 876        (guix-switch-to-generation guix-profile (button-get btn 'number)
 877                                   (current-buffer)))
 878      "Switch to this generation (make it the current one)"
 879      'number (guix-entry-value entry 'number))))
 880
 881 \f
 882 (defvar guix-info-font-lock-keywords
 883   (eval-when-compile
 884     `((,(rx "(" (group "guix-info-define-interface")
 885             symbol-end)
 886        . 1))))
 887
 888 (font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
 889
 890 (provide 'guix-info)
 891
 892 ;;; guix-info.el ends here