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