X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/40bd2cfb436f53c092c37d069748c093d9ad84cd..aaf34461ff5804e5cebe163b31e535da72e81d87:/lisp/help-mode.el diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 1c516930c3..1435eb019e 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, 2007 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -10,7 +10,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -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,8 @@ (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) @@ -52,13 +53,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'." @@ -123,24 +139,30 @@ 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 :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")) @@ -156,7 +178,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 @@ -166,8 +190,10 @@ 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 @@ -178,7 +204,9 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun 'defface 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 face's definition")) @@ -196,6 +224,10 @@ Commands: (view-mode) (make-local-variable 'view-no-disable-on-exit) (setq view-no-disable-on-exit t) + (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 @@ -231,11 +263,14 @@ 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\\)\\|" + (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: @@ -257,6 +292,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. @@ -271,7 +310,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. @@ -338,6 +378,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. @@ -370,8 +415,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 @@ -388,15 +434,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) @@ -411,9 +461,11 @@ that." ;; 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)))) @@ -450,11 +502,19 @@ that." (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") (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) @@ -503,7 +563,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))) @@ -527,7 +590,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)))) @@ -565,19 +629,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 @@ -593,12 +649,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 () "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) + (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. @@ -608,27 +691,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