X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ad4888e42d508a3c8afd338d49ef1e8508f1e1ba..4787a496a05fdc03241850b45911dd283d4b06b8:/lisp/help-mode.el
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 6e8ab0e34a..912be60706 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,17 +1,17 @@
;;; help-mode.el --- `help-mode' used by *Help* buffers
-;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
+;; 2003, 2004, 2005, 2006, 2007, 2008 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
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -19,9 +19,7 @@
;; 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.
+;; along with GNU Emacs. If not, see .
;;; Commentary:
@@ -32,6 +30,7 @@
(require 'button)
(require 'view)
+(eval-when-compile (require 'easymenu))
(defvar help-mode-map (make-sparse-keymap)
"Keymap for help mode.")
@@ -40,10 +39,25 @@
(define-key help-mode-map [mouse-2] 'help-follow-mouse)
(define-key help-mode-map "\C-c\C-b" 'help-go-back)
-(define-key help-mode-map "\C-c\C-c" 'help-follow)
+(define-key help-mode-map "\C-c\C-f" 'help-go-forward)
+(define-key help-mode-map "\C-c\C-c" 'help-follow-symbol)
;; Documentation only, since we use minor-mode-overriding-map-alist.
(define-key help-mode-map "\r" 'help-follow)
+(easy-menu-define help-mode-menu help-mode-map
+ "Menu for Help Mode."
+ '("Help-Mode"
+ ["Show Help for Symbol" help-follow-symbol
+ :help "Show the docs for the symbol at point"]
+ ["Previous Topic" help-go-back
+ :help "Go back to previous topic in this help buffer"]
+ ["Next Topic" help-go-forward
+ :help "Go back to next topic in this help buffer"]
+ ["Move to Previous Button" backward-button
+ :help "Move to the Next Button in the help buffer"]
+ ["Move to Next Button" forward-button
+ :help "Move to the Next Button in the help buffer"]))
+
(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'.
@@ -52,13 +66,28 @@ To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-stack 'permanent-local t)
(make-variable-buffer-local 'help-xref-stack)
+(defvar help-xref-forward-stack nil
+ "The stack of used to navigate help forwards after using the back button.
+Used by `help-follow' and `help-xref-go-forward'.
+An element looks like (POSITION FUNCTION ARGS...).
+To use the element, do (apply FUNCTION ARGS) then goto the point.")
+(put 'help-xref-forward-stack 'permanent-local t)
+(make-variable-buffer-local 'help-xref-forward-stack)
+
(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)
(make-variable-buffer-local 'help-xref-stack-item)
+(defvar help-xref-stack-forward-item nil
+ "An item for `help-go-back' to push onto `help-xref-forward-stack'.
+The format is (FUNCTION ARGS...).")
+(put 'help-xref-stack-forward-item 'permanent-local t)
+(make-variable-buffer-local 'help-xref-stack-forward-item)
+
(setq-default help-xref-stack nil help-xref-stack-item nil)
+(setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
(defcustom help-mode-hook nil
"Hook run by `help-mode'."
@@ -68,6 +97,7 @@ The format is (FUNCTION ARGS...).")
;; Button types used by help
(define-button-type 'help-xref
+ 'follow-link t
'action #'help-button-action)
(defun help-button-action (button)
@@ -122,24 +152,36 @@ The format is (FUNCTION ARGS...).")
'help-function #'help-xref-go-back
'help-echo (purecopy "mouse-2, RET: go back to previous help buffer"))
+(define-button-type 'help-forward
+ :supertype 'help-xref
+ 'help-function #'help-xref-go-forward
+ 'help-echo (purecopy "mouse-2, RET: move forward to next help buffer"))
+
+(define-button-type 'help-info-variable
+ :supertype 'help-xref
+ ;; the name of the variable is put before the argument to Info
+ 'help-function (lambda (a v) (info v))
+ 'help-echo (purecopy "mouse-2, RET: read this Info node"))
+
(define-button-type 'help-info
:supertype 'help-xref
'help-function #'info
- 'help-echo (purecopy"mouse-2, RET: read this Info node"))
+ 'help-echo (purecopy "mouse-2, RET: read this Info node"))
+
+(define-button-type 'help-url
+ :supertype 'help-xref
+ 'help-function #'browse-url
+ 'help-echo (purecopy "mouse-2, RET: view this URL in a browser"))
(define-button-type 'help-customize-variable
:supertype 'help-xref
'help-function (lambda (v)
- (if help-xref-stack
- (pop help-xref-stack))
(customize-variable v))
'help-echo (purecopy "mouse-2, RET: customize variable"))
(define-button-type 'help-customize-face
:supertype 'help-xref
'help-function (lambda (v)
- (if help-xref-stack
- (pop help-xref-stack))
(customize-face v))
'help-echo (purecopy "mouse-2, RET: customize face"))
@@ -147,23 +189,44 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function (lambda (fun file)
(require 'find-func)
+ (when (eq file 'C-source)
+ (setq file
+ (help-C-file-name (indirect-function fun) 'fun)))
;; Don't use find-function-noselect because it follows
;; aliases (which fails for built-in functions).
(let ((location
- (if (bufferp file) (cons file fun)
- (find-function-search-for-symbol fun nil file))))
+ (find-function-search-for-symbol fun nil file)))
(pop-to-buffer (car location))
- (goto-char (cdr location))))
+ (if (cdr location)
+ (goto-char (cdr location))
+ (message "Unable to find location in file"))))
'help-echo (purecopy "mouse-2, RET: find function's definition"))
(define-button-type 'help-variable-def
:supertype 'help-xref
'help-function (lambda (var &optional file)
+ (when (eq file 'C-source)
+ (setq file (help-C-file-name var 'var)))
+ (let ((location (find-variable-noselect var file)))
+ (pop-to-buffer (car location))
+ (if (cdr location)
+ (goto-char (cdr location))
+ (message "Unable to find location in file"))))
+ 'help-echo (purecopy "mouse-2, RET: find variable's definition"))
+
+(define-button-type 'help-face-def
+ :supertype 'help-xref
+ '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-variable-noselect var file)))
+ (find-function-search-for-symbol fun 'defface file)))
(pop-to-buffer (car location))
- (goto-char (cdr location))))
- 'help-echo (purecopy"mouse-2, RET: find variable's definition"))
+ (if (cdr location)
+ (goto-char (cdr location))
+ (message "Unable to find location in file"))))
+ 'help-echo (purecopy "mouse-2, RET: find face's definition"))
;;;###autoload
@@ -177,10 +240,23 @@ Commands:
(use-local-map help-mode-map)
(setq mode-name "Help")
(setq major-mode 'help-mode)
+
(view-mode)
- (make-local-variable 'view-no-disable-on-exit)
- (setq view-no-disable-on-exit t)
- (run-hooks 'help-mode-hook))
+ (set (make-local-variable 'view-no-disable-on-exit) t)
+ ;; With Emacs 22 `view-exit-action' could delete the selected window
+ ;; disregarding whether the help buffer was shown in that window at
+ ;; all. Since `view-exit-action' is called with the help buffer as
+ ;; argument it seems more appropriate to have it work on the buffer
+ ;; only and leave it to `view-mode-exit' to delete any associated
+ ;; window(s).
+ (setq view-exit-action
+ (lambda (buffer)
+ ;; Use `with-current-buffer' to make sure that `bury-buffer'
+ ;; also removes BUFFER from the selected window.
+ (with-current-buffer buffer
+ (bury-buffer))))
+
+ (run-mode-hooks 'help-mode-hook))
;;;###autoload
(defun help-mode-setup ()
@@ -189,14 +265,28 @@ Commands:
;;;###autoload
(defun help-mode-finish ()
+ (if (eq help-window t)
+ ;; If `help-window' is t, `view-return-to-alist' is handled by
+ ;; `with-help-window'. In this case set `help-window' to the
+ ;; selected window since now is the only moment where we can
+ ;; unambiguously identify it.
+ (setq help-window (selected-window))
+ (let ((entry (assq (selected-window) view-return-to-alist)))
+ (if entry
+ ;; When entering Help mode from the Help window,
+ ;; such as by following a link, preserve the same
+ ;; meaning for the q command.
+ ;; (setcdr entry (cons (selected-window) help-return-method))
+ nil
+ (setq view-return-to-alist
+ (cons (cons (selected-window) help-return-method)
+ view-return-to-alist)))))
+
(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))))
-
+ (help-make-xrefs (current-buffer))))
;; Grokking cross-reference information in doc strings and
;; hyperlinking it.
@@ -208,12 +298,16 @@ Commands:
(defvar help-back-label (purecopy "[back]")
"Label to use by `help-make-xrefs' for the go-back reference.")
+(defvar help-forward-label (purecopy "[forward]")
+ "Label to use by `help-make-xrefs' for the go-forward reference.")
+
(defconst help-xref-symbol-regexp
- (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|"
- "\\(function\\|command\\)\\|"
- "\\(face\\)\\|"
- "\\(symbol\\)\\|"
- "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)\\s-+\\)?"
+ (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var
+ "\\(function\\|command\\)\\|" ; Link to function
+ "\\(face\\)\\|" ; Link to face
+ "\\(symbol\\|program\\|property\\)\\|" ; Don't link
+ "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
+ "[ \t\n]+\\)?"
;; Note starting with word-syntax character:
"`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'"))
"Regexp matching doc string references to symbols.
@@ -230,9 +324,13 @@ when help commands related to multilingual environment (e.g.,
(defconst help-xref-info-regexp
- (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'")
+ (purecopy "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+`\\([^']+\\)'")
"Regexp matching doc string references to an Info node.")
+(defconst help-xref-url-regexp
+ (purecopy "\\<[Uu][Rr][Ll][ \t\n]+`\\([^']+\\)'")
+ "Regexp matching doc string references to a URL.")
+
;;;###autoload
(defun help-setup-xref (item interactive-p)
"Invoked from commands using the \"*Help*\" buffer to install some xref info.
@@ -247,7 +345,8 @@ because we want to record the \"previous\" position of point so we can
restore it properly when going back."
(with-current-buffer (help-buffer)
(when help-xref-stack-item
- (push (cons (point) help-xref-stack-item) help-xref-stack))
+ (push (cons (point) help-xref-stack-item) help-xref-stack)
+ (setq help-xref-forward-stack nil))
(when interactive-p
(let ((tail (nthcdr 10 help-xref-stack)))
;; Truncate the stack.
@@ -257,6 +356,7 @@ restore it properly when going back."
(defvar help-xref-following nil
"Non-nil when following a help cross-reference.")
+;;;###autoload
(defun help-buffer ()
(buffer-name ;for with-output-to-temp-buffer
(if help-xref-following
@@ -278,7 +378,10 @@ Find cross-reference information in a buffer and 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'.
+`help-xref-symbol-regexp'. Faces only get cross-referenced if
+preceded or followed by the word `face'. Variables without
+variable documentation do not get cross-referenced, unless
+preceded by the word `variable' or `option'.
If the variable `help-xref-mule-regexp' is non-nil, find also
cross-reference information related to multilingual environment
@@ -306,11 +409,16 @@ that."
;; Info references
(save-excursion
(while (re-search-forward help-xref-info-regexp nil t)
- (let ((data (match-string 1)))
+ (let ((data (match-string 2)))
(save-match-data
(unless (string-match "^([^)]+)" data)
(setq data (concat "(emacs)" data))))
- (help-xref-button 1 'help-info data))))
+ (help-xref-button 2 'help-info data))))
+ ;; URLs
+ (save-excursion
+ (while (re-search-forward help-xref-url-regexp nil t)
+ (let ((data (match-string 1)))
+ (help-xref-button 1 'help-url data))))
;; Mule related keywords. Do this before trying
;; `help-xref-symbol-regexp' because some of Mule
;; keywords have variable or function definitions.
@@ -342,11 +450,12 @@ that."
(sym (intern-soft data)))
(if sym
(cond
- ((match-string 3) ; `variable' &c
- (and (boundp sym) ; `variable' doesn't ensure
+ ((match-string 3) ; `variable' &c
+ (and (or (boundp sym) ; `variable' doesn't ensure
; it's actually bound
+ (get sym 'variable-documentation))
(help-xref-button 8 'help-variable sym)))
- ((match-string 4) ; `function' &c
+ ((match-string 4) ; `function' &c
(and (fboundp sym) ; similarly
(help-xref-button 8 'help-function sym)))
((match-string 5) ; `face'
@@ -354,29 +463,45 @@ that."
(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))))
+;;; 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))
+ ((and
+ (facep sym)
+ (save-match-data (looking-at "[ \t\n]+face\\W")))
+ (help-xref-button 8 'help-face sym))
+ ((and (or (boundp sym)
+ (get sym 'variable-documentation))
+ (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)
+ ((and
+ (or (boundp sym)
+ (get sym 'variable-documentation))
+ (or
+ (documentation-property
+ sym 'variable-documentation)
+ (condition-case nil
+ (documentation-property
+ (indirect-variable sym)
+ 'variable-documentation)
+ (cyclic-variable-indirection nil))))
(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)))))))
+ (help-xref-button 8 'help-function 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.'.
- "\\bar'.
+ ;; Command required to end with word constituent
+ ;; to avoid `.' at end of a sentence.
+ "\\= (current-column) col)
- (looking-at "\\(\\sw\\|-\\)+$"))
+ (looking-at "\\(\\sw\\|\\s_\\)+$"))
(let ((sym (intern-soft (match-string 0))))
(if (fboundp sym)
(help-xref-button 0 'help-function sym))))
- (forward-line)))))))
- (set-syntax-table stab))
+ (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))
+ (insert "\n")
+ (when (or help-xref-stack help-xref-forward-stack)
+ (insert "\n"))
;; Make a back-reference in this buffer if appropriate.
(when help-xref-stack
- (insert "\n\n")
(help-insert-xref-button help-back-label 'help-back
- (current-buffer))))
+ (current-buffer)))
+ ;; Make a forward-reference in this buffer if appropriate.
+ (when help-xref-forward-stack
+ (when help-xref-stack
+ (insert "\t"))
+ (help-insert-xref-button help-forward-label 'help-forward
+ (current-buffer)))
+ (when (or help-xref-stack help-xref-forward-stack)
+ (insert "\n")))
;; View mode steals RET from us.
(set (make-local-variable 'minor-mode-overriding-map-alist)
(list (cons 'view-mode help-xref-override-view-map)))
@@ -464,7 +599,10 @@ See `help-make-xrefs'."
((or (memq sym '(t nil))
(keywordp sym))
nil)
- ((and sym (boundp sym))
+ ((and sym
+ (or (boundp sym)
+ (get sym
+ 'variable-documentation)))
'help-variable))))
(when type (help-xref-button 1 type sym)))
(goto-char (match-end 1)))
@@ -488,7 +626,8 @@ help buffer."
;; Don't record the current entry in the stack.
(setq help-xref-stack-item nil)
(describe-function symbol)))
- (sdoc (when (boundp symbol)
+ (sdoc (when (or (boundp symbol)
+ (get symbol 'variable-documentation))
;; Don't record the current entry in the stack.
(setq help-xref-stack-item nil)
(describe-variable symbol))))
@@ -526,19 +665,11 @@ help buffer."
;; Navigation/hyperlinking with xrefs
-(defun help-follow-mouse (click)
- "Follow the cross-reference that you CLICK on."
- (interactive "e")
- (let* ((start (event-start click))
- (window (car start))
- (pos (car (cdr start))))
- (with-current-buffer (window-buffer window)
- (help-follow pos))))
-
(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
+ (push (cons (point) help-xref-stack-item) help-xref-forward-stack)
(when help-xref-stack
(setq item (pop help-xref-stack)
;; Clear the current item so that it won't get pushed
@@ -554,13 +685,39 @@ help buffer."
(set-window-point (get-buffer-window buffer) position)
(goto-char position)))))
+(defun help-xref-go-forward (buffer)
+ "From BUFFER, go forward to next help buffer."
+ (let (item position method args)
+ (with-current-buffer buffer
+ (push (cons (point) help-xref-stack-item) help-xref-stack)
+ (when help-xref-forward-stack
+ (setq item (pop help-xref-forward-stack)
+ ;; Clear the current item so that it won't get pushed
+ ;; by the function we're about to call. TODO: We could also
+ ;; push it onto a "forward" stack and add a `forw' button.
+ help-xref-stack-item nil
+ position (car item)
+ method (cadr item)
+ args (cddr item))))
+ (apply method args)
+ (with-current-buffer buffer
+ (if (get-buffer-window buffer)
+ (set-window-point (get-buffer-window buffer) position)
+ (goto-char position)))))
+
(defun help-go-back ()
- "Invoke the [back] button (if any) in the Help mode buffer."
+ "Go back to previous topic in this help buffer."
+ (interactive)
+ (if help-xref-stack
+ (help-xref-go-back (current-buffer))
+ (error "No previous help buffer")))
+
+(defun help-go-forward ()
+ "Go back to next topic in this help buffer."
(interactive)
- (let ((back-button (button-at (1- (point-max)))))
- (if back-button
- (button-activate back-button)
- (error "No [back] button"))))
+ (if help-xref-forward-stack
+ (help-xref-go-forward (current-buffer))
+ (error "No next help buffer")))
(defun help-do-xref (pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
@@ -570,26 +727,50 @@ a proper [back] button."
(let ((help-xref-following t))
(apply function args)))
-(defun help-follow (&optional pos)
- "Follow cross-reference at POS, defaulting to point.
+;; The doc string is meant to explain what buttons do.
+(defun help-follow-mouse ()
+ "Follow the cross-reference that you click on."
+ (interactive)
+ (error "No cross-reference here"))
+
+;; The doc string is meant to explain what buttons do.
+(defun help-follow ()
+ "Follow cross-reference at point.
For the cross-reference format, see `help-make-xrefs'."
+ (interactive)
+ (error "No cross-reference here"))
+
+(defun help-follow-symbol (&optional pos)
+ "In help buffer, show docs for symbol at POS, defaulting to point.
+Show all docs for that symbol as either a variable, function or face."
(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) (facep sym))
- (help-do-xref pos #'help-xref-interned (list sym))))))
-
+ ;; check if the symbol under point is a function, variable or face
+ (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)
+ (get sym 'variable-documentation)
+ (fboundp sym) (facep sym))
+ (help-do-xref pos #'help-xref-interned (list sym)))))
+
+(defun help-insert-string (string)
+ "Insert STRING to the help buffer and install xref info for it.
+This function can be used to restore the old contents of the help buffer
+when going back to the previous topic in the xref stack. It is needed
+in case when it is impossible to recompute the old contents of the
+help buffer by other means."
+ (setq help-xref-stack-item (list #'help-insert-string string))
+ (with-output-to-temp-buffer (help-buffer)
+ (insert string)))
(provide 'help-mode)
+;; arch-tag: 850954ae-3725-4cb4-8e91-0bf6d52d6b0b
;;; help-mode.el ends here