diff options
| author | Kim F. Storm | 2005-11-12 00:10:40 +0000 |
|---|---|---|
| committer | Kim F. Storm | 2005-11-12 00:10:40 +0000 |
| commit | 0820b753f7c0fcb341fdcdaecaf5a7ab21b80b7b (patch) | |
| tree | 7ed537c19c934dcfff60bd8d42b14bc6fe79c441 | |
| parent | 42aad0f69a905f265c53297dfc7d5ea724421cc1 (diff) | |
| download | emacs-0820b753f7c0fcb341fdcdaecaf5a7ab21b80b7b.tar.gz emacs-0820b753f7c0fcb341fdcdaecaf5a7ab21b80b7b.zip | |
(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'.
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/apropos.el | 274 |
2 files changed, 165 insertions, 112 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 769339faf41..fa2ddc87533 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,8 @@ | |||
| 1 | 2005-11-12 Kim F. Storm <storm@cua.dk> | 1 | 2005-11-12 Kim F. Storm <storm@cua.dk> |
| 2 | 2 | ||
| 3 | * simple.el (what-cursor-position): Print (EOB) instead of (100%) | ||
| 4 | when point is at end-of-buffer. | ||
| 5 | |||
| 3 | * apropos.el (apropos-match-face): Doc fix. | 6 | * apropos.el (apropos-match-face): Doc fix. |
| 4 | (apropos-sort-by-scores): Add new choice `verbose'. | 7 | (apropos-sort-by-scores): Add new choice `verbose'. |
| 5 | (apropos-documentation-sort-by-scores): New defcustom. | 8 | (apropos-documentation-sort-by-scores): New defcustom. |
diff --git a/lisp/apropos.el b/lisp/apropos.el index e7446c6fc6c..5f2ed106e0e 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el | |||
| @@ -100,15 +100,27 @@ turns off mouse highlighting." | |||
| 100 | (defcustom apropos-match-face 'match | 100 | (defcustom apropos-match-face 'match |
| 101 | "*Face for matching text in Apropos documentation/value, or nil for none. | 101 | "*Face for matching text in Apropos documentation/value, or nil for none. |
| 102 | This applies when you look for matches in the documentation or variable value | 102 | This applies when you look for matches in the documentation or variable value |
| 103 | for the regexp; the part that matches gets displayed in this font." | 103 | for the pattern; the part that matches gets displayed in this font." |
| 104 | :group 'apropos | 104 | :group 'apropos |
| 105 | :type 'face) | 105 | :type 'face) |
| 106 | 106 | ||
| 107 | (defcustom apropos-sort-by-scores nil | 107 | (defcustom apropos-sort-by-scores nil |
| 108 | "*Non-nil means sort matches by scores; best match is shown first. | 108 | "*Non-nil means sort matches by scores; best match is shown first. |
| 109 | The computed score is shown for each match." | 109 | This applies to all `apropos' commands except `apropos-documentation'. |
| 110 | If value is `verbose', the computed score is shown for each match." | ||
| 110 | :group 'apropos | 111 | :group 'apropos |
| 111 | :type 'boolean) | 112 | :type '(choice (const :tag "off" nil) |
| 113 | (const :tag "on" t) | ||
| 114 | (const :tag "show scores" verbose))) | ||
| 115 | |||
| 116 | (defcustom apropos-documentation-sort-by-scores t | ||
| 117 | "*Non-nil means sort matches by scores; best match is shown first. | ||
| 118 | This applies to `apropos-documentation' only. | ||
| 119 | If value is `verbose', the computed score is shown for each match." | ||
| 120 | :group 'apropos | ||
| 121 | :type '(choice (const :tag "off" nil) | ||
| 122 | (const :tag "on" t) | ||
| 123 | (const :tag "show scores" verbose))) | ||
| 112 | 124 | ||
| 113 | (defvar apropos-mode-map | 125 | (defvar apropos-mode-map |
| 114 | (let ((map (make-sparse-keymap))) | 126 | (let ((map (make-sparse-keymap))) |
| @@ -127,12 +139,21 @@ The computed score is shown for each match." | |||
| 127 | "*Hook run when mode is turned on.") | 139 | "*Hook run when mode is turned on.") |
| 128 | 140 | ||
| 129 | (defvar apropos-pattern nil | 141 | (defvar apropos-pattern nil |
| 130 | "Regexp used in current apropos run.") | 142 | "Apropos pattern as entered by user.") |
| 143 | |||
| 144 | (defvar apropos-pattern-quoted nil | ||
| 145 | "Apropos pattern passed through `regexp-quoute'.") | ||
| 146 | |||
| 147 | (defvar apropos-words () | ||
| 148 | "Current list of apropos words extracted from `apropos-pattern'.") | ||
| 131 | 149 | ||
| 132 | (defvar apropos-orig-pattern nil | 150 | (defvar apropos-all-words () |
| 133 | "Regexp as entered by user.") | 151 | "Current list of words and synonyms.") |
| 134 | 152 | ||
| 135 | (defvar apropos-all-regexp nil | 153 | (defvar apropos-regexp nil |
| 154 | "Regexp used in current apropos run.") | ||
| 155 | |||
| 156 | (defvar apropos-all-words-regexp nil | ||
| 136 | "Regexp matching apropos-all-words.") | 157 | "Regexp matching apropos-all-words.") |
| 137 | 158 | ||
| 138 | (defvar apropos-files-scanned () | 159 | (defvar apropos-files-scanned () |
| @@ -152,12 +173,6 @@ The computed score is shown for each match." | |||
| 152 | Each element is a list of words where the first word is the standard emacs | 173 | Each element is a list of words where the first word is the standard emacs |
| 153 | term, and the rest of the words are alternative terms.") | 174 | term, and the rest of the words are alternative terms.") |
| 154 | 175 | ||
| 155 | (defvar apropos-words () | ||
| 156 | "Current list of words.") | ||
| 157 | |||
| 158 | (defvar apropos-all-words () | ||
| 159 | "Current list of words and synonyms.") | ||
| 160 | |||
| 161 | 176 | ||
| 162 | ;;; Button types used by apropos | 177 | ;;; Button types used by apropos |
| 163 | 178 | ||
| @@ -269,19 +284,35 @@ before finding a label." | |||
| 269 | "\\)") | 284 | "\\)") |
| 270 | ""))) | 285 | ""))) |
| 271 | 286 | ||
| 272 | (defun apropos-rewrite-regexp (regexp) | 287 | ;;;###autoload |
| 273 | "Rewrite a space-separated words list to a regexp matching all permutations. | 288 | (defun apropos-read-pattern (subject) |
| 274 | If REGEXP contains any special regexp characters, that means it | 289 | "Read an apropos pattern, either a word list or a regexp. |
| 275 | is already a regexp, so return it unchanged." | 290 | Returns the user pattern, either a list of words which are matched |
| 276 | (setq apropos-orig-pattern regexp) | 291 | literally, or a string which is used as a regexp to search for. |
| 277 | (setq apropos-words () apropos-all-words ()) | 292 | |
| 278 | (if (string-equal (regexp-quote regexp) regexp) | 293 | SUBJECT is a string that is included in the prompt to identify what |
| 294 | kind of objects to search." | ||
| 295 | (let ((pattern | ||
| 296 | (read-string (concat "Apropos " subject " (word list or regexp): ")))) | ||
| 297 | (if (string-equal (regexp-quote pattern) pattern) | ||
| 298 | ;; Split into words | ||
| 299 | (split-string pattern "[ \t]+") | ||
| 300 | pattern))) | ||
| 301 | |||
| 302 | (defun apropos-parse-pattern (pattern) | ||
| 303 | "Rewrite a list of words to a regexp matching all permutations. | ||
| 304 | If PATTERN is a string, that means it is already a regexp." | ||
| 305 | (setq apropos-words nil | ||
| 306 | apropos-all-words nil) | ||
| 307 | (if (consp pattern) | ||
| 279 | ;; We don't actually make a regexp matching all permutations. | 308 | ;; We don't actually make a regexp matching all permutations. |
| 280 | ;; Instead, for e.g. "a b c", we make a regexp matching | 309 | ;; Instead, for e.g. "a b c", we make a regexp matching |
| 281 | ;; any combination of two or more words like this: | 310 | ;; any combination of two or more words like this: |
| 282 | ;; (a|b|c).*(a|b|c) which may give some false matches, | 311 | ;; (a|b|c).*(a|b|c) which may give some false matches, |
| 283 | ;; but as long as it also gives the right ones, that's ok. | 312 | ;; but as long as it also gives the right ones, that's ok. |
| 284 | (let ((words (split-string regexp "[ \t]+"))) | 313 | (let ((words pattern)) |
| 314 | (setq apropos-pattern (mapconcat 'identity pattern " ") | ||
| 315 | apropos-pattern-quoted (regexp-quote apropos-pattern)) | ||
| 285 | (dolist (word words) | 316 | (dolist (word words) |
| 286 | (let ((syn apropos-synonyms) (s word) (a word)) | 317 | (let ((syn apropos-synonyms) (s word) (a word)) |
| 287 | (while syn | 318 | (while syn |
| @@ -294,30 +325,30 @@ is already a regexp, so return it unchanged." | |||
| 294 | (setq syn (cdr syn)))) | 325 | (setq syn (cdr syn)))) |
| 295 | (setq apropos-words (cons s apropos-words) | 326 | (setq apropos-words (cons s apropos-words) |
| 296 | apropos-all-words (cons a apropos-all-words)))) | 327 | apropos-all-words (cons a apropos-all-words)))) |
| 297 | (setq apropos-all-regexp (apropos-words-to-regexp apropos-all-words ".+")) | 328 | (setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+")) |
| 298 | (apropos-words-to-regexp apropos-words ".*?")) | 329 | (apropos-words-to-regexp apropos-words ".*?")) |
| 299 | (setq apropos-all-regexp regexp))) | 330 | (setq apropos-pattern-quoted (regexp-quote pattern) |
| 331 | apropos-all-words-regexp pattern | ||
| 332 | apropos-pattern pattern))) | ||
| 333 | |||
| 300 | 334 | ||
| 301 | (defun apropos-calc-scores (str words) | 335 | (defun apropos-calc-scores (str words) |
| 302 | "Return apropos scores for string STR matching WORDS. | 336 | "Return apropos scores for string STR matching WORDS. |
| 303 | Value is a list of offsets of the words into the string." | 337 | Value is a list of offsets of the words into the string." |
| 304 | (let ((scores ()) | 338 | (let (scores i) |
| 305 | i) | ||
| 306 | (if words | 339 | (if words |
| 307 | (dolist (word words scores) | 340 | (dolist (word words scores) |
| 308 | (if (setq i (string-match word str)) | 341 | (if (setq i (string-match word str)) |
| 309 | (setq scores (cons i scores)))) | 342 | (setq scores (cons i scores)))) |
| 310 | ;; Return list of start and end position of regexp | 343 | ;; Return list of start and end position of regexp |
| 311 | (string-match apropos-pattern str) | 344 | (and (string-match apropos-regexp str) |
| 312 | (list (match-beginning 0) (match-end 0))))) | 345 | (list (match-beginning 0) (match-end 0)))))) |
| 313 | 346 | ||
| 314 | (defun apropos-score-str (str) | 347 | (defun apropos-score-str (str) |
| 315 | "Return apropos score for string STR." | 348 | "Return apropos score for string STR." |
| 316 | (if str | 349 | (if str |
| 317 | (let* ( | 350 | (let* ((l (length str)) |
| 318 | (l (length str)) | 351 | (score (- (/ l 10)))) |
| 319 | (score (- (/ l 10))) | ||
| 320 | i) | ||
| 321 | (dolist (s (apropos-calc-scores str apropos-all-words) score) | 352 | (dolist (s (apropos-calc-scores str apropos-all-words) score) |
| 322 | (setq score (+ score 1000 (/ (* (- l s) 1000) l))))) | 353 | (setq score (+ score 1000 (/ (* (- l s) 1000) l))))) |
| 323 | 0)) | 354 | 0)) |
| @@ -326,8 +357,9 @@ Value is a list of offsets of the words into the string." | |||
| 326 | "Return apropos score for documentation string DOC." | 357 | "Return apropos score for documentation string DOC." |
| 327 | (let ((l (length doc))) | 358 | (let ((l (length doc))) |
| 328 | (if (> l 0) | 359 | (if (> l 0) |
| 329 | (let ((score 0) | 360 | (let ((score 0) i) |
| 330 | i) | 361 | (when (setq i (string-match apropos-pattern-quoted doc)) |
| 362 | (setq score 10000)) | ||
| 331 | (dolist (s (apropos-calc-scores doc apropos-all-words) score) | 363 | (dolist (s (apropos-calc-scores doc apropos-all-words) score) |
| 332 | (setq score (+ score 50 (/ (* (- l s) 50) l))))) | 364 | (setq score (+ score 50 (/ (* (- l s) 50) l))))) |
| 333 | 0))) | 365 | 0))) |
| @@ -336,8 +368,7 @@ Value is a list of offsets of the words into the string." | |||
| 336 | "Return apropos score for SYMBOL." | 368 | "Return apropos score for SYMBOL." |
| 337 | (setq symbol (symbol-name symbol)) | 369 | (setq symbol (symbol-name symbol)) |
| 338 | (let ((score 0) | 370 | (let ((score 0) |
| 339 | (l (length symbol)) | 371 | (l (length symbol))) |
| 340 | i) | ||
| 341 | (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3))) | 372 | (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3))) |
| 342 | (setq score (+ score (- 60 l) (/ (* (- l s) 60) l)))))) | 373 | (setq score (+ score (- 60 l) (/ (* (- l s) 60) l)))))) |
| 343 | 374 | ||
| @@ -368,18 +399,20 @@ This requires that at least 2 keywords (unless only one was given)." | |||
| 368 | \\{apropos-mode-map}") | 399 | \\{apropos-mode-map}") |
| 369 | 400 | ||
| 370 | ;;;###autoload | 401 | ;;;###autoload |
| 371 | (defun apropos-variable (regexp &optional do-all) | 402 | (defun apropos-variable (pattern &optional do-all) |
| 372 | "Show user variables that match REGEXP. | 403 | "Show user variables that match PATTERN. |
| 373 | With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also show | 404 | PATTERN can be a word, a list of words (separated by spaces), |
| 405 | or a regexp (using some regexp special characters). If it is a word, | ||
| 406 | search for matches for that word as a substring. If it is a list of words, | ||
| 407 | search for matches for any two (or more) of those words. | ||
| 408 | |||
| 409 | With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show | ||
| 374 | normal variables." | 410 | normal variables." |
| 375 | (interactive (list (read-string | 411 | (interactive (list (apropos-read-pattern |
| 376 | (concat "Apropos " | 412 | (if (or current-prefix-arg apropos-do-all) |
| 377 | (if (or current-prefix-arg apropos-do-all) | 413 | "variable" "user option")) |
| 378 | "variable" | ||
| 379 | "user option") | ||
| 380 | " (word list or regexp): ")) | ||
| 381 | current-prefix-arg)) | 414 | current-prefix-arg)) |
| 382 | (apropos-command regexp nil | 415 | (apropos-command pattern nil |
| 383 | (if (or do-all apropos-do-all) | 416 | (if (or do-all apropos-do-all) |
| 384 | #'(lambda (symbol) | 417 | #'(lambda (symbol) |
| 385 | (and (boundp symbol) | 418 | (and (boundp symbol) |
| @@ -390,32 +423,32 @@ normal variables." | |||
| 390 | ;;;###autoload | 423 | ;;;###autoload |
| 391 | (defalias 'command-apropos 'apropos-command) | 424 | (defalias 'command-apropos 'apropos-command) |
| 392 | ;;;###autoload | 425 | ;;;###autoload |
| 393 | (defun apropos-command (apropos-pattern &optional do-all var-predicate) | 426 | (defun apropos-command (pattern &optional do-all var-predicate) |
| 394 | "Show commands (interactively callable functions) that match APROPOS-PATTERN. | 427 | "Show commands (interactively callable functions) that match PATTERN. |
| 395 | APROPOS-PATTERN can be a word, a list of words (separated by spaces), | 428 | PATTERN can be a word, a list of words (separated by spaces), |
| 396 | or a regexp (using some regexp special characters). If it is a word, | 429 | or a regexp (using some regexp special characters). If it is a word, |
| 397 | search for matches for that word as a substring. If it is a list of words, | 430 | search for matches for that word as a substring. If it is a list of words, |
| 398 | search for matches for any two (or more) of those words. | 431 | search for matches for any two (or more) of those words. |
| 399 | 432 | ||
| 400 | With optional prefix DO-ALL, or if `apropos-do-all' is non-nil, also show | 433 | With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show |
| 401 | noninteractive functions. | 434 | noninteractive functions. |
| 402 | 435 | ||
| 403 | If VAR-PREDICATE is non-nil, show only variables, and only those that | 436 | If VAR-PREDICATE is non-nil, show only variables, and only those that |
| 404 | satisfy the predicate VAR-PREDICATE." | 437 | satisfy the predicate VAR-PREDICATE. |
| 405 | (interactive (list (read-string (concat | 438 | |
| 406 | "Apropos command " | 439 | When called from a Lisp program, a string PATTERN is used as a regexp, |
| 407 | (if (or current-prefix-arg | 440 | while a list of strings is used as a word list." |
| 408 | apropos-do-all) | 441 | (interactive (list (apropos-read-pattern |
| 409 | "or function ") | 442 | (if (or current-prefix-arg apropos-do-all) |
| 410 | "(word list or regexp): ")) | 443 | "command or function" "command")) |
| 411 | current-prefix-arg)) | 444 | current-prefix-arg)) |
| 412 | (setq apropos-pattern (apropos-rewrite-regexp apropos-pattern)) | 445 | (setq apropos-regexp (apropos-parse-pattern pattern)) |
| 413 | (let ((message | 446 | (let ((message |
| 414 | (let ((standard-output (get-buffer-create "*Apropos*"))) | 447 | (let ((standard-output (get-buffer-create "*Apropos*"))) |
| 415 | (print-help-return-message 'identity)))) | 448 | (print-help-return-message 'identity)))) |
| 416 | (or do-all (setq do-all apropos-do-all)) | 449 | (or do-all (setq do-all apropos-do-all)) |
| 417 | (setq apropos-accumulator | 450 | (setq apropos-accumulator |
| 418 | (apropos-internal apropos-pattern | 451 | (apropos-internal apropos-regexp |
| 419 | (or var-predicate | 452 | (or var-predicate |
| 420 | (if do-all 'functionp 'commandp)))) | 453 | (if do-all 'functionp 'commandp)))) |
| 421 | (let ((tem apropos-accumulator)) | 454 | (let ((tem apropos-accumulator)) |
| @@ -447,7 +480,7 @@ satisfy the predicate VAR-PREDICATE." | |||
| 447 | (string-match "\n" doc))))))) | 480 | (string-match "\n" doc))))))) |
| 448 | (setcar (cdr (car p)) score) | 481 | (setcar (cdr (car p)) score) |
| 449 | (setq p (cdr p)))) | 482 | (setq p (cdr p)))) |
| 450 | (and (apropos-print t nil) | 483 | (and (apropos-print t nil nil t) |
| 451 | message | 484 | message |
| 452 | (message "%s" message)))) | 485 | (message "%s" message)))) |
| 453 | 486 | ||
| @@ -463,20 +496,21 @@ satisfy the predicate VAR-PREDICATE." | |||
| 463 | 496 | ||
| 464 | 497 | ||
| 465 | ;;;###autoload | 498 | ;;;###autoload |
| 466 | (defun apropos (apropos-pattern &optional do-all) | 499 | (defun apropos (pattern &optional do-all) |
| 467 | "Show all bound symbols whose names match APROPOS-PATTERN. | 500 | "Show all bound symbols whose names match PATTERN. |
| 468 | APROPOS-PATTERN can be a word, a list of words (separated by spaces), | 501 | PATTERN can be a word, a list of words (separated by spaces), |
| 469 | or a regexp (using some regexp special characters). If it is a word, | 502 | or a regexp (using some regexp special characters). If it is a word, |
| 470 | search for matches for that word as a substring. If it is a list of words, | 503 | search for matches for that word as a substring. If it is a list of words, |
| 471 | search for matches for any two (or more) of those words. | 504 | search for matches for any two (or more) of those words. |
| 472 | 505 | ||
| 473 | With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also | 506 | With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also |
| 474 | show unbound symbols and key bindings, which is a little more | 507 | show unbound symbols and key bindings, which is a little more |
| 475 | time-consuming. Returns list of symbols and documentation found." | 508 | time-consuming. Returns list of symbols and documentation found." |
| 476 | (interactive "sApropos symbol (word list or regexp): \nP") | 509 | (interactive (list (apropos-read-pattern "symbol") |
| 477 | (setq apropos-pattern (apropos-rewrite-regexp apropos-pattern)) | 510 | current-prefix-arg)) |
| 511 | (setq apropos-regexp (apropos-parse-pattern pattern)) | ||
| 478 | (apropos-symbols-internal | 512 | (apropos-symbols-internal |
| 479 | (apropos-internal apropos-pattern | 513 | (apropos-internal apropos-regexp |
| 480 | (and (not do-all) | 514 | (and (not do-all) |
| 481 | (not apropos-do-all) | 515 | (not apropos-do-all) |
| 482 | (lambda (symbol) | 516 | (lambda (symbol) |
| @@ -531,26 +565,27 @@ time-consuming. Returns list of symbols and documentation found." | |||
| 531 | 565 | ||
| 532 | 566 | ||
| 533 | ;;;###autoload | 567 | ;;;###autoload |
| 534 | (defun apropos-value (apropos-pattern &optional do-all) | 568 | (defun apropos-value (pattern &optional do-all) |
| 535 | "Show all symbols whose value's printed image matches APROPOS-PATTERN. | 569 | "Show all symbols whose value's printed image matches PATTERN. |
| 536 | APROPOS-PATTERN can be a word, a list of words (separated by spaces), | 570 | PATTERN can be a word, a list of words (separated by spaces), |
| 537 | or a regexp (using some regexp special characters). If it is a word, | 571 | or a regexp (using some regexp special characters). If it is a word, |
| 538 | search for matches for that word as a substring. If it is a list of words, | 572 | search for matches for that word as a substring. If it is a list of words, |
| 539 | search for matches for any two (or more) of those words. | 573 | search for matches for any two (or more) of those words. |
| 540 | 574 | ||
| 541 | With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks | 575 | With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks |
| 542 | at the function and at the names and values of properties. | 576 | at the function and at the names and values of properties. |
| 543 | Returns list of symbols and values found." | 577 | Returns list of symbols and values found." |
| 544 | (interactive "sApropos value (word list or regexp): \nP") | 578 | (interactive (list (apropos-read-pattern "value") |
| 545 | (setq apropos-pattern (apropos-rewrite-regexp apropos-pattern)) | 579 | current-prefix-arg)) |
| 580 | (setq apropos-regexp (apropos-parse-pattern pattern)) | ||
| 546 | (or do-all (setq do-all apropos-do-all)) | 581 | (or do-all (setq do-all apropos-do-all)) |
| 547 | (setq apropos-accumulator ()) | 582 | (setq apropos-accumulator ()) |
| 548 | (let (f v p) | 583 | (let (f v p) |
| 549 | (mapatoms | 584 | (mapatoms |
| 550 | (lambda (symbol) | 585 | (lambda (symbol) |
| 551 | (setq f nil v nil p nil) | 586 | (setq f nil v nil p nil) |
| 552 | (or (memq symbol '(apropos-pattern | 587 | (or (memq symbol '(apropos-regexp |
| 553 | apropos-orig-pattern apropos-all-regexp | 588 | apropos-pattern apropos-all-words-regexp |
| 554 | apropos-words apropos-all-words | 589 | apropos-words apropos-all-words |
| 555 | do-all apropos-accumulator | 590 | do-all apropos-accumulator |
| 556 | symbol f v p)) | 591 | symbol f v p)) |
| @@ -575,22 +610,24 @@ Returns list of symbols and values found." | |||
| 575 | 610 | ||
| 576 | 611 | ||
| 577 | ;;;###autoload | 612 | ;;;###autoload |
| 578 | (defun apropos-documentation (apropos-pattern &optional do-all) | 613 | (defun apropos-documentation (pattern &optional do-all) |
| 579 | "Show symbols whose documentation contain matches for APROPOS-PATTERN. | 614 | "Show symbols whose documentation contain matches for PATTERN. |
| 580 | APROPOS-PATTERN can be a word, a list of words (separated by spaces), | 615 | PATTERN can be a word, a list of words (separated by spaces), |
| 581 | or a regexp (using some regexp special characters). If it is a word, | 616 | or a regexp (using some regexp special characters). If it is a word, |
| 582 | search for matches for that word as a substring. If it is a list of words, | 617 | search for matches for that word as a substring. If it is a list of words, |
| 583 | search for matches for any two (or more) of those words. | 618 | search for matches for any two (or more) of those words. |
| 584 | 619 | ||
| 585 | With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use | 620 | With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also use |
| 586 | documentation that is not stored in the documentation file and show key | 621 | documentation that is not stored in the documentation file and show key |
| 587 | bindings. | 622 | bindings. |
| 588 | Returns list of symbols and documentation found." | 623 | Returns list of symbols and documentation found." |
| 589 | (interactive "sApropos documentation (word list or regexp): \nP") | 624 | (interactive (list (apropos-read-pattern "documentation") |
| 590 | (setq apropos-pattern (apropos-rewrite-regexp apropos-pattern)) | 625 | current-prefix-arg)) |
| 626 | (setq apropos-regexp (apropos-parse-pattern pattern)) | ||
| 591 | (or do-all (setq do-all apropos-do-all)) | 627 | (or do-all (setq do-all apropos-do-all)) |
| 592 | (setq apropos-accumulator () apropos-files-scanned ()) | 628 | (setq apropos-accumulator () apropos-files-scanned ()) |
| 593 | (let ((standard-input (get-buffer-create " apropos-temp")) | 629 | (let ((standard-input (get-buffer-create " apropos-temp")) |
| 630 | (apropos-sort-by-scores apropos-documentation-sort-by-scores) | ||
| 594 | f v sf sv) | 631 | f v sf sv) |
| 595 | (unwind-protect | 632 | (unwind-protect |
| 596 | (save-excursion | 633 | (save-excursion |
| @@ -623,7 +660,7 @@ Returns list of symbols and documentation found." | |||
| 623 | (+ (apropos-score-symbol symbol 2) sf sv) | 660 | (+ (apropos-score-symbol symbol 2) sf sv) |
| 624 | f v) | 661 | f v) |
| 625 | apropos-accumulator))))))) | 662 | apropos-accumulator))))))) |
| 626 | (apropos-print nil "\n----------------\n")) | 663 | (apropos-print nil "\n----------------\n" nil t)) |
| 627 | (kill-buffer standard-input)))) | 664 | (kill-buffer standard-input)))) |
| 628 | 665 | ||
| 629 | 666 | ||
| @@ -631,7 +668,7 @@ Returns list of symbols and documentation found." | |||
| 631 | (if (funcall predicate symbol) | 668 | (if (funcall predicate symbol) |
| 632 | (progn | 669 | (progn |
| 633 | (setq symbol (prin1-to-string (funcall function symbol))) | 670 | (setq symbol (prin1-to-string (funcall function symbol))) |
| 634 | (if (string-match apropos-pattern symbol) | 671 | (if (string-match apropos-regexp symbol) |
| 635 | (progn | 672 | (progn |
| 636 | (if apropos-match-face | 673 | (if apropos-match-face |
| 637 | (put-text-property (match-beginning 0) (match-end 0) | 674 | (put-text-property (match-beginning 0) (match-end 0) |
| @@ -642,23 +679,24 @@ Returns list of symbols and documentation found." | |||
| 642 | (defun apropos-documentation-internal (doc) | 679 | (defun apropos-documentation-internal (doc) |
| 643 | (if (consp doc) | 680 | (if (consp doc) |
| 644 | (apropos-documentation-check-elc-file (car doc)) | 681 | (apropos-documentation-check-elc-file (car doc)) |
| 645 | (and doc | 682 | (if (and doc |
| 646 | (string-match apropos-all-regexp doc) | 683 | (string-match apropos-all-words-regexp doc) |
| 647 | (save-match-data (apropos-true-hit-doc doc)) | 684 | (apropos-true-hit-doc doc)) |
| 648 | (progn | 685 | (when apropos-match-face |
| 649 | (if apropos-match-face | 686 | (setq doc (substitute-command-keys (copy-sequence doc))) |
| 650 | (put-text-property (match-beginning 0) | 687 | (if (or (string-match apropos-pattern-quoted doc) |
| 651 | (match-end 0) | 688 | (string-match apropos-all-words-regexp doc)) |
| 652 | 'face apropos-match-face | 689 | (put-text-property (match-beginning 0) |
| 653 | (setq doc (copy-sequence doc)))) | 690 | (match-end 0) |
| 654 | doc)))) | 691 | 'face apropos-match-face doc)) |
| 692 | doc)))) | ||
| 655 | 693 | ||
| 656 | (defun apropos-format-plist (pl sep &optional compare) | 694 | (defun apropos-format-plist (pl sep &optional compare) |
| 657 | (setq pl (symbol-plist pl)) | 695 | (setq pl (symbol-plist pl)) |
| 658 | (let (p p-out) | 696 | (let (p p-out) |
| 659 | (while pl | 697 | (while pl |
| 660 | (setq p (format "%s %S" (car pl) (nth 1 pl))) | 698 | (setq p (format "%s %S" (car pl) (nth 1 pl))) |
| 661 | (if (or (not compare) (string-match apropos-pattern p)) | 699 | (if (or (not compare) (string-match apropos-regexp p)) |
| 662 | (if apropos-property-face | 700 | (if apropos-property-face |
| 663 | (put-text-property 0 (length (symbol-name (car pl))) | 701 | (put-text-property 0 (length (symbol-name (car pl))) |
| 664 | 'face apropos-property-face p)) | 702 | 'face apropos-property-face p)) |
| @@ -674,10 +712,10 @@ Returns list of symbols and documentation found." | |||
| 674 | p-out)) | 712 | p-out)) |
| 675 | 713 | ||
| 676 | 714 | ||
| 677 | ;; Finds all documentation related to APROPOS-PATTERN in internal-doc-file-name. | 715 | ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. |
| 678 | 716 | ||
| 679 | (defun apropos-documentation-check-doc-file () | 717 | (defun apropos-documentation-check-doc-file () |
| 680 | (let (type symbol (sepa 2) sepb beg end) | 718 | (let (type symbol (sepa 2) sepb) |
| 681 | (insert ?\^_) | 719 | (insert ?\^_) |
| 682 | (backward-char) | 720 | (backward-char) |
| 683 | (insert-file-contents (concat doc-directory internal-doc-file-name)) | 721 | (insert-file-contents (concat doc-directory internal-doc-file-name)) |
| @@ -688,30 +726,31 @@ Returns list of symbols and documentation found." | |||
| 688 | (beginning-of-line 2) | 726 | (beginning-of-line 2) |
| 689 | (if (save-restriction | 727 | (if (save-restriction |
| 690 | (narrow-to-region (point) (1- sepb)) | 728 | (narrow-to-region (point) (1- sepb)) |
| 691 | (re-search-forward apropos-all-regexp nil t)) | 729 | (re-search-forward apropos-all-words-regexp nil t)) |
| 692 | (progn | 730 | (progn |
| 693 | (setq beg (match-beginning 0) | ||
| 694 | end (point)) | ||
| 695 | (goto-char (1+ sepa)) | 731 | (goto-char (1+ sepa)) |
| 696 | (setq type (if (eq ?F (preceding-char)) | 732 | (setq type (if (eq ?F (preceding-char)) |
| 697 | 2 ; function documentation | 733 | 2 ; function documentation |
| 698 | 3) ; variable documentation | 734 | 3) ; variable documentation |
| 699 | symbol (read) | 735 | symbol (read) |
| 700 | beg (- beg (point) 1) | ||
| 701 | end (- end (point) 1) | ||
| 702 | doc (buffer-substring (1+ (point)) (1- sepb))) | 736 | doc (buffer-substring (1+ (point)) (1- sepb))) |
| 703 | (when (apropos-true-hit-doc doc) | 737 | (when (apropos-true-hit-doc doc) |
| 704 | (or (and (setq apropos-item (assq symbol apropos-accumulator)) | 738 | (or (and (setq apropos-item (assq symbol apropos-accumulator)) |
| 705 | (setcar (cdr apropos-item) | 739 | (setcar (cdr apropos-item) |
| 706 | (+ (cadr apropos-item) (apropos-score-doc doc)))) | 740 | (apropos-score-doc doc))) |
| 707 | (setq apropos-item (list symbol | 741 | (setq apropos-item (list symbol |
| 708 | (+ (apropos-score-symbol symbol 2) | 742 | (+ (apropos-score-symbol symbol 2) |
| 709 | (apropos-score-doc doc)) | 743 | (apropos-score-doc doc)) |
| 710 | nil nil) | 744 | nil nil) |
| 711 | apropos-accumulator (cons apropos-item | 745 | apropos-accumulator (cons apropos-item |
| 712 | apropos-accumulator))) | 746 | apropos-accumulator))) |
| 713 | (if apropos-match-face | 747 | (when apropos-match-face |
| 714 | (put-text-property beg end 'face apropos-match-face doc)) | 748 | (setq doc (substitute-command-keys doc)) |
| 749 | (if (or (string-match apropos-pattern-quoted doc) | ||
| 750 | (string-match apropos-all-words-regexp doc)) | ||
| 751 | (put-text-property (match-beginning 0) | ||
| 752 | (match-end 0) | ||
| 753 | 'face apropos-match-face doc))) | ||
| 715 | (setcar (nthcdr type apropos-item) doc)))) | 754 | (setcar (nthcdr type apropos-item) doc)))) |
| 716 | (setq sepa (goto-char sepb))))) | 755 | (setq sepa (goto-char sepb))))) |
| 717 | 756 | ||
| @@ -731,7 +770,7 @@ Returns list of symbols and documentation found." | |||
| 731 | (if (save-restriction | 770 | (if (save-restriction |
| 732 | ;; match ^ and $ relative to doc string | 771 | ;; match ^ and $ relative to doc string |
| 733 | (narrow-to-region beg end) | 772 | (narrow-to-region beg end) |
| 734 | (re-search-forward apropos-all-regexp nil t)) | 773 | (re-search-forward apropos-all-words-regexp nil t)) |
| 735 | (progn | 774 | (progn |
| 736 | (goto-char (+ end 2)) | 775 | (goto-char (+ end 2)) |
| 737 | (setq doc (buffer-substring beg end) | 776 | (setq doc (buffer-substring beg end) |
| @@ -759,9 +798,13 @@ Returns list of symbols and documentation found." | |||
| 759 | nil nil) | 798 | nil nil) |
| 760 | apropos-accumulator (cons apropos-item | 799 | apropos-accumulator (cons apropos-item |
| 761 | apropos-accumulator))) | 800 | apropos-accumulator))) |
| 762 | (if apropos-match-face | 801 | (when apropos-match-face |
| 763 | (put-text-property beg end 'face apropos-match-face | 802 | (setq doc (substitute-command-keys doc)) |
| 764 | doc)) | 803 | (if (or (string-match apropos-pattern-quoted doc) |
| 804 | (string-match apropos-all-words-regexp doc)) | ||
| 805 | (put-text-property (match-beginning 0) | ||
| 806 | (match-end 0) | ||
| 807 | 'face apropos-match-face doc))) | ||
| 765 | (setcar (nthcdr (if this-is-a-variable 3 2) | 808 | (setcar (nthcdr (if this-is-a-variable 3 2) |
| 766 | apropos-item) | 809 | apropos-item) |
| 767 | doc)))))))))) | 810 | doc)))))))))) |
| @@ -791,7 +834,7 @@ Will return nil instead." | |||
| 791 | function)) | 834 | function)) |
| 792 | 835 | ||
| 793 | 836 | ||
| 794 | (defun apropos-print (do-keys spacing &optional text) | 837 | (defun apropos-print (do-keys spacing &optional text nosubst) |
| 795 | "Output result of apropos searching into buffer `*Apropos*'. | 838 | "Output result of apropos searching into buffer `*Apropos*'. |
| 796 | The value of `apropos-accumulator' is the list of items to output. | 839 | The value of `apropos-accumulator' is the list of items to output. |
| 797 | Each element should have the format | 840 | Each element should have the format |
| @@ -803,7 +846,7 @@ alphabetically by symbol name; but this function also sets | |||
| 803 | If SPACING is non-nil, it should be a string; separate items with that string. | 846 | If SPACING is non-nil, it should be a string; separate items with that string. |
| 804 | If non-nil TEXT is a string that will be printed as a heading." | 847 | If non-nil TEXT is a string that will be printed as a heading." |
| 805 | (if (null apropos-accumulator) | 848 | (if (null apropos-accumulator) |
| 806 | (message "No apropos matches for `%s'" apropos-orig-pattern) | 849 | (message "No apropos matches for `%s'" apropos-pattern) |
| 807 | (setq apropos-accumulator | 850 | (setq apropos-accumulator |
| 808 | (sort apropos-accumulator | 851 | (sort apropos-accumulator |
| 809 | (lambda (a b) | 852 | (lambda (a b) |
| @@ -837,13 +880,20 @@ If non-nil TEXT is a string that will be printed as a heading." | |||
| 837 | (setq apropos-item (car p) | 880 | (setq apropos-item (car p) |
| 838 | symbol (car apropos-item) | 881 | symbol (car apropos-item) |
| 839 | p (cdr p)) | 882 | p (cdr p)) |
| 883 | ;; Insert dummy score element for backwards compatibility with 21.x | ||
| 884 | ;; apropos-item format. | ||
| 885 | (if (not (numberp (cadr apropos-item))) | ||
| 886 | (setq apropos-item | ||
| 887 | (cons (car apropos-item) | ||
| 888 | (cons nil (cdr apropos-item))))) | ||
| 840 | (insert-text-button (symbol-name symbol) | 889 | (insert-text-button (symbol-name symbol) |
| 841 | 'type 'apropos-symbol | 890 | 'type 'apropos-symbol |
| 842 | ;; Can't use default, since user may have | 891 | ;; Can't use default, since user may have |
| 843 | ;; changed the variable! | 892 | ;; changed the variable! |
| 844 | ;; Just say `no' to variables containing faces! | 893 | ;; Just say `no' to variables containing faces! |
| 845 | 'face apropos-symbol-face) | 894 | 'face apropos-symbol-face) |
| 846 | (if apropos-sort-by-scores | 895 | (if (and (eq apropos-sort-by-scores 'verbose) |
| 896 | (cadr apropos-item)) | ||
| 847 | (insert " (" (number-to-string (cadr apropos-item)) ") ")) | 897 | (insert " (" (number-to-string (cadr apropos-item)) ") ")) |
| 848 | ;; Calculate key-bindings if we want them. | 898 | ;; Calculate key-bindings if we want them. |
| 849 | (and do-keys | 899 | (and do-keys |
| @@ -895,8 +945,8 @@ If non-nil TEXT is a string that will be printed as a heading." | |||
| 895 | (if (apropos-macrop symbol) | 945 | (if (apropos-macrop symbol) |
| 896 | 'apropos-macro | 946 | 'apropos-macro |
| 897 | 'apropos-function)) | 947 | 'apropos-function)) |
| 898 | t) | 948 | (not nosubst)) |
| 899 | (apropos-print-doc 3 'apropos-variable t) | 949 | (apropos-print-doc 3 'apropos-variable (not nosubst)) |
| 900 | (apropos-print-doc 7 'apropos-group t) | 950 | (apropos-print-doc 7 'apropos-group t) |
| 901 | (apropos-print-doc 6 'apropos-face t) | 951 | (apropos-print-doc 6 'apropos-face t) |
| 902 | (apropos-print-doc 5 'apropos-widget t) | 952 | (apropos-print-doc 5 'apropos-widget t) |