[Emacs-diffs] Changes to emacs/lisp/apropos.el

[Kim F. Storm]

Index: emacs/lisp/apropos.el
diff -c emacs/lisp/apropos.el:1.86 emacs/lisp/apropos.el:1.87
*** emacs/lisp/apropos.el:1.86  Thu May 23 06:24:14 2002
--- emacs/lisp/apropos.el       Thu May 23 16:21:30 2002
***************
*** 324,329 ****
--- 324,350 ----
      (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.
***************
*** 378,384 ****
                                (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 ((p apropos-accumulator)
--- 399,406 ----
                                (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)
***************
*** 501,506 ****
--- 523,534 ----
        (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)
            (setq apropos-accumulator (cons (list symbol 
                                                  (+ (apropos-score-str f)
***************
*** 576,581 ****
--- 604,610 ----
        (apropos-documentation-check-elc-file (car doc))
      (and 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)
***************
*** 624,648 ****
            (setq beg (match-beginning 0)
                  end (point))
            (goto-char (1+ sepa))
!           (or (and (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))
!                          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)
--- 653,678 ----
            (setq beg (match-beginning 0)
                  end (point))
            (goto-char (1+ sepa))
!           (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)
***************
*** 666,699 ****
              (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 (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)))))))))
  
  
  
--- 696,730 ----
              (goto-char (+ end 2))
              (setq doc (buffer-substring beg end)
                    end (- (match-end 0) beg)
!                   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))))))))))