LCOV - code coverage report
Current view: top level - lisp - help-mode.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 233 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 23 0.0 %

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

Generated by: LCOV version 1.12