emacs/guix-info.el

   1 ;;; guix-info.el --- Info buffers for displaying entries
   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-history)
  28 (require 'guix-base)
  29 (require 'guix-utils)
  30
  31 (defgroup guix-info nil
  32   "General settings for info buffers."
  33   :prefix "guix-info-"
  34   :group 'guix)
  35
  36 (defface guix-info-param-title
  37   '((t :inherit font-lock-type-face))
  38   "Face used for titles of parameters."
  39   :group 'guix-info)
  40
  41 (defface guix-info-file-path
  42   '((t :inherit link))
  43   "Face used for file paths."
  44   :group 'guix-info)
  45
  46 (defface guix-info-url
  47   '((t :inherit link))
  48   "Face used for URLs."
  49   :group 'guix-info)
  50
  51 (defface guix-info-time
  52   '((t :inherit font-lock-constant-face))
  53   "Face used for timestamps."
  54   :group 'guix-info)
  55
  56 (defface guix-info-action-button
  57   '((((type x w32 ns) (class color))
  58      :box (:line-width 2 :style released-button)
  59      :background "lightgrey" :foreground "black")
  60     (t :inherit button))
  61   "Face used for action buttons."
  62   :group 'guix-info)
  63
  64 (defface guix-info-action-button-mouse
  65   '((((type x w32 ns) (class color))
  66      :box (:line-width 2 :style released-button)
  67      :background "grey90" :foreground "black")
  68     (t :inherit highlight))
  69   "Mouse face used for action buttons."
  70   :group 'guix-info)
  71
  72 (defcustom guix-info-ignore-empty-vals nil
  73   "If non-nil, do not display parameters with nil values."
  74   :type 'boolean
  75   :group 'guix-info)
  76
  77 (defvar guix-info-param-title-format "%-18s: "
  78   "String used to format a title of a parameter.
  79 It should be a '%s'-sequence.  After inserting a title formatted
  80 with this string, a value of the parameter is inserted.
  81 This string is used by `guix-info-insert-title-default'.")
  82
  83 (defvar guix-info-multiline-prefix (make-string 20 ?\s)
  84   "String used to format multi-line parameter values.
  85 If a value occupies more than one line, this string is inserted
  86 in the beginning of each line after the first one.
  87 This string is used by `guix-info-insert-val-default'.")
  88
  89 (defvar guix-info-indent 2
  90   "Number of spaces used to indent various parts of inserted text.")
  91
  92 (defvar guix-info-fill-column 60
  93   "Column used for filling (word wrapping) parameters with long lines.
  94 If a value is not multi-line and it occupies more than this
  95 number of characters, it will be split into several lines.")
  96
  97 (defvar guix-info-delimiter "\n\f\n"
  98   "String used to separate entries.")
  99
 100 (defvar guix-info-insert-methods
 101   '((package
 102      (name              guix-package-info-name)
 103      (version           guix-package-info-version)
 104      (license           guix-package-info-license)
 105      (synopsis          guix-package-info-synopsis)
 106      (description       guix-package-info-insert-description
 107                         guix-info-insert-title-simple)
 108      (outputs           guix-package-info-insert-outputs
 109                         guix-info-insert-title-simple)
 110      (home-url          guix-info-insert-url)
 111      (inputs            guix-package-info-insert-inputs)
 112      (native-inputs     guix-package-info-insert-native-inputs)
 113      (propagated-inputs guix-package-info-insert-propagated-inputs)
 114      (location          guix-package-info-insert-location))
 115     (installed
 116      (path              guix-package-info-insert-output-path
 117                         guix-info-insert-title-simple)
 118      (dependencies      guix-package-info-insert-output-dependencies
 119                         guix-info-insert-title-simple))
 120     (generation
 121      (number            guix-generation-info-insert-number)
 122      (path              guix-info-insert-file-path)
 123      (time              guix-info-insert-time)))
 124   "Methods for inserting parameter values.
 125 Each element of the list should have a form:
 126
 127   (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...))
 128
 129 INSERT-VALUE may be either nil, a face name or a function.  If it
 130 is nil or a face, `guix-info-insert-val-default' function is
 131 called with parameter value and INSERT-VALUE as arguments.  If it
 132 is a function, this function is called with parameter value and
 133 entry info (alist of parameters and their values) as arguments.
 134
 135 INSERT-TITLE may be either nil, a face name or a function.  If it
 136 is nil or a face, `guix-info-insert-title-default' function is
 137 called with parameter title and INSERT-TITLE as arguments.  If it
 138 is a function, this function is called with parameter title as
 139 argument.")
 140
 141 (defvar guix-info-displayed-params
 142   '((package name version synopsis outputs location home-url
 143              license inputs native-inputs propagated-inputs description)
 144     (installed path dependencies)
 145     (generation number prev-number time path))
 146   "List of displayed entry parameters.
 147 Each element of the list should have a form:
 148
 149   (ENTRY-TYPE . (PARAM ...))
 150
 151 The order of displayed parameters is the same as in this list.")
 152
 153 (defun guix-info-get-insert-methods (entry-type param)
 154   "Return list of insert methods for parameter PARAM of ENTRY-TYPE.
 155 See `guix-info-insert-methods' for details."
 156   (guix-get-key-val guix-info-insert-methods
 157                     entry-type param))
 158
 159 (defun guix-info-get-displayed-params (entry-type)
 160   "Return parameters of ENTRY-TYPE that should be displayed."
 161   (guix-get-key-val guix-info-displayed-params
 162                     entry-type))
 163
 164 (defun guix-info-get-indent (&optional level)
 165   "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
 166 LEVEL is 1 by default."
 167   (make-string (* guix-info-indent (or level 1)) ?\s))
 168
 169 (defun guix-info-insert-indent (&optional level)
 170   "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
 171   (insert (guix-info-get-indent level)))
 172
 173 (defun guix-info-insert-entries (entries entry-type)
 174   "Display ENTRIES of ENTRY-TYPE in the current info buffer.
 175 ENTRIES should have a form of `guix-entries'."
 176   (guix-mapinsert (lambda (entry)
 177                     (guix-info-insert-entry entry entry-type))
 178                   entries
 179                   guix-info-delimiter))
 180
 181 (defun guix-info-insert-entry (entry entry-type &optional indent-level)
 182   "Insert ENTRY of ENTRY-TYPE into the current info buffer.
 183 If INDENT-LEVEL is non-nil, indent displayed information by this
 184 number of `guix-info-indent' spaces."
 185   (let ((region-beg (point)))
 186     (mapc (lambda (param)
 187             (guix-info-insert-param param entry entry-type))
 188           (guix-info-get-displayed-params entry-type))
 189     (when indent-level
 190       (indent-rigidly region-beg (point)
 191                       (* indent-level guix-info-indent)))))
 192
 193 (defun guix-info-insert-param (param entry entry-type)
 194   "Insert title and value of a PARAM at point.
 195 ENTRY is alist with parameters and their values.
 196 ENTRY-TYPE is a type of ENTRY."
 197   (let ((val (guix-get-key-val entry param)))
 198     (unless (and guix-info-ignore-empty-vals (null val))
 199       (let* ((title          (guix-get-param-title entry-type param))
 200              (insert-methods (guix-info-get-insert-methods entry-type param))
 201              (val-method     (car insert-methods))
 202              (title-method   (cadr insert-methods)))
 203         (guix-info-method-funcall title title-method
 204                                   #'guix-info-insert-title-default)
 205         (guix-info-method-funcall val val-method
 206                                   #'guix-info-insert-val-default
 207                                   entry)
 208         (insert "\n")))))
 209
 210 (defun guix-info-method-funcall (val method default-fun &rest args)
 211   "Call METHOD or DEFAULT-FUN.
 212
 213 If METHOD is a function and VAL is non-nil, call this
 214 function by applying it to VAL and ARGS.
 215
 216 If METHOD is a face, propertize inserted VAL with this face."
 217   (cond ((or (null method)
 218              (facep method))
 219          (funcall default-fun val method))
 220         ((functionp method)
 221          (apply method val args))
 222         (t (error "Unknown method '%S'" method))))
 223
 224 (defun guix-info-insert-title-default (title &optional face format)
 225   "Insert TITLE formatted with `guix-info-param-title-format' at point."
 226   (guix-format-insert title
 227                       (or face 'guix-info-param-title)
 228                       (or format guix-info-param-title-format)))
 229
 230 (defun guix-info-insert-title-simple (title &optional face)
 231   "Insert TITLE at point."
 232   (guix-info-insert-title-default title face "%s:"))
 233
 234 (defun guix-info-insert-val-default (val &optional face)
 235   "Format and insert parameter value VAL at point.
 236
 237 This function is intended to be called after
 238 `guix-info-insert-title-default'.
 239
 240 If VAL is a one-line string longer than `guix-info-fill-column',
 241 split it into several short lines.  See also
 242 `guix-info-multiline-prefix'.
 243
 244 If FACE is non-nil, propertize inserted line(s) with this FACE."
 245   (guix-split-insert val face
 246                      guix-info-fill-column
 247                      (concat "\n" guix-info-multiline-prefix)))
 248
 249 (defun guix-info-insert-val-simple (val &optional face-or-fun)
 250   "Format and insert parameter value VAL at point.
 251
 252 This function is intended to be called after
 253 `guix-info-insert-title-simple'.
 254
 255 If VAL is a one-line string longer than `guix-info-fill-column',
 256 split it into several short lines and indent each line with
 257 `guix-info-indent' spaces.
 258
 259 If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE.
 260
 261 If FACE-OR-FUN is a function, call it with VAL as argument.  If
 262 VAL is a list, call the function on each element of this list."
 263   (if (null val)
 264       (progn (guix-info-insert-indent)
 265              (guix-format-insert nil))
 266     (let ((prefix (concat "\n" (guix-info-get-indent))))
 267       (insert prefix)
 268       (if (functionp face-or-fun)
 269           (guix-mapinsert face-or-fun
 270                           (if (listp val) val (list val))
 271                           prefix)
 272         (guix-split-insert val face-or-fun
 273                            guix-info-fill-column prefix)))))
 274
 275 (defun guix-info-insert-action-button (label action &optional message
 276                                              &rest properties)
 277   "Make action button with LABEL and insert it at point.
 278 For the meaning of ACTION, MESSAGE and PROPERTIES, see
 279 `guix-insert-button'."
 280   (apply #'guix-insert-button
 281          label 'guix-info-action-button action message
 282          'mouse-face 'guix-info-action-button-mouse
 283          properties))
 284
 285 (defun guix-info-insert-file-path (path &optional _)
 286   "Make button from file PATH and insert it at point."
 287   (guix-insert-button
 288    path 'guix-info-file-path
 289    (lambda (btn) (find-file (button-label btn)))
 290    "Find file"))
 291
 292 (defun guix-info-insert-url (url &optional _)
 293   "Make button from URL and insert it at point."
 294   (guix-insert-button
 295    url 'guix-info-url
 296    (lambda (btn) (browse-url (button-label btn)))
 297    "Browse URL"))
 298
 299 (defun guix-info-insert-time (seconds &optional _)
 300   "Insert formatted time string using SECONDS at point."
 301   (guix-info-insert-val-default (guix-get-time-string seconds)
 302                                 'guix-info-time))
 303
 304 \f
 305 (defvar guix-info-mode-map
 306   (let ((map (make-sparse-keymap)))
 307     (set-keymap-parent
 308      map (make-composed-keymap button-buffer-map
 309                                special-mode-map))
 310     map)
 311   "Parent keymap for info buffers.")
 312
 313 (define-derived-mode guix-info-mode special-mode "Guix-Info"
 314   "Parent mode for displaying information in info buffers.")
 315
 316 \f
 317 ;;; Displaying packages
 318
 319 (guix-define-buffer-type info package
 320   :required (id installed non-unique))
 321
 322 (defface guix-package-info-name
 323   '((t :inherit font-lock-keyword-face))
 324   "Face used for a name of a package."
 325   :group 'guix-package-info)
 326
 327 (defface guix-package-info-version
 328   '((t :inherit font-lock-builtin-face))
 329   "Face used for a version of a package."
 330   :group 'guix-package-info)
 331
 332 (defface guix-package-info-synopsis
 333   '((t :inherit font-lock-doc-face))
 334   "Face used for a synopsis of a package."
 335   :group 'guix-package-info)
 336
 337 (defface guix-package-info-description
 338   '((t))
 339   "Face used for a description of a package."
 340   :group 'guix-package-info)
 341
 342 (defface guix-package-info-license
 343   '((t :inherit font-lock-string-face))
 344   "Face used for a license of a package."
 345   :group 'guix-package-info)
 346
 347 (defface guix-package-info-location
 348   '((t :inherit link))
 349   "Face used for a location of a package."
 350   :group 'guix-package-info)
 351
 352 (defface guix-package-info-installed-outputs
 353   '((default :weight bold)
 354     (((class color) (min-colors 88) (background light))
 355      :foreground "ForestGreen")
 356     (((class color) (min-colors 88) (background dark))
 357      :foreground "PaleGreen")
 358     (((class color) (min-colors 8))
 359      :foreground "green")
 360     (t :underline t))
 361   "Face used for installed outputs of a package."
 362   :group 'guix-package-info)
 363
 364 (defface guix-package-info-uninstalled-outputs
 365   '((t :weight bold))
 366   "Face used for uninstalled outputs of a package."
 367   :group 'guix-package-info)
 368
 369 (defface guix-package-info-obsolete
 370   '((t :inherit error))
 371   "Face used if a package is obsolete."
 372   :group 'guix-package-info)
 373
 374 (defun guix-package-info-insert-description (desc &optional _)
 375   "Insert description DESC at point."
 376   (guix-info-insert-val-simple desc 'guix-package-info-description))
 377
 378 (defun guix-package-info-insert-location (location &optional _)
 379   "Make button from file LOCATION and insert it at point."
 380   (guix-insert-button
 381    location 'guix-package-info-location
 382    (lambda (btn) (guix-find-location (button-label btn)))
 383    "Find location of this package"))
 384
 385 (defmacro guix-package-info-define-insert-inputs (&optional type)
 386   "Define a face and a function for inserting package inputs.
 387 TYPE is a type of inputs.
 388 Function name is `guix-package-info-insert-TYPE-inputs'.
 389 Face name is `guix-package-info-TYPE-inputs'."
 390   (let* ((type-str (symbol-name type))
 391          (type-name (and type (concat type-str "-")))
 392          (type-desc (and type (concat type-str " ")))
 393          (face (intern (concat "guix-package-info-" type-name "inputs")))
 394          (fun  (intern (concat "guix-package-info-insert-" type-name "inputs"))))
 395     `(progn
 396        (defface ,face
 397          '((t :inherit button))
 398          ,(concat "Face used for " type-desc "inputs of a package.")
 399          :group 'guix-package-info)
 400
 401        (defun ,fun (inputs &optional _)
 402          ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.")
 403          (guix-package-info-insert-full-names inputs ',face)))))
 404
 405 (guix-package-info-define-insert-inputs)
 406 (guix-package-info-define-insert-inputs native)
 407 (guix-package-info-define-insert-inputs propagated)
 408
 409 (defun guix-package-info-insert-full-names (names face)
 410   "Make buttons from package NAMES and insert them at point.
 411 NAMES is a list of strings.
 412 Propertize buttons with FACE."
 413   (if names
 414       (guix-info-insert-val-default
 415        (with-temp-buffer
 416          (guix-mapinsert (lambda (name)
 417                            (guix-package-info-insert-full-name
 418                             name face))
 419                          names
 420                          guix-list-separator)
 421          (buffer-substring (point-min) (point-max))))
 422     (guix-format-insert nil)))
 423
 424 (defun guix-package-info-insert-full-name (name face)
 425   "Make button and insert package NAME at point.
 426 Propertize package button with FACE."
 427   (guix-insert-button
 428    name face
 429    (lambda (btn)
 430      (guix-package-info-get-show 'name (button-label btn)))
 431    "Describe this package"))
 432
 433 \f
 434 ;;; Inserting outputs and installed parameters
 435
 436 (defvar guix-package-info-output-format "%-10s"
 437   "String used to format output names of the packages.
 438 It should be a '%s'-sequence.  After inserting an output name
 439 formatted with this string, an action button is inserted.")
 440
 441 (defvar guix-package-info-obsolete-string "(This package is obsolete)"
 442   "String used if a package is obsolete.")
 443
 444 (defun guix-package-info-insert-outputs (outputs entry)
 445   "Insert OUTPUTS from package ENTRY at point."
 446   (and (guix-get-key-val entry 'obsolete)
 447        (guix-package-info-insert-obsolete-text))
 448   (and (guix-get-key-val entry 'non-unique)
 449        (guix-get-key-val entry 'installed)
 450        (guix-package-info-insert-non-unique-text
 451         (guix-get-full-name entry)))
 452   (insert "\n")
 453   (mapc (lambda (output)
 454           (guix-package-info-insert-output output entry))
 455         outputs))
 456
 457 (defun guix-package-info-insert-obsolete-text ()
 458   "Insert a message about obsolete package at point."
 459   (guix-info-insert-indent)
 460   (guix-format-insert guix-package-info-obsolete-string
 461                       'guix-package-info-obsolete))
 462
 463 (defun guix-package-info-insert-non-unique-text (full-name)
 464   "Insert a message about non-unique package with FULL-NAME at point."
 465   (insert "\n")
 466   (guix-info-insert-indent)
 467   (insert "Installed outputs are displayed for a non-unique ")
 468   (guix-package-info-insert-full-name full-name
 469                                       'guix-package-info-inputs)
 470   (insert " package."))
 471
 472 (defun guix-package-info-insert-output (output entry)
 473   "Insert OUTPUT at point.
 474 Make some fancy text with buttons and additional stuff if the
 475 current OUTPUT is installed (if there is such output in
 476 `installed' parameter of a package ENTRY)."
 477   (let* ((installed (guix-get-key-val entry 'installed))
 478          (obsolete  (guix-get-key-val entry 'obsolete))
 479          (installed-entry (cl-find-if
 480                            (lambda (entry)
 481                              (string= (guix-get-key-val entry 'output)
 482                                       output))
 483                            installed))
 484          (action-type (if installed-entry 'delete 'install)))
 485     (guix-info-insert-indent)
 486     (guix-format-insert output
 487                         (if installed-entry
 488                             'guix-package-info-installed-outputs
 489                           'guix-package-info-uninstalled-outputs)
 490                         guix-package-info-output-format)
 491     (guix-package-info-insert-action-button action-type entry output)
 492     (when obsolete
 493       (guix-info-insert-indent)
 494       (guix-package-info-insert-action-button 'upgrade entry output))
 495     (insert "\n")
 496     (when installed-entry
 497       (guix-info-insert-entry installed-entry 'installed 2))))
 498
 499 (defun guix-package-info-insert-action-button (type entry output)
 500   "Insert button to process an action on a package OUTPUT at point.
 501 TYPE is one of the following symbols: `install', `delete', `upgrade'.
 502 ENTRY is an alist with package info."
 503   (let ((type-str (capitalize (symbol-name type)))
 504         (full-name (guix-get-full-name entry output)))
 505     (guix-info-insert-action-button
 506      type-str
 507      (lambda (btn)
 508        (guix-process-package-actions
 509         (list (button-get btn 'action-type)
 510               (list (button-get btn 'id)
 511                     (button-get btn 'output)))))
 512      (concat type-str " '" full-name "'")
 513      'action-type type
 514      'id (guix-get-key-val entry 'id)
 515      'output output)))
 516
 517 (defun guix-package-info-insert-output-path (path &optional _)
 518   "Insert PATH of the installed output."
 519   (guix-info-insert-val-simple path #'guix-info-insert-file-path))
 520
 521 (defun guix-package-info-insert-output-dependencies (deps &optional _)
 522   "Insert dependencies DEPS of the installed output."
 523   (guix-info-insert-val-simple deps #'guix-info-insert-file-path))
 524
 525 \f
 526 ;;; Displaying generations
 527
 528 (guix-define-buffer-type info generation)
 529
 530 (defface guix-generation-info-number
 531   '((t :inherit font-lock-keyword-face))
 532   "Face used for a number of a generation."
 533   :group 'guix-generation-info)
 534
 535 (declare-function guix-package-list-get-show "guix-list" t t)
 536
 537 (defun guix-generation-info-insert-number (number &optional _)
 538   "Insert generation NUMBER and action buttons."
 539   (guix-info-insert-val-default number 'guix-generation-info-number)
 540   (guix-info-insert-indent)
 541   (guix-info-insert-action-button
 542    "Packages"
 543    (lambda (btn)
 544      (guix-package-list-get-show 'generation
 545                                  (button-get btn 'number)))
 546    "Show installed packages for this generation"
 547    'number number)
 548   (guix-info-insert-indent)
 549   (guix-info-insert-action-button
 550    "Delete"
 551    (lambda (btn) (error "Sorry, not implemented yet"))
 552    "Delete this generation"))
 553
 554 (provide 'guix-info)
 555
 556 ;;; guix-info.el ends here