lisp/help-mode.el

   1 ;;; help-mode.el --- `help-mode' used by *Help* buffers
   2
   3 ;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
   4 ;; Foundation, Inc.
   5
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Keywords: help, internal
   8 ;; Package: emacs
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Defines `help-mode', which is the mode used by *Help* buffers, and
  28 ;; associated support machinery, such as adding hyperlinks, etc.,
  29
  30 ;;; Code:
  31
  32 (require 'button)
  33 (eval-when-compile (require 'easymenu))
  34
  35 (defvar help-mode-map
  36   (let ((map (make-sparse-keymap)))
  37     (set-keymap-parent map (make-composed-keymap button-buffer-map
  38                                                  special-mode-map))
  39     (define-key map [mouse-2] 'help-follow-mouse)
  40     (define-key map "l" 'help-go-back)
  41     (define-key map "r" 'help-go-forward)
  42     (define-key map "\C-c\C-b" 'help-go-back)
  43     (define-key map "\C-c\C-f" 'help-go-forward)
  44     (define-key map [XF86Back] 'help-go-back)
  45     (define-key map [XF86Forward] 'help-go-forward)
  46     (define-key map "\C-c\C-c" 'help-follow-symbol)
  47     (define-key map "\r" 'help-follow)
  48     map)
  49   "Keymap for help mode.")
  50
  51 (easy-menu-define help-mode-menu help-mode-map
  52   "Menu for Help Mode."
  53   '("Help-Mode"
  54     ["Show Help for Symbol" help-follow-symbol
  55      :help "Show the docs for the symbol at point"]
  56     ["Previous Topic" help-go-back
  57      :help "Go back to previous topic in this help buffer"]
  58     ["Next Topic" help-go-forward
  59      :help "Go back to next topic in this help buffer"]
  60     ["Move to Previous Button" backward-button
  61      :help "Move to the Next Button in the help buffer"]
  62     ["Move to Next Button" forward-button
  63       :help "Move to the Next Button in the help buffer"]))
  64
  65 (defvar help-xref-stack nil
  66   "A stack of ways by which to return to help buffers after following xrefs.
  67 Used by `help-follow' and `help-xref-go-back'.
  68 An element looks like (POSITION FUNCTION ARGS...).
  69 To use the element, do (apply FUNCTION ARGS) then goto the point.")
  70 (put 'help-xref-stack 'permanent-local t)
  71 (make-variable-buffer-local 'help-xref-stack)
  72
  73 (defvar help-xref-forward-stack nil
  74   "A stack used to navigate help forwards after using the back button.
  75 Used by `help-follow' and `help-xref-go-forward'.
  76 An element looks like (POSITION FUNCTION ARGS...).
  77 To use the element, do (apply FUNCTION ARGS) then goto the point.")
  78 (put 'help-xref-forward-stack 'permanent-local t)
  79 (make-variable-buffer-local 'help-xref-forward-stack)
  80
  81 (defvar help-xref-stack-item nil
  82   "An item for `help-follow' in this buffer to push onto `help-xref-stack'.
  83 The format is (FUNCTION ARGS...).")
  84 (put 'help-xref-stack-item 'permanent-local t)
  85 (make-variable-buffer-local 'help-xref-stack-item)
  86
  87 (defvar help-xref-stack-forward-item nil
  88   "An item for `help-go-back' to push onto `help-xref-forward-stack'.
  89 The format is (FUNCTION ARGS...).")
  90 (put 'help-xref-stack-forward-item 'permanent-local t)
  91 (make-variable-buffer-local 'help-xref-stack-forward-item)
  92
  93 (setq-default help-xref-stack nil help-xref-stack-item nil)
  94 (setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
  95
  96 (defcustom help-mode-hook nil
  97   "Hook run by `help-mode'."
  98   :type 'hook
  99   :group 'help)
 100 \f
 101 ;; Button types used by help
 102
 103 (define-button-type 'help-xref
 104   'follow-link t
 105   'action #'help-button-action)
 106
 107 (defun help-button-action (button)
 108   "Call BUTTON's help function."
 109   (help-do-xref (button-start button)
 110                 (button-get button 'help-function)
 111                 (button-get button 'help-args)))
 112
 113 ;; These 6 calls to define-button-type were generated in a dolist
 114 ;; loop, but that is bad because it means these button types don't
 115 ;; have an easily found definition.
 116
 117 (define-button-type 'help-function
 118   :supertype 'help-xref
 119   'help-function 'describe-function
 120   'help-echo (purecopy "mouse-2, RET: describe this function"))
 121
 122 (define-button-type 'help-variable
 123   :supertype 'help-xref
 124   'help-function 'describe-variable
 125   'help-echo (purecopy "mouse-2, RET: describe this variable"))
 126
 127 (define-button-type 'help-face
 128   :supertype 'help-xref
 129   'help-function 'describe-face
 130   'help-echo (purecopy "mouse-2, RET: describe this face"))
 131
 132 (define-button-type 'help-coding-system
 133   :supertype 'help-xref
 134   'help-function 'describe-coding-system
 135   'help-echo (purecopy "mouse-2, RET: describe this coding system"))
 136
 137 (define-button-type 'help-input-method
 138   :supertype 'help-xref
 139   'help-function 'describe-input-method
 140   'help-echo (purecopy "mouse-2, RET: describe this input method"))
 141
 142 (define-button-type 'help-character-set
 143   :supertype 'help-xref
 144   'help-function 'describe-character-set
 145   'help-echo (purecopy "mouse-2, RET: describe this character set"))
 146
 147 ;; Make some more idiosyncratic button types.
 148
 149 (define-button-type 'help-symbol
 150   :supertype 'help-xref
 151   'help-function #'help-xref-interned
 152   'help-echo (purecopy "mouse-2, RET: describe this symbol"))
 153
 154 (define-button-type 'help-back
 155   :supertype 'help-xref
 156   'help-function #'help-xref-go-back
 157   'help-echo (purecopy "mouse-2, RET: go back to previous help buffer"))
 158
 159 (define-button-type 'help-forward
 160   :supertype 'help-xref
 161   'help-function #'help-xref-go-forward
 162   'help-echo (purecopy "mouse-2, RET: move forward to next help buffer"))
 163
 164 (define-button-type 'help-info-variable
 165   :supertype 'help-xref
 166   ;; the name of the variable is put before the argument to Info
 167   'help-function (lambda (_a v) (info v))
 168   'help-echo (purecopy "mouse-2, RET: read this Info node"))
 169
 170 (define-button-type 'help-info
 171   :supertype 'help-xref
 172   'help-function #'info
 173   'help-echo (purecopy "mouse-2, RET: read this Info node"))
 174
 175 (define-button-type 'help-url
 176   :supertype 'help-xref
 177   'help-function #'browse-url
 178   'help-echo (purecopy "mouse-2, RET: view this URL in a browser"))
 179
 180 (define-button-type 'help-customize-variable
 181   :supertype 'help-xref
 182   'help-function (lambda (v)
 183                    (customize-variable v))
 184   'help-echo (purecopy "mouse-2, RET: customize variable"))
 185
 186 (define-button-type 'help-customize-face
 187   :supertype 'help-xref
 188   'help-function (lambda (v)
 189                    (customize-face v))
 190   'help-echo (purecopy "mouse-2, RET: customize face"))
 191
 192 (define-button-type 'help-function-def
 193   :supertype 'help-xref
 194   'help-function (lambda (fun file &optional type)
 195                    (require 'find-func)
 196                    (when (eq file 'C-source)
 197                      (setq file
 198                            (help-C-file-name (indirect-function fun) 'fun)))
 199                    ;; Don't use find-function-noselect because it follows
 200                    ;; aliases (which fails for built-in functions).
 201                    (let ((location
 202                           (find-function-search-for-symbol fun type file)))
 203                      (pop-to-buffer (car location))
 204                      (if (cdr location)
 205                          (goto-char (cdr location))
 206                        (message "Unable to find location in file"))))
 207   'help-echo (purecopy "mouse-2, RET: find function's definition"))
 208
 209 (define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4.
 210   :supertype 'help-xref
 211   'help-function (lambda (fun file)
 212                    (setq file (locate-library file t))
 213                    (if (and file (file-readable-p file))
 214                        (progn
 215                          (pop-to-buffer (find-file-noselect file))
 216                          (goto-char (point-min))
 217                          (if (re-search-forward
 218                               (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"
 219                                       (regexp-quote (symbol-name fun))) nil t)
 220                              (forward-line 0)
 221                            (message "Unable to find location in file")))
 222                      (message "Unable to find file")))
 223   'help-echo (purecopy "mouse-2, RET: find function's compiler macro"))
 224
 225 (define-button-type 'help-variable-def
 226   :supertype 'help-xref
 227   'help-function (lambda (var &optional file)
 228                    (when (eq file 'C-source)
 229                      (setq file (help-C-file-name var 'var)))
 230                    (let ((location (find-variable-noselect var file)))
 231                      (pop-to-buffer (car location))
 232                      (if (cdr location)
 233                        (goto-char (cdr location))
 234                        (message "Unable to find location in file"))))
 235   'help-echo (purecopy "mouse-2, RET: find variable's definition"))
 236
 237 (define-button-type 'help-face-def
 238   :supertype 'help-xref
 239   'help-function (lambda (fun file)
 240                    (require 'find-func)
 241                    ;; Don't use find-function-noselect because it follows
 242                    ;; aliases (which fails for built-in functions).
 243                    (let ((location
 244                           (find-function-search-for-symbol fun 'defface file)))
 245                      (pop-to-buffer (car location))
 246                      (if (cdr location)
 247                          (goto-char (cdr location))
 248                        (message "Unable to find location in file"))))
 249   'help-echo (purecopy "mouse-2, RET: find face's definition"))
 250
 251 (define-button-type 'help-package
 252   :supertype 'help-xref
 253   'help-function 'describe-package
 254   'help-echo (purecopy "mouse-2, RET: Describe package"))
 255
 256 (define-button-type 'help-package-def
 257   :supertype 'help-xref
 258   'help-function (lambda (file) (dired file))
 259   'help-echo (purecopy "mouse-2, RET: visit package directory"))
 260
 261 (define-button-type 'help-theme-def
 262   :supertype 'help-xref
 263   'help-function 'find-file
 264   'help-echo (purecopy "mouse-2, RET: visit theme file"))
 265
 266 (define-button-type 'help-theme-edit
 267   :supertype 'help-xref
 268   'help-function 'customize-create-theme
 269   'help-echo (purecopy "mouse-2, RET: edit this theme file"))
 270
 271 (define-button-type 'help-dir-local-var-def
 272   :supertype 'help-xref
 273   'help-function (lambda (_var &optional file)
 274                    ;; FIXME: this should go to the point where the
 275                    ;; local variable was defined.
 276                    (find-file file))
 277   'help-echo (purecopy "mouse-2, RET: open directory-local variables file"))
 278
 279 \f
 280 (defvar bookmark-make-record-function)
 281
 282 ;;;###autoload
 283 (define-derived-mode help-mode special-mode "Help"
 284   "Major mode for viewing help text and navigating references in it.
 285 Entry to this mode runs the normal hook `help-mode-hook'.
 286 Commands:
 287 \\{help-mode-map}"
 288   (set (make-local-variable 'revert-buffer-function)
 289        'help-mode-revert-buffer)
 290   (set (make-local-variable 'bookmark-make-record-function)
 291        'help-bookmark-make-record))
 292
 293 ;;;###autoload
 294 (defun help-mode-setup ()
 295   (help-mode)
 296   (setq buffer-read-only nil))
 297
 298 ;;;###autoload
 299 (defun help-mode-finish ()
 300   (when (derived-mode-p 'help-mode)
 301     (setq buffer-read-only t)
 302     (help-make-xrefs (current-buffer))))
 303 \f
 304 ;; Grokking cross-reference information in doc strings and
 305 ;; hyperlinking it.
 306
 307 ;; This may have some scope for extension and the same or something
 308 ;; similar should be done for widget doc strings, which currently use
 309 ;; another mechanism.
 310
 311 (defvar help-back-label (purecopy "[back]")
 312   "Label to use by `help-make-xrefs' for the go-back reference.")
 313
 314 (defvar help-forward-label (purecopy "[forward]")
 315   "Label to use by `help-make-xrefs' for the go-forward reference.")
 316
 317 (defconst help-xref-symbol-regexp
 318   (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|"  ; Link to var
 319                     "\\(function\\|command\\|call\\)\\|"   ; Link to function
 320                     "\\(face\\)\\|"                        ; Link to face
 321                     "\\(symbol\\|program\\|property\\)\\|" ; Don't link
 322                     "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
 323                     "[ \t\n]+\\)?"
 324                     ;; Note starting with word-syntax character:
 325                     "[`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))
 326   "Regexp matching doc string references to symbols.
 327
 328 The words preceding the quoted symbol can be used in doc strings to
 329 distinguish references to variables, functions and symbols.")
 330
 331 (defvar help-xref-mule-regexp nil
 332   "Regexp matching doc string references to MULE-related keywords.
 333
 334 It is usually nil, and is temporarily bound to an appropriate regexp
 335 when help commands related to multilingual environment (e.g.,
 336 `describe-coding-system') are invoked.")
 337
 338
 339 (defconst help-xref-info-regexp
 340   (purecopy
 341    "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+[`‘]\\([^'’]+\\)['’]")
 342   "Regexp matching doc string references to an Info node.")
 343
 344 (defconst help-xref-url-regexp
 345   (purecopy "\\<[Uu][Rr][Ll][ \t\n]+[`‘]\\([^'’]+\\)['’]")
 346   "Regexp matching doc string references to a URL.")
 347
 348 ;;;###autoload
 349 (defun help-setup-xref (item interactive-p)
 350   "Invoked from commands using the \"*Help*\" buffer to install some xref info.
 351
 352 ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help
 353 buffer after following a reference.  INTERACTIVE-P is non-nil if the
 354 calling command was invoked interactively.  In this case the stack of
 355 items for help buffer \"back\" buttons is cleared.
 356
 357 This should be called very early, before the output buffer is cleared,
 358 because we want to record the \"previous\" position of point so we can
 359 restore it properly when going back."
 360   (with-current-buffer (help-buffer)
 361     (when help-xref-stack-item
 362       (push (cons (point) help-xref-stack-item) help-xref-stack)
 363       (setq help-xref-forward-stack nil))
 364     (when interactive-p
 365       (let ((tail (nthcdr 10 help-xref-stack)))
 366         ;; Truncate the stack.
 367         (if tail (setcdr tail nil))))
 368     (setq help-xref-stack-item item)))
 369
 370 (defvar help-xref-following nil
 371   "Non-nil when following a help cross-reference.")
 372
 373 ;;;###autoload
 374 (defun help-buffer ()
 375   "Return the name of a buffer for inserting help.
 376 If `help-xref-following' is non-nil, this is the name of the
 377 current buffer.  Signal an error if this buffer is not derived
 378 from `help-mode'.
 379 Otherwise, return \"*Help*\", creating a buffer with that name if
 380 it does not already exist."
 381   (buffer-name                          ;for with-output-to-temp-buffer
 382    (if (not help-xref-following)
 383        (get-buffer-create "*Help*")
 384      (unless (derived-mode-p 'help-mode)
 385        (error "Current buffer is not in Help mode"))
 386      (current-buffer))))
 387
 388 ;;;###autoload
 389 (defun help-make-xrefs (&optional buffer)
 390   "Parse and hyperlink documentation cross-references in the given BUFFER.
 391
 392 Find cross-reference information in a buffer and activate such cross
 393 references for selection with `help-follow'.  Cross-references have
 394 the canonical form `...'  and the type of reference may be
 395 disambiguated by the preceding word(s) used in
 396 `help-xref-symbol-regexp'.  Faces only get cross-referenced if
 397 preceded or followed by the word `face'.  Variables without
 398 variable documentation do not get cross-referenced, unless
 399 preceded by the word `variable' or `option'.
 400
 401 If the variable `help-xref-mule-regexp' is non-nil, find also
 402 cross-reference information related to multilingual environment
 403 \(e.g., coding-systems).  This variable is also used to disambiguate
 404 the type of reference as the same way as `help-xref-symbol-regexp'.
 405
 406 A special reference `back' is made to return back through a stack of
 407 help buffers.  Variable `help-back-label' specifies the text for
 408 that."
 409   (interactive "b")
 410   (with-current-buffer (or buffer (current-buffer))
 411     (save-excursion
 412       (goto-char (point-min))
 413       ;; Skip the header-type info, though it might be useful to parse
 414       ;; it at some stage (e.g. "function in `library'").
 415       (forward-paragraph)
 416       (let ((old-modified (buffer-modified-p)))
 417         (let ((stab (syntax-table))
 418               (case-fold-search t)
 419               (inhibit-read-only t))
 420           (set-syntax-table emacs-lisp-mode-syntax-table)
 421           ;; The following should probably be abstracted out.
 422           (unwind-protect
 423               (progn
 424                 ;; Info references
 425                 (save-excursion
 426                   (while (re-search-forward help-xref-info-regexp nil t)
 427                     (let ((data (match-string 2)))
 428                       (save-match-data
 429                         (unless (string-match "^([^)]+)" data)
 430                           (setq data (concat "(emacs)" data)))
 431                         (setq data ;; possible newlines if para filled
 432                               (replace-regexp-in-string "[ \t\n]+" " " data t t)))
 433                       (help-xref-button 2 'help-info data))))
 434                 ;; URLs
 435                 (save-excursion
 436                   (while (re-search-forward help-xref-url-regexp nil t)
 437                     (let ((data (match-string 1)))
 438                       (help-xref-button 1 'help-url data))))
 439                 ;; Mule related keywords.  Do this before trying
 440                 ;; `help-xref-symbol-regexp' because some of Mule
 441                 ;; keywords have variable or function definitions.
 442                 (if help-xref-mule-regexp
 443                     (save-excursion
 444                       (while (re-search-forward help-xref-mule-regexp nil t)
 445                         (let* ((data (match-string 7))
 446                                (sym (intern-soft data)))
 447                           (cond
 448                            ((match-string 3) ; coding system
 449                             (and sym (coding-system-p sym)
 450                                  (help-xref-button 6 'help-coding-system sym)))
 451                            ((match-string 4) ; input method
 452                             (and (assoc data input-method-alist)
 453                                  (help-xref-button 7 'help-input-method data)))
 454                            ((or (match-string 5) (match-string 6)) ; charset
 455                             (and sym (charsetp sym)
 456                                  (help-xref-button 7 'help-character-set sym)))
 457                            ((assoc data input-method-alist)
 458                             (help-xref-button 7 'help-character-set data))
 459                            ((and sym (coding-system-p sym))
 460                             (help-xref-button 7 'help-coding-system sym))
 461                            ((and sym (charsetp sym))
 462                             (help-xref-button 7 'help-character-set sym)))))))
 463                 ;; Quoted symbols
 464                 (save-excursion
 465                   (while (re-search-forward help-xref-symbol-regexp nil t)
 466                     (let* ((data (match-string 8))
 467                            (sym (intern-soft data)))
 468                       (if sym
 469                           (cond
 470                            ((match-string 3) ; `variable' &c
 471                             (and (or (boundp sym) ; `variable' doesn't ensure
 472                                         ; it's actually bound
 473                                      (get sym 'variable-documentation))
 474                                  (help-xref-button 8 'help-variable sym)))
 475                            ((match-string 4) ; `function' &c
 476                             (and (fboundp sym) ; similarly
 477                                  (help-xref-button 8 'help-function sym)))
 478                            ((match-string 5) ; `face'
 479                             (and (facep sym)
 480                                  (help-xref-button 8 'help-face sym)))
 481                            ((match-string 6)) ; nothing for `symbol'
 482                            ((match-string 7)
 483                             ;; this used:
 484                             ;; #'(lambda (arg)
 485                             ;;     (let ((location
 486                             ;;            (find-function-noselect arg)))
 487                             ;;       (pop-to-buffer (car location))
 488                             ;;  (goto-char (cdr location))))
 489                             (help-xref-button 8 'help-function-def sym))
 490                            ((and
 491                              (facep sym)
 492                              (save-match-data (looking-at "[ \t\n]+face\\W")))
 493                             (help-xref-button 8 'help-face sym))
 494                            ((and (or (boundp sym)
 495                                      (get sym 'variable-documentation))
 496                                  (fboundp sym))
 497                             ;; We can't intuit whether to use the
 498                             ;; variable or function doc -- supply both.
 499                             (help-xref-button 8 'help-symbol sym))
 500                            ((and
 501                              (or (boundp sym)
 502                                  (get sym 'variable-documentation))
 503                              (or
 504                               (documentation-property
 505                                sym 'variable-documentation)
 506                               (documentation-property
 507                                (indirect-variable sym)
 508                                'variable-documentation)))
 509                             (help-xref-button 8 'help-variable sym))
 510                            ((fboundp sym)
 511                             (help-xref-button 8 'help-function sym)))))))
 512                 ;; An obvious case of a key substitution:
 513                 (save-excursion
 514                   (while (re-search-forward
 515                           ;; Assume command name is only word and symbol
 516                           ;; characters to get things like `use M-x foo->bar'.
 517                           ;; Command required to end with word constituent
 518                           ;; to avoid `.' at end of a sentence.
 519                           "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
 520                     (let ((sym (intern-soft (match-string 1))))
 521                       (if (fboundp sym)
 522                           (help-xref-button 1 'help-function sym)))))
 523                 ;; Look for commands in whole keymap substitutions:
 524                 (save-excursion
 525                   ;; Make sure to find the first keymap.
 526                   (goto-char (point-min))
 527                   ;; Find a header and the column at which the command
 528                   ;; name will be found.
 529
 530                   ;; If the keymap substitution isn't the last thing in
 531                   ;; the doc string, and if there is anything on the same
 532                   ;; line after it, this code won't recognize the end of it.
 533                   (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
 534                                             nil t)
 535                     (let ((col (- (match-end 1) (match-beginning 1))))
 536                       (while
 537                           (and (not (eobp))
 538                                ;; Stop at a pair of blank lines.
 539                                (not (looking-at-p "\n\\s-*\n")))
 540                         ;; Skip a single blank line.
 541                         (and (eolp) (forward-line))
 542                         (end-of-line)
 543                         (skip-chars-backward "^ \t\n")
 544                         (if (and (>= (current-column) col)
 545                                  (looking-at "\\(\\sw\\|\\s_\\)+$"))
 546                             (let ((sym (intern-soft (match-string 0))))
 547                               (if (fboundp sym)
 548                                   (help-xref-button 0 'help-function sym))))
 549                         (forward-line))))))
 550             (set-syntax-table stab))
 551           ;; Delete extraneous newlines at the end of the docstring
 552           (goto-char (point-max))
 553           (while (and (not (bobp)) (bolp))
 554             (delete-char -1))
 555           (insert "\n")
 556           (when (or help-xref-stack help-xref-forward-stack)
 557             (insert "\n"))
 558           ;; Make a back-reference in this buffer if appropriate.
 559           (when help-xref-stack
 560             (help-insert-xref-button help-back-label 'help-back
 561                                      (current-buffer)))
 562           ;; Make a forward-reference in this buffer if appropriate.
 563           (when help-xref-forward-stack
 564             (when help-xref-stack
 565               (insert "\t"))
 566             (help-insert-xref-button help-forward-label 'help-forward
 567                                      (current-buffer)))
 568           (when (or help-xref-stack help-xref-forward-stack)
 569             (insert "\n")))
 570         (set-buffer-modified-p old-modified)))))
 571
 572 ;;;###autoload
 573 (defun help-xref-button (match-number type &rest args)
 574   "Make a hyperlink for cross-reference text previously matched.
 575 MATCH-NUMBER is the subexpression of interest in the last matched
 576 regexp.  TYPE is the type of button to use.  Any remaining arguments are
 577 passed to the button's help-function when it is invoked.
 578 See `help-make-xrefs'."
 579   ;; Don't mung properties we've added specially in some instances.
 580   (unless (button-at (match-beginning match-number))
 581     (make-text-button (match-beginning match-number)
 582                       (match-end match-number)
 583                       'type type 'help-args args)))
 584
 585 ;;;###autoload
 586 (defun help-insert-xref-button (string type &rest args)
 587   "Insert STRING and make a hyperlink from cross-reference text on it.
 588 TYPE is the type of button to use.  Any remaining arguments are passed
 589 to the button's help-function when it is invoked.
 590 See `help-make-xrefs'."
 591   (unless (button-at (point))
 592     (insert-text-button string 'type type 'help-args args)))
 593
 594 ;;;###autoload
 595 (defun help-xref-on-pp (from to)
 596   "Add xrefs for symbols in `pp's output between FROM and TO."
 597   (if (> (- to from) 5000) nil
 598     (with-syntax-table emacs-lisp-mode-syntax-table
 599       (save-excursion
 600         (save-restriction
 601           (narrow-to-region from to)
 602           (goto-char (point-min))
 603           (ignore-errors
 604             (while (not (eobp))
 605               (cond
 606                ((looking-at-p "\"") (forward-sexp 1))
 607                ((looking-at-p "#<") (search-forward ">" nil 'move))
 608                ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
 609                 (let* ((sym (intern-soft (match-string 1)))
 610                        (type (cond ((fboundp sym) 'help-function)
 611                                    ((or (memq sym '(t nil))
 612                                         (keywordp sym))
 613                                     nil)
 614                                    ((and sym
 615                                          (or (boundp sym)
 616                                              (get sym
 617                                                   'variable-documentation)))
 618                                     'help-variable))))
 619                   (when type (help-xref-button 1 type sym)))
 620                 (goto-char (match-end 1)))
 621                (t (forward-char 1))))))))))
 622
 623 \f
 624 ;; Additional functions for (re-)creating types of help buffers.
 625
 626 ;;;###autoload
 627 (defun help-xref-interned (symbol &optional buffer frame)
 628   "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
 629 Both variable, function and face documentation are extracted into a single
 630 help buffer. If SYMBOL is a variable, include buffer-local value for optional
 631 BUFFER or FRAME."
 632   (with-current-buffer (help-buffer)
 633     ;; Push the previous item on the stack before clobbering the output buffer.
 634     (help-setup-xref nil nil)
 635     (let ((facedoc (when (facep symbol)
 636                      ;; Don't record the current entry in the stack.
 637                      (setq help-xref-stack-item nil)
 638                      (describe-face symbol)))
 639           (fdoc (when (fboundp symbol)
 640                   ;; Don't record the current entry in the stack.
 641                   (setq help-xref-stack-item nil)
 642                   (describe-function symbol)))
 643           (sdoc (when (or (boundp symbol)
 644                           (get symbol 'variable-documentation))
 645                   ;; Don't record the current entry in the stack.
 646                   (setq help-xref-stack-item nil)
 647                   (describe-variable symbol buffer frame))))
 648       (cond
 649        (sdoc
 650         ;; We now have a help buffer on the variable.
 651         ;; Insert the function and face text before it.
 652         (when (or fdoc facedoc)
 653           (goto-char (point-min))
 654           (let ((inhibit-read-only t))
 655             (when fdoc
 656               (insert fdoc "\n\n")
 657               (when facedoc
 658                 (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
 659                         " is also a " "face." "\n\n")))
 660             (when facedoc
 661               (insert facedoc "\n\n"))
 662             (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
 663                     " is also a " "variable." "\n\n"))
 664           ;; Don't record the `describe-variable' item in the stack.
 665           (setq help-xref-stack-item nil)
 666           (help-setup-xref (list #'help-xref-interned symbol) nil)))
 667        (fdoc
 668         ;; We now have a help buffer on the function.
 669         ;; Insert face text before it.
 670         (when facedoc
 671           (goto-char (point-max))
 672           (let ((inhibit-read-only t))
 673             (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol)
 674                     " is also a " "face." "\n\n" facedoc))
 675           ;; Don't record the `describe-function' item in the stack.
 676           (setq help-xref-stack-item nil)
 677           (help-setup-xref (list #'help-xref-interned symbol) nil))))
 678       (goto-char (point-min)))))
 679
 680 \f
 681 ;; Navigation/hyperlinking with xrefs
 682
 683 (defun help-xref-go-back (buffer)
 684   "From BUFFER, go back to previous help buffer text using `help-xref-stack'."
 685   (let (item position method args)
 686     (with-current-buffer buffer
 687       (push (cons (point) help-xref-stack-item) help-xref-forward-stack)
 688       (when help-xref-stack
 689         (setq item (pop help-xref-stack)
 690               ;; Clear the current item so that it won't get pushed
 691               ;; by the function we're about to call.  TODO: We could also
 692               ;; push it onto a "forward" stack and add a `forw' button.
 693               help-xref-stack-item nil
 694               position (car item)
 695               method (cadr item)
 696               args (cddr item))))
 697     (apply method args)
 698     (with-current-buffer buffer
 699       (if (get-buffer-window buffer)
 700           (set-window-point (get-buffer-window buffer) position)
 701         (goto-char position)))))
 702
 703 (defun help-xref-go-forward (buffer)
 704   "From BUFFER, go forward to next help buffer."
 705   (let (item position method args)
 706     (with-current-buffer buffer
 707       (push (cons (point) help-xref-stack-item) help-xref-stack)
 708       (when help-xref-forward-stack
 709         (setq item (pop help-xref-forward-stack)
 710               ;; Clear the current item so that it won't get pushed
 711               ;; by the function we're about to call.  TODO: We could also
 712               ;; push it onto a "forward" stack and add a `forw' button.
 713               help-xref-stack-item nil
 714               position (car item)
 715               method (cadr item)
 716               args (cddr item))))
 717     (apply method args)
 718     (with-current-buffer buffer
 719       (if (get-buffer-window buffer)
 720           (set-window-point (get-buffer-window buffer) position)
 721         (goto-char position)))))
 722
 723 (defun help-go-back ()
 724   "Go back to previous topic in this help buffer."
 725   (interactive)
 726   (if help-xref-stack
 727       (help-xref-go-back (current-buffer))
 728     (user-error "No previous help buffer")))
 729
 730 (defun help-go-forward ()
 731   "Go to the next topic in this help buffer."
 732   (interactive)
 733   (if help-xref-forward-stack
 734       (help-xref-go-forward (current-buffer))
 735     (user-error "No next help buffer")))
 736
 737 (defun help-do-xref (_pos function args)
 738   "Call the help cross-reference function FUNCTION with args ARGS.
 739 Things are set up properly so that the resulting help-buffer has
 740 a proper [back] button."
 741   ;; There is a reference at point.  Follow it.
 742   (let ((help-xref-following t))
 743     (apply function (if (eq function 'info)
 744                         (append args (list (generate-new-buffer-name "*info*"))) args))))
 745
 746 ;; The doc string is meant to explain what buttons do.
 747 (defun help-follow-mouse ()
 748   "Follow the cross-reference that you click on."
 749   (interactive)
 750   (error "No cross-reference here"))
 751
 752 ;; The doc string is meant to explain what buttons do.
 753 (defun help-follow ()
 754   "Follow cross-reference at point.
 755
 756 For the cross-reference format, see `help-make-xrefs'."
 757   (interactive)
 758   (user-error "No cross-reference here"))
 759
 760 (defun help-follow-symbol (&optional pos)
 761   "In help buffer, show docs for symbol at POS, defaulting to point.
 762 Show all docs for that symbol as either a variable, function or face."
 763   (interactive "d")
 764   (unless pos
 765     (setq pos (point)))
 766   ;; check if the symbol under point is a function, variable or face
 767   (let ((sym
 768          (intern
 769           (save-excursion
 770             (goto-char pos) (skip-syntax-backward "w_")
 771             (buffer-substring (point)
 772                               (progn (skip-syntax-forward "w_")
 773                                      (point)))))))
 774     (when (or (boundp sym)
 775               (get sym 'variable-documentation)
 776               (fboundp sym) (facep sym))
 777       (help-do-xref pos #'help-xref-interned (list sym)))))
 778
 779 (defun help-mode-revert-buffer (_ignore-auto noconfirm)
 780   (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
 781     (let ((pos (point))
 782           (item help-xref-stack-item)
 783           ;; Pretend there is no current item to add to the history.
 784           (help-xref-stack-item nil)
 785           ;; Use the current buffer.
 786           (help-xref-following t))
 787       (apply (car item) (cdr item))
 788       (goto-char pos))))
 789
 790 (defun help-insert-string (string)
 791   "Insert STRING to the help buffer and install xref info for it.
 792 This function can be used to restore the old contents of the help buffer
 793 when going back to the previous topic in the xref stack.  It is needed
 794 in case when it is impossible to recompute the old contents of the
 795 help buffer by other means."
 796   (setq help-xref-stack-item (list #'help-insert-string string))
 797   (with-output-to-temp-buffer (help-buffer)
 798     (insert string)))
 799
 800 \f
 801 ;; Bookmark support
 802
 803 (declare-function bookmark-prop-get "bookmark" (bookmark prop))
 804 (declare-function bookmark-make-record-default "bookmark"
 805                   (&optional no-file no-context posn))
 806
 807 (defun help-bookmark-make-record ()
 808   "Create and return a help-mode bookmark record.
 809 Implements `bookmark-make-record-function' for help-mode buffers."
 810   (unless (car help-xref-stack-item)
 811     (error "Cannot create bookmark - help command not known"))
 812   `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
 813       (help-fn     . ,(car help-xref-stack-item))
 814       (help-args   . ,(cdr help-xref-stack-item))
 815       (position    . ,(point))
 816       (handler     . help-bookmark-jump)))
 817
 818 ;;;###autoload
 819 (defun help-bookmark-jump (bookmark)
 820   "Jump to help-mode bookmark BOOKMARK.
 821 Handler function for record returned by `help-bookmark-make-record'.
 822 BOOKMARK is a bookmark name or a bookmark record."
 823   (let ((help-fn    (bookmark-prop-get bookmark 'help-fn))
 824         (help-args  (bookmark-prop-get bookmark 'help-args))
 825         (position   (bookmark-prop-get bookmark 'position)))
 826     (apply help-fn help-args)
 827     (pop-to-buffer "*Help*")
 828     (goto-char position)))
 829
 830
 831 (provide 'help-mode)
 832
 833 ;;; help-mode.el ends here