X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2ea0f8fde524c4998c0ab933cd27ecd50c54e09a..29660eb7cb1ac6ec24d20521cce51c07d9ec5f75:/lisp/help-mode.el diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 1f1b529c8e..ce79e618cd 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -1,7 +1,7 @@ ;;; help-mode.el --- `help-mode' used by *Help* buffers -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -20,8 +20,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -40,7 +40,7 @@ (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-c" 'help-follow-symbol) ;; Documentation only, since we use minor-mode-overriding-map-alist. (define-key help-mode-map "\r" 'help-follow) @@ -68,6 +68,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) @@ -125,21 +126,22 @@ The format is (FUNCTION ARGS...).") (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")) @@ -155,7 +157,9 @@ The format is (FUNCTION ARGS...).") (let ((location (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 @@ -165,8 +169,24 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (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")) + (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-function-search-for-symbol fun 'defface 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 face's definition")) ;;;###autoload @@ -183,7 +203,11 @@ Commands: (view-mode) (make-local-variable 'view-no-disable-on-exit) (setq view-no-disable-on-exit t) - (run-hooks 'help-mode-hook)) + (setq view-exit-action (lambda (buffer) + (or (window-minibuffer-p (selected-window)) + (one-window-p t) + (delete-window)))) + (run-mode-hooks 'help-mode-hook)) ;;;###autoload (defun help-mode-setup () @@ -193,8 +217,12 @@ Commands: ;;;###autoload (defun help-mode-finish () (let ((entry (assq (selected-window) view-return-to-alist))) - (if entry (setcdr entry (cons (selected-window) - help-return-method)) + (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)))) @@ -215,10 +243,10 @@ Commands: "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\\)\\|" + (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: @@ -240,6 +268,10 @@ when help commands related to multilingual environment (e.g., (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. @@ -321,6 +353,11 @@ that." (unless (string-match "^([^)]+)" data) (setq data (concat "(emacs)" 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. @@ -353,8 +390,9 @@ that." (if sym (cond ((match-string 3) ; `variable' &c - (and (boundp sym) ; `variable' doesn't ensure + (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 (and (fboundp sym) ; similarly @@ -371,15 +409,19 @@ that." ;;; (pop-to-buffer (car location)) ;;; (goto-char (cdr location)))) (help-xref-button 8 'help-function-def sym)) - ((facep sym) - (if (save-match-data (looking-at "[ \t\n]+face\\W")) - (help-xref-button 8 'help-face 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)) ((and - (boundp sym) + (or (boundp sym) + (get sym 'variable-documentation)) (or (documentation-property sym 'variable-documentation) @@ -486,7 +528,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))) @@ -510,7 +555,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)))) @@ -548,15 +594,6 @@ 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) @@ -577,12 +614,11 @@ help buffer." (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) - (let ((back-button (button-at (1- (point-max))))) - (if back-button - (button-activate back-button) - (error "No [back] button")))) + (if help-xref-stack + (help-xref-go-back (current-buffer)) + (error "No previous help buffer"))) (defun help-do-xref (pos function args) "Call the help cross-reference function FUNCTION with args ARGS. @@ -592,27 +628,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 +;; arch-tag: 850954ae-3725-4cb4-8e91-0bf6d52d6b0b ;;; help-mode.el ends here