Merge from emacs--rel--22
[bpt/emacs.git] / lisp / help-mode.el
index 032509b..075b893 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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 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,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'."
@@ -68,6 +84,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 +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"))
 
@@ -147,23 +170,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"))
 
 \f
 ;;;###autoload
@@ -180,7 +224,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 ()
@@ -189,14 +237,21 @@ 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))))
   (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))))
 \f
 ;; Grokking cross-reference information in doc strings and
 ;; hyperlinking it.
@@ -208,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:
@@ -234,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.
@@ -248,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.
@@ -315,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.
@@ -347,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
@@ -365,17 +434,27 @@ 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)
-                          (documentation-property sym
-                                                  'variable-documentation))
+                          (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)))))))
@@ -408,7 +487,7 @@ 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\\|-\\)+$"))
                          (let ((sym (intern-soft (match-string 0))))
@@ -420,11 +499,21 @@ that."
        (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)))
@@ -472,7 +561,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)))
@@ -496,7 +588,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))))
@@ -534,19 +627,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
@@ -562,13 +647,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.
@@ -578,27 +689,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