Update years in copyright notice; nfc.
[bpt/emacs.git] / lisp / help.el
index 82a43c6..f8ed278 100644 (file)
@@ -1,7 +1,7 @@
 ;;; help.el --- help commands for Emacs
 
-;; 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 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:
 
 (add-hook 'temp-buffer-setup-hook 'help-mode-setup)
 (add-hook 'temp-buffer-show-hook 'help-mode-finish)
 
-(defvar help-map (make-sparse-keymap)
+(defvar help-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (char-to-string help-char) 'help-for-help)
+    (define-key map [help] 'help-for-help)
+    (define-key map [f1] 'help-for-help)
+    (define-key map "." 'display-local-help)
+    (define-key map "?" 'help-for-help)
+
+    (define-key map "\C-c" 'describe-copying)
+    (define-key map "\C-d" 'describe-distribution)
+    (define-key map "\C-e" 'view-emacs-problems)
+    (define-key map "\C-f" 'view-emacs-FAQ)
+    (define-key map "\C-m" 'view-order-manuals)
+    (define-key map "\C-n" 'view-emacs-news)
+    (define-key map "\C-p" 'describe-project)
+    (define-key map "\C-t" 'view-todo)
+    (define-key map "\C-w" 'describe-no-warranty)
+
+    ;; This does not fit the pattern, but it is natural given the C-\ command.
+    (define-key map "\C-\\" 'describe-input-method)
+
+    (define-key map "C" 'describe-coding-system)
+    (define-key map "F" 'Info-goto-emacs-command-node)
+    (define-key map "I" 'describe-input-method)
+    (define-key map "K" 'Info-goto-emacs-key-command-node)
+    (define-key map "L" 'describe-language-environment)
+    (define-key map "S" 'info-lookup-symbol)
+
+    (define-key map "a" 'apropos-command)
+    (define-key map "b" 'describe-bindings)
+    (define-key map "c" 'describe-key-briefly)
+    (define-key map "d" 'apropos-documentation)
+    (define-key map "e" 'view-echo-area-messages)
+    (define-key map "f" 'describe-function)
+    (define-key map "h" 'view-hello-file)
+
+    (define-key map "i" 'info)
+    (define-key map "4i" 'info-other-window)
+
+    (define-key map "k" 'describe-key)
+    (define-key map "l" 'view-lossage)
+    (define-key map "m" 'describe-mode)
+    (define-key map "n" 'view-emacs-news)
+    (define-key map "p" 'finder-by-keyword)
+    (define-key map "r" 'info-emacs-manual)
+    (define-key map "s" 'describe-syntax)
+    (define-key map "t" 'help-with-tutorial)
+    (define-key map "w" 'where-is)
+    (define-key map "v" 'describe-variable)
+    (define-key map "q" 'help-quit)
+    map)
   "Keymap for characters following the Help key.")
 
 (define-key global-map (char-to-string help-char) 'help-command)
 (define-key global-map [f1] 'help-command)
 (fset 'help-command help-map)
 
-(define-key help-map (char-to-string help-char) 'help-for-help)
-(define-key help-map [help] 'help-for-help)
-(define-key help-map [f1] 'help-for-help)
-(define-key help-map "." 'display-local-help)
-(define-key help-map "?" 'help-for-help)
-
-(define-key help-map "\C-c" 'describe-copying)
-(define-key help-map "\C-d" 'describe-distribution)
-(define-key help-map "\C-e" 'view-emacs-problems)
-(define-key help-map "\C-f" 'view-emacs-FAQ)
-(define-key help-map "\C-m" 'view-order-manuals)
-(define-key help-map "\C-n" 'view-emacs-news)
-(define-key help-map "\C-p" 'describe-project)
-(define-key help-map "\C-t" 'view-todo)
-(define-key help-map "\C-w" 'describe-no-warranty)
-
-;; This does not fit the pattern, but it is natural given the C-\ command.
-(define-key help-map "\C-\\" 'describe-input-method)
-
-(define-key help-map "C" 'describe-coding-system)
-(define-key help-map "F" 'Info-goto-emacs-command-node)
-(define-key help-map "I" 'describe-input-method)
-(define-key help-map "K" 'Info-goto-emacs-key-command-node)
-(define-key help-map "L" 'describe-language-environment)
-(define-key help-map "S" 'info-lookup-symbol)
-
-(define-key help-map "a" 'apropos-command)
-
-(define-key help-map "b" 'describe-bindings)
-
-(define-key help-map "c" 'describe-key-briefly)
-
-(define-key help-map "e" 'view-echo-area-messages)
-
-(define-key help-map "f" 'describe-function)
-
-(define-key help-map "h" 'view-hello-file)
-
-(define-key help-map "i" 'info)
-(define-key help-map "4i" 'info-other-window)
-
-(define-key help-map "k" 'describe-key)
-
-(define-key help-map "l" 'view-lossage)
-
-(define-key help-map "m" 'describe-mode)
-
-(define-key help-map "n" 'view-emacs-news)
-
-(define-key help-map "p" 'finder-by-keyword)
 (autoload 'finder-by-keyword "finder"
   "Find packages matching a given keyword." t)
 
-(define-key help-map "r" 'info-emacs-manual)
-
-(define-key help-map "s" 'describe-syntax)
-
-(define-key help-map "t" 'help-with-tutorial)
-
-(define-key help-map "w" 'where-is)
-
-(define-key help-map "v" 'describe-variable)
-
-(define-key help-map "q" 'help-quit)
+;; insert-button makes the action nil if it is not store somewhere
+(defvar help-button-cache nil)
 
 \f
 (defun help-quit ()
 (defvar help-return-method nil
   "What to do to \"exit\" the help buffer.
 This is a list
- (WINDOW . t)              delete the selected window, go to WINDOW.
+ (WINDOW . t)              delete the selected window (and possibly its frame,
+                           see `quit-window' and `View-quit'), go to WINDOW.
  (WINDOW . quit-window)    do quit-window, then select WINDOW.
  (WINDOW BUF START POINT)  display BUF at START, POINT, then select WINDOW.")
 
@@ -128,10 +120,14 @@ This is a list
   "Display or return message saying how to restore windows after help command.
 This function assumes that `standard-output' is the help buffer.
 It computes a message, and applies the optional argument FUNCTION to it.
-If FUNCTION is nil, it applies `message', thus displaying the message."
+If FUNCTION is nil, it applies `message', thus displaying the message.
+In addition, this function sets up `help-return-method', which see, that
+specifies what to do when the user exits the help buffer."
   (and (not (get-buffer-window standard-output))
        (let ((first-message
-             (cond ((special-display-p (buffer-name standard-output))
+             (cond ((or
+                     pop-up-frames
+                     (special-display-p (buffer-name standard-output)))
                     (setq help-return-method (cons (selected-window) t))
                     ;; If the help output buffer is a special display buffer,
                     ;; don't say anything about how to get rid of it.
@@ -163,7 +159,8 @@ If FUNCTION is nil, it applies `message', thus displaying the message."
                   (if first-message "  ")
                   ;; If the help buffer will go in a separate frame,
                   ;; it's no use mentioning a command to scroll, so don't.
-                  (if (special-display-p (buffer-name standard-output))
+                  (if (or pop-up-windows
+                          (special-display-p (buffer-name standard-output)))
                       nil
                     (if (same-window-p (buffer-name standard-output))
                         ;; Say how to scroll this window.
@@ -176,40 +173,50 @@ If FUNCTION is nil, it applies `message', thus displaying the message."
 ;; So keyboard macro definitions are documented correctly
 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
 
-(defalias 'help 'help-for-help)
-(make-help-screen help-for-help
-  "a b c C e f F i I k C-k l L m p s t v w C-c C-d C-f C-n C-p C-t C-w . or ? :"
+(defalias 'help 'help-for-help-internal)
+;; find-function can find this.
+(defalias 'help-for-help 'help-for-help-internal)
+;; It can't find this, but nobody will look.
+(make-help-screen help-for-help-internal
+  "a b c C e f F i I k C-k l L m p r s t v w C-c C-d C-f C-n C-p C-t C-w . or ? :"
   "You have typed %THIS-KEY%, the help character.  Type a Help option:
 \(Use SPC or DEL to scroll through this text.  Type \\<help-map>\\[help-quit] to exit the Help command.)
 
-a  command-apropos.  Give a substring, and see a list of commands
-       (functions interactively callable) that contain
-       that substring.  See also the  apropos  command.
+a  command-apropos.  Give a list of words or a regexp, to get a list of
+        commands whose names match.  See also the  apropos  command.
 b  describe-bindings.  Display table of all key bindings.
 c  describe-key-briefly.  Type a command key sequence;
        it prints the function name that sequence runs.
 C  describe-coding-system.  This describes either a specific coding system
         (if you type its name) or the coding systems currently in use
        (if you type just RET).
-e  view-echo-area-messages.  Show the `*Messages*' buffer.
-f  describe-function.  Type a function name and get documentation of it.
+d  apropos-documentation.  Give a pattern (a list or words or a regexp), and
+       see a list of functions, variables, and other items whose built-in
+       doucmentation string matches that pattern.  See also the apropos command.
+e  view-echo-area-messages.  Show the buffer where the echo-area messages
+       are stored.
+f  describe-function.  Type a function name and get its documentation.
 F  Info-goto-emacs-command-node.  Type a function name;
-       it takes you to the Info node for that command.
+       it takes you to the on-line manual's section that describes
+       the command.
 h  Display the HELLO file which illustrates various scripts.
-i  info. The  info  documentation reader.
+i  info. The Info documentation reader: read on-line manuals.
 I  describe-input-method.  Describe a specific input method (if you type
        its name) or the current input method (if you type just RET).
 k  describe-key.  Type a command key sequence;
-       it displays the full documentation.
+       it displays the full documentation for that key sequence.
 K Info-goto-emacs-key-command-node.  Type a command key sequence;
-       it takes you to the Info node for the command bound to that key.
+       it takes you to the on-line manual's section that describes
+       the command bound to that key.
 l  view-lossage.  Show last 100 characters you typed.
 L  describe-language-environment.  This describes either a
        specific language environment (if you type its name)
        or the current language environment (if you type just RET).
-m  describe-mode.  Print documentation of current minor modes,
+m  describe-mode.  Display documentation of current minor modes,
        and the current major mode, including their special commands.
+n  view-emacs-news.  Display news of recent Emacs changes.
 p  finder-by-keyword. Find packages matching a given topic keyword.
+r  info-emacs-manual.  Display the Emacs manual in Info mode.
 s  describe-syntax.  Display contents of syntax table, plus explanations.
 S  info-lookup-symbol.  Display the definition of a specific symbol
         as found in the manual for the language this buffer is written in.
@@ -237,32 +244,40 @@ C-w Display information on absence of warranty for GNU Emacs."
 (defun function-called-at-point ()
   "Return a function around point or else called by the list containing point.
 If that doesn't give a function, return nil."
-  (with-syntax-table emacs-lisp-mode-syntax-table
-    (or (condition-case ()
-           (save-excursion
-             (or (not (zerop (skip-syntax-backward "_w")))
-                 (eq (char-syntax (following-char)) ?w)
-                 (eq (char-syntax (following-char)) ?_)
-                 (forward-sexp -1))
-             (skip-chars-forward "'")
-             (let ((obj (read (current-buffer))))
-               (and (symbolp obj) (fboundp obj) obj)))
-         (error nil))
-       (condition-case ()
-           (save-excursion
-             (save-restriction
-               (narrow-to-region (max (point-min)
-                                      (- (point) 1000)) (point-max))
-               ;; Move up to surrounding paren, then after the open.
-               (backward-up-list 1)
-               (forward-char 1)
-               ;; If there is space here, this is probably something
-               ;; other than a real Lisp function call, so ignore it.
-               (if (looking-at "[ \t]")
-                   (error "Probably not a Lisp function call"))
-               (let ((obj (read (current-buffer))))
-                 (and (symbolp obj) (fboundp obj) obj))))
-         (error nil)))))
+  (or (with-syntax-table emacs-lisp-mode-syntax-table
+       (or (condition-case ()
+               (save-excursion
+                 (or (not (zerop (skip-syntax-backward "_w")))
+                     (eq (char-syntax (following-char)) ?w)
+                     (eq (char-syntax (following-char)) ?_)
+                     (forward-sexp -1))
+                 (skip-chars-forward "'")
+                 (let ((obj (read (current-buffer))))
+                   (and (symbolp obj) (fboundp obj) obj)))
+             (error nil))
+           (condition-case ()
+               (save-excursion
+                 (save-restriction
+                   (narrow-to-region (max (point-min)
+                                          (- (point) 1000)) (point-max))
+                   ;; Move up to surrounding paren, then after the open.
+                   (backward-up-list 1)
+                   (forward-char 1)
+                   ;; If there is space here, this is probably something
+                   ;; other than a real Lisp function call, so ignore it.
+                   (if (looking-at "[ \t]")
+                       (error "Probably not a Lisp function call"))
+                   (let ((obj (read (current-buffer))))
+                     (and (symbolp obj) (fboundp obj) obj))))
+             (error nil))))
+      (let* ((str (find-tag-default))
+            (sym (if str (intern-soft str))))
+       (if (and sym (fboundp sym))
+           sym
+         (save-match-data
+           (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
+             (setq sym (intern-soft (match-string 1 str)))
+             (and (fboundp sym) sym)))))))
 
 \f
 ;;; `User' help functions
@@ -313,19 +328,61 @@ of the key sequence that ran this command."
 
 (defun view-emacs-news (&optional arg)
   "Display info on recent changes to Emacs.
-With numeric argument, display information on correspondingly older changes."
+With argument, display info only for the selected version."
   (interactive "P")
-  (let* ((arg (if arg (prefix-numeric-value arg) 0))
-        (file (cond ((eq arg 0) "NEWS")
-                    ((eq arg 1) "ONEWS")
-                    (t
-                     (nth (- arg 2)
-                          (nreverse (directory-files data-directory
-                                                     nil "^ONEWS\\.[0-9]+$"
-                                                     nil)))))))
-    (if file
-       (view-file (expand-file-name file data-directory))
-      (error "No such old news"))))
+  (if (not arg)
+      (view-file (expand-file-name "NEWS" data-directory))
+    (let* ((map (sort
+                 (delete-dups
+                  (apply
+                   'nconc
+                   (mapcar
+                    (lambda (file)
+                      (with-temp-buffer
+                        (insert-file-contents
+                         (expand-file-name file data-directory))
+                        (let (res)
+                          (while (re-search-forward
+                                  (if (string-match "^ONEWS\\.[0-9]+$" file)
+                                      "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
+                                    "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
+                            (setq res (cons (list (match-string-no-properties 1)
+                                                  file) res)))
+                          res)))
+                    (append '("NEWS" "ONEWS")
+                            (directory-files data-directory nil
+                                             "^ONEWS\\.[0-9]+$" nil)))))
+                 (lambda (a b)
+                   (string< (car b) (car a)))))
+           (current (caar map))
+           (version (completing-read
+                     (format "Read NEWS for the version (default %s): " current)
+                     (mapcar 'car map) nil nil nil nil current))
+           (file (cadr (assoc version map)))
+           res)
+      (if (not file)
+          (error "No news is good news")
+        (view-file (expand-file-name file data-directory))
+        (widen)
+        (goto-char (point-min))
+        (when (re-search-forward
+               (concat (if (string-match "^ONEWS\\.[0-9]+$" file)
+                           "Changes in \\(?:Emacs\\|version\\)?[ \t]*"
+                         "^\* [^0-9\n]*") version)
+               nil t)
+          (beginning-of-line)
+          (narrow-to-region
+           (point)
+           (save-excursion
+             (while (and (setq res
+                               (re-search-forward
+                                (if (string-match "^ONEWS\\.[0-9]+$" file)
+                                    "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
+                                  "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
+                         (equal (match-string-no-properties 1) version)))
+             (or res (goto-char (point-max)))
+             (beginning-of-line)
+             (point))))))))
 
 (defun view-todo (&optional arg)
   "Display the Emacs TODO list."
@@ -386,7 +443,8 @@ We put that list in a buffer, and display the buffer.
 The optional argument PREFIX, if non-nil, should be a key sequence;
 then we display only bindings that start with that prefix.
 The optional argument BUFFER specifies which buffer's bindings
-to display (default, the current buffer)."
+to display (default, the current buffer).  BUFFER can be a buffer
+or a buffer name."
   (interactive)
   (or buffer (setq buffer (current-buffer)))
   (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p))
@@ -425,6 +483,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
   (let ((func (indirect-function definition))
         (defs nil)
         (standard-output (if insert (current-buffer) t)))
+    ;; In DEFS, find all symbols that are aliases for DEFINITION.
     (mapatoms (lambda (symbol)
                (and (fboundp symbol)
                     (not (eq symbol definition))
@@ -432,27 +491,37 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
                                  (indirect-function symbol)
                                (error symbol)))
                     (push symbol defs))))
-    (princ (mapconcat
-            #'(lambda (symbol)
-                (let* ((remapped (command-remapping symbol))
-                      (keys (where-is-internal
-                             symbol overriding-local-map nil nil remapped))
-                       (keys (mapconcat 'key-description keys ", ")))
-                  (if insert
-                      (if (> (length keys) 0)
-                          (if remapped
-                              (format "%s (%s) (remapped from %s)"
-                                      keys remapped symbol)
-                            (format "%s (%s)" keys symbol))
-                        (format "M-x %s RET" symbol))
-                    (if (> (length keys) 0)
-                        (if remapped
-                            (format "%s is remapped to %s which is on %s"
-                                    definition symbol keys)
-                          (format "%s is on %s" symbol keys))
-                      (format "%s is not on any key" symbol)))))
-            (cons definition defs)
-            ";\nand ")))
+    ;; Look at all the symbols--first DEFINITION,
+    ;; then its aliases.
+    (dolist (symbol (cons definition defs))
+      (let* ((remapped (command-remapping symbol))
+            (keys (where-is-internal
+                   symbol overriding-local-map nil nil remapped))
+            (keys (mapconcat 'key-description keys ", "))
+            string)
+       (setq string
+             (if insert
+                 (if (> (length keys) 0)
+                     (if remapped
+                         (format "%s (%s) (remapped from %s)"
+                                 keys remapped symbol)
+                       (format "%s (%s)" keys symbol))
+                   (format "M-x %s RET" symbol))
+               (if (> (length keys) 0)
+                   (if remapped
+                       (format "%s is remapped to %s which is on %s"
+                               definition symbol keys)
+                     (format "%s is on %s" symbol keys))
+                 ;; If this is the command the user asked about,
+                 ;; and it is not on any key, say so.
+                 ;; For other symbols, its aliases, say nothing
+                 ;; about them unless they are on keys.
+                 (if (eq symbol definition)
+                     (format "%s is not on any key" symbol)))))
+       (when string
+         (unless (eq symbol definition)
+           (princ ";\n its alias "))
+         (princ string)))))
   nil)
 
 (defun string-key-binding (key)
@@ -513,8 +582,17 @@ the last key hit are used."
            (goto-char position)))
       ;; Ok, now look up the key and name the command.
       (let ((defn (or (string-key-binding key)
-                     (key-binding key)))
-           (key-desc (help-key-description key untranslated)))
+                     (key-binding key t)))
+           key-desc)
+       ;; Don't bother user with strings from (e.g.) the select-paste menu.
+       (if (stringp (aref key (1- (length key))))
+           (aset key (1- (length key)) "(any string)"))
+       (if (and (> (length untranslated) 0)
+                (stringp (aref untranslated (1- (length untranslated)))))
+           (aset untranslated (1- (length untranslated))
+                 "(any string)"))
+       ;; Now describe the key, perhaps as changed.
+       (setq key-desc (help-key-description key untranslated))
        (if (or (null defn) (integerp defn) (equal defn 'undefined))
            (princ (format "%s is undefined" key-desc))
          (princ (format (if (windowp window)
@@ -523,15 +601,17 @@ the last key hit are used."
                         key-desc
                         (if (symbolp defn) defn (prin1-to-string defn)))))))))
 
-
-(defun describe-key (key &optional untranslated)
+(defun describe-key (key &optional untranslated up-event)
   "Display documentation of the function invoked by KEY.
-KEY should be a key sequence--when calling from a program,
-pass a string or a vector.
-If non-nil UNTRANSLATED is a vector of the untranslated events.
-It can also be a number in which case the untranslated events from
-the last key hit are used."
-  (interactive "kDescribe key: \np")
+KEY can be any kind of a key sequence; it can include keyboard events,
+mouse events, and/or menu events.  When calling from a program,
+pass KEY as a string or a vector.
+
+If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
+It can also be a number, in which case the untranslated events from
+the last key sequence entered are used."
+  ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil.
+  (interactive "kDescribe key (or click or menu item): \np\nU")
   (if (numberp untranslated)
       (setq untranslated (this-single-command-raw-keys)))
   (save-excursion
@@ -547,10 +627,17 @@ the last key hit are used."
       (when (windowp window)
            (set-buffer (window-buffer window))
        (goto-char position))
-      (let ((defn (or (string-key-binding key) (key-binding key))))
+      (let ((defn (or (string-key-binding key) (key-binding key t))))
        (if (or (null defn) (integerp defn) (equal defn 'undefined))
            (message "%s is undefined" (help-key-description key untranslated))
          (help-setup-xref (list #'describe-function defn) (interactive-p))
+         ;; Don't bother user with strings from (e.g.) the select-paste menu.
+         (if (stringp (aref key (1- (length key))))
+             (aset key (1- (length key)) "(any string)"))
+         (if (and untranslated
+                  (stringp (aref untranslated (1- (length untranslated)))))
+             (aset untranslated (1- (length untranslated))
+                   "(any string)"))
          (with-output-to-temp-buffer (help-buffer)
            (princ (help-key-description key untranslated))
            (if (windowp window)
@@ -559,80 +646,141 @@ the last key hit are used."
            (prin1 defn)
            (princ "\n   which is ")
            (describe-function-1 defn)
+           (when up-event
+             (let ((ev (aref up-event 0))
+                   (descr (key-description up-event))
+                   (hdr "\n\n-------------- up event ---------------\n\n")
+                   defn
+                   mouse-1-tricky mouse-1-remapped)
+               (when (and (consp ev)
+                          (eq (car ev) 'mouse-1)
+                          (windowp window)
+                          mouse-1-click-follows-link
+                          (not (eq mouse-1-click-follows-link 'double))
+                          (with-current-buffer (window-buffer window)
+                            (mouse-on-link-p (posn-point (event-start ev)))))
+                 (setq mouse-1-tricky (integerp mouse-1-click-follows-link)
+                       mouse-1-remapped (or (not mouse-1-tricky)
+                                            (> mouse-1-click-follows-link 0)))
+                 (if mouse-1-remapped
+                     (setcar ev 'mouse-2)))
+               (setq defn (or (string-key-binding up-event) (key-binding up-event)))
+               (unless (or (null defn) (integerp defn) (equal defn 'undefined))
+                 (princ (if mouse-1-tricky
+                            "\n\n----------------- up-event (short click) ----------------\n\n"
+                          hdr))
+                 (setq hdr nil)
+                 (princ descr)
+                 (if (windowp window)
+                     (princ " at that spot"))
+                 (if mouse-1-remapped
+                     (princ " is remapped to <mouse-2>\n  which" ))
+                 (princ " runs the command ")
+                 (prin1 defn)
+                 (princ "\n   which is ")
+                 (describe-function-1 defn))
+               (when mouse-1-tricky
+                 (setcar ev
+                         (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2))
+                 (setq defn (or (string-key-binding up-event) (key-binding up-event)))
+                 (unless (or (null defn) (integerp defn) (equal defn 'undefined))
+                   (princ (or hdr
+                              "\n\n----------------- up-event (long click) ----------------\n\n"))
+                   (princ "Pressing ")
+                   (princ descr)
+                   (if (windowp window)
+                       (princ " at that spot"))
+                   (princ (format " for longer than %d milli-seconds\n"
+                                  (abs mouse-1-click-follows-link)))
+                   (if (not mouse-1-remapped)
+                       (princ " remaps it to <mouse-2> which" ))
+                   (princ " runs the command ")
+                   (prin1 defn)
+                   (princ "\n   which is ")
+                   (describe-function-1 defn)))))
            (print-help-return-message)))))))
 
 \f
 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.
-The major mode description comes first, followed by the minor modes,
-each on a separate page.
-For this to work correctly for a minor mode, the mode's indicator variable
-\(listed in `minor-mode-alist') must also be a function whose documentation
-describes the minor mode."
+A brief summary of the minor modes comes first, followed by the
+major mode description.  This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable \(listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode."
   (interactive)
-  (help-setup-xref (list #'describe-mode (or buffer (current-buffer)))
+  (unless buffer (setq buffer (current-buffer)))
+  (help-setup-xref (list #'describe-mode buffer)
                   (interactive-p))
   ;; For the sake of help-do-xref and help-xref-go-back,
   ;; don't switch buffers before calling `help-buffer'.
   (with-output-to-temp-buffer (help-buffer)
-    (save-excursion
-      (when buffer (set-buffer buffer))
+    (with-current-buffer buffer
       (let (minor-modes)
+       ;; Older packages do not register in minor-mode-list but only in
+       ;; minor-mode-alist.
+       (dolist (x minor-mode-alist)
+         (setq x (car x))
+         (unless (memq x minor-mode-list)
+           (push x minor-mode-list)))
        ;; Find enabled minor mode we will want to mention.
        (dolist (mode minor-mode-list)
          ;; Document a minor mode if it is listed in minor-mode-alist,
          ;; non-nil, and has a function definition.
-         (and (boundp mode) (symbol-value mode)
-              (fboundp mode)
-              (let ((pretty-minor-mode mode)
-                    indicator)
-                (if (string-match "\\(-minor\\)?-mode\\'"
-                                  (symbol-name mode))
-                    (setq pretty-minor-mode
-                          (capitalize
-                           (substring (symbol-name mode)
-                                      0 (match-beginning 0)))))
-                (setq indicator (cadr (assq mode minor-mode-alist)))
-                (while (and indicator (symbolp indicator)
-                            (boundp indicator)
-                            (not (eq indicator (symbol-value indicator))))
-                  (setq indicator (symbol-value indicator)))
-                (push (list pretty-minor-mode mode indicator)
-                      minor-modes))))
-       (if auto-fill-function
-           (push '("Auto Fill" auto-fill-mode " Fill")
-                 minor-modes))
+         (let ((fmode (or (get mode :minor-mode-function) mode)))
+           (and (boundp mode) (symbol-value mode)
+                (fboundp fmode)
+                (let ((pretty-minor-mode
+                       (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+                                         (symbol-name fmode))
+                           (capitalize
+                            (substring (symbol-name fmode)
+                                       0 (match-beginning 0)))
+                         fmode)))
+                  (push (list fmode pretty-minor-mode
+                              (format-mode-line (assq mode minor-mode-alist)))
+                        minor-modes)))))
        (setq minor-modes
              (sort minor-modes
-                   (lambda (a b) (string-lessp (car a) (car b)))))
+                   (lambda (a b) (string-lessp (cadr a) (cadr b)))))
        (when minor-modes
          (princ "Summary of minor modes:\n")
-         (dolist (mode minor-modes)
-           (let ((pretty-minor-mode (nth 0 mode))
-                 (indicator (nth 2 mode)))
-             (princ (format "  %s minor mode (%s):\n"
-                            pretty-minor-mode
-                            (if indicator
-                                (format "indicator%s" indicator)
-                              "no indicator")))))
+         (make-local-variable 'help-button-cache)
+         (with-current-buffer standard-output
+           (dolist (mode minor-modes)
+             (let ((mode-function (nth 0 mode))
+                   (pretty-minor-mode (nth 1 mode))
+                   (indicator (nth 2 mode)))
+               (setq indicator (if (zerop (length indicator))
+                                   "no indicator"
+                                 (format "indicator%s" indicator)))
+               (add-text-properties 0 (length pretty-minor-mode)
+                                    '(face bold) pretty-minor-mode)
+               (save-excursion
+                 (goto-char (point-max))
+                 (princ "\n\f\n")
+                 (push (point-marker) help-button-cache)
+                 ;; Document the minor modes fully.
+                 (insert pretty-minor-mode)
+                 (princ (format " minor mode (%s):\n" indicator))
+                 (princ (documentation mode-function)))
+               (princ "  ")
+               (insert-button pretty-minor-mode
+                              'action (car help-button-cache)
+                              'follow-link t
+                              'help-echo "mouse-2, RET: show full information")
+               (princ (format " minor mode (%s):\n" indicator)))))
          (princ "\n(Full information about these minor modes
 follows the description of the major mode.)\n\n"))
        ;; Document the major mode.
-       (princ mode-name)
+       (let ((mode mode-name))
+         (with-current-buffer standard-output
+           (insert mode)
+           (add-text-properties (- (point) (length mode)) (point) '(face bold))))
        (princ " mode:\n")
-       (princ (documentation major-mode))
-       ;; Document the minor modes fully.
-       (dolist (mode minor-modes)
-         (let ((pretty-minor-mode (nth 0 mode))
-               (mode-function (nth 1 mode))
-               (indicator (nth 2 mode)))
-           (princ "\n\f\n")
-           (princ (format "%s minor mode (%s):\n"
-                          pretty-minor-mode
-                          (if indicator
-                              (format "indicator%s" indicator)
-                            "no indicator")))
-           (princ (documentation mode-function)))))
+       (princ (documentation major-mode)))
       (print-help-return-message))))
 
 
@@ -769,5 +917,5 @@ out of view."
 ;; defcustoms which require 'help'.
 (provide 'help)
 
-;;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
+;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
 ;;; help.el ends here