1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-23 10:34:07 +00:00

New file, contents mostly from `help.el'.

This commit is contained in:
Miles Bader 2001-10-09 11:16:25 +00:00
parent 44e75f509b
commit f4ed5b197e

511
lisp/help-mode.el Normal file
View File

@ -0,0 +1,511 @@
;;; help-mode.el --- `help-mode' used by *Help* buffers
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Defines `help-mode', which is the mode used by *Help* buffers, and
;; associated support machinery, such as adding hyperlinks, etc.,
;;; Code:
(require 'button)
(eval-when-compile (require 'view))
(defvar help-mode-map (make-sparse-keymap)
"Keymap for help mode.")
(set-keymap-parent help-mode-map button-buffer-map)
(define-key help-mode-map "\C-c\C-b" 'help-go-back)
(define-key help-mode-map "\C-c\C-c" 'help-follow)
;; Documentation only, since we use minor-mode-overriding-map-alist.
(define-key help-mode-map "\r" 'help-follow)
(defvar help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
Used by `help-follow' and `help-xref-go-back'.
An element looks like (POSITION FUNCTION ARGS...), where POSITION is
`(POINT . BUFFER-NAME)'.
To use the element, do (apply FUNCTION ARGS) then goto the point in
the named buffer.")
(put 'help-xref-stack 'permanent-local t)
(defvar help-xref-stack-item nil
"An item for `help-follow' in this buffer to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
(setq-default help-xref-stack nil help-xref-stack-item nil)
;; Button types used by help
;; Make some button types that all use the same naming conventions
(dolist (help-type '("function" "variable" "face"
"coding-system" "input-method" "character-set"))
(define-button-type (intern (purecopy (concat "help-" help-type)))
'help-function (intern (concat "describe-" help-type))
'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type))
'action #'help-button-action))
;; make some more ideosyncratic button types
(define-button-type 'help-symbol
'help-function #'help-xref-interned
'help-echo (purecopy "mouse-2, RET: describe this symbol")
'action #'help-button-action)
(define-button-type 'help-back
'help-function #'help-xref-go-back
'help-echo (purecopy "mouse-2, RET: go back to previous help buffer")
'action #'help-button-action)
(define-button-type 'help-info
'help-function #'info
'help-echo (purecopy"mouse-2, RET: read this Info node")
'action #'help-button-action)
(define-button-type 'help-customize-variable
'help-function (lambda (v)
(if help-xref-stack
(pop help-xref-stack))
(customize-variable v))
'help-echo (purecopy "mouse-2, RET: customize variable")
'action #'help-button-action)
(define-button-type 'help-function-def
'help-function (lambda (fun file)
(require 'find-func)
;; Don't use find-function-noselect because it follows
;; aliases (which fails for built-in functions).
(let* ((location (find-function-search-for-symbol
fun nil file)))
(pop-to-buffer (car location))
(goto-char (cdr location))))
'help-echo (purecopy "mouse-2, RET: find function's definition")
'action #'help-button-action)
(define-button-type 'help-variable-def
'help-function (lambda (var &optional file)
(let ((location
(find-variable-noselect var file)))
(pop-to-buffer (car location))
(goto-char (cdr location))))
'help-echo (purecopy"mouse-2, RET: find variable's definition")
'action #'help-button-action)
(defun help-button-action (button)
"Call BUTTON's help function."
(help-do-xref (button-start button)
(button-get button 'help-function)
(button-get button 'help-args)))
;;;###autoload
(define-derived-mode help-mode nil "Help"
"Major mode for viewing help text and navigating references in it.
Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
\\{help-mode-map}"
(setq font-lock-defaults nil) ; font-lock would defeat xref
(view-mode)
(make-local-variable 'view-no-disable-on-exit)
(setq view-no-disable-on-exit t))
;;;###autoload
(defun help-mode-setup ()
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
(when (eq major-mode 'help-mode)
;; View mode's read-only status of existing *Help* buffer is lost
;; by with-output-to-temp-buffer.
(toggle-read-only 1)
(help-make-xrefs (current-buffer)))
(setq view-return-to-alist
(list (cons (selected-window) help-return-method))))
;;; Grokking cross-reference information in doc strings and
;;; hyperlinking it.
;; This may have some scope for extension and the same or something
;; similar should be done for widget doc strings, which currently use
;; another mechanism.
(defcustom help-highlight-p t
"*If non-nil, `help-make-xrefs' highlight cross-references.
Under a window system it highlights them with face defined by
`help-highlight-face'."
:group 'help
:version "20.3"
:type 'boolean)
(defcustom help-highlight-face 'underline
"Face used by `help-make-xrefs' to highlight cross-references.
Must be previously-defined."
:group 'help
:version "20.3"
:type 'face)
(defvar help-back-label (purecopy "[back]")
"Label to use by `help-make-xrefs' for the go-back reference.")
(defconst help-xref-symbol-regexp
(purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|"
"\\(function\\|command\\)\\|"
"\\(face\\)\\|"
"\\(symbol\\)\\|"
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)\\s-+\\)?"
;; Note starting with word-syntax character:
"`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to
distinguish references to variables, functions and symbols.")
(defconst help-xref-mule-regexp nil
"Regexp matching doc string references to MULE-related keywords.
It is usually nil, and is temporarily bound to an appropriate regexp
when help commands related to multilingual environment (e.g.,
`describe-coding-system') are invoked.")
(defconst help-xref-info-regexp
(purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'")
"Regexp matching doc string references to an Info node.")
;;;###autoload
(defun help-setup-xref (item interactive-p)
"Invoked from commands using the \"*Help*\" buffer to install some xref info.
ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help
buffer after following a reference. INTERACTIVE-P is non-nil if the
calling command was invoked interactively. In this case the stack of
items for help buffer \"back\" buttons is cleared."
(if interactive-p
(setq help-xref-stack nil))
(setq help-xref-stack-item item))
(defvar help-xref-following nil
"Non-nil when following a help cross-reference.")
;;;###autoload
(defun help-make-xrefs (&optional buffer)
"Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and, if
`help-highlight-p' is non-nil, highlight it with face defined by
`help-highlight-face'; activate such cross references for selection
with `help-follow'. Cross-references have the canonical form `...'
and the type of reference may be disambiguated by the preceding
word(s) used in `help-xref-symbol-regexp'.
If the variable `help-xref-mule-regexp' is non-nil, find also
cross-reference information related to multilingual environment
\(e.g., coding-systems). This variable is also used to disambiguate
the type of reference as the same way as `help-xref-symbol-regexp'.
A special reference `back' is made to return back through a stack of
help buffers. Variable `help-back-label' specifies the text for
that."
(interactive "b")
(save-excursion
(set-buffer (or buffer (current-buffer)))
(goto-char (point-min))
;; Skip the header-type info, though it might be useful to parse
;; it at some stage (e.g. "function in `library'").
(forward-paragraph)
(let ((old-modified (buffer-modified-p)))
(let ((stab (syntax-table))
(case-fold-search t)
(inhibit-read-only t))
(set-syntax-table emacs-lisp-mode-syntax-table)
;; The following should probably be abstracted out.
(unwind-protect
(progn
;; Info references
(save-excursion
(while (re-search-forward help-xref-info-regexp nil t)
(let ((data (match-string 1)))
(save-match-data
(unless (string-match "^([^)]+)" data)
(setq data (concat "(emacs)" data))))
(help-xref-button 1 'help-info data))))
;; Mule related keywords. Do this before trying
;; `help-xref-symbol-regexp' because some of Mule
;; keywords have variable or function definitions.
(if help-xref-mule-regexp
(save-excursion
(while (re-search-forward help-xref-mule-regexp nil t)
(let* ((data (match-string 7))
(sym (intern-soft data)))
(cond
((match-string 3) ; coding system
(and sym (coding-system-p sym)
(help-xref-button 6 'help-coding-system sym)))
((match-string 4) ; input method
(and (assoc data input-method-alist)
(help-xref-button 7 'help-input-method data)))
((or (match-string 5) (match-string 6)) ; charset
(and sym (charsetp sym)
(help-xref-button 7 'help-character-set sym)))
((assoc data input-method-alist)
(help-xref-button 7 'help-character-set data))
((and sym (coding-system-p sym))
(help-xref-button 7 'help-coding-system sym))
((and sym (charsetp sym))
(help-xref-button 7 'help-character-set sym)))))))
;; Quoted symbols
(save-excursion
(while (re-search-forward help-xref-symbol-regexp nil t)
(let* ((data (match-string 8))
(sym (intern-soft data)))
(if sym
(cond
((match-string 3) ; `variable' &c
(and (boundp sym) ; `variable' doesn't ensure
; it's actually bound
(help-xref-button 8 'help-variable sym)))
((match-string 4) ; `function' &c
(and (fboundp sym) ; similarly
(help-xref-button 8 'help-function sym)))
((match-string 5) ; `face'
(and (facep sym)
(help-xref-button 8 'help-face sym)))
((match-string 6)) ; nothing for `symbol'
((match-string 7)
;; this used:
;; #'(lambda (arg)
;; (let ((location
;; (find-function-noselect arg)))
;; (pop-to-buffer (car location))
;; (goto-char (cdr location))))
(help-xref-button 8 'help-function-def sym))
((and (boundp sym) (fboundp sym))
;; We can't intuit whether to use the
;; variable or function doc -- supply both.
(help-xref-button 8 'help-symbol sym))
((boundp sym)
(help-xref-button 8 'help-variable sym))
((fboundp sym)
(help-xref-button 8 'help-function sym))
((facep sym)
(help-xref-button 8 'help-face sym)))))))
;; An obvious case of a key substitution:
(save-excursion
(while (re-search-forward
;; Assume command name is only word characters
;; and dashes to get things like `use M-x foo.'.
"\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t)
(let ((sym (intern-soft (match-string 1))))
(if (fboundp sym)
(help-xref-button 1 'help-function sym)))))
;; Look for commands in whole keymap substitutions:
(save-excursion
;; Make sure to find the first keymap.
(goto-char (point-min))
;; Find a header and the column at which the command
;; name will be found.
(while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
nil t)
(let ((col (- (match-end 1) (match-beginning 1))))
(while
;; Ignore single blank lines in table, but not
;; double ones, which should terminate it.
(and (not (looking-at "\n\\s-*\n"))
(progn
(and (eolp) (forward-line))
(end-of-line)
(skip-chars-backward "^\t\n")
(if (and (>= (current-column) col)
(looking-at "\\(\\sw\\|-\\)+$"))
(let ((sym (intern-soft (match-string 0))))
(if (fboundp sym)
(help-xref-button 0 'help-function sym))))
(zerop (forward-line)))))))))
(set-syntax-table stab))
;; Delete extraneous newlines at the end of the docstring
(goto-char (point-max))
(while (and (not (bobp)) (bolp))
(delete-char -1))
;; Make a back-reference in this buffer if appropriate.
(when (and help-xref-following help-xref-stack)
(insert "\n\n")
(help-insert-xref-button help-back-label 'help-back
(current-buffer))))
;; View mode steals RET from us.
(set (make-local-variable 'minor-mode-overriding-map-alist)
(list (cons 'view-mode
(let ((map (make-sparse-keymap)))
(set-keymap-parent map view-mode-map)
(define-key map "\r" 'help-follow)
map))))
(set-buffer-modified-p old-modified))))
;;;###autoload
(defun help-xref-button (match-number type &rest args)
"Make a hyperlink for cross-reference text previously matched.
MATCH-NUMBER is the subexpression of interest in the last matched
regexp. TYPE is the type of button to use. Any remaining arguments are
passed to the button's help-function when it is invoked.
See `help-make-xrefs'."
;; Don't mung properties we've added specially in some instances.
(unless (button-at (match-beginning match-number))
(make-text-button (match-beginning match-number)
(match-end match-number)
'type type 'help-args args)))
;;;###autoload
(defun help-insert-xref-button (string type &rest args)
"Insert STRING and make a hyperlink from cross-reference text on it.
TYPE is the type of button to use. Any remaining arguments are passed
to the button's help-function when it is invoked.
See `help-make-xrefs'."
(unless (button-at (point))
(insert-text-button string 'type type 'help-args args)))
;;;###autoload
(defun help-xref-on-pp (from to)
"Add xrefs for symbols in `pp's output between FROM and TO."
(let ((ost (syntax-table)))
(unwind-protect
(save-excursion
(save-restriction
(set-syntax-table emacs-lisp-mode-syntax-table)
(narrow-to-region from to)
(goto-char (point-min))
(while (not (eobp))
(cond
((looking-at "\"") (forward-sexp 1))
((looking-at "#<") (search-forward ">" nil 'move))
((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
(let* ((sym (intern-soft (match-string 1)))
(type (cond ((fboundp sym) 'help-function)
((or (memq sym '(t nil))
(keywordp sym))
nil)
((and sym (boundp sym))
'help-variable))))
(when type (help-xref-button 1 type sym)))
(goto-char (match-end 1)))
(t (forward-char 1))))))
(set-syntax-table ost))))
;; Additional functions for (re-)creating types of help buffers.
(defun help-xref-interned (symbol)
"Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
Both variable and function documentation are extracted into a single
help buffer."
(let ((fdoc (when (fboundp symbol) (describe-function symbol)))
(facedoc (when (facep symbol) (describe-face symbol))))
(when (or (boundp symbol) (not fdoc))
(describe-variable symbol)
;; We now have a help buffer on the variable. Insert the function
;; text before it.
(when (or fdoc facedoc)
(with-current-buffer "*Help*"
(goto-char (point-min))
(let ((inhibit-read-only t))
(when fdoc
(insert fdoc "\n\n"))
(when facedoc
(insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
" is also a " "face." "\n\n" facedoc "\n\n"))
(insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
" is also a " "variable." "\n\n"))
(help-setup-xref (list #'help-xref-interned symbol) nil))))))
;;; Navigation/hyperlinking with xrefs
(defun help-xref-go-back (buffer)
"From BUFFER, go back to previous help buffer text using `help-xref-stack'."
(let (item position method args)
(with-current-buffer buffer
(when help-xref-stack
(setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow
(setq item (pop help-xref-stack)
position (car item)
method (cadr item)
args (cddr item))))
(apply method args)
;; We assume that the buffer we just recreated has the saved name,
;; which might not always be true.
(when (get-buffer (cdr position))
(with-current-buffer (cdr position)
(goto-char (car position))))))
(defun help-go-back ()
"Invoke the [back] button (if any) in the Help mode buffer."
(interactive)
(let ((back-button (button-at (1- (point-max)))))
(if back-button
(button-activate back-button)
(error "No [back] button"))))
(defun help-do-xref (pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
Things are set up properly so that the resulting help-buffer has
a proper [back] button."
(setq help-xref-stack (cons (cons (cons pos (buffer-name))
help-xref-stack-item)
help-xref-stack))
(setq help-xref-stack-item nil)
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
(apply function args)))
(defun help-follow (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
(unless pos
(setq pos (point)))
(unless (push-button pos)
;; check if the symbol under point is a function or variable
(let ((sym
(intern
(save-excursion
(goto-char pos) (skip-syntax-backward "w_")
(buffer-substring (point)
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym))
(help-do-xref pos #'help-xref-interned (list sym))))))
(provide 'help-mode)
;;; help-mode.el ends here