lisp/help-mode.el

   1 ;;; help-mode.el --- `help-mode' used by *Help* buffers
   2
   3 ;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software
   4 ;; Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   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)
 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 nil 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 "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+`\\([^']+\\)'")
 341   "Regexp matching doc string references to an Info node.")
 342
 343 (defconst help-xref-url-regexp
 344   (purecopy "\\<[Uu][Rr][Ll][ \t\n]+`\\([^']+\\)'")
 345   "Regexp matching doc string references to a URL.")
 346
 347 ;;;###autoload
 348 (defun help-setup-xref (item interactive-p)
 349   "Invoked from commands using the \"*Help*\" buffer to install some xref info.
 350
 351 ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help
 352 buffer after following a reference.  INTERACTIVE-P is non-nil if the
 353 calling command was invoked interactively.  In this case the stack of
 354 items for help buffer \"back\" buttons is cleared.
 355
 356 This should be called very early, before the output buffer is cleared,
 357 because we want to record the \"previous\" position of point so we can
 358 restore it properly when going back."
 359   (with-current-buffer (help-buffer)
 360     (when help-xref-stack-item
 361       (push (cons (point) help-xref-stack-item) help-xref-stack)
 362       (setq help-xref-forward-stack nil))
 363     (when interactive-p
 364       (let ((tail (nthcdr 10 help-xref-stack)))
 365         ;; Truncate the stack.
 366         (if tail (setcdr tail nil))))
 367     (setq help-xref-stack-item item)))
 368
 369 (defvar help-xref-following nil
 370   "Non-nil when following a help cross-reference.")
 371
 372 ;;;###autoload
 373 (defun help-buffer ()
 374   "Return the name of a buffer for inserting help.
 375 If `help-xref-following' is non-nil, this is the name of the
 376 current buffer.  Signal an error if this buffer is not derived
 377 from `help-mode'.
 378 Otherwise, return \"*Help*\", creating a buffer with that name if
 379 it does not already exist."
 380   (buffer-name                          ;for with-output-to-temp-buffer
 381    (if (not help-xref-following)
 382        (get-buffer-create "*Help*")
 383      (unless (derived-mode-p 'help-mode)
 384        (error "Current buffer is not in Help mode"))
 385      (current-buffer))))
 386
 387 ;;;###autoload
 388 (defun help-make-xrefs (&optional buffer)
 389   "Parse and hyperlink documentation cross-references in the given BUFFER.
 390
 391 Find cross-reference information in a buffer and activate such cross
 392 references for selection with `help-follow'.  Cross-references have
 393 the canonical form `...'  and the type of reference may be
 394 disambiguated by the preceding word(s) used in
 395 `help-xref-symbol-regexp'.  Faces only get cross-referenced if
 396 preceded or followed by the word `face'.  Variables without
 397 variable documentation do not get cross-referenced, unless
 398 preceded by the word `variable' or `option'.
 399
 400 If the variable `help-xref-mule-regexp' is non-nil, find also
 401 cross-reference information related to multilingual environment
 402 \(e.g., coding-systems).  This variable is also used to disambiguate
 403 the type of reference as the same way as `help-xref-symbol-regexp'.
 404
 405 A special reference `back' is made to return back through a stack of
 406 help buffers.  Variable `help-back-label' specifies the text for
 407 that."
 408   (interactive "b")
 409   (with-current-buffer (or buffer (current-buffer))
 410     (save-excursion
 411       (goto-char (point-min))
 412       ;; Skip the header-type info, though it might be useful to parse
 413       ;; it at some stage (e.g. "function in `library'").
 414       (forward-paragraph)
 415       (let ((old-modified (buffer-modified-p)))
 416         (let ((stab (syntax-table))
 417               (case-fold-search t)
 418               (inhibit-read-only t))
 419           (set-syntax-table emacs-lisp-mode-syntax-table)
 420           ;; The following should probably be abstracted out.
 421           (unwind-protect
 422               (progn
 423                 ;; Info references
 424                 (save-excursion
 425                   (while (re-search-forward help-xref-info-regexp nil t)
 426                     (let ((data (match-string 2)))
 427                       (save-match-data
 428                         (unless (string-match "^([^)]+)" data)
 429                           (setq data (concat "(emacs)" data)))
 430                         (setq data ;; possible newlines if para filled
 431                               (replace-regexp-in-string "[ \t\n]+" " " data t t)))
 432                       (help-xref-button 2 'help-info data))))
 433                 ;; URLs
 434                 (save-excursion
 435                   (while (re-search-forward help-xref-url-regexp nil t)
 436                     (let ((data (match-string 1)))
 437                       (help-xref-button 1 'help-url data))))
 438                 ;; Mule related keywords.  Do this before trying
 439                 ;; `help-xref-symbol-regexp' because some of Mule
 440                 ;; keywords have variable or function definitions.
 441                 (if help-xref-mule-regexp
 442                     (save-excursion
 443                       (while (re-search-forward help-xref-mule-regexp nil t)
 444                         (let* ((data (match-string 7))
 445                                (sym (intern-soft data)))
 446                           (cond
 447                            ((match-string 3) ; coding system
 448                             (and sym (coding-system-p sym)
 449                                  (help-xref-button 6 'help-coding-system sym)))
 450                            ((match-string 4) ; input method
 451                             (and (assoc data input-method-alist)
 452                                  (help-xref-button 7 'help-input-method data)))
 453                            ((or (match-string 5) (match-string 6)) ; charset
 454                             (and sym (charsetp sym)
 455                                  (help-xref-button 7 'help-character-set sym)))
 456                            ((assoc data input-method-alist)
 457                             (help-xref-button 7 'help-character-set data))
 458                            ((and sym (coding-system-p sym))
 459                             (help-xref-button 7 'help-coding-system sym))
 460                            ((and sym (charsetp sym))
 461                             (help-xref-button 7 'help-character-set sym)))))))
 462                 ;; Quoted symbols
 463                 (save-excursion
 464                   (while (re-search-forward help-xref-symbol-regexp nil t)
 465                     (let* ((data (match-string 8))
 466                            (sym (intern-soft data)))
 467                       (if sym
 468                           (cond
 469                            ((match-string 3) ; `variable' &c
 470                             (and (or (boundp sym) ; `variable' doesn't ensure
 471                                         ; it's actually bound
 472                                      (get sym 'variable-documentation))
 473                                  (help-xref-button 8 'help-variable sym)))
 474                            ((match-string 4) ; `function' &c
 475                             (and (fboundp sym) ; similarly
 476                                  (help-xref-button 8 'help-function sym)))
 477                            ((match-string 5) ; `face'
 478                             (and (facep sym)
 479                                  (help-xref-button 8 'help-face sym)))
 480                            ((match-string 6)) ; nothing for `symbol'
 481                            ((match-string 7)
 482                             ;; this used:
 483                             ;; #'(lambda (arg)
 484                             ;;     (let ((location
 485                             ;;            (find-function-noselect arg)))
 486                             ;;       (pop-to-buffer (car location))
 487                             ;;  (goto-char (cdr location))))
 488                             (help-xref-button 8 'help-function-def sym))
 489                            ((and
 490                              (facep sym)
 491                              (save-match-data (looking-at "[ \t\n]+face\\W")))
 492                             (help-xref-button 8 'help-face sym))
 493                            ((and (or (boundp sym)
 494                                      (get sym 'variable-documentation))
 495                                  (fboundp sym))
 496                             ;; We can't intuit whether to use the
 497                             ;; variable or function doc -- supply both.
 498                             (help-xref-button 8 'help-symbol sym))
 499                            ((and
 500                              (or (boundp sym)
 501                                  (get sym 'variable-documentation))
 502                              (or
 503                               (documentation-property
 504                                sym 'variable-documentation)
 505                               (documentation-property
 506                                (indirect-variable sym)
 507                                'variable-documentation)))
 508                             (help-xref-button 8 'help-variable sym))
 509                            ((fboundp sym)
 510                             (help-xref-button 8 'help-function sym)))))))
 511                 ;; An obvious case of a key substitution:
 512                 (save-excursion
 513                   (while (re-search-forward
 514                           ;; Assume command name is only word and symbol
 515                           ;; characters to get things like `use M-x foo->bar'.
 516                           ;; Command required to end with word constituent
 517                           ;; to avoid `.' at end of a sentence.
 518                           "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
 519                     (let ((sym (intern-soft (match-string 1))))
 520                       (if (fboundp sym)
 521                           (help-xref-button 1 'help-function sym)))))
 522                 ;; Look for commands in whole keymap substitutions:
 523                 (save-excursion
 524                   ;; Make sure to find the first keymap.
 525                   (goto-char (point-min))
 526                   ;; Find a header and the column at which the command
 527                   ;; name will be found.
 528
 529                   ;; If the keymap substitution isn't the last thing in
 530                   ;; the doc string, and if there is anything on the same
 531                   ;; line after it, this code won't recognize the end of it.
 532                   (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
 533                                             nil t)
 534                     (let ((col (- (match-end 1) (match-beginning 1))))
 535                       (while
 536                           (and (not (eobp))
 537                                ;; Stop at a pair of blank lines.
 538                                (not (looking-at-p "\n\\s-*\n")))
 539                         ;; Skip a single blank line.
 540                         (and (eolp) (forward-line))
 541                         (end-of-line)
 542                         (skip-chars-backward "^ \t\n")
 543                         (if (and (>= (current-column) col)
 544                                  (looking-at "\\(\\sw\\|\\s_\\)+$"))
 545                             (let ((sym (intern-soft (match-string 0))))
 546                               (if (fboundp sym)
 547                                   (help-xref-button 0 'help-function sym))))
 548                         (forward-line))))))
 549             (set-syntax-table stab))
 550           ;; Delete extraneous newlines at the end of the docstring
 551           (goto-char (point-max))
 552           (while (and (not (bobp)) (bolp))
 553             (delete-char -1))
 554           (insert "\n")
 555           (when (or help-xref-stack help-xref-forward-stack)
 556             (insert "\n"))
 557           ;; Make a back-reference in this buffer if appropriate.
 558           (when help-xref-stack
 559             (help-insert-xref-button help-back-label 'help-back
 560                                      (current-buffer)))
 561           ;; Make a forward-reference in this buffer if appropriate.
 562           (when help-xref-forward-stack
 563             (when help-xref-stack
 564               (insert "\t"))
 565             (help-insert-xref-button help-forward-label 'help-forward
 566                                      (current-buffer)))
 567           (when (or help-xref-stack help-xref-forward-stack)
 568             (insert "\n")))
 569         (set-buffer-modified-p old-modified)))))
 570
 571 ;;;###autoload
 572 (defun help-xref-button (match-number type &rest args)
 573   "Make a hyperlink for cross-reference text previously matched.
 574 MATCH-NUMBER is the subexpression of interest in the last matched
 575 regexp.  TYPE is the type of button to use.  Any remaining arguments are
 576 passed to the button's help-function when it is invoked.
 577 See `help-make-xrefs'."
 578   ;; Don't mung properties we've added specially in some instances.
 579   (unless (button-at (match-beginning match-number))
 580     (make-text-button (match-beginning match-number)
 581                       (match-end match-number)
 582                       'type type 'help-args args)))
 583
 584 ;;;###autoload
 585 (defun help-insert-xref-button (string type &rest args)
 586   "Insert STRING and make a hyperlink from cross-reference text on it.
 587 TYPE is the type of button to use.  Any remaining arguments are passed
 588 to the button's help-function when it is invoked.
 589 See `help-make-xrefs'."
 590   (unless (button-at (point))
 591     (insert-text-button string 'type type 'help-args args)))
 592
 593 ;;;###autoload
 594 (defun help-xref-on-pp (from to)
 595   "Add xrefs for symbols in `pp's output between FROM and TO."
 596   (if (> (- to from) 5000) nil
 597     (with-syntax-table emacs-lisp-mode-syntax-table
 598       (save-excursion
 599         (save-restriction
 600           (narrow-to-region from to)
 601           (goto-char (point-min))
 602           (ignore-errors
 603             (while (not (eobp))
 604               (cond
 605                ((looking-at-p "\"") (forward-sexp 1))
 606                ((looking-at-p "#<") (search-forward ">" nil 'move))
 607                ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
 608                 (let* ((sym (intern-soft (match-string 1)))
 609                        (type (cond ((fboundp sym) 'help-function)
 610                                    ((or (memq sym '(t nil))
 611                                         (keywordp sym))
 612                                     nil)
 613                                    ((and sym
 614                                          (or (boundp sym)
 615                                              (get sym
 616                                                   'variable-documentation)))
 617                                     'help-variable))))
 618                   (when type (help-xref-button 1 type sym)))
 619                 (goto-char (match-end 1)))
 620                (t (forward-char 1))))))))))
 621
 622 \f
 623 ;; Additional functions for (re-)creating types of help buffers.
 624 (defun help-xref-interned (symbol)
 625   "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
 626 Both variable, function and face documentation are extracted into a single
 627 help buffer."
 628   (with-current-buffer (help-buffer)
 629     ;; Push the previous item on the stack before clobbering the output buffer.
 630     (help-setup-xref nil nil)
 631     (let ((facedoc (when (facep symbol)
 632                      ;; Don't record the current entry in the stack.
 633                      (setq help-xref-stack-item nil)
 634                      (describe-face symbol)))
 635           (fdoc (when (fboundp symbol)
 636                   ;; Don't record the current entry in the stack.
 637                   (setq help-xref-stack-item nil)
 638                   (describe-function symbol)))
 639           (sdoc (when (or (boundp symbol)
 640                           (get symbol 'variable-documentation))
 641                   ;; Don't record the current entry in the stack.
 642                   (setq help-xref-stack-item nil)
 643                   (describe-variable symbol))))
 644       (cond
 645        (sdoc
 646         ;; We now have a help buffer on the variable.
 647         ;; Insert the function and face text before it.
 648         (when (or fdoc facedoc)
 649           (goto-char (point-min))
 650           (let ((inhibit-read-only t))
 651             (when fdoc
 652               (insert fdoc "\n\n")
 653               (when facedoc
 654                 (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
 655                         " is also a " "face." "\n\n")))
 656             (when facedoc
 657               (insert facedoc "\n\n"))
 658             (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
 659                     " is also a " "variable." "\n\n"))
 660           ;; Don't record the `describe-variable' item in the stack.
 661           (setq help-xref-stack-item nil)
 662           (help-setup-xref (list #'help-xref-interned symbol) nil)))
 663        (fdoc
 664         ;; We now have a help buffer on the function.
 665         ;; Insert face text before it.
 666         (when facedoc
 667           (goto-char (point-max))
 668           (let ((inhibit-read-only t))
 669             (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol)
 670                     " is also a " "face." "\n\n" facedoc))
 671           ;; Don't record the `describe-function' item in the stack.
 672           (setq help-xref-stack-item nil)
 673           (help-setup-xref (list #'help-xref-interned symbol) nil))))
 674       (goto-char (point-min)))))
 675
 676 \f
 677 ;; Navigation/hyperlinking with xrefs
 678
 679 (defun help-xref-go-back (buffer)
 680   "From BUFFER, go back to previous help buffer text using `help-xref-stack'."
 681   (let (item position method args)
 682     (with-current-buffer buffer
 683       (push (cons (point) help-xref-stack-item) help-xref-forward-stack)
 684       (when help-xref-stack
 685         (setq item (pop help-xref-stack)
 686               ;; Clear the current item so that it won't get pushed
 687               ;; by the function we're about to call.  TODO: We could also
 688               ;; push it onto a "forward" stack and add a `forw' button.
 689               help-xref-stack-item nil
 690               position (car item)
 691               method (cadr item)
 692               args (cddr item))))
 693     (apply method args)
 694     (with-current-buffer buffer
 695       (if (get-buffer-window buffer)
 696           (set-window-point (get-buffer-window buffer) position)
 697         (goto-char position)))))
 698
 699 (defun help-xref-go-forward (buffer)
 700   "From BUFFER, go forward to next help buffer."
 701   (let (item position method args)
 702     (with-current-buffer buffer
 703       (push (cons (point) help-xref-stack-item) help-xref-stack)
 704       (when help-xref-forward-stack
 705         (setq item (pop help-xref-forward-stack)
 706               ;; Clear the current item so that it won't get pushed
 707               ;; by the function we're about to call.  TODO: We could also
 708               ;; push it onto a "forward" stack and add a `forw' button.
 709               help-xref-stack-item nil
 710               position (car item)
 711               method (cadr item)
 712               args (cddr item))))
 713     (apply method args)
 714     (with-current-buffer buffer
 715       (if (get-buffer-window buffer)
 716           (set-window-point (get-buffer-window buffer) position)
 717         (goto-char position)))))
 718
 719 (defun help-go-back ()
 720   "Go back to previous topic in this help buffer."
 721   (interactive)
 722   (if help-xref-stack
 723       (help-xref-go-back (current-buffer))
 724     (error "No previous help buffer")))
 725
 726 (defun help-go-forward ()
 727   "Go back to next topic in this help buffer."
 728   (interactive)
 729   (if help-xref-forward-stack
 730       (help-xref-go-forward (current-buffer))
 731     (error "No next help buffer")))
 732
 733 (defun help-do-xref (_pos function args)
 734   "Call the help cross-reference function FUNCTION with args ARGS.
 735 Things are set up properly so that the resulting help-buffer has
 736 a proper [back] button."
 737   ;; There is a reference at point.  Follow it.
 738   (let ((help-xref-following t))
 739     (apply function args)))
 740
 741 ;; The doc string is meant to explain what buttons do.
 742 (defun help-follow-mouse ()
 743   "Follow the cross-reference that you click on."
 744   (interactive)
 745   (error "No cross-reference here"))
 746
 747 ;; The doc string is meant to explain what buttons do.
 748 (defun help-follow ()
 749   "Follow cross-reference at point.
 750
 751 For the cross-reference format, see `help-make-xrefs'."
 752   (interactive)
 753   (error "No cross-reference here"))
 754
 755 (defun help-follow-symbol (&optional pos)
 756   "In help buffer, show docs for symbol at POS, defaulting to point.
 757 Show all docs for that symbol as either a variable, function or face."
 758   (interactive "d")
 759   (unless pos
 760     (setq pos (point)))
 761   ;; check if the symbol under point is a function, variable or face
 762   (let ((sym
 763          (intern
 764           (save-excursion
 765             (goto-char pos) (skip-syntax-backward "w_")
 766             (buffer-substring (point)
 767                               (progn (skip-syntax-forward "w_")
 768                                      (point)))))))
 769     (when (or (boundp sym)
 770               (get sym 'variable-documentation)
 771               (fboundp sym) (facep sym))
 772       (help-do-xref pos #'help-xref-interned (list sym)))))
 773
 774 (defun help-mode-revert-buffer (_ignore-auto noconfirm)
 775   (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
 776     (let ((pos (point))
 777           (item help-xref-stack-item)
 778           ;; Pretend there is no current item to add to the history.
 779           (help-xref-stack-item nil)
 780           ;; Use the current buffer.
 781           (help-xref-following t))
 782       (apply (car item) (cdr item))
 783       (goto-char pos))))
 784
 785 (defun help-insert-string (string)
 786   "Insert STRING to the help buffer and install xref info for it.
 787 This function can be used to restore the old contents of the help buffer
 788 when going back to the previous topic in the xref stack.  It is needed
 789 in case when it is impossible to recompute the old contents of the
 790 help buffer by other means."
 791   (setq help-xref-stack-item (list #'help-insert-string string))
 792   (with-output-to-temp-buffer (help-buffer)
 793     (insert string)))
 794
 795 \f
 796 ;; Bookmark support
 797
 798 (declare-function bookmark-prop-get "bookmark" (bookmark prop))
 799 (declare-function bookmark-make-record-default "bookmark"
 800                   (&optional no-file no-context posn))
 801
 802 (defun help-bookmark-make-record ()
 803   "Create and return a help-mode bookmark record.
 804 Implements `bookmark-make-record-function' for help-mode buffers."
 805   (unless (car help-xref-stack-item)
 806     (error "Cannot create bookmark - help command not known"))
 807   `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
 808       (help-fn     . ,(car help-xref-stack-item))
 809       (help-args   . ,(cdr help-xref-stack-item))
 810       (position    . ,(point))
 811       (handler     . help-bookmark-jump)))
 812
 813 ;;;###autoload
 814 (defun help-bookmark-jump (bookmark)
 815   "Jump to help-mode bookmark BOOKMARK.
 816 Handler function for record returned by `help-bookmark-make-record'.
 817 BOOKMARK is a bookmark name or a bookmark record."
 818   (let ((help-fn    (bookmark-prop-get bookmark 'help-fn))
 819         (help-args  (bookmark-prop-get bookmark 'help-args))
 820         (position   (bookmark-prop-get bookmark 'position)))
 821     (apply help-fn help-args)
 822     (pop-to-buffer "*Help*")
 823     (goto-char position)))
 824
 825
 826 (provide 'help-mode)
 827
 828 ;;; help-mode.el ends here