mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
(apropos-match-face): Doc fix.
(apropos-sort-by-scores): Add new choice `verbose'. (apropos-documentation-sort-by-scores): New defcustom. (apropos-pattern): Now contains the pattern entered by the user. (apropos-pattern-quoted): New defvar. (apropos-regexp): New defvar, containing the regexp corresponding to apropos-pattern. (apropos-all-words-regexp): Renamed from apropos-all-regexp. (apropos-read-pattern): New defun. Use it to read pattern arg in interactive calls; returns list of words for a word list, and string for a regexp. (apropos-parse-pattern): Renamed from apropos-rewrite-regexp. Now parses a list of words or regexp as returned by apropos-read-pattern. (apropos-calc-scores): Return nil if apropos-regexp doesn't match. (apropos-score-doc): Return a very high score if the string entered by the user matches literally. (apropos-variable): Doc fix. Use apropos-read-pattern. (apropos-command): Doc fix. Use apropos-read-pattern and apropos-parse-pattern. Call apropos-print with nosubst=t. (apropos, apropos-value): Doc fix. Use apropos-read-pattern and apropos-parse-pattern. (apropos-documentation): Doc fix. Use apropos-read-pattern and apropos-parse-pattern. Locally bind apropos-sort-by-scores to apropos-documentation-sort-by-scores. Call apropos-print with nosubst=t. (apropos-documentation-internal): Pass doc string through substitute-key-definition before adding text properties. Highlight substring matching literal user input if possible. (apropos-documentation-check-doc-file): Remove locals beg and end. Fix calculation of score (as added twice). Pass doc string through substitute-key-definition before adding text properties. (apropos-documentation-check-elc-file): Pass doc string through substitute-key-definition before adding text properties. Highlight substring matching literal user input if possible. (apropos-print): Add new arg NOSUBST; if set, command and variable doc strings have already been passed through substitute-key-definition. Add code to handle apropos-accumulator items without score element for backwards compatibility (e.g. with woman package). Only show scores if apropos-sort-by-scores is `verbose'.
This commit is contained in:
Kim F. Storm
parent
42aad0f69a
commit
0820b753f7
@ -1,5 +1,8 @@
|
||||
2005-11-12 Kim F. Storm <storm@cua.dk>
|
||||
|
||||
* simple.el (what-cursor-position): Print (EOB) instead of (100%)
|
||||
when point is at end-of-buffer.
|
||||
|
||||
* apropos.el (apropos-match-face): Doc fix.
|
||||
(apropos-sort-by-scores): Add new choice `verbose'.
|
||||
(apropos-documentation-sort-by-scores): New defcustom.
|
||||
|
||||
274
lisp/apropos.el
274
lisp/apropos.el
@ -100,15 +100,27 @@ turns off mouse highlighting."
|
||||
(defcustom apropos-match-face 'match
|
||||
"*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."
|
||||
for the pattern; the part that matches gets displayed in this font."
|
||||
:group 'apropos
|
||||
:type 'face)
|
||||
|
||||
(defcustom apropos-sort-by-scores nil
|
||||
"*Non-nil means sort matches by scores; best match is shown first.
|
||||
The computed score is shown for each match."
|
||||
This applies to all `apropos' commands except `apropos-documentation'.
|
||||
If value is `verbose', the computed score is shown for each match."
|
||||
:group 'apropos
|
||||
:type 'boolean)
|
||||
:type '(choice (const :tag "off" nil)
|
||||
(const :tag "on" t)
|
||||
(const :tag "show scores" verbose)))
|
||||
|
||||
(defcustom apropos-documentation-sort-by-scores t
|
||||
"*Non-nil means sort matches by scores; best match is shown first.
|
||||
This applies to `apropos-documentation' only.
|
||||
If value is `verbose', the computed score is shown for each match."
|
||||
:group 'apropos
|
||||
:type '(choice (const :tag "off" nil)
|
||||
(const :tag "on" t)
|
||||
(const :tag "show scores" verbose)))
|
||||
|
||||
(defvar apropos-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
@ -127,12 +139,21 @@ The computed score is shown for each match."
|
||||
"*Hook run when mode is turned on.")
|
||||
|
||||
(defvar apropos-pattern nil
|
||||
"Apropos pattern as entered by user.")
|
||||
|
||||
(defvar apropos-pattern-quoted nil
|
||||
"Apropos pattern passed through `regexp-quoute'.")
|
||||
|
||||
(defvar apropos-words ()
|
||||
"Current list of apropos words extracted from `apropos-pattern'.")
|
||||
|
||||
(defvar apropos-all-words ()
|
||||
"Current list of words and synonyms.")
|
||||
|
||||
(defvar apropos-regexp nil
|
||||
"Regexp used in current apropos run.")
|
||||
|
||||
(defvar apropos-orig-pattern nil
|
||||
"Regexp as entered by user.")
|
||||
|
||||
(defvar apropos-all-regexp nil
|
||||
(defvar apropos-all-words-regexp nil
|
||||
"Regexp matching apropos-all-words.")
|
||||
|
||||
(defvar apropos-files-scanned ()
|
||||
@ -152,12 +173,6 @@ The computed score is shown for each match."
|
||||
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.")
|
||||
|
||||
|
||||
;;; Button types used by apropos
|
||||
|
||||
@ -269,19 +284,35 @@ before finding a label."
|
||||
"\\)")
|
||||
"")))
|
||||
|
||||
(defun apropos-rewrite-regexp (regexp)
|
||||
"Rewrite a space-separated words list to a regexp matching all permutations.
|
||||
If REGEXP contains any special regexp characters, that means it
|
||||
is already a regexp, so return it unchanged."
|
||||
(setq apropos-orig-pattern regexp)
|
||||
(setq apropos-words () apropos-all-words ())
|
||||
(if (string-equal (regexp-quote regexp) regexp)
|
||||
;;;###autoload
|
||||
(defun apropos-read-pattern (subject)
|
||||
"Read an apropos pattern, either a word list or a regexp.
|
||||
Returns the user pattern, either a list of words which are matched
|
||||
literally, or a string which is used as a regexp to search for.
|
||||
|
||||
SUBJECT is a string that is included in the prompt to identify what
|
||||
kind of objects to search."
|
||||
(let ((pattern
|
||||
(read-string (concat "Apropos " subject " (word list or regexp): "))))
|
||||
(if (string-equal (regexp-quote pattern) pattern)
|
||||
;; Split into words
|
||||
(split-string pattern "[ \t]+")
|
||||
pattern)))
|
||||
|
||||
(defun apropos-parse-pattern (pattern)
|
||||
"Rewrite a list of words to a regexp matching all permutations.
|
||||
If PATTERN is a string, that means it is already a regexp."
|
||||
(setq apropos-words nil
|
||||
apropos-all-words nil)
|
||||
(if (consp pattern)
|
||||
;; 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]+")))
|
||||
(let ((words pattern))
|
||||
(setq apropos-pattern (mapconcat 'identity pattern " ")
|
||||
apropos-pattern-quoted (regexp-quote apropos-pattern))
|
||||
(dolist (word words)
|
||||
(let ((syn apropos-synonyms) (s word) (a word))
|
||||
(while syn
|
||||
@ -294,30 +325,30 @@ is already a regexp, so return it unchanged."
|
||||
(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 ".+"))
|
||||
(setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+"))
|
||||
(apropos-words-to-regexp apropos-words ".*?"))
|
||||
(setq apropos-all-regexp regexp)))
|
||||
(setq apropos-pattern-quoted (regexp-quote pattern)
|
||||
apropos-all-words-regexp pattern
|
||||
apropos-pattern pattern)))
|
||||
|
||||
|
||||
(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)
|
||||
(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-pattern str)
|
||||
(list (match-beginning 0) (match-end 0)))))
|
||||
(and (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)
|
||||
(let* ((l (length str))
|
||||
(score (- (/ l 10))))
|
||||
(dolist (s (apropos-calc-scores str apropos-all-words) score)
|
||||
(setq score (+ score 1000 (/ (* (- l s) 1000) l)))))
|
||||
0))
|
||||
@ -326,8 +357,9 @@ Value is a list of offsets of the words into the string."
|
||||
"Return apropos score for documentation string DOC."
|
||||
(let ((l (length doc)))
|
||||
(if (> l 0)
|
||||
(let ((score 0)
|
||||
i)
|
||||
(let ((score 0) i)
|
||||
(when (setq i (string-match apropos-pattern-quoted doc))
|
||||
(setq score 10000))
|
||||
(dolist (s (apropos-calc-scores doc apropos-all-words) score)
|
||||
(setq score (+ score 50 (/ (* (- l s) 50) l)))))
|
||||
0)))
|
||||
@ -336,8 +368,7 @@ Value is a list of offsets of the words into the string."
|
||||
"Return apropos score for SYMBOL."
|
||||
(setq symbol (symbol-name symbol))
|
||||
(let ((score 0)
|
||||
(l (length symbol))
|
||||
i)
|
||||
(l (length symbol)))
|
||||
(dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3)))
|
||||
(setq score (+ score (- 60 l) (/ (* (- l s) 60) l))))))
|
||||
|
||||
@ -368,18 +399,20 @@ This requires that at least 2 keywords (unless only one was given)."
|
||||
\\{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
|
||||
(defun apropos-variable (pattern &optional do-all)
|
||||
"Show user variables that match PATTERN.
|
||||
PATTERN can be a word, a list of words (separated by spaces),
|
||||
or a regexp (using some regexp special characters). If it is a word,
|
||||
search for matches for that word as a substring. If it is a list of words,
|
||||
search for matches for any two (or more) of those words.
|
||||
|
||||
With \\[universal-argument] prefix, 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")
|
||||
" (word list or regexp): "))
|
||||
(interactive (list (apropos-read-pattern
|
||||
(if (or current-prefix-arg apropos-do-all)
|
||||
"variable" "user option"))
|
||||
current-prefix-arg))
|
||||
(apropos-command regexp nil
|
||||
(apropos-command pattern nil
|
||||
(if (or do-all apropos-do-all)
|
||||
#'(lambda (symbol)
|
||||
(and (boundp symbol)
|
||||
@ -390,32 +423,32 @@ normal variables."
|
||||
;;;###autoload
|
||||
(defalias 'command-apropos 'apropos-command)
|
||||
;;;###autoload
|
||||
(defun apropos-command (apropos-pattern &optional do-all var-predicate)
|
||||
"Show commands (interactively callable functions) that match APROPOS-PATTERN.
|
||||
APROPOS-PATTERN can be a word, a list of words (separated by spaces),
|
||||
(defun apropos-command (pattern &optional do-all var-predicate)
|
||||
"Show commands (interactively callable functions) that match PATTERN.
|
||||
PATTERN can be a word, a list of words (separated by spaces),
|
||||
or a regexp (using some regexp special characters). If it is a word,
|
||||
search for matches for that word as a substring. If it is a list of words,
|
||||
search for matches for any two (or more) of those words.
|
||||
|
||||
With optional prefix DO-ALL, or if `apropos-do-all' is non-nil, also show
|
||||
With \\[universal-argument] prefix, 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 ")
|
||||
"(word list or regexp): "))
|
||||
satisfy the predicate VAR-PREDICATE.
|
||||
|
||||
When called from a Lisp program, a string PATTERN is used as a regexp,
|
||||
while a list of strings is used as a word list."
|
||||
(interactive (list (apropos-read-pattern
|
||||
(if (or current-prefix-arg apropos-do-all)
|
||||
"command or function" "command"))
|
||||
current-prefix-arg))
|
||||
(setq apropos-pattern (apropos-rewrite-regexp apropos-pattern))
|
||||
(setq apropos-regexp (apropos-parse-pattern pattern))
|
||||
(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-pattern
|
||||
(apropos-internal apropos-regexp
|
||||
(or var-predicate
|
||||
(if do-all 'functionp 'commandp))))
|
||||
(let ((tem apropos-accumulator))
|
||||
@ -447,7 +480,7 @@ satisfy the predicate VAR-PREDICATE."
|
||||
(string-match "\n" doc)))))))
|
||||
(setcar (cdr (car p)) score)
|
||||
(setq p (cdr p))))
|
||||
(and (apropos-print t nil)
|
||||
(and (apropos-print t nil nil t)
|
||||
message
|
||||
(message "%s" message))))
|
||||
|
||||
@ -463,20 +496,21 @@ satisfy the predicate VAR-PREDICATE."
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun apropos (apropos-pattern &optional do-all)
|
||||
"Show all bound symbols whose names match APROPOS-PATTERN.
|
||||
APROPOS-PATTERN can be a word, a list of words (separated by spaces),
|
||||
(defun apropos (pattern &optional do-all)
|
||||
"Show all bound symbols whose names match PATTERN.
|
||||
PATTERN can be a word, a list of words (separated by spaces),
|
||||
or a regexp (using some regexp special characters). If it is a word,
|
||||
search for matches for that word as a substring. If it is a list of words,
|
||||
search for matches for any two (or more) of those words.
|
||||
|
||||
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
|
||||
With \\[universal-argument] prefix, 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 (word list or regexp): \nP")
|
||||
(setq apropos-pattern (apropos-rewrite-regexp apropos-pattern))
|
||||
(interactive (list (apropos-read-pattern "symbol")
|
||||
current-prefix-arg))
|
||||
(setq apropos-regexp (apropos-parse-pattern pattern))
|
||||
(apropos-symbols-internal
|
||||
(apropos-internal apropos-pattern
|
||||
(apropos-internal apropos-regexp
|
||||
(and (not do-all)
|
||||
(not apropos-do-all)
|
||||
(lambda (symbol)
|
||||
@ -531,26 +565,27 @@ time-consuming. Returns list of symbols and documentation found."
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun apropos-value (apropos-pattern &optional do-all)
|
||||
"Show all symbols whose value's printed image matches APROPOS-PATTERN.
|
||||
APROPOS-PATTERN can be a word, a list of words (separated by spaces),
|
||||
(defun apropos-value (pattern &optional do-all)
|
||||
"Show all symbols whose value's printed image matches PATTERN.
|
||||
PATTERN can be a word, a list of words (separated by spaces),
|
||||
or a regexp (using some regexp special characters). If it is a word,
|
||||
search for matches for that word as a substring. If it is a list of words,
|
||||
search for matches for any two (or more) of those words.
|
||||
|
||||
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks
|
||||
With \\[universal-argument] prefix, 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."
|
||||
(interactive "sApropos value (word list or regexp): \nP")
|
||||
(setq apropos-pattern (apropos-rewrite-regexp apropos-pattern))
|
||||
(interactive (list (apropos-read-pattern "value")
|
||||
current-prefix-arg))
|
||||
(setq apropos-regexp (apropos-parse-pattern pattern))
|
||||
(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-pattern
|
||||
apropos-orig-pattern apropos-all-regexp
|
||||
(or (memq symbol '(apropos-regexp
|
||||
apropos-pattern apropos-all-words-regexp
|
||||
apropos-words apropos-all-words
|
||||
do-all apropos-accumulator
|
||||
symbol f v p))
|
||||
@ -575,22 +610,24 @@ Returns list of symbols and values found."
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun apropos-documentation (apropos-pattern &optional do-all)
|
||||
"Show symbols whose documentation contain matches for APROPOS-PATTERN.
|
||||
APROPOS-PATTERN can be a word, a list of words (separated by spaces),
|
||||
(defun apropos-documentation (pattern &optional do-all)
|
||||
"Show symbols whose documentation contain matches for PATTERN.
|
||||
PATTERN can be a word, a list of words (separated by spaces),
|
||||
or a regexp (using some regexp special characters). If it is a word,
|
||||
search for matches for that word as a substring. If it is a list of words,
|
||||
search for matches for any two (or more) of those words.
|
||||
|
||||
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use
|
||||
With \\[universal-argument] prefix, 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."
|
||||
(interactive "sApropos documentation (word list or regexp): \nP")
|
||||
(setq apropos-pattern (apropos-rewrite-regexp apropos-pattern))
|
||||
(interactive (list (apropos-read-pattern "documentation")
|
||||
current-prefix-arg))
|
||||
(setq apropos-regexp (apropos-parse-pattern pattern))
|
||||
(or do-all (setq do-all apropos-do-all))
|
||||
(setq apropos-accumulator () apropos-files-scanned ())
|
||||
(let ((standard-input (get-buffer-create " apropos-temp"))
|
||||
(apropos-sort-by-scores apropos-documentation-sort-by-scores)
|
||||
f v sf sv)
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
@ -623,7 +660,7 @@ Returns list of symbols and documentation found."
|
||||
(+ (apropos-score-symbol symbol 2) sf sv)
|
||||
f v)
|
||||
apropos-accumulator)))))))
|
||||
(apropos-print nil "\n----------------\n"))
|
||||
(apropos-print nil "\n----------------\n" nil t))
|
||||
(kill-buffer standard-input))))
|
||||
|
||||
|
||||
@ -631,7 +668,7 @@ Returns list of symbols and documentation found."
|
||||
(if (funcall predicate symbol)
|
||||
(progn
|
||||
(setq symbol (prin1-to-string (funcall function symbol)))
|
||||
(if (string-match apropos-pattern symbol)
|
||||
(if (string-match apropos-regexp symbol)
|
||||
(progn
|
||||
(if apropos-match-face
|
||||
(put-text-property (match-beginning 0) (match-end 0)
|
||||
@ -642,23 +679,24 @@ Returns list of symbols and documentation found."
|
||||
(defun apropos-documentation-internal (doc)
|
||||
(if (consp doc)
|
||||
(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)
|
||||
(match-end 0)
|
||||
'face apropos-match-face
|
||||
(setq doc (copy-sequence doc))))
|
||||
doc))))
|
||||
(if (and doc
|
||||
(string-match apropos-all-words-regexp doc)
|
||||
(apropos-true-hit-doc doc))
|
||||
(when apropos-match-face
|
||||
(setq doc (substitute-command-keys (copy-sequence doc)))
|
||||
(if (or (string-match apropos-pattern-quoted doc)
|
||||
(string-match apropos-all-words-regexp doc))
|
||||
(put-text-property (match-beginning 0)
|
||||
(match-end 0)
|
||||
'face apropos-match-face doc))
|
||||
doc))))
|
||||
|
||||
(defun apropos-format-plist (pl sep &optional compare)
|
||||
(setq pl (symbol-plist pl))
|
||||
(let (p p-out)
|
||||
(while pl
|
||||
(setq p (format "%s %S" (car pl) (nth 1 pl)))
|
||||
(if (or (not compare) (string-match apropos-pattern p))
|
||||
(if (or (not compare) (string-match apropos-regexp p))
|
||||
(if apropos-property-face
|
||||
(put-text-property 0 (length (symbol-name (car pl)))
|
||||
'face apropos-property-face p))
|
||||
@ -674,10 +712,10 @@ Returns list of symbols and documentation found."
|
||||
p-out))
|
||||
|
||||
|
||||
;; Finds all documentation related to APROPOS-PATTERN in internal-doc-file-name.
|
||||
;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
|
||||
|
||||
(defun apropos-documentation-check-doc-file ()
|
||||
(let (type symbol (sepa 2) sepb beg end)
|
||||
(let (type symbol (sepa 2) sepb)
|
||||
(insert ?\^_)
|
||||
(backward-char)
|
||||
(insert-file-contents (concat doc-directory internal-doc-file-name))
|
||||
@ -688,30 +726,31 @@ Returns list of symbols and documentation found."
|
||||
(beginning-of-line 2)
|
||||
(if (save-restriction
|
||||
(narrow-to-region (point) (1- sepb))
|
||||
(re-search-forward apropos-all-regexp nil t))
|
||||
(re-search-forward apropos-all-words-regexp nil t))
|
||||
(progn
|
||||
(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))))
|
||||
(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))
|
||||
(when apropos-match-face
|
||||
(setq doc (substitute-command-keys doc))
|
||||
(if (or (string-match apropos-pattern-quoted doc)
|
||||
(string-match apropos-all-words-regexp doc))
|
||||
(put-text-property (match-beginning 0)
|
||||
(match-end 0)
|
||||
'face apropos-match-face doc)))
|
||||
(setcar (nthcdr type apropos-item) doc))))
|
||||
(setq sepa (goto-char sepb)))))
|
||||
|
||||
@ -731,7 +770,7 @@ Returns list of symbols and documentation found."
|
||||
(if (save-restriction
|
||||
;; match ^ and $ relative to doc string
|
||||
(narrow-to-region beg end)
|
||||
(re-search-forward apropos-all-regexp nil t))
|
||||
(re-search-forward apropos-all-words-regexp nil t))
|
||||
(progn
|
||||
(goto-char (+ end 2))
|
||||
(setq doc (buffer-substring beg end)
|
||||
@ -759,9 +798,13 @@ Returns list of symbols and documentation found."
|
||||
nil nil)
|
||||
apropos-accumulator (cons apropos-item
|
||||
apropos-accumulator)))
|
||||
(if apropos-match-face
|
||||
(put-text-property beg end 'face apropos-match-face
|
||||
doc))
|
||||
(when apropos-match-face
|
||||
(setq doc (substitute-command-keys doc))
|
||||
(if (or (string-match apropos-pattern-quoted doc)
|
||||
(string-match apropos-all-words-regexp doc))
|
||||
(put-text-property (match-beginning 0)
|
||||
(match-end 0)
|
||||
'face apropos-match-face doc)))
|
||||
(setcar (nthcdr (if this-is-a-variable 3 2)
|
||||
apropos-item)
|
||||
doc))))))))))
|
||||
@ -791,7 +834,7 @@ Will return nil instead."
|
||||
function))
|
||||
|
||||
|
||||
(defun apropos-print (do-keys spacing &optional text)
|
||||
(defun apropos-print (do-keys spacing &optional text nosubst)
|
||||
"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
|
||||
@ -803,7 +846,7 @@ alphabetically by symbol name; but this function also sets
|
||||
If SPACING is non-nil, it should be a string; separate items with that string.
|
||||
If non-nil TEXT is a string that will be printed as a heading."
|
||||
(if (null apropos-accumulator)
|
||||
(message "No apropos matches for `%s'" apropos-orig-pattern)
|
||||
(message "No apropos matches for `%s'" apropos-pattern)
|
||||
(setq apropos-accumulator
|
||||
(sort apropos-accumulator
|
||||
(lambda (a b)
|
||||
@ -837,13 +880,20 @@ If non-nil TEXT is a string that will be printed as a heading."
|
||||
(setq apropos-item (car p)
|
||||
symbol (car apropos-item)
|
||||
p (cdr p))
|
||||
;; Insert dummy score element for backwards compatibility with 21.x
|
||||
;; apropos-item format.
|
||||
(if (not (numberp (cadr apropos-item)))
|
||||
(setq apropos-item
|
||||
(cons (car apropos-item)
|
||||
(cons nil (cdr apropos-item)))))
|
||||
(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-sort-by-scores
|
||||
(if (and (eq apropos-sort-by-scores 'verbose)
|
||||
(cadr apropos-item))
|
||||
(insert " (" (number-to-string (cadr apropos-item)) ") "))
|
||||
;; Calculate key-bindings if we want them.
|
||||
(and do-keys
|
||||
@ -895,8 +945,8 @@ If non-nil TEXT is a string that will be printed as a heading."
|
||||
(if (apropos-macrop symbol)
|
||||
'apropos-macro
|
||||
'apropos-function))
|
||||
t)
|
||||
(apropos-print-doc 3 'apropos-variable t)
|
||||
(not nosubst))
|
||||
(apropos-print-doc 3 'apropos-variable (not nosubst))
|
||||
(apropos-print-doc 7 'apropos-group t)
|
||||
(apropos-print-doc 6 'apropos-face t)
|
||||
(apropos-print-doc 5 'apropos-widget t)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user