Mercurial > emacs
view lisp/help-mode.el @ 39727:3806fe844742
New file, contents mostly from `help.el'.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 09 Oct 2001 11:16:25 +0000 |
parents | |
children | b44e34df3fa2 |
line wrap: on
line source
;;; 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