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