Mercurial > emacs
comparison lisp/apropos.el @ 66821:8139e472d52b
(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'.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sat, 12 Nov 2005 00:08:50 +0000 |
parents | d94cbfddc07a |
children | 1a91d2217086 |
comparison
equal
deleted
inserted
replaced
66820:bd3b98af64fe | 66821:8139e472d52b |
---|---|
98 :type 'face) | 98 :type 'face) |
99 | 99 |
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))) |
115 (set-keymap-parent map button-buffer-map) | 127 (set-keymap-parent map button-buffer-map) |
116 ;; Use `apropos-follow' instead of just using the button | 128 ;; Use `apropos-follow' instead of just using the button |
125 | 137 |
126 (defvar apropos-mode-hook nil | 138 (defvar apropos-mode-hook nil |
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 |
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'.") | |
149 | |
150 (defvar apropos-all-words () | |
151 "Current list of words and synonyms.") | |
152 | |
153 (defvar apropos-regexp nil | |
130 "Regexp used in current apropos run.") | 154 "Regexp used in current apropos run.") |
131 | 155 |
132 (defvar apropos-orig-pattern nil | 156 (defvar apropos-all-words-regexp nil |
133 "Regexp as entered by user.") | |
134 | |
135 (defvar apropos-all-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 () |
139 "List of elc files already scanned in current run of `apropos-documentation'.") | 160 "List of elc files already scanned in current run of `apropos-documentation'.") |
140 | 161 |
149 ("kill" "cut") | 170 ("kill" "cut") |
150 ("yank" "paste")) | 171 ("yank" "paste")) |
151 "List of synonyms known by apropos. | 172 "List of synonyms known by apropos. |
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 | |
155 (defvar apropos-words () | |
156 "Current list of words.") | |
157 | |
158 (defvar apropos-all-words () | |
159 "Current list of words and synonyms.") | |
160 | 175 |
161 | 176 |
162 ;;; Button types used by apropos | 177 ;;; Button types used by apropos |
163 | 178 |
164 (define-button-type 'apropos-symbol | 179 (define-button-type 'apropos-symbol |
267 "\\(" | 282 "\\(" |
268 (mapconcat 'identity words "\\|") | 283 (mapconcat 'identity words "\\|") |
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 |
288 (if (member word (car syn)) | 319 (if (member word (car syn)) |
289 (progn | 320 (progn |
292 (setq s a)) | 323 (setq s a)) |
293 (setq syn nil)) | 324 (setq syn nil)) |
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)) |
324 | 355 |
325 (defun apropos-score-doc (doc) | 356 (defun apropos-score-doc (doc) |
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))) |
334 | 366 |
335 (defun apropos-score-symbol (symbol &optional weight) | 367 (defun apropos-score-symbol (symbol &optional weight) |
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 |
344 (defun apropos-true-hit (str words) | 375 (defun apropos-true-hit (str words) |
345 "Return t if STR is a genuine hit. | 376 "Return t if STR is a genuine hit. |
366 "Major mode for following hyperlinks in output of apropos commands. | 397 "Major mode for following hyperlinks in output of apropos commands. |
367 | 398 |
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) |
386 (get symbol 'variable-documentation))) | 419 (get symbol 'variable-documentation))) |
387 'user-variable-p))) | 420 'user-variable-p))) |
388 | 421 |
389 ;; For auld lang syne: | 422 ;; For auld lang syne: |
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)) |
422 (while tem | 455 (while tem |
423 (if (or (get (car tem) 'apropos-inhibit) | 456 (if (or (get (car tem) 'apropos-inhibit) |
445 (setq score (+ score (apropos-score-doc doc))) | 478 (setq score (+ score (apropos-score-doc doc))) |
446 (substring doc 0 | 479 (substring doc 0 |
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 |
454 | 487 |
455 ;;;###autoload | 488 ;;;###autoload |
461 "(not documented)")) | 494 "(not documented)")) |
462 (error "(error retrieving documentation)"))) | 495 (error "(error retrieving documentation)"))) |
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) |
483 (or (fboundp symbol) | 517 (or (fboundp symbol) |
484 (boundp symbol) | 518 (boundp symbol) |
529 symbols))) | 563 symbols))) |
530 (apropos-print keys nil text))) | 564 (apropos-print keys nil text))) |
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)) |
557 (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) | 592 (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) |
558 (if do-all | 593 (if do-all |
573 apropos-accumulator)))))) | 608 apropos-accumulator)))))) |
574 (apropos-print nil "\n----------------\n")) | 609 (apropos-print nil "\n----------------\n")) |
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 |
597 (set-buffer standard-input) | 634 (set-buffer standard-input) |
598 (apropos-documentation-check-doc-file) | 635 (apropos-documentation-check-doc-file) |
621 (setq apropos-accumulator | 658 (setq apropos-accumulator |
622 (cons (list symbol | 659 (cons (list symbol |
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 |
630 (defun apropos-value-internal (predicate symbol function) | 667 (defun apropos-value-internal (predicate symbol function) |
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) |
638 'face apropos-match-face | 675 'face apropos-match-face |
639 symbol)) | 676 symbol)) |
640 symbol))))) | 677 symbol))))) |
641 | 678 |
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)) |
665 (setq p nil)) | 703 (setq p nil)) |
666 (if p | 704 (if p |
672 (setq p-out (concat p-out (if p-out sep) p)))) | 710 (setq p-out (concat p-out (if p-out sep) p)))) |
673 (setq pl (nthcdr 2 pl))) | 711 (setq pl (nthcdr 2 pl))) |
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)) |
684 (forward-char) | 722 (forward-char) |
685 (while (save-excursion | 723 (while (save-excursion |
686 (setq sepb (search-forward "\^_")) | 724 (setq sepb (search-forward "\^_")) |
687 (not (eobp))) | 725 (not (eobp))) |
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 |
718 (defun apropos-documentation-check-elc-file (file) | 757 (defun apropos-documentation-check-elc-file (file) |
719 (if (member file apropos-files-scanned) | 758 (if (member file apropos-files-scanned) |
729 end (+ (point) end -1)) | 768 end (+ (point) end -1)) |
730 (forward-char) | 769 (forward-char) |
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) |
738 end (- (match-end 0) beg) | 777 end (- (match-end 0) beg) |
739 beg (- (match-beginning 0) beg)) | 778 beg (- (match-beginning 0) beg)) |
757 (+ (apropos-score-symbol symbol 2) | 796 (+ (apropos-score-symbol symbol 2) |
758 (apropos-score-doc doc)) | 797 (apropos-score-doc doc)) |
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)))))))))) |
768 | 811 |
769 | 812 |
789 (if (integerp function) | 832 (if (integerp function) |
790 nil | 833 nil |
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 |
798 (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]). | 841 (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]). |
799 The return value is the list that was in `apropos-accumulator', sorted | 842 The return value is the list that was in `apropos-accumulator', sorted |
801 `apropos-accumulator' to nil before returning. | 844 `apropos-accumulator' to nil before returning. |
802 | 845 |
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) |
810 ;; Don't sort by score if user can't see the score. | 853 ;; Don't sort by score if user can't see the score. |
811 ;; It would be confusing. -- rms. | 854 ;; It would be confusing. -- rms. |
835 (when (and spacing (not (bobp))) | 878 (when (and spacing (not (bobp))) |
836 (princ spacing)) | 879 (princ spacing)) |
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 |
850 (commandp symbol) | 900 (commandp symbol) |
851 (indent-to 30 1) | 901 (indent-to 30 1) |
893 (if (commandp symbol) | 943 (if (commandp symbol) |
894 'apropos-command | 944 'apropos-command |
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) |
903 (apropos-print-doc 4 'apropos-plist nil)) | 953 (apropos-print-doc 4 'apropos-plist nil)) |
904 (setq buffer-read-only t)))) | 954 (setq buffer-read-only t)))) |