javascript-generic-mode: Added C style block comment as used in ECMA-262

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

diff --git a/lisp/apropos.el b/lisp/apropos.el
index 04b0223..9a5230e 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, 2002 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.


@@ -19,8 +19,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -56,48 +57,80 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(require 'button)
+
+(defgroup apropos nil
+  "Apropos commands for users and programmers"
+  :group 'help
+  :prefix "apropos")
+

 ;; I see a degradation of maybe 10-20% only.
 ;; I see a degradation of maybe 10-20% only.

-(defvar apropos-do-all nil
+(defcustom apropos-do-all nil

   "*Whether the apropos commands should do more.
   "*Whether the apropos commands should do more.

-Slows them down more or less.  Set this non-nil if you have a fast machine.")

 
 

+Slows them down more or less.  Set this non-nil if you have a fast machine."
+  :group 'apropos
+  :type 'boolean)

 
 

-(defvar 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.")

 
 

-(defvar 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-symbol-face 'bold
+  "*Face for symbol name in Apropos output, or nil for none."
+  :group 'apropos
+  :type 'face)

 
 

-(defvar 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-keybinding-face 'underline
+  "*Face for lists of keybinding in Apropos output, or nil for none."
+  :group 'apropos
+  :type 'face)

 
 

-(defvar 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-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)

 
 

-(defvar 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-property-face 'bold-italic
+  "*Face for property name in apropos output, or nil for none."
+  :group 'apropos
+  :type 'face)
+
+(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)))
 
 
 (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 "\C-m" 'apropos-follow)

-    (define-key map [mouse-2] 'apropos-mouse-follow)
-    (define-key map [down-mouse-2] nil)
+    (define-key map " "    'scroll-up)
+    (define-key map "\177" 'scroll-down)
+    (define-key map "q"    'quit-window)

     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-show-scores nil
+  "*Show apropos scores if non-nil.")

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

+(defvar apropos-orig-regexp nil
+  "Regexp as entered by user.")
+
+(defvar apropos-all-regexp nil
+  "Regexp matching apropos-all-words.")
+

 (defvar apropos-files-scanned ()
   "List of elc files already scanned in current run of `apropos-documentation'.")
 
 (defvar apropos-files-scanned ()
   "List of elc files already scanned in current run of `apropos-documentation'.")
 


@@ -105,72 +138,307 @@ 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'.")
+
+(defvar apropos-synonyms '(
+  ("find" "open" "edit")
+  ("kill" "cut")
+  ("yank" "paste"))
+  "List of synonyms known by apropos.
+Each element is a list of words where the first word is the standard emacs
+term, and the rest of the words are alternative terms.")
+
+(defvar apropos-words ()
+  "Current list of words.")
+
+(defvar apropos-all-words ()
+  "Current list of words and synonyms.")
+
+\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-group-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)
+  "Return 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 ()
+(defun apropos-words-to-regexp (words wild)
+  "Make regexp matching any two of the words in WORDS."
+  (concat "\\("
+         (mapconcat 'identity words "\\|")
+         "\\)" wild
+         (if (cdr words) 
+             (concat "\\("
+                     (mapconcat 'identity words "\\|")
+                     "\\)")
+           "")))
+
+(defun apropos-rewrite-regexp (regexp)
+  "Rewrite a list of words to a regexp matching all permutations.
+If REGEXP is already a regexp, don't modify it."
+  (setq apropos-orig-regexp regexp)
+  (setq apropos-words () apropos-all-words ())
+  (if (string-equal (regexp-quote regexp) regexp)
+      ;; We don't actually make a regexp matching all permutations.
+      ;; Instead, for e.g. "a b c", we make a regexp matching
+      ;; any combination of two or more words like this:
+      ;; (a|b|c).*(a|b|c) which may give some false matches,
+      ;; but as long as it also gives the right ones, that's ok.
+      (let ((words (split-string regexp "[ \t]+")))
+       (dolist (word words)
+         (let ((syn apropos-synonyms) (s word) (a word))
+           (while syn
+             (if (member word (car syn))
+                 (progn
+                   (setq a (mapconcat 'identity (car syn) "\\|"))
+                   (if (member word (cdr (car syn)))
+                       (setq s a))
+                   (setq syn nil))
+               (setq syn (cdr syn))))
+           (setq apropos-words (cons s apropos-words)
+                 apropos-all-words (cons a apropos-all-words))))
+       (setq apropos-all-regexp (apropos-words-to-regexp apropos-all-words ".+"))
+       (apropos-words-to-regexp apropos-words ".*?"))
+    (setq apropos-all-regexp regexp)))
+
+(defun apropos-calc-scores (str words)
+  "Return apropos scores for string STR matching WORDS.
+Value is a list of offsets of the words into the string."
+  (let ((scores ())
+       i)
+    (if words
+       (dolist (word words scores)
+         (if (setq i (string-match word str))
+             (setq scores (cons i scores))))
+      ;; Return list of start and end position of regexp
+      (string-match apropos-regexp str)
+      (list (match-beginning 0) (match-end 0)))))
+
+(defun apropos-score-str (str)
+  "Return apropos score for string STR."
+  (if str
+      (let* (
+            (l (length str))
+            (score (- (/ l 10)))
+           i)
+       (dolist (s (apropos-calc-scores str apropos-all-words) score)
+         (setq score (+ score 1000 (/ (* (- l s) 1000) l)))))
+      0))
+
+(defun apropos-score-doc (doc)
+  "Return apropos score for documentation string DOC."
+  (if doc
+      (let ((score 0)
+           (l (length doc))
+           i)
+       (dolist (s (apropos-calc-scores doc apropos-all-words) score)
+         (setq score (+ score 50 (/ (* (- l s) 50) l)))))
+      0))
+         
+(defun apropos-score-symbol (symbol &optional weight)
+  "Return apropos score for SYMBOL."
+  (setq symbol (symbol-name symbol))
+  (let ((score 0)
+       (l (length symbol))
+       i)
+    (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3)))
+      (setq score (+ score (- 60 l) (/ (* (- l s) 60) l))))))
+
+(defun apropos-true-hit (str words)
+  "Return t if STR is a genuine hit.
+This may fail if only one of the keywords is matched more than once.
+This requires that at least 2 keywords (unless only one was given)."
+  (or (not str)
+      (not words)
+      (not (cdr words))
+      (> (length (apropos-calc-scores str words)) 1)))
+
+(defun apropos-false-hit-symbol (symbol)
+  "Return t if SYMBOL is not really matched by the current keywords."
+  (not (apropos-true-hit (symbol-name symbol) apropos-words)))
+
+(defun apropos-false-hit-str (str)
+  "Return t if STR is not really matched by the current keywords."
+  (not (apropos-true-hit str apropos-words)))
+
+(defun apropos-true-hit-doc (doc)
+  "Return t if DOC is really matched by the current keywords."
+  (apropos-true-hit doc apropos-all-words))
+
+;;;###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
+(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 or words): "))
+                     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
 
 ;; For auld lang syne:
 ;;;###autoload

-(fset 'command-apropos 'apropos-command)
+(defalias 'command-apropos 'apropos-command)

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

-(defun apropos-command (apropos-regexp &optional do-all)
-  "Shows commands (interactively callable functions) that match REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also show
-variables."
-  (interactive (list (read-string (concat "Apropos command "
-                                         (if (or current-prefix-arg
-                                                 apropos-do-all)
-                                             "or variable ")
-                                         "(regexp): "))
+(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)
+                                      "or function ")
+                                  "(regexp or words): "))

                     current-prefix-arg))
                     current-prefix-arg))

+  (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp))

   (let ((message
         (let ((standard-output (get-buffer-create "*Apropos*")))
           (print-help-return-message 'identity))))
     (or do-all (setq do-all apropos-do-all))
     (setq apropos-accumulator
          (apropos-internal apropos-regexp
   (let ((message
         (let ((standard-output (get-buffer-create "*Apropos*")))
           (print-help-return-message 'identity))))
     (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)))
-                             'commandp)))
-    (if (apropos-print
-        t
-        (lambda (p)
-          (let (doc symbol)
-            (while p
-              (setcar p (list
-                         (setq symbol (car p))
-                         (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)))))
+                           (or var-predicate
+                               (if do-all 'functionp 'commandp))))
+    (let ((tem apropos-accumulator))
+      (while tem
+       (if (or (get (car tem) 'apropos-inhibit)
+               (apropos-false-hit-symbol (car tem)))
+           (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
+       (setq tem (cdr tem))))
+    (let ((p apropos-accumulator)
+         doc symbol score)
+      (while p
+       (setcar p (list
+                  (setq symbol (car p))
+                  (setq score (apropos-score-symbol symbol))
+                  (unless var-predicate
+                    (if (functionp symbol)
+                        (if (setq doc (documentation symbol t))
+                            (progn
+                              (setq score (+ score (apropos-score-doc doc))) 
+                              (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))
+                            (progn
+                              (setq score (+ score (apropos-score-doc doc)))
+                              (substring doc 0
+                                         (string-match "\n" doc)))))))
+       (setcar (cdr (car p)) score)
+       (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."
-  (interactive "sApropos symbol (regexp): \nP")
+  "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 or words): \nP")
+  (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp))

   (setq apropos-accumulator
        (apropos-internal apropos-regexp
                          (and (not do-all)
   (setq apropos-accumulator
        (apropos-internal apropos-regexp
                          (and (not do-all)


@@ -178,69 +446,112 @@ Returns list of symbols and documentation found."
                               (lambda (symbol)
                                 (or (fboundp symbol)
                                     (boundp symbol)
                               (lambda (symbol)
                                 (or (fboundp symbol)
                                     (boundp symbol)

+                                    (facep symbol)

                                     (symbol-plist symbol))))))
                                     (symbol-plist symbol))))))

+  (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 ((p apropos-accumulator)
+       symbol doc properties)
+    (while p
+      (setcar p (list
+                (setq symbol (car p))
+                0
+                (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)
-       (while p
-        (setcar p (list
-                   (setq symbol (car p))
-                   (if (fboundp symbol)
-                       (if (setq doc (documentation symbol t))
-                           (substring doc 0 (string-match "\n" doc))
-                         "(not documented)"))
-                   (if (boundp symbol)
-                       (if (setq doc (documentation-property
-                                      symbol 'variable-documentation t))
-                           (substring doc 0
-                                      (string-match "\n" doc))
-                         "(not documented)"))
-                   (if (setq doc (symbol-plist symbol))
-                       (if (eq (/ (length doc) 2) 1)
-                           (format "1 property (%s)" (car doc))
-                         (concat (/ (length doc) 2) " properties")))))
-        (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."
 at the function and at the names and values of properties.
 Returns list of symbols and values found."

-  (interactive "sApropos value (regexp): \nP")
+  (interactive "sApropos value (regexp or words): \nP")
+  (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp))

   (or do-all (setq do-all apropos-do-all))
   (setq apropos-accumulator ())
    (let (f v p)
      (mapatoms
       (lambda (symbol)
        (setq f nil v nil p nil)
   (or do-all (setq do-all apropos-do-all))
   (setq apropos-accumulator ())
    (let (f v p)
      (mapatoms
       (lambda (symbol)
        (setq f nil v nil p nil)

-       (or (memq symbol '(apropos-regexp do-all apropos-accumulator
-                                         symbol f v p))
+       (or (memq symbol '(apropos-regexp
+                          apropos-orig-regexp apropos-all-regexp
+                          apropos-words apropos-all-words
+                          do-all apropos-accumulator
+                          symbol f v p))

            (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
        (if do-all
            (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
                  p (apropos-format-plist symbol "\n    " t)))
            (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
        (if do-all
            (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
                  p (apropos-format-plist symbol "\n    " t)))

+       (if (apropos-false-hit-str v)
+           (setq v nil))
+       (if (apropos-false-hit-str f)
+           (setq f nil))
+       (if (apropos-false-hit-str p)
+           (setq p nil))

        (if (or f v p)
        (if (or f v p)

-           (setq apropos-accumulator (cons (list symbol f v p)
+           (setq apropos-accumulator (cons (list symbol 
+                                                 (+ (apropos-score-str f)
+                                                    (apropos-score-str v)
+                                                    (apropos-score-str p))
+                                                 f v p)

                                            apropos-accumulator))))))
                                            apropos-accumulator))))))

-  (apropos-print nil nil t))
+  (apropos-print nil "\n----------------\n"))

 
 
 ;;;###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."

-  (interactive "sApropos documentation (regexp): \nP")
+  (interactive "sApropos documentation (regexp or words): \nP")
+  (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp))

   (or do-all (setq do-all apropos-do-all))
   (setq apropos-accumulator () apropos-files-scanned ())
   (let ((standard-input (get-buffer-create " apropos-temp"))
   (or do-all (setq do-all apropos-do-all))
   (setq apropos-accumulator () apropos-files-scanned ())
   (let ((standard-input (get-buffer-create " apropos-temp"))

-       f v)
+       f v sf sv)

     (unwind-protect
        (save-excursion
          (set-buffer standard-input)
     (unwind-protect
        (save-excursion
          (set-buffer standard-input)


@@ -253,18 +564,26 @@ Returns list of symbols and documentation found."
                 (if (integerp v) (setq v))
                 (setq f (apropos-documentation-internal f)
                       v (apropos-documentation-internal v))
                 (if (integerp v) (setq v))
                 (setq f (apropos-documentation-internal f)
                       v (apropos-documentation-internal v))

+                (setq sf (apropos-score-doc f)
+                      sv (apropos-score-doc v))

                 (if (or f v)
                     (if (setq apropos-item
                               (cdr (assq symbol apropos-accumulator)))
                         (progn
                           (if f
                 (if (or f v)
                     (if (setq apropos-item
                               (cdr (assq symbol apropos-accumulator)))
                         (progn
                           (if f

-                              (setcar apropos-item f))
+                              (progn
+                                (setcar (nthcdr 1 apropos-item) f)
+                                (setcar apropos-item (+ (car apropos-item) sf))))

                           (if v
                           (if v

-                              (setcar (cdr apropos-item) v)))
+                              (progn
+                                (setcar (nthcdr 2 apropos-item) v)
+                                (setcar apropos-item (+ (car apropos-item) sv)))))

                       (setq apropos-accumulator
                       (setq apropos-accumulator

-                            (cons (list symbol f v)
+                            (cons (list symbol 
+                                        (+ (apropos-score-symbol symbol 2) sf sv)
+                                        f v)

                                   apropos-accumulator)))))))
                                   apropos-accumulator)))))))

-         (apropos-print nil nil t))
+         (apropos-print nil "\n----------------\n"))

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


@@ -284,7 +603,8 @@ Returns list of symbols and documentation found."
   (if (consp doc)
       (apropos-documentation-check-elc-file (car doc))
     (and doc
   (if (consp doc)
       (apropos-documentation-check-elc-file (car doc))
     (and doc

-        (string-match apropos-regexp doc)
+        (string-match apropos-all-regexp doc)
+        (save-match-data (apropos-true-hit-doc doc))

         (progn
           (if apropos-match-face
               (put-text-property (match-beginning 0)
         (progn
           (if apropos-match-face
               (put-text-property (match-beginning 0)


@@ -328,25 +648,31 @@ Returns list of symbols and documentation found."
       (beginning-of-line 2)
       (if (save-restriction
            (narrow-to-region (point) (1- sepb))
       (beginning-of-line 2)
       (if (save-restriction
            (narrow-to-region (point) (1- sepb))

-           (re-search-forward apropos-regexp nil t))
+           (re-search-forward apropos-all-regexp nil t))

          (progn
            (setq beg (match-beginning 0)
                  end (point))
            (goto-char (1+ sepa))
          (progn
            (setq beg (match-beginning 0)
                  end (point))
            (goto-char (1+ sepa))

-           (or (setq type (if (eq ?F (preceding-char))
-                              1        ; function documentation
-                            2)         ; variable documentation
-                     symbol (read)
-                     beg (- beg (point) 1)
-                     end (- end (point) 1)
-                     doc (buffer-substring (1+ (point)) (1- sepb))
-                     apropos-item (assq symbol apropos-accumulator))
-               (setq apropos-item (list symbol nil nil)
-                     apropos-accumulator (cons apropos-item
-                                               apropos-accumulator)))
-           (if apropos-match-face
-               (put-text-property beg end 'face apropos-match-face doc))
-           (setcar (nthcdr type apropos-item) doc)))
+           (setq type (if (eq ?F (preceding-char))
+                          2    ; function documentation
+                        3)             ; variable documentation
+                 symbol (read)
+                 beg (- beg (point) 1)
+                 end (- end (point) 1)
+                 doc (buffer-substring (1+ (point)) (1- sepb)))
+           (when (apropos-true-hit-doc doc)
+             (or (and (setq apropos-item (assq symbol apropos-accumulator))
+                      (setcar (cdr apropos-item)
+                              (+ (cadr apropos-item) (apropos-score-doc doc))))
+                 (setq apropos-item (list symbol 
+                                          (+ (apropos-score-symbol symbol 2)
+                                             (apropos-score-doc doc))
+                                          nil nil)
+                       apropos-accumulator (cons apropos-item
+                                                 apropos-accumulator)))
+             (if apropos-match-face
+                 (put-text-property beg end 'face apropos-match-face doc))
+             (setcar (nthcdr type apropos-item) doc))))

       (setq sepa (goto-char sepb)))))
 
 (defun apropos-documentation-check-elc-file (file)
       (setq sepa (goto-char sepb)))))
 
 (defun apropos-documentation-check-elc-file (file)


@@ -365,39 +691,45 @@ Returns list of symbols and documentation found."
        (if (save-restriction
              ;; match ^ and $ relative to doc string
              (narrow-to-region beg end)
        (if (save-restriction
              ;; match ^ and $ relative to doc string
              (narrow-to-region beg end)

-             (re-search-forward apropos-regexp nil t))
+             (re-search-forward apropos-all-regexp nil t))

            (progn
              (goto-char (+ end 2))
              (setq doc (buffer-substring beg end)
                    end (- (match-end 0) beg)
            (progn
              (goto-char (+ end 2))
              (setq doc (buffer-substring beg end)
                    end (- (match-end 0) beg)

-                   beg (- (match-beginning 0) beg)
-                   this-is-a-variable (looking-at "(def\\(var\\|const\\) ")
-                   symbol (progn
-                            (skip-chars-forward "(a-z")
-                            (forward-char)
-                            (read))
-                   symbol (if (consp symbol)
-                              (nth 1 symbol)
-                            symbol))
-             (if (if this-is-a-variable
-                     (get symbol 'variable-documentation)
-                   (and (fboundp symbol) (apropos-safe-documentation symbol)))
-                 (progn
-                   (or (setq apropos-item (assq symbol apropos-accumulator))
-                       (setq apropos-item (list symbol nil nil)
-                             apropos-accumulator (cons apropos-item
-                                                       apropos-accumulator)))
-                   (if apropos-match-face
-                       (put-text-property beg end 'face apropos-match-face
-                                          doc))
-                   (setcar (nthcdr (if this-is-a-variable 2 1)
-                                   apropos-item)
-                           doc)))))))))
+                   beg (- (match-beginning 0) beg))
+             (when (apropos-true-hit-doc doc)
+               (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ")
+                     symbol (progn
+                              (skip-chars-forward "(a-z")
+                              (forward-char)
+                              (read))
+                     symbol (if (consp symbol)
+                                (nth 1 symbol)
+                              symbol))
+               (if (if this-is-a-variable
+                       (get symbol 'variable-documentation)
+                     (and (fboundp symbol) (apropos-safe-documentation symbol)))
+                   (progn
+                     (or (and (setq apropos-item (assq symbol apropos-accumulator))
+                              (setcar (cdr apropos-item)
+                                      (+ (cadr apropos-item) (apropos-score-doc doc))))
+                         (setq apropos-item (list symbol
+                                                  (+ (apropos-score-symbol symbol 2)
+                                                     (apropos-score-doc doc))
+                                                  nil nil)
+                               apropos-accumulator (cons apropos-item
+                                                         apropos-accumulator)))
+                     (if apropos-match-face
+                         (put-text-property beg end 'face apropos-match-face
+                                            doc))
+                     (setcar (nthcdr (if this-is-a-variable 3 2)
+                                     apropos-item)
+                             doc))))))))))

 
 
 
 (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)


@@ -419,82 +751,112 @@ Will return nil instead."
     function))
 
 
     function))
 
 

+(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 SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-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.

 
 

-(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."
+If SPACING is non-nil, it should be a string;
+separate items with that string."

   (if (null apropos-accumulator)
   (if (null apropos-accumulator)

-      (message "No apropos matches for `%s'" apropos-regexp)
-    (if doc-fn
-       (funcall doc-fn apropos-accumulator))
+      (message "No apropos matches for `%s'" apropos-orig-regexp)

     (setq apropos-accumulator
          (sort apropos-accumulator (lambda (a 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)))
+                                     (or (> (cadr a) (cadr b))
+                                         (and (= (cadr a) (cadr b))
+                                              (string-lessp (car a) (car b)))))))

     (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"
-                   (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"))
+       (if (display-mouse-p)
+           (insert
+            "If moving the mouse over text changes the text's color, "
+            "you can click\n"
+            "mouse-2 (second button from right) 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)
        (while (consp p)

-         (or (not spacing) (bobp) (terpri))
+         (when (and spacing (not (bobp)))
+           (princ spacing))

          (setq apropos-item (car p)
                symbol (car apropos-item)
          (setq apropos-item (car p)
                symbol (car apropos-item)

-               p (cdr p)
-               point1 (point))
-         (princ symbol)                        ; print symbol name
-         (setq point2 (point))
-         ;; don't calculate key-bindings unless needed
+               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)
+         (if apropos-show-scores
+             (insert " (" (number-to-string (cadr apropos-item)) ") "))
+         ;; Calculate key-bindings if we want them.

          (and do-keys
               (commandp symbol)
               (indent-to 30 1)
          (and do-keys
               (commandp symbol)
               (indent-to 30 1)

-              (insert
-               (if (setq item (save-excursion
-                                (set-buffer old-buffer)
-                                (where-is-internal symbol)))
+              (if (let ((keys
+                         (save-excursion
+                           (set-buffer old-buffer)
+                           (where-is-internal symbol)))
+                        filtered)
+                    ;; Copy over the list of key sequences,
+                    ;; omitting any that contain a buffer or a frame.
+                    (while keys
+                      (let ((key (car keys))
+                            (i 0)
+                            loser)
+                        (while (< i (length key))
+                          (if (or (framep (aref key i))
+                                  (bufferp (aref key i)))
+                              (setq loser t))
+                          (setq i (1+ i)))
+                        (or loser
+                            (setq filtered (cons key filtered))))
+                      (setq keys (cdr keys)))
+                    (setq item filtered))
+                  ;; Convert the remaining keys to a string and insert.
+                  (insert

                    (mapconcat
                    (mapconcat

-                    (if apropos-keybinding-face
-                        (lambda (key)
-                          (setq key (key-description key))
+                    (lambda (key)
+                      (setq key (condition-case ()
+                                    (key-description key)
+                                  (error)))
+                      (if apropos-keybinding-face

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

-                                             key)
-                          key)
-                      'key-description)
-                    item ", ")
-                 "(not bound to any keys)")))
+                                             key))
+                      key)
+                    item ", "))
+                (insert "M-x")
+                (put-text-property (- (point) 3) (point)
+                                   'face apropos-keybinding-face)
+                (insert " " (symbol-name symbol) " ")
+                (insert "RET")
+                (put-text-property (- (point) 3) (point)
+                                   'face apropos-keybinding-face)))

          (terpri)
          (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 2

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

-                                "Command"
+                                'apropos-command

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

-                                  "Macro"
-                                "Function"))
-                            do-keys)
-         (apropos-print-doc 'describe-variable 2
-                            "Variable" do-keys)
-         (apropos-print-doc 'apropos-describe-plist 3
-                            "Plist" nil)))))
+                                  'apropos-macro
+                                'apropos-function))
+                            t)
+         (apropos-print-doc 3 'apropos-variable t)
+         (apropos-print-doc 7 'apropos-group t)
+         (apropos-print-doc 6 'apropos-face t)
+         (apropos-print-doc 5 'apropos-widget t)
+         (apropos-print-doc 4 'apropos-plist nil))
+       (setq buffer-read-only t))))

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


@@ -510,55 +872,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)


@@ -574,4 +909,7 @@ found."
     (princ ")")
     (print-help-return-message)))
 
     (princ ")")
     (print-help-return-message)))
 

+
+(provide 'apropos)
+

 ;;; apropos.el ends here
 ;;; apropos.el ends here