Resurrect a comment lost in the previous commit.

[bpt/emacs.git] / lisp / apropos.el

diff --git a/lisp/apropos.el b/lisp/apropos.el
index f726029..ab4c04c 100644 (file)
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,9 +1,9 @@
-;;; apropos.el --- apropos commands for users and programmers.
+;;; apropos.el --- apropos commands for users and programmers

 
 

-;; Copyright (C) 1989, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994, 1995, 2001 Free Software Foundation, Inc.

 
 ;; Author: Joe Wells <jbw@bigbird.bu.edu>
 
 ;; Author: Joe Wells <jbw@bigbird.bu.edu>

-;; Rewritten: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
+;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>

 ;; Keywords: help
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: help
 
 ;; This file is part of GNU Emacs.


@@ -57,9 +57,11 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'button)
+

 (defgroup apropos nil
   "Apropos commands for users and programmers"
 (defgroup apropos nil
   "Apropos commands for users and programmers"

-  :group 'Help
+  :group 'help

   :prefix "apropos")
 
 ;; I see a degradation of maybe 10-20% only.
   :prefix "apropos")
 
 ;; I see a degradation of maybe 10-20% only.


@@ -71,51 +73,51 @@ Slows them down more or less.  Set this non-nil if you have a fast machine."
   :type 'boolean)
 
 
   :type 'boolean)
 
 

-(defcustom apropos-symbol-face (if window-system 'bold)
-  "*Face for symbol name in apropos output or `nil'.
-This looks good, but slows down the commands several times."
+(defcustom apropos-symbol-face 'bold
+  "*Face for symbol name in Apropos output, or nil for none."

   :group 'apropos
   :type 'face)
 
   :group 'apropos
   :type 'face)
 

-(defcustom apropos-keybinding-face (if window-system 'underline)
-  "*Face for keybinding display in apropos output or `nil'.  
-This looks good, but slows down the commands several times."
+(defcustom apropos-keybinding-face 'underline
+  "*Face for lists of keybinding in Apropos output, or nil for none."

   :group 'apropos
   :type 'face)
 
   :group 'apropos
   :type 'face)
 

-(defcustom apropos-label-face (if window-system 'italic)
-  "*Face for label (Command, Variable ...) in apropos output or `nil'.
-If this is `nil' no mouse highlighting occurs.
-This looks good, but slows down the commands several times.
-When this is a face name, as it is initially, it gets transformed to a
-text-property list for efficiency."
+(defcustom apropos-label-face 'italic
+  "*Face for label (`Command', `Variable' ...) in Apropos output.
+A value of nil means don't use any special font for them, and also
+turns off mouse highlighting."

   :group 'apropos
   :type 'face)
 
   :group 'apropos
   :type 'face)
 

-(defcustom apropos-property-face (if window-system 'bold-italic)
-  "*Face for property name in apropos output or `nil'.  
-This looks good, but slows down the commands several times."
+(defcustom apropos-property-face 'bold-italic
+  "*Face for property name in apropos output, or nil for none."

   :group 'apropos
   :type 'face)
 
   :group 'apropos
   :type 'face)
 

-(defcustom apropos-match-face (if window-system 'secondary-selection)
-  "*Face for matching part in apropos-documentation/value output or `nil'.  
-This looks good, but slows down the commands several times."
+(defcustom apropos-match-face 'secondary-selection
+  "*Face for matching text in Apropos documentation/value, or nil for none.
+This applies when you look for matches in the documentation or variable value
+for the regexp; the part that matches gets displayed in this font."

   :group 'apropos
   :type 'face)
 
 
 (defvar apropos-mode-map
   (let ((map (make-sparse-keymap)))
   :group 'apropos
   :type 'face)
 
 
 (defvar apropos-mode-map
   (let ((map (make-sparse-keymap)))

+    (set-keymap-parent map button-buffer-map)
+    ;; Use `apropos-follow' instead of just using the button
+    ;; definition of RET, so that users can use it anywhere in an
+    ;; apropos item, not just on top of a button.

     (define-key map "\C-m" 'apropos-follow)
     (define-key map " "    'scroll-up)
     (define-key map "\177" 'scroll-down)
     (define-key map "q"    'quit-window)
     (define-key map "\C-m" 'apropos-follow)
     (define-key map " "    'scroll-up)
     (define-key map "\177" 'scroll-down)
     (define-key map "q"    'quit-window)

-    (define-key map [mouse-2] 'apropos-mouse-follow)
-    (define-key map [down-mouse-2] nil)

     map)
   "Keymap used in Apropos mode.")
 
     map)
   "Keymap used in Apropos mode.")
 

+(defvar apropos-mode-hook nil
+  "*Hook run when mode is turned on.")

 
 (defvar apropos-regexp nil
   "Regexp used in current apropos run.")
 
 (defvar apropos-regexp nil
   "Regexp used in current apropos run.")


@@ -127,36 +129,137 @@ This looks good, but slows down the commands several times."
   "Alist of symbols already found in current apropos run.")
 
 (defvar apropos-item ()
   "Alist of symbols already found in current apropos run.")
 
 (defvar apropos-item ()

-  "Current item in or for apropos-accumulator.")
+  "Current item in or for `apropos-accumulator'.")
+
+\f
+;;; Button types used by apropos
+
+(define-button-type 'apropos-symbol
+  'face apropos-symbol-face
+  'help-echo "mouse-2, RET: Display more help on this symbol"
+  'action #'apropos-symbol-button-display-help
+  'skip t)
+
+(defun apropos-symbol-button-display-help (button)
+  "Display further help for the `apropos-symbol' button BUTTON."
+  (button-activate
+   (or (apropos-next-label-button (button-start button))
+       (error "There is nothing to follow for `%s'" (button-label button)))))
+
+(define-button-type 'apropos-function
+  'apropos-label "Function"
+  'action (lambda (button)
+           (describe-function (button-get button 'apropos-symbol)))
+  'help-echo "mouse-2, RET: Display more help on this function")
+(define-button-type 'apropos-macro
+  'apropos-label "Macro"
+  'action (lambda (button)
+           (describe-function (button-get button 'apropos-symbol)))
+  'help-echo "mouse-2, RET: Display more help on this macro")
+(define-button-type 'apropos-command
+  'apropos-label "Command"
+  'action (lambda (button)
+           (describe-function (button-get button 'apropos-symbol)))
+  'help-echo "mouse-2, RET: Display more help on this command")
+  
+;; We used to use `customize-variable-other-window' instead for a
+;; customizable variable, but that is slow.  It is better to show an
+;; ordinary help buffer and let the user click on the customization
+;; button in that buffer, if he wants to.
+;; Likewise for `customize-face-other-window'.
+(define-button-type 'apropos-variable
+  'apropos-label "Variable"
+  'help-echo "mouse-2, RET: Display more help on this variable"
+  'action (lambda (button)
+           (describe-variable (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-face
+  'apropos-label "Face"
+  'help-echo "mouse-2, RET: Display more help on this face"
+  'action (lambda (button)
+           (describe-face (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-group
+  'apropos-label "Group"
+  'help-echo "mouse-2, RET: Display more help on this group"
+  'action (lambda (button)
+           (customize-variable-other-window
+            (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-widget
+  'apropos-label "Widget"
+  'help-echo "mouse-2, RET: Display more help on this widget"
+  'action (lambda (button)
+           (widget-browse-other-window (button-get button 'apropos-symbol))))
+
+(define-button-type 'apropos-plist
+  'apropos-label "Plist"
+  'help-echo "mouse-2, RET: Display more help on this plist"
+  'action (lambda (button)
+           (apropos-describe-plist (button-get button 'apropos-symbol))))
+
+(defun apropos-next-label-button (pos)
+  "Returns the next apropos label button after POS, or nil if there's none.
+Will also return nil if more than one `apropos-symbol' button is encountered
+before finding a label."
+  (let* ((button (next-button pos t))
+        (already-hit-symbol nil)
+        (label (and button (button-get button 'apropos-label)))
+        (type (and button (button-get button 'type))))
+    (while (and button
+               (not label)
+               (or (not (eq type 'apropos-symbol))
+                   (not already-hit-symbol)))
+      (when (eq type 'apropos-symbol)
+       (setq already-hit-symbol t))
+      (setq button (next-button (button-start button)))
+      (when button
+       (setq label (button-get button 'apropos-label))
+       (setq type (button-get button 'type))))
+    (and label button)))
+

 \f
 \f

-(defun apropos-mode ()
+;;;###autoload
+(define-derived-mode apropos-mode fundamental-mode "Apropos"

   "Major mode for following hyperlinks in output of apropos commands.
 
   "Major mode for following hyperlinks in output of apropos commands.
 

-\\{apropos-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map apropos-mode-map)
-  (setq major-mode 'apropos-mode
-       mode-name "Apropos"))
+\\{apropos-mode-map}")

 
 ;;;###autoload
 
 ;;;###autoload

-(defun apropos-variable (regexp)
-  (interactive (list (read-string "Apropos variable (regexp): ")))
-  (apropos-command regexp nil t))
+(defun apropos-variable (regexp &optional do-all)
+  "Show user variables that match REGEXP.
+With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also show
+normal variables."
+  (interactive (list (read-string
+                      (concat "Apropos "
+                              (if (or current-prefix-arg apropos-do-all)
+                                 "variable"
+                               "user option")
+                              " (regexp): "))
+                     current-prefix-arg))
+  (apropos-command regexp nil
+                  (if (or do-all apropos-do-all)
+                      #'(lambda (symbol)
+                          (and (boundp symbol)
+                               (get symbol 'variable-documentation)))
+                    'user-variable-p)))

 
 ;; For auld lang syne:
 ;;;###autoload
 (fset 'command-apropos 'apropos-command)
 ;;;###autoload
 
 ;; For auld lang syne:
 ;;;###autoload
 (fset 'command-apropos 'apropos-command)
 ;;;###autoload

-(defun apropos-command (apropos-regexp &optional do-all just-vars)
-  "Show commands (interactively callable functions) that match REGEXP.
-With optional prefix ARG, or if `apropos-do-all' is non-nil, also show
-variables.  If JUST-VARS is non-nil, show only variables."
+(defun apropos-command (apropos-regexp &optional do-all var-predicate)
+  "Show commands (interactively callable functions) that match APROPOS-REGEXP.
+With optional prefix DO-ALL, or if `apropos-do-all' is non-nil, also show
+noninteractive functions.
+
+If VAR-PREDICATE is non-nil, show only variables, and only those that
+satisfy the predicate VAR-PREDICATE."

   (interactive (list (read-string (concat
                                   "Apropos command "
                                   (if (or current-prefix-arg
                                           apropos-do-all)
   (interactive (list (read-string (concat
                                   "Apropos command "
                                   (if (or current-prefix-arg
                                           apropos-do-all)

-                                      "or variable ")
+                                      "or function ")

                                   "(regexp): "))
                     current-prefix-arg))
   (let ((message
                                   "(regexp): "))
                     current-prefix-arg))
   (let ((message


@@ -165,45 +268,41 @@ variables.  If JUST-VARS is non-nil, show only variables."
     (or do-all (setq do-all apropos-do-all))
     (setq apropos-accumulator
          (apropos-internal apropos-regexp
     (or do-all (setq do-all apropos-do-all))
     (setq apropos-accumulator
          (apropos-internal apropos-regexp

-                           (if do-all
-                               (lambda (symbol) (or (commandp symbol)
-                                                    (user-variable-p symbol)))
-                             (if just-vars 'user-variable-p
-                               'commandp))))
+                           (or var-predicate
+                               (if do-all 'functionp 'commandp))))

     (let ((tem apropos-accumulator))
       (while tem
        (if (get (car tem) 'apropos-inhibit)
            (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
        (setq tem (cdr tem))))
     (let ((tem apropos-accumulator))
       (while tem
        (if (get (car tem) 'apropos-inhibit)
            (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
        (setq tem (cdr tem))))

-    (if (apropos-print
-        t
-        (lambda (p)
-          (let (doc symbol)
-            (while p
-              (setcar p (list
-                         (setq symbol (car p))
-                         (if (or do-all (not just-vars))
-                             (if (commandp symbol)
-                                 (if (setq doc (documentation symbol t))
-                                     (substring doc 0 (string-match "\n" doc))
-                                   "(not documented)")))
-                         (and do-all
-                              (user-variable-p symbol)
-                              (if (setq doc (documentation-property
-                                             symbol 'variable-documentation t))
-                                  (substring doc 0
-                                             (string-match "\n" doc))))))
-              (setq p (cdr p)))))
-        nil)
-       (and message (message message)))))
+    (let ((p apropos-accumulator)
+         doc symbol)
+      (while p
+       (setcar p (list
+                  (setq symbol (car p))
+                  (unless var-predicate
+                    (if (functionp symbol)
+                        (if (setq doc (documentation symbol t))
+                            (substring doc 0 (string-match "\n" doc))
+                          "(not documented)")))
+                  (and var-predicate
+                       (funcall var-predicate symbol)
+                       (if (setq doc (documentation-property
+                                      symbol 'variable-documentation t))
+                           (substring doc 0
+                                      (string-match "\n" doc))))))
+       (setq p (cdr p))))
+    (and (apropos-print t nil)
+        message
+        (message message))))

 
 
 ;;;###autoload
 (defun apropos (apropos-regexp &optional do-all)
 
 
 ;;;###autoload
 (defun apropos (apropos-regexp &optional do-all)

-  "Show all bound symbols whose names match REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound
-symbols and key bindings, which is a little more time-consuming.
-Returns list of symbols and documentation found."
+  "Show all bound symbols whose names match APROPOS-REGEXP.
+With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
+show unbound symbols and key bindings, which is a little more
+time-consuming.  Returns list of symbols and documentation found."

   (interactive "sApropos symbol (regexp): \nP")
   (setq apropos-accumulator
        (apropos-internal apropos-regexp
   (interactive "sApropos symbol (regexp): \nP")
   (setq apropos-accumulator
        (apropos-internal apropos-regexp


@@ -219,56 +318,56 @@ Returns list of symbols and documentation found."
       (if (get (car tem) 'apropos-inhibit)
          (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
       (setq tem (cdr tem))))
       (if (get (car tem) 'apropos-inhibit)
          (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
       (setq tem (cdr tem))))

+  (let ((p apropos-accumulator)
+       symbol doc properties)
+    (while p
+      (setcar p (list
+                (setq symbol (car p))
+                (when (fboundp symbol)
+                  (if (setq doc (condition-case nil
+                                    (documentation symbol t)
+                                  (void-function
+                                   "(alias for undefined function)")))
+                      (substring doc 0 (string-match "\n" doc))
+                    "(not documented)"))
+                (when (boundp symbol)
+                  (if (setq doc (documentation-property
+                                 symbol 'variable-documentation t))
+                      (substring doc 0 (string-match "\n" doc))
+                    "(not documented)"))
+                (when (setq properties (symbol-plist symbol))
+                  (setq doc (list (car properties)))
+                  (while (setq properties (cdr (cdr properties)))
+                    (setq doc (cons (car properties) doc)))
+                  (mapconcat #'symbol-name (nreverse doc) " "))
+                (when (get symbol 'widget-type)
+                  (if (setq doc (documentation-property
+                                 symbol 'widget-documentation t))
+                      (substring doc 0
+                                 (string-match "\n" doc))
+                    "(not documented)"))
+                (when (facep symbol)
+                  (if (setq doc (documentation-property
+                                 symbol 'face-documentation t))
+                      (substring doc 0
+                                 (string-match "\n" doc))
+                    "(not documented)"))
+                (when (get symbol 'custom-group)
+                  (if (setq doc (documentation-property
+                                 symbol 'group-documentation t))
+                      (substring doc 0
+                                 (string-match "\n" doc))
+                    "(not documented)"))))
+      (setq p (cdr p))))

   (apropos-print
    (or do-all apropos-do-all)
   (apropos-print
    (or do-all apropos-do-all)

-   (lambda (p)
-     (let (symbol doc properties)
-       (while p
-        (setcar p (list
-                   (setq symbol (car p))
-                   (when (fboundp symbol)
-                      (if (setq doc (condition-case nil
-                                        (documentation symbol t)
-                                      (void-function
-                                       "(alias for undefined function)")))
-                         (substring doc 0 (string-match "\n" doc))
-                       "(not documented)"))
-                   (when (boundp symbol)
-                     (if (setq doc (documentation-property
-                                    symbol 'variable-documentation t))
-                         (substring doc 0 (string-match "\n" doc))
-                       "(not documented)"))
-                   (when (setq properties (symbol-plist symbol))
-                     (setq doc (list (car properties)))
-                     (while (setq properties (cdr (cdr properties)))
-                       (setq doc (cons (car properties) doc)))
-                     (mapconcat #'symbol-name (nreverse doc) " "))
-                   (when (get symbol 'widget-type)
-                     (if (setq doc (documentation-property
-                                    symbol 'widget-documentation t))
-                         (substring doc 0
-                                    (string-match "\n" doc))
-                       "(not documented)"))
-                   (when (facep symbol)
-                     (if (setq doc (documentation-property
-                                    symbol 'face-documentation t))
-                         (substring doc 0
-                                    (string-match "\n" doc))
-                       "(not documented)"))
-                   (when (get symbol 'custom-group)
-                     (if (setq doc (documentation-property
-                                    symbol 'group-documentation t))
-                         (substring doc 0
-                                    (string-match "\n" doc))
-                       "(not documented)"))))
-        (setq p (cdr p)))))

    nil))
 
 
 ;;;###autoload
 (defun apropos-value (apropos-regexp &optional do-all)
    nil))
 
 
 ;;;###autoload
 (defun apropos-value (apropos-regexp &optional do-all)

-  "Show all symbols whose value's printed image matches REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also looks
+  "Show all symbols whose value's printed image matches APROPOS-REGEXP.
+With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks

 at the function and at the names and values of properties.
 Returns list of symbols and values found."
   (interactive "sApropos value (regexp): \nP")
 at the function and at the names and values of properties.
 Returns list of symbols and values found."
   (interactive "sApropos value (regexp): \nP")


@@ -287,13 +386,13 @@ Returns list of symbols and values found."
        (if (or f v p)
            (setq apropos-accumulator (cons (list symbol f v p)
                                            apropos-accumulator))))))
        (if (or f v p)
            (setq apropos-accumulator (cons (list symbol f v p)
                                            apropos-accumulator))))))

-  (apropos-print nil nil t))
+  (apropos-print nil t))

 
 
 ;;;###autoload
 (defun apropos-documentation (apropos-regexp &optional do-all)
 
 
 ;;;###autoload
 (defun apropos-documentation (apropos-regexp &optional do-all)

-  "Show symbols whose documentation contain matches for REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also use
+  "Show symbols whose documentation contain matches for APROPOS-REGEXP.
+With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use

 documentation that is not stored in the documentation file and show key
 bindings.
 Returns list of symbols and documentation found."
 documentation that is not stored in the documentation file and show key
 bindings.
 Returns list of symbols and documentation found."


@@ -325,7 +424,7 @@ Returns list of symbols and documentation found."
                       (setq apropos-accumulator
                             (cons (list symbol f v)
                                   apropos-accumulator)))))))
                       (setq apropos-accumulator
                             (cons (list symbol f v)
                                   apropos-accumulator)))))))

-         (apropos-print nil nil t))
+         (apropos-print nil t))

       (kill-buffer standard-input))))
 
 \f
       (kill-buffer standard-input))))
 
 \f


@@ -458,7 +557,7 @@ Returns list of symbols and documentation found."
 
 
 (defun apropos-safe-documentation (function)
 
 
 (defun apropos-safe-documentation (function)

-  "Like documentation, except it avoids calling `get_doc_string'.
+  "Like `documentation', except it avoids calling `get_doc_string'.

 Will return nil instead."
   (while (and function (symbolp function))
     (setq function (if (fboundp function)
 Will return nil instead."
   (while (and function (symbolp function))
     (setq function (if (fboundp function)


@@ -480,44 +579,43 @@ Will return nil instead."
     function))
 
 
     function))
 
 

-
-(defun apropos-print (do-keys doc-fn spacing)
-  "Output result of various apropos commands with `apropos-regexp'.
-APROPOS-ACCUMULATOR is a list.  Optional DOC-FN is called for each element
-of apropos-accumulator and may modify it resulting in (symbol fn-doc
-var-doc [plist-doc]).  Returns sorted list of symbols and documentation
-found."
+(defun apropos-print (do-keys spacing)
+  "Output result of apropos searching into buffer `*Apropos*'.
+The value of `apropos-accumulator' is the list of items to output.
+Each element should have the format (SYMBOL FN-DOC VAR-DOC [PLIST-DOC]).
+The return value is the list that was in `apropos-accumulator', sorted
+alphabetically by symbol name; but this function also sets
+`apropos-accumulator' to nil before returning."

   (if (null apropos-accumulator)
       (message "No apropos matches for `%s'" apropos-regexp)
   (if (null apropos-accumulator)
       (message "No apropos matches for `%s'" apropos-regexp)

-    (if doc-fn
-       (funcall doc-fn apropos-accumulator))

     (setq apropos-accumulator
          (sort apropos-accumulator (lambda (a b)
                                      (string-lessp (car a) (car b)))))
     (setq apropos-accumulator
          (sort apropos-accumulator (lambda (a b)
                                      (string-lessp (car a) (car b)))))

-    (and apropos-label-face
-        (symbolp apropos-label-face)
-        (setq apropos-label-face `(face ,apropos-label-face
-                                        mouse-face highlight)))

     (with-output-to-temp-buffer "*Apropos*"
       (let ((p apropos-accumulator)
            (old-buffer (current-buffer))
     (with-output-to-temp-buffer "*Apropos*"
       (let ((p apropos-accumulator)
            (old-buffer (current-buffer))

-           symbol item point1 point2)
+           symbol item)

        (set-buffer standard-output)
        (apropos-mode)
        (set-buffer standard-output)
        (apropos-mode)

-       (if window-system
-           (insert "If you move the mouse over text that changes color,\n"
+       (if (display-mouse-p)
+           (insert "If moving the mouse over text changes the text's color,\n"

                    (substitute-command-keys
                    (substitute-command-keys

-                    "you can click \\[apropos-mouse-follow] to get more information.\n")))
-       (insert (substitute-command-keys
-                "In this buffer, type \\[apropos-follow] to get full documentation.\n\n"))
+                    "you can click \\[push-button] on that text to get more information.\n")))
+       (insert "In this buffer, go to the name of the command, or function,"
+               " or variable,\n"
+               (substitute-command-keys
+                "and type \\[apropos-follow] to get full documentation.\n\n"))

        (while (consp p)
          (or (not spacing) (bobp) (terpri))
          (setq apropos-item (car p)
                symbol (car apropos-item)
        (while (consp p)
          (or (not spacing) (bobp) (terpri))
          (setq apropos-item (car p)
                symbol (car apropos-item)

-               p (cdr p)
-               point1 (point))
-         (princ symbol)                        ; print symbol name
-         (setq point2 (point))
+               p (cdr p))
+         (insert-text-button (symbol-name symbol)
+                             'type 'apropos-symbol
+                             ;; Can't use default, since user may have
+                             ;; changed the variable!
+                             ;; Just say `no' to variables containing faces!
+                             'face apropos-symbol-face)

          ;; Calculate key-bindings if we want them.
          (and do-keys
               (commandp symbol)
          ;; Calculate key-bindings if we want them.
          (and do-keys
               (commandp symbol)


@@ -546,7 +644,9 @@ found."
                   (insert
                    (mapconcat
                     (lambda (key)
                   (insert
                    (mapconcat
                     (lambda (key)

-                      (setq key (key-description key))
+                      (setq key (condition-case ()
+                                    (key-description key)
+                                  (error)))

                       (if apropos-keybinding-face
                           (put-text-property 0 (length key)
                                              'face apropos-keybinding-face
                       (if apropos-keybinding-face
                           (put-text-property 0 (length key)
                                              'face apropos-keybinding-face


@@ -561,30 +661,19 @@ found."
                 (put-text-property (- (point) 3) (point)
                                    'face apropos-keybinding-face)))
          (terpri)
                 (put-text-property (- (point) 3) (point)
                                    'face apropos-keybinding-face)))
          (terpri)

-         ;; only now so we don't propagate text attributes all over
-         (put-text-property point1 point2 'item
-                            (if (eval `(or ,@(cdr apropos-item)))
-                                (car apropos-item)
-                              apropos-item))
-         (if apropos-symbol-face
-             (put-text-property point1 point2 'face apropos-symbol-face))
-         (apropos-print-doc 'describe-function 1
+         (apropos-print-doc 1

                             (if (commandp symbol)
                             (if (commandp symbol)

-                                "Command"
+                                'apropos-command

                               (if (apropos-macrop symbol)
                               (if (apropos-macrop symbol)

-                                  "Macro"
-                                "Function"))
+                                  'apropos-macro
+                                'apropos-function))

                             t)
                             t)

-         (if (get symbol 'custom-type)
-             (apropos-print-doc 'customize-variable-other-window 2
-                                "User Option" t)
-           (apropos-print-doc 'describe-variable 2
-                              "Variable" t))
-         (apropos-print-doc 'customize-group-other-window 6 "Group" t)
-         (apropos-print-doc 'customize-face-other-window 5 "Face" t)
-         (apropos-print-doc 'widget-browse-other-window 4 "Widget" t)
-         (apropos-print-doc 'apropos-describe-plist 3
-                            "Plist" nil)))))
+         (apropos-print-doc 2 'apropos-variable t)
+         (apropos-print-doc 6 'apropos-group t)
+         (apropos-print-doc 5 'apropos-face t)
+         (apropos-print-doc 4 'apropos-widget t)
+         (apropos-print-doc 3 'apropos-plist nil))
+       (setq buffer-read-only t))))

   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))    ; permit gc
 
   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))    ; permit gc
 


@@ -600,55 +689,28 @@ found."
                     '(macro t))))))
 
 
                     '(macro t))))))
 
 

-(defun apropos-print-doc (action i str do-keys)
+(defun apropos-print-doc (i type do-keys)

   (if (stringp (setq i (nth i apropos-item)))
       (progn
        (insert "  ")
   (if (stringp (setq i (nth i apropos-item)))
       (progn
        (insert "  ")

-       (put-text-property (- (point) 2) (1- (point))
-                          'action action)
-       (insert str ": ")
-       (if apropos-label-face
-           (add-text-properties (- (point) (length str) 2)
-                                (1- (point))
-                                apropos-label-face))
+       (insert-text-button (button-type-get type 'apropos-label)
+                           'type type
+                           ;; Can't use the default button face, since
+                           ;; user may have changed the variable!
+                           ;; Just say `no' to variables containing faces!
+                           'face apropos-label-face
+                           'apropos-symbol (car apropos-item))
+       (insert ": ")

        (insert (if do-keys (substitute-command-keys i) i))
        (or (bolp) (terpri)))))
 
 
        (insert (if do-keys (substitute-command-keys i) i))
        (or (bolp) (terpri)))))
 
 

-(defun apropos-mouse-follow (event)
-  (interactive "e")
-  (let ((other (if (eq (current-buffer) (get-buffer "*Apropos*"))
-                  ()
-                (current-buffer))))
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-start event))))
-      (goto-char (posn-point (event-start event)))
-      (or (and (not (eobp)) (get-text-property (point) 'mouse-face))
-         (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
-         (error "There is nothing to follow here"))
-      (apropos-follow other))))
-
-
-(defun apropos-follow (&optional other)
+(defun apropos-follow ()
+  "Invokes any button at point, otherwise invokes the nearest label button."

   (interactive)
   (interactive)

-  (let* (;; Properties are always found at the beginning of the line.
-        (bol (save-excursion (beginning-of-line) (point)))
-        ;; If there is no `item' property here, look behind us.
-        (item (get-text-property bol 'item))
-        (item-at (if item nil (previous-single-property-change bol 'item)))
-        ;; Likewise, if there is no `action' property here, look in front.
-        (action (get-text-property bol 'action))
-        (action-at (if action nil (next-single-property-change bol 'action))))
-    (and (null item) item-at
-        (setq item (get-text-property (1- item-at) 'item)))
-    (and (null action) action-at
-        (setq action (get-text-property action-at 'action)))
-    (if (not (and item action))
-       (error "There is nothing to follow here"))
-    (if (consp item) (error "There is nothing to follow in `%s'" (car item)))
-    (if other (set-buffer other))
-    (funcall action item)))
-
+  (button-activate
+   (or (apropos-next-label-button (line-beginning-position))
+       (error "There is nothing to follow here"))))

 
 
 (defun apropos-describe-plist (symbol)
 
 
 (defun apropos-describe-plist (symbol)


@@ -664,6 +726,7 @@ found."
     (princ ")")
     (print-help-return-message)))
 
     (princ ")")
     (print-help-return-message)))
 

+

 (provide 'apropos)
 
 ;;; apropos.el ends here
 (provide 'apropos)
 
 ;;; apropos.el ends here