emacs/guix-info.el

   1 ;;; guix-info.el --- 'Info' buffer interface for displaying data  -*- 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 'info' (help-like) buffer interface for displaying
  24 ;; an arbitrary data.
  25
  26 ;;; Code:
  27
  28 (require 'guix-buffer)
  29 (require 'guix-entry)
  30 (require 'guix-utils)
  31
  32 (guix-define-buffer-type info)
  33
  34 (defface guix-info-heading
  35   '((((type tty pc) (class color)) :weight bold)
  36     (t :height 1.6 :weight bold :inherit variable-pitch))
  37   "Face for headings."
  38   :group 'guix-info-faces)
  39
  40 (defface guix-info-param-title
  41   '((t :inherit font-lock-type-face))
  42   "Face used for titles of parameters."
  43   :group 'guix-info-faces)
  44
  45 (defface guix-info-file-name
  46   '((t :inherit link))
  47   "Face used for file names."
  48   :group 'guix-info-faces)
  49
  50 (defface guix-info-url
  51   '((t :inherit link))
  52   "Face used for URLs."
  53   :group 'guix-info-faces)
  54
  55 (defface guix-info-time
  56   '((t :inherit font-lock-constant-face))
  57   "Face used for timestamps."
  58   :group 'guix-info-faces)
  59
  60 (defface guix-info-action-button
  61   '((((type x w32 ns) (class color))
  62      :box (:line-width 2 :style released-button)
  63      :background "lightgrey" :foreground "black")
  64     (t :inherit button))
  65   "Face used for action buttons."
  66   :group 'guix-info-faces)
  67
  68 (defface guix-info-action-button-mouse
  69   '((((type x w32 ns) (class color))
  70      :box (:line-width 2 :style released-button)
  71      :background "grey90" :foreground "black")
  72     (t :inherit highlight))
  73   "Mouse face used for action buttons."
  74   :group 'guix-info-faces)
  75
  76 (defcustom guix-info-ignore-empty-values nil
  77   "If non-nil, do not display parameters with nil values."
  78   :type 'boolean
  79   :group 'guix-info)
  80
  81 (defcustom guix-info-fill t
  82   "If non-nil, fill string parameters to fit the window.
  83 If nil, insert text parameters (like synopsis or description) in
  84 a raw form."
  85   :type 'boolean
  86   :group 'guix-info)
  87
  88 (defvar guix-info-param-title-format "%-18s: "
  89   "String used to format a title of a parameter.
  90 It should be a '%s'-sequence.  After inserting a title formatted
  91 with this string, a value of the parameter is inserted.
  92 This string is used by `guix-info-insert-title-format'.")
  93
  94 (defvar guix-info-multiline-prefix
  95   (make-string (length (format guix-info-param-title-format " "))
  96                ?\s)
  97   "String used to format multi-line parameter values.
  98 If a value occupies more than one line, this string is inserted
  99 in the beginning of each line after the first one.
 100 This string is used by `guix-info-insert-value-format'.")
 101
 102 (defvar guix-info-indent 2
 103   "Number of spaces used to indent various parts of inserted text.")
 104
 105 (defvar guix-info-delimiter "\n\f\n"
 106   "String used to separate entries.")
 107
 108 \f
 109 ;;; Wrappers for 'info' variables
 110
 111 (defvar guix-info-data nil
 112   "Alist with 'info' data.
 113 This alist is filled by `guix-info-define-interface' macro.")
 114
 115 (defun guix-info-value (entry-type symbol)
 116   "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'."
 117   (symbol-value (guix-assq-value guix-info-data entry-type symbol)))
 118
 119 (defun guix-info-param-title (entry-type param)
 120   "Return a title of an ENTRY-TYPE parameter PARAM."
 121   (guix-buffer-param-title 'info entry-type param))
 122
 123 (defun guix-info-format (entry-type)
 124   "Return 'info' format for ENTRY-TYPE."
 125   (guix-info-value entry-type 'format))
 126
 127 (defun guix-info-displayed-params (entry-type)
 128   "Return a list of ENTRY-TYPE parameters that should be displayed."
 129   (delq nil
 130         (mapcar (lambda (spec)
 131                   (pcase spec
 132                     (`(,param . ,_) param)))
 133                 (guix-info-format entry-type))))
 134
 135 \f
 136 ;;; Inserting entries
 137
 138 (defvar guix-info-title-aliases
 139   '((format . guix-info-insert-title-format)
 140     (simple . guix-info-insert-title-simple))
 141   "Alist of aliases and functions to insert titles.")
 142
 143 (defvar guix-info-value-aliases
 144   '((format . guix-info-insert-value-format)
 145     (indent . guix-info-insert-value-indent)
 146     (simple . guix-info-insert-value-simple)
 147     (time   . guix-info-insert-time))
 148   "Alist of aliases and functions to insert values.")
 149
 150 (defun guix-info-title-function (fun-or-alias)
 151   "Convert FUN-OR-ALIAS into a function to insert a title."
 152   (or (guix-assq-value guix-info-title-aliases fun-or-alias)
 153       fun-or-alias))
 154
 155 (defun guix-info-value-function (fun-or-alias)
 156   "Convert FUN-OR-ALIAS into a function to insert a value."
 157   (or (guix-assq-value guix-info-value-aliases fun-or-alias)
 158       fun-or-alias))
 159
 160 (defun guix-info-title-method->function (method)
 161   "Convert title METHOD into a function to insert a title."
 162   (pcase method
 163     ((pred null) #'ignore)
 164     ((pred symbolp) (guix-info-title-function method))
 165     (`(,fun-or-alias . ,rest-args)
 166      (lambda (title)
 167        (apply (guix-info-title-function fun-or-alias)
 168               title rest-args)))
 169     (_ (error "Unknown title method '%S'" method))))
 170
 171 (defun guix-info-value-method->function (method)
 172   "Convert value METHOD into a function to insert a value."
 173   (pcase method
 174     ((pred null) #'ignore)
 175     ((pred functionp) method)
 176     (`(,fun-or-alias . ,rest-args)
 177      (lambda (value _)
 178        (apply (guix-info-value-function fun-or-alias)
 179               value rest-args)))
 180     (_ (error "Unknown value method '%S'" method))))
 181
 182 (defun guix-info-fill-column ()
 183   "Return fill column for the current window."
 184   (min (window-width) fill-column))
 185
 186 (defun guix-info-get-indent (&optional level)
 187   "Return `guix-info-indent' \"multiplied\" by LEVEL spaces.
 188 LEVEL is 1 by default."
 189   (make-string (* guix-info-indent (or level 1)) ?\s))
 190
 191 (defun guix-info-insert-indent (&optional level)
 192   "Insert `guix-info-indent' spaces LEVEL times (1 by default)."
 193   (insert (guix-info-get-indent level)))
 194
 195 (defun guix-info-insert-entries (entries entry-type)
 196   "Display ENTRY-TYPE ENTRIES in the current info buffer."
 197   (guix-mapinsert (lambda (entry)
 198                     (guix-info-insert-entry entry entry-type))
 199                   entries
 200                   guix-info-delimiter))
 201
 202 (defun guix-info-insert-entry (entry entry-type &optional indent-level)
 203   "Insert ENTRY of ENTRY-TYPE into the current info buffer.
 204 If INDENT-LEVEL is non-nil, indent displayed data by this number
 205 of `guix-info-indent' spaces."
 206   (guix-with-indent (* (or indent-level 0)
 207                        guix-info-indent)
 208     (dolist (spec (guix-info-format entry-type))
 209       (guix-info-insert-entry-unit spec entry entry-type))))
 210
 211 (defun guix-info-insert-entry-unit (format-spec entry entry-type)
 212   "Insert title and value of a PARAM at point.
 213 ENTRY is alist with parameters and their values.
 214 ENTRY-TYPE is a type of ENTRY."
 215   (pcase format-spec
 216     ((pred functionp)
 217      (funcall format-spec entry)
 218      (insert "\n"))
 219     (`(,param ,title-method ,value-method)
 220      (let ((value (guix-entry-value entry param)))
 221        (unless (and guix-info-ignore-empty-values (null value))
 222          (let ((title        (guix-info-param-title entry-type param))
 223                (insert-title (guix-info-title-method->function title-method))
 224                (insert-value (guix-info-value-method->function value-method)))
 225            (funcall insert-title title)
 226            (funcall insert-value value entry)
 227            (insert "\n")))))
 228     (_ (error "Unknown format specification '%S'" format-spec))))
 229
 230 (defun guix-info-insert-title-simple (title &optional face)
 231   "Insert \"TITLE: \" string at point.
 232 If FACE is nil, use `guix-info-param-title'."
 233   (guix-format-insert title
 234                       (or face 'guix-info-param-title)
 235                       "%s: "))
 236
 237 (defun guix-info-insert-title-format (title &optional face)
 238   "Insert TITLE using `guix-info-param-title-format' at point.
 239 If FACE is nil, use `guix-info-param-title'."
 240   (guix-format-insert title
 241                       (or face 'guix-info-param-title)
 242                       guix-info-param-title-format))
 243
 244 (defun guix-info-insert-value-simple (value &optional button-or-face indent)
 245   "Format and insert parameter VALUE at point.
 246
 247 VALUE may be split into several short lines to fit the current
 248 window, depending on `guix-info-fill', and each line is indented
 249 with INDENT number of spaces.
 250
 251 If BUTTON-OR-FACE is a button type symbol, transform VALUE into
 252 this (these) button(s) and insert each one on a new line.  If it
 253 is a face symbol, propertize inserted line(s) with this face."
 254   (or indent (setq indent 0))
 255   (guix-with-indent indent
 256     (let* ((button?  (guix-button-type? button-or-face))
 257            (face     (unless button? button-or-face))
 258            (fill-col (unless (or button?
 259                                  (and (stringp value)
 260                                       (not guix-info-fill)))
 261                        (- (guix-info-fill-column) indent)))
 262            (value    (if (and value button?)
 263                          (guix-buttonize value button-or-face "\n")
 264                        value)))
 265       (guix-split-insert value face fill-col "\n"))))
 266
 267 (defun guix-info-insert-value-indent (value &optional button-or-face)
 268   "Format and insert parameter VALUE at point.
 269
 270 This function is intended to be called after inserting a title
 271 with `guix-info-insert-title-simple'.
 272
 273 VALUE may be split into several short lines to fit the current
 274 window, depending on `guix-info-fill', and each line is indented
 275 with `guix-info-indent'.
 276
 277 For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'."
 278   (when value (insert "\n"))
 279   (guix-info-insert-value-simple value button-or-face guix-info-indent))
 280
 281 (defun guix-info-insert-value-format (value &optional button-or-face
 282                                             &rest button-properties)
 283   "Format and insert parameter VALUE at point.
 284
 285 This function is intended to be called after inserting a title
 286 with `guix-info-insert-title-format'.
 287
 288 VALUE may be split into several short lines to fit the current
 289 window, depending on `guix-info-fill' and
 290 `guix-info-multiline-prefix'.  If VALUE is a list, its elements
 291 will be separated with `guix-list-separator'.
 292
 293 If BUTTON-OR-FACE is a button type symbol, transform VALUE into
 294 this (these) button(s).  If it is a face symbol, propertize
 295 inserted line(s) with this face.
 296
 297 BUTTON-PROPERTIES are passed to `guix-buttonize' (only if
 298 BUTTON-OR-FACE is a button type)."
 299   (let* ((button?  (guix-button-type? button-or-face))
 300          (face     (unless button? button-or-face))
 301          (fill-col (when (or button?
 302                              guix-info-fill
 303                              (not (stringp value)))
 304                      (- (guix-info-fill-column)
 305                         (length guix-info-multiline-prefix))))
 306          (value    (if (and value button?)
 307                        (apply #'guix-buttonize
 308                               value button-or-face guix-list-separator
 309                               button-properties)
 310                      value)))
 311     (guix-split-insert value face fill-col
 312                        (concat "\n" guix-info-multiline-prefix))))
 313
 314 (defun guix-info-insert-time (seconds &optional face)
 315   "Insert formatted time string using SECONDS at point."
 316   (guix-format-insert (guix-get-time-string seconds)
 317                       (or face 'guix-info-time)))
 318
 319 \f
 320 ;;; Buttons
 321
 322 (defvar guix-info-button-map
 323   (let ((map (make-sparse-keymap)))
 324     (set-keymap-parent map button-map)
 325     (define-key map (kbd "c") 'guix-info-button-copy-label)
 326     map)
 327   "Keymap for buttons in info buffers.")
 328
 329 (define-button-type 'guix
 330   'keymap guix-info-button-map
 331   'follow-link t)
 332
 333 (define-button-type 'guix-action
 334   :supertype 'guix
 335   'face 'guix-info-action-button
 336   'mouse-face 'guix-info-action-button-mouse)
 337
 338 (define-button-type 'guix-file
 339   :supertype 'guix
 340   'face 'guix-info-file-name
 341   'help-echo "Find file"
 342   'action (lambda (btn)
 343             (guix-find-file (button-label btn))))
 344
 345 (define-button-type 'guix-url
 346   :supertype 'guix
 347   'face 'guix-info-url
 348   'help-echo "Browse URL"
 349   'action (lambda (btn)
 350             (browse-url (button-label btn))))
 351
 352 (defun guix-info-button-copy-label (&optional pos)
 353   "Copy a label of the button at POS into kill ring.
 354 If POS is nil, use the current point position."
 355   (interactive)
 356   (let ((button (button-at (or pos (point)))))
 357     (when button
 358       (guix-copy-as-kill (button-label button)))))
 359
 360 (defun guix-info-insert-action-button (label action &optional message
 361                                              &rest properties)
 362   "Make action button with LABEL and insert it at point.
 363 ACTION is a function called when the button is pressed.  It
 364 should accept button as the argument.
 365 MESSAGE is a button message.
 366 See `insert-text-button' for the meaning of PROPERTIES."
 367   (apply #'guix-insert-button
 368          label 'guix-action
 369          'action action
 370          'help-echo message
 371          properties))
 372
 373 \f
 374 ;;; Major mode and interface definer
 375
 376 (defvar guix-info-mode-map
 377   (let ((map (make-sparse-keymap)))
 378     (set-keymap-parent
 379      map (make-composed-keymap (list guix-buffer-map button-buffer-map)
 380                                special-mode-map))
 381     map)
 382   "Keymap for `guix-info-mode' buffers.")
 383
 384 (define-derived-mode guix-info-mode special-mode "Guix-Info"
 385   "Parent mode for displaying data in 'info' form."
 386   (setq-local revert-buffer-function 'guix-buffer-revert))
 387
 388 (defun guix-info-mode-initialize ()
 389   "Set up the current 'info' buffer."
 390   ;; Without this, syntactic fontification is performed, and it may
 391   ;; break our highlighting.  For example, description of "emacs-typo"
 392   ;; package contains a single " (double-quote) character, so the
 393   ;; default syntactic fontification highlights the rest text after it
 394   ;; as a string.  See (info "(elisp) Font Lock Basics") for details.
 395   (setq font-lock-defaults '(nil t)))
 396
 397 (defmacro guix-info-define-interface (entry-type &rest args)
 398   "Define 'info' interface for displaying ENTRY-TYPE entries.
 399 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 400
 401 Required keywords:
 402
 403   - `:format' - default value of the generated
 404     `guix-ENTRY-TYPE-info-format' variable.
 405
 406 The rest keyword arguments are passed to
 407 `guix-buffer-define-interface' macro."
 408   (declare (indent 1))
 409   (let* ((entry-type-str     (symbol-name entry-type))
 410          (prefix             (concat "guix-" entry-type-str "-info"))
 411          (group              (intern prefix))
 412          (format-var         (intern (concat prefix "-format"))))
 413     (guix-keyword-args-let args
 414         ((show-entries-val   :show-entries-function)
 415          (format-val         :format))
 416       `(progn
 417          (defcustom ,format-var ,format-val
 418            ,(format "\
 419 List of methods for inserting '%s' entry.
 420 Each METHOD should be either a function or should have the
 421 following form:
 422
 423   (PARAM INSERT-TITLE INSERT-VALUE)
 424
 425 If METHOD is a function, it is called with an entry as argument.
 426
 427 PARAM is a name of '%s' entry parameter.
 428
 429 INSERT-TITLE may be either a symbol or a list.  If it is a
 430 symbol, it should be a function or an alias from
 431 `guix-info-title-aliases', in which case it is called with title
 432 as argument.  If it is a list, it should have a
 433 form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
 434 called with title and ARGS as arguments.
 435
 436 INSERT-VALUE may be either a symbol or a list.  If it is a
 437 symbol, it should be a function or an alias from
 438 `guix-info-value-aliases', in which case it is called with value
 439 and entry as arguments.  If it is a list, it should have a
 440 form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is
 441 called with value and ARGS as arguments.
 442
 443 Parameters are inserted in the same order as defined by this list.
 444 After calling each METHOD, a new line is inserted."
 445                     entry-type-str entry-type-str)
 446            :type 'sexp
 447            :group ',group)
 448
 449          (guix-alist-put!
 450           '((format . ,format-var))
 451           'guix-info-data ',entry-type)
 452
 453          ,(if show-entries-val
 454               `(guix-buffer-define-interface info ,entry-type
 455                  :show-entries-function ,show-entries-val
 456                  ,@%foreign-args)
 457
 458             (let ((insert-fun (intern (concat prefix "-insert-entries"))))
 459               `(progn
 460                  (defun ,insert-fun (entries)
 461                    ,(format "\
 462 Print '%s' ENTRIES in the current 'info' buffer."
 463                             entry-type-str)
 464                    (guix-info-insert-entries entries ',entry-type))
 465
 466                  (guix-buffer-define-interface info ,entry-type
 467                    :insert-entries-function ',insert-fun
 468                    :mode-init-function 'guix-info-mode-initialize
 469                    ,@%foreign-args))))))))
 470
 471 \f
 472 (defvar guix-info-font-lock-keywords
 473   (eval-when-compile
 474     `((,(rx "(" (group "guix-info-define-interface")
 475             symbol-end)
 476        . 1))))
 477
 478 (font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords)
 479
 480 (provide 'guix-info)
 481
 482 ;;; guix-info.el ends here