(help-make-xrefs): If a symbol representing a face name is not followed by the
[bpt/emacs.git] / lisp / help-mode.el
index 38f0c73..cd8c6a1 100644 (file)
@@ -1,6 +1,6 @@
 ;;; help-mode.el --- `help-mode' used by *Help* buffers
 
-;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -31,7 +31,7 @@
 ;;; Code:
 
 (require 'button)
-(eval-when-compile (require 'view))
+(require 'view)
 
 (defvar help-mode-map (make-sparse-keymap)
   "Keymap for help mode.")
@@ -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)
@@ -147,10 +148,13 @@ The format is (FUNCTION ARGS...).")
   :supertype 'help-xref
   'help-function (lambda (fun file)
                   (require 'find-func)
-                 ;; Don't use find-function-noselect because it follows
+                  (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 (find-function-search-for-symbol
-                                    fun nil file)))
+                  (let ((location
+                         (find-function-search-for-symbol fun nil file)))
                     (pop-to-buffer (car location))
                     (goto-char (cdr location))))
   'help-echo (purecopy "mouse-2, RET: find function's definition"))
@@ -158,12 +162,25 @@ The format is (FUNCTION ARGS...).")
 (define-button-type 'help-variable-def
   :supertype 'help-xref
   'help-function (lambda (var &optional file)
-                  (let ((location
-                         (find-variable-noselect var 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))
                     (goto-char (cdr location))))
   '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))
+                    (goto-char (cdr location))))
+  'help-echo (purecopy "mouse-2, RET: find face's definition"))
+
 \f
 ;;;###autoload
 (defun help-mode ()
@@ -179,7 +196,7 @@ Commands:
   (view-mode)
   (make-local-variable 'view-no-disable-on-exit)
   (setq view-no-disable-on-exit t)
-  (run-hooks 'help-mode-hook))
+  (run-mode-hooks 'help-mode-hook))
 
 ;;;###autoload
 (defun help-mode-setup ()
@@ -188,17 +205,24 @@ 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.
+;; Grokking cross-reference information in doc strings and
+;; hyperlinking it.
 
 ;; This may have some scope for extension and the same or something
 ;; similar should be done for widget doc strings, which currently use
@@ -212,7 +236,8 @@ Commands:
                    "\\(function\\|command\\)\\|"
                    "\\(face\\)\\|"
                    "\\(symbol\\)\\|"
-                   "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)\\s-+\\)?"
+                   "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
+                   "[ \t\n]+\\)?"
                    ;; Note starting with word-syntax character:
                    "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'"))
   "Regexp matching doc string references to symbols.
@@ -220,7 +245,7 @@ Commands:
 The words preceding the quoted symbol can be used in doc strings to
 distinguish references to variables, functions and symbols.")
 
-(defconst help-xref-mule-regexp nil
+(defvar help-xref-mule-regexp nil
   "Regexp matching doc string references to MULE-related keywords.
 
 It is usually nil, and is temporarily bound to an appropriate regexp
@@ -229,7 +254,7 @@ 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.")
 
 ;;;###autoload
@@ -245,11 +270,12 @@ This should be called very early, before the output buffer is cleared,
 because we want to record the \"previous\" position of point so we can
 restore it properly when going back."
   (with-current-buffer (help-buffer)
-    (if interactive-p
-       ;; Why do we want to prevent the user from going back ??  -stef
-       (setq help-xref-stack nil)
-      (when help-xref-stack-item
-       (push (cons (point) help-xref-stack-item) help-xref-stack)))
+    (when help-xref-stack-item
+      (push (cons (point) help-xref-stack-item) help-xref-stack))
+    (when interactive-p
+      (let ((tail (nthcdr 10 help-xref-stack)))
+       ;; Truncate the stack.
+       (if tail (setcdr tail nil))))
     (setq help-xref-stack-item item)))
 
 (defvar help-xref-following nil
@@ -261,6 +287,13 @@ restore it properly when going back."
        (current-buffer)
      (get-buffer-create "*Help*"))))
 
+(defvar help-xref-override-view-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map view-mode-map)
+    (define-key map "\r" nil)
+    map)
+  "Replacement keymap for `view-mode' in help buffers.")
+
 ;;;###autoload
 (defun help-make-xrefs (&optional buffer)
   "Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -269,7 +302,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
@@ -297,11 +333,11 @@ 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))))
              ;; Mule related keywords.  Do this before trying
              ;; `help-xref-symbol-regexp' because some of Mule
              ;; keywords have variable or function definitions.
@@ -333,11 +369,11 @@ that."
                          (sym (intern-soft data)))
                     (if sym
                         (cond
-                         ((match-string 3) ; `variable' &c
+                         ((match-string 3)  ; `variable' &c
                           (and (boundp sym) ; `variable' doesn't ensure
                                         ; it's actually bound
                                (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'
@@ -345,23 +381,34 @@ 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
+                           (facep sym)
+                           (save-match-data (looking-at "[ \t\n]+face\\W")))
+                          (help-xref-button 8 'help-face sym))
                          ((and (boundp sym) (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
+                          (boundp sym)
+                          (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
@@ -377,40 +424,42 @@ that."
                (goto-char (point-min))
                 ;; Find a header and the column at which the command
                 ;; name will be found.
+
+               ;; If the keymap substitution isn't the last thing in
+               ;; the doc string, and if there is anything on the
+               ;; same line after it, this code won't recognize the end of it.
                 (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
                                           nil t)
                   (let ((col (- (match-end 1) (match-beginning 1))))
                     (while
-                        ;; Ignore single blank lines in table, but not
-                        ;; double ones, which should terminate it.
-                        (and (not (looking-at "\n\\s-*\n"))
-                             (progn
-                              (and (eolp) (forward-line))
-                              (end-of-line)
-                              (skip-chars-backward "^\t\n")
-                               (if (and (>= (current-column) col)
-                                       (looking-at "\\(\\sw\\|-\\)+$"))
-                                   (let ((sym (intern-soft (match-string 0))))
-                                     (if (fboundp sym)
-                                         (help-xref-button 0 'help-function sym))))
-                              (zerop (forward-line)))))))))
-          (set-syntax-table stab))
+                        (and (not (eobp))
+                            ;; Stop at a pair of blank lines.
+                            (not (looking-at "\n\\s-*\n")))
+                     ;; Skip a single blank line.
+                     (and (eolp) (forward-line))
+                     (end-of-line)
+                     (skip-chars-backward "^\t\n")
+                     (if (and (>= (current-column) col)
+                              (looking-at "\\(\\sw\\|-\\)+$"))
+                         (let ((sym (intern-soft (match-string 0))))
+                           (if (fboundp sym)
+                               (help-xref-button 0 'help-function sym))))
+                     (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")
         ;; Make a back-reference in this buffer if appropriate.
         (when help-xref-stack
-         (insert "\n\n")
+         (insert "\n")
          (help-insert-xref-button help-back-label 'help-back
-                                  (current-buffer))))
+                                  (current-buffer))
+          (insert "\n")))
       ;; View mode steals RET from us.
       (set (make-local-variable 'minor-mode-overriding-map-alist)
-           (list (cons 'view-mode
-                       (let ((map (make-sparse-keymap)))
-                         (set-keymap-parent map view-mode-map)
-                         (define-key map "\r" 'help-follow)
-                         map))))
+           (list (cons 'view-mode help-xref-override-view-map)))
       (set-buffer-modified-p old-modified))))
 
 ;;;###autoload
@@ -438,31 +487,29 @@ See `help-make-xrefs'."
 ;;;###autoload
 (defun help-xref-on-pp (from to)
   "Add xrefs for symbols in `pp's output between FROM and TO."
-  (let ((ost (syntax-table)))
-    (unwind-protect
-       (save-excursion
-         (save-restriction
-           (set-syntax-table emacs-lisp-mode-syntax-table)
-           (narrow-to-region from to)
-           (goto-char (point-min))
-           (condition-case nil
-               (while (not (eobp))
-                 (cond
-                  ((looking-at "\"") (forward-sexp 1))
-                  ((looking-at "#<") (search-forward ">" nil 'move))
-                  ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
-                   (let* ((sym (intern-soft (match-string 1)))
-                          (type (cond ((fboundp sym) 'help-function)
-                                      ((or (memq sym '(t nil))
-                                           (keywordp sym))
-                                       nil)
-                                      ((and sym (boundp sym))
-                                       'help-variable))))
-                     (when type (help-xref-button 1 type sym)))
-                   (goto-char (match-end 1)))
-                  (t (forward-char 1))))
-             (error nil))))
-      (set-syntax-table ost))))
+  (if (> (- to from) 5000) nil
+    (with-syntax-table emacs-lisp-mode-syntax-table
+      (save-excursion
+       (save-restriction
+         (narrow-to-region from to)
+         (goto-char (point-min))
+         (condition-case nil
+             (while (not (eobp))
+               (cond
+                ((looking-at "\"") (forward-sexp 1))
+                ((looking-at "#<") (search-forward ">" nil 'move))
+                ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
+                 (let* ((sym (intern-soft (match-string 1)))
+                        (type (cond ((fboundp sym) 'help-function)
+                                    ((or (memq sym '(t nil))
+                                         (keywordp sym))
+                                     nil)
+                                    ((and sym (boundp sym))
+                                     'help-variable))))
+                   (when type (help-xref-button 1 type sym)))
+                 (goto-char (match-end 1)))
+                (t (forward-char 1))))
+           (error nil)))))))
 
 \f
 ;; Additional functions for (re-)creating types of help buffers.
@@ -517,7 +564,7 @@ help buffer."
          (help-setup-xref (list #'help-xref-interned symbol) nil)))))))
 
 \f
-;;; Navigation/hyperlinking with xrefs
+;; Navigation/hyperlinking with xrefs
 
 (defun help-follow-mouse (click)
   "Follow the cross-reference that you CLICK on."
@@ -548,12 +595,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.
@@ -585,4 +631,5 @@ For the cross-reference format, see `help-make-xrefs'."
 
 (provide 'help-mode)
 
+;;; arch-tag: 850954ae-3725-4cb4-8e91-0bf6d52d6b0b
 ;;; help-mode.el ends here