Some hi-lock doc
[bpt/emacs.git] / lisp / apropos.el
index 000d2d8..f24871d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; apropos.el --- apropos commands for users and programmers
 
-;; Copyright (C) 1989, 1994-1995, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1994-1995, 2001-2014 Free Software Foundation,
 ;; Inc.
 
 ;; Author: Joe Wells <jbw@bigbird.bu.edu>
@@ -131,6 +131,7 @@ include key-binding information in its output."
   "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 pattern; the part that matches gets displayed in this font."
+  :type '(choice (const nil) face)
   :group 'apropos
   :version "24.3")
 
@@ -341,16 +342,21 @@ before finding a label."
 
 \f
 (defun apropos-words-to-regexp (words wild)
-  "Make regexp matching any two of the words in WORDS."
-  (concat "\\("
-         (mapconcat 'identity words "\\|")
-         "\\)"
-         (if (cdr words)
-             (concat wild
-                     "\\("
-                     (mapconcat 'identity words "\\|")
-                     "\\)")
-           "")))
+  "Make regexp matching any two of the words in WORDS.
+WILD should be a subexpression matching wildcards between matches."
+  (setq words (delete-dups (copy-sequence words)))
+  (if (null (cdr words))
+      (car words)
+    (mapconcat
+     (lambda (w)
+       (concat "\\(?:" w "\\)" ;; parens for synonyms
+               wild "\\(?:"
+               (mapconcat 'identity
+                         (delq w (copy-sequence words))
+                         "\\|")
+               "\\)"))
+     words
+     "\\|")))
 
 ;;;###autoload
 (defun apropos-read-pattern (subject)
@@ -1000,8 +1006,7 @@ Returns list of symbols and documentation found."
   "Like `documentation', except it avoids calling `get_doc_string'.
 Will return nil instead."
   (while (and function (symbolp function))
-    (setq function (if (fboundp function)
-                      (symbol-function function))))
+    (setq function (symbol-function function)))
   (if (eq (car-safe function) 'macro)
       (setq function (cdr function)))
   (setq function (if (byte-code-function-p function)
@@ -1121,7 +1126,7 @@ If non-nil TEXT is a string that will be printed as a heading."
          (apropos-print-doc 2
                             (if (commandp symbol)
                                 'apropos-command
-                              (if (apropos-macrop symbol)
+                              (if (macrop symbol)
                                   'apropos-macro
                                 'apropos-function))
                             (not nosubst))
@@ -1139,17 +1144,6 @@ If non-nil TEXT is a string that will be printed as a heading."
   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))    ; permit gc
 
-(defun apropos-macrop (symbol)
-  "Return t if SYMBOL is a Lisp macro."
-  (and (fboundp symbol)
-       (consp (setq symbol
-                   (symbol-function symbol)))
-       (or (eq (car symbol) 'macro)
-          (if (autoloadp symbol)
-              (memq (nth 4 symbol)
-                    '(macro t))))))
-
-
 (defun apropos-print-doc (i type do-keys)
   (let ((doc (nth i apropos-item)))
     (when (stringp doc)