'apropos-label "Group"
'help-echo "mouse-2, RET: Display more help on this group"
'action (lambda (button)
- (customize-variable-other-window
+ (customize-group-other-window
(button-get button 'apropos-symbol))))
(define-button-type 'apropos-widget
(defun apropos-score-str (str)
"Return apropos score for string STR."
(if str
- (let ((score 0)
- (l (length str))
+ (let* (
+ (l (length str))
+ (score (- (/ l 10)))
i)
(dolist (s (apropos-calc-scores str apropos-all-words) score)
- (setq score (+ score 1000 (- (/ l 10)) (/ (* (- l s) 1000) l)))))
+ (setq score (+ score 1000 (/ (* (- l s) 1000) l)))))
0))
(defun apropos-score-doc (doc)
(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.
;; For auld lang syne:
;;;###autoload
-(fset 'command-apropos 'apropos-command)
+(defalias 'command-apropos 'apropos-command)
;;;###autoload
(defun apropos-command (apropos-regexp &optional do-all var-predicate)
"Show commands (interactively callable functions) that match APROPOS-REGEXP.
(if do-all 'functionp 'commandp))))
(let ((tem apropos-accumulator))
(while tem
- (if (get (car tem) 'apropos-inhibit)
+ (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)
(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)
(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)
(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 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)
(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)))))))))
+ 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))))))))))
HCoop / bpt / emacs.git / blobdiff