diff --git a/lisp/help-mode.el b/lisp/help-mode.el new file mode 100644 index 00000000000..24ab7b62e36 --- /dev/null +++ b/lisp/help-mode.el @@ -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.'. + "\\= (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 + +