]> code.delx.au - gnu-emacs/blobdiff - lisp/help-mode.el
(mailclient-send-it): Fix message.
[gnu-emacs] / lisp / help-mode.el
index 3349bc058f3aa80dd6bc196d01e7a8c25b915a5c..91fb4f9925754d9e3695ff209af4516015f05c9e 100644 (file)
@@ -1,17 +1,17 @@
 ;;; 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, 2008, 2009 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; 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.")
 
 (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
+  "A stack 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 +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"))
 
@@ -156,7 +197,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 +209,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 +223,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"))
 
 \f
@@ -193,9 +240,22 @@ 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)
+  (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
@@ -205,16 +265,23 @@ Commands:
 
 ;;;###autoload
 (defun help-mode-finish ()
-  (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))))
+  (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.
@@ -231,11 +298,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 +327,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 +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.
@@ -281,7 +356,13 @@ restore it properly when going back."
 (defvar help-xref-following nil
   "Non-nil when following a help cross-reference.")
 
+;;;###autoload
 (defun help-buffer ()
+  "Return the name of a buffer for inserting help.
+If `help-xref-following' is non-nil, this is the name of the
+current buffer.
+Otherwise, it is *Help*; if no buffer with that name currently
+exists, it is created."
   (buffer-name                         ;for with-output-to-temp-buffer
    (if help-xref-following
        (current-buffer)
@@ -338,6 +419,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 +456,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
@@ -392,12 +479,15 @@ that."
                            (facep sym)
                            (save-match-data (looking-at "[ \t\n]+face\\W")))
                           (help-xref-button 8 'help-face sym))
-                         ((and (boundp sym) (fboundp 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)
@@ -412,9 +502,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.'.
-                        "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t)
+                        ;; Assume command name is only word and symbol
+                        ;; characters to get things like `use M-x foo->bar'.
+                        ;; Command required to end with word constituent
+                        ;; to avoid `.' at end of a sentence.
+                        "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
                   (let ((sym (intern-soft (match-string 1))))
                     (if (fboundp sym)
                         (help-xref-button 1 'help-function sym)))))
@@ -438,9 +530,9 @@ that."
                      ;; Skip a single blank line.
                      (and (eolp) (forward-line))
                      (end-of-line)
-                     (skip-chars-backward "^\t\n")
+                     (skip-chars-backward "^ \t\n")
                      (if (and (>= (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))))
@@ -451,11 +543,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)
@@ -504,7 +604,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)))
@@ -528,7 +631,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))))
@@ -566,19 +670,11 @@ help buffer."
 \f
 ;; 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
@@ -594,6 +690,26 @@ 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)
@@ -601,6 +717,13 @@ help buffer."
       (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.
 Things are set up properly so that the resulting help-buffer has
@@ -609,27 +732,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