Changeset 3988 for vendor/emacs-CVS_HEAD/lisp/apropos.el
- Timestamp:
- 2005年11月26日 08時33分26秒 (3 years ago)
- Files:
-
- vendor/emacs-CVS_HEAD/lisp/apropos.el (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
vendor/emacs-CVS_HEAD/lisp/apropos.el
r3892 r3988 101 101 "*Face for matching text in Apropos documentation/value, or nil for none. 102 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 104 :group 'apropos 105 105 :type 'face) … … 107 107 (defcustom apropos-sort-by-scores nil 108 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 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 125 (defvar apropos-mode-map … … 127 139 "*Hook run when mode is turned on.") 128 140 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 129 153 (defvar apropos-regexp nil 130 154 "Regexp used in current apropos run.") 131 155 132 (defvar apropos-orig-regexp nil 133 "Regexp as entered by user.") 134 135 (defvar apropos-all-regexp nil 156 (defvar apropos-all-words-regexp nil 136 157 "Regexp matching apropos-all-words.") 137 158 … … 152 173 Each element is a list of words where the first word is the standard emacs 153 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 … … 270 285 ""))) 271 286 272 (defun apropos-rewrite-regexp (regexp) 287 ;;;###autoload 288 (defun apropos-read-pattern (subject) 289 "Read an apropos pattern, either a word list or a regexp. 290 Returns the user pattern, either a list of words which are matched 291 literally, or a string which is used as a regexp to search for. 292 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) 273 303 "Rewrite a list of words to a regexp matching all permutations. 274 If REGEXP is already a regexp, don't modify it."275 (setq apropos- orig-regexp regexp)276 (setq apropos-words () apropos-all-words ())277 (if ( string-equal (regexp-quote regexp) regexp)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) 278 308 ;; We don't actually make a regexp matching all permutations. 279 309 ;; Instead, for e.g. "a b c", we make a regexp matching … … 281 311 ;; (a|b|c).*(a|b|c) which may give some false matches, 282 312 ;; but as long as it also gives the right ones, that's ok. 283 (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)) 284 316 (dolist (word words) 285 317 (let ((syn apropos-synonyms) (s word) (a word)) … … 294 326 (setq apropos-words (cons s apropos-words) 295 327 apropos-all-words (cons a apropos-all-words)))) 296 (setq apropos-all- regexp (apropos-words-to-regexp apropos-all-words ".+"))328 (setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+")) 297 329 (apropos-words-to-regexp apropos-words ".*?")) 298 (setq apropos-all-regexp regexp))) 330 (setq apropos-pattern-quoted (regexp-quote pattern) 331 apropos-all-words-regexp pattern 332 apropos-pattern pattern))) 333 299 334 300 335 (defun apropos-calc-scores (str words) 301 336 "Return apropos scores for string STR matching WORDS. 302 337 Value is a list of offsets of the words into the string." 303 (let ((scores ()) 304 i) 338 (let (scores i) 305 339 (if words 306 340 (dolist (word words scores) … … 308 342 (setq scores (cons i scores)))) 309 343 ;; Return list of start and end position of regexp 310 ( string-match apropos-regexpstr)311 (list (match-beginning 0) (match-end 0)))))344 (and (string-match apropos-pattern str) 345 (list (match-beginning 0) (match-end 0)))))) 312 346 313 347 (defun apropos-score-str (str) 314 348 "Return apropos score for string STR." 315 349 (if str 316 (let* ( 317 (l (length str)) 318 (score (- (/ l 10))) 319 i) 350 (let* ((l (length str)) 351 (score (- (/ l 10)))) 320 352 (dolist (s (apropos-calc-scores str apropos-all-words) score) 321 353 (setq score (+ score 1000 (/ (* (- l s) 1000) l))))) … … 326 358 (let ((l (length doc))) 327 359 (if (> l 0) 328 (let ((score 0) 329 i) 360 (let ((score 0) i) 361 (when (setq i (string-match apropos-pattern-quoted doc)) 362 (setq score 10000)) 330 363 (dolist (s (apropos-calc-scores doc apropos-all-words) score) 331 364 (setq score (+ score 50 (/ (* (- l s) 50) l))))) … … 336 369 (setq symbol (symbol-name symbol)) 337 370 (let ((score 0) 338 (l (length symbol)) 339 i) 371 (l (length symbol))) 340 372 (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3))) 341 373 (setq score (+ score (- 60 l) (/ (* (- l s) 60) l)))))) … … 368 400 369 401 ;;;###autoload 370 (defun apropos-variable (regexp &optional do-all) 371 "Show user variables that match REGEXP. 372 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also show 402 (defun apropos-variable (pattern &optional do-all) 403 "Show user variables that match PATTERN. 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 373 410 normal variables." 374 (interactive (list (read-string 375 (concat "Apropos " 376 (if (or current-prefix-arg apropos-do-all) 377 "variable" 378 "user option") 379 " (regexp or words): ")) 411 (interactive (list (apropos-read-pattern 412 (if (or current-prefix-arg apropos-do-all) 413 "variable" "user option")) 380 414 current-prefix-arg)) 381 (apropos-command regexpnil415 (apropos-command pattern nil 382 416 (if (or do-all apropos-do-all) 383 417 #'(lambda (symbol) … … 390 424 (defalias 'command-apropos 'apropos-command) 391 425 ;;;###autoload 392 (defun apropos-command (apropos-regexp &optional do-all var-predicate) 393 "Show commands (interactively callable functions) that match APROPOS-REGEXP. 394 With optional prefix DO-ALL, or if `apropos-do-all' is non-nil, also show 426 (defun apropos-command (pattern &optional do-all var-predicate) 427 "Show commands (interactively callable functions) that match PATTERN. 428 PATTERN can be a word, a list of words (separated by spaces), 429 or a regexp (using some regexp special characters). If it is a word, 430 search for matches for that word as a substring. If it is a list of words, 431 search for matches for any two (or more) of those words. 432 433 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show 395 434 noninteractive functions. 396 435 397 436 If VAR-PREDICATE is non-nil, show only variables, and only those that 398 satisfy the predicate VAR-PREDICATE. "399 (interactive (list (read-string (concat 400 "Apropos command " 401 (if (or current-prefix-arg 402 apropos-do-all) 403 "or function ")404 "(regexp or words):"))437 satisfy the predicate VAR-PREDICATE. 438 439 When called from a Lisp program, a string PATTERN is used as a regexp, 440 while a list of strings is used as a word list." 441 (interactive (list (apropos-read-pattern 442 (if (or current-prefix-arg apropos-do-all) 443 "command or function" "command")) 405 444 current-prefix-arg)) 406 (setq apropos-regexp (apropos- rewrite-regexp apropos-regexp))445 (setq apropos-regexp (apropos-parse-pattern pattern)) 407 446 (let ((message 408 447 (let ((standard-output (get-buffer-create "*Apropos*"))) … … 442 481 (setcar (cdr (car p)) score) 443 482 (setq p (cdr p)))) 444 (and (apropos-print t nil )483 (and (apropos-print t nil nil t) 445 484 message 446 485 (message "%s" message)))) … … 458 497 459 498 ;;;###autoload 460 (defun apropos (apropos-regexp &optional do-all) 461 "Show all bound symbols whose names match APROPOS-REGEXP. 462 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also 499 (defun apropos (pattern &optional do-all) 500 "Show all bound symbols whose names match PATTERN. 501 PATTERN can be a word, a list of words (separated by spaces), 502 or a regexp (using some regexp special characters). If it is a word, 503 search for matches for that word as a substring. If it is a list of words, 504 search for matches for any two (or more) of those words. 505 506 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also 463 507 show unbound symbols and key bindings, which is a little more 464 508 time-consuming. Returns list of symbols and documentation found." 465 (interactive "sApropos symbol (regexp or words): \nP") 466 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) 509 (interactive (list (apropos-read-pattern "symbol") 510 current-prefix-arg)) 511 (setq apropos-regexp (apropos-parse-pattern pattern)) 467 512 (apropos-symbols-internal 468 513 (apropos-internal apropos-regexp … … 521 566 522 567 ;;;###autoload 523 (defun apropos-value (apropos-regexp &optional do-all) 524 "Show all symbols whose value's printed image matches APROPOS-REGEXP. 525 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks 568 (defun apropos-value (pattern &optional do-all) 569 "Show all symbols whose value's printed image matches PATTERN. 570 PATTERN can be a word, a list of words (separated by spaces), 571 or a regexp (using some regexp special characters). If it is a word, 572 search for matches for that word as a substring. If it is a list of words, 573 search for matches for any two (or more) of those words. 574 575 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks 526 576 at the function and at the names and values of properties. 527 577 Returns list of symbols and values found." 528 (interactive "sApropos value (regexp or words): \nP") 529 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) 578 (interactive (list (apropos-read-pattern "value") 579 current-prefix-arg)) 580 (setq apropos-regexp (apropos-parse-pattern pattern)) 530 581 (or do-all (setq do-all apropos-do-all)) 531 582 (setq apropos-accumulator ()) … … 535 586 (setq f nil v nil p nil) 536 587 (or (memq symbol '(apropos-regexp 537 apropos- orig-regexp apropos-all-regexp588 apropos-pattern apropos-all-words-regexp 538 589 apropos-words apropos-all-words 539 590 do-all apropos-accumulator … … 560 611 561 612 ;;;###autoload 562 (defun apropos-documentation (apropos-regexp &optional do-all) 563 "Show symbols whose documentation contain matches for APROPOS-REGEXP. 564 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use 613 (defun apropos-documentation (pattern &optional do-all) 614 "Show symbols whose documentation contain matches for PATTERN. 615 PATTERN can be a word, a list of words (separated by spaces), 616 or a regexp (using some regexp special characters). If it is a word, 617 search for matches for that word as a substring. If it is a list of words, 618 search for matches for any two (or more) of those words. 619 620 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also use 565 621 documentation that is not stored in the documentation file and show key 566 622 bindings. 567 623 Returns list of symbols and documentation found." 568 (interactive "sApropos documentation (regexp or words): \nP") 569 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) 624 (interactive (list (apropos-read-pattern "documentation") 625 current-prefix-arg)) 626 (setq apropos-regexp (apropos-parse-pattern pattern)) 570 627 (or do-all (setq do-all apropos-do-all)) 571 628 (setq apropos-accumulator () apropos-files-scanned ()) 572 629 (let ((standard-input (get-buffer-create " apropos-temp")) 630 (apropos-sort-by-scores apropos-documentation-sort-by-scores) 573 631 f v sf sv) 574 632 (unwind-protect … … 603 661 f v) 604 662 apropos-accumulator))))))) 605 (apropos-print nil "\n----------------\n" ))663 (apropos-print nil "\n----------------\n" nil t)) 606 664 (kill-buffer standard-input)))) 607 665 … … 622 680 (if (consp doc) 623 681 (apropos-documentation-check-elc-file (car doc)) 624 (and doc 625 (string-match apropos-all-regexp doc) 626 (save-match-data (apropos-true-hit-doc doc)) 627 (progn 628 (if apropos-match-face 629 (put-text-property (match-beginning 0) 630 (match-end 0) 631 'face apropos-match-face 632 (setq doc (copy-sequence doc)))) 633 doc)))) 682 (if (and doc 683 (string-match apropos-all-words-regexp doc) 684 (apropos-true-hit-doc doc)) 685 (when apropos-match-face 686 (setq doc (substitute-command-keys (copy-sequence doc))) 687 (if (or (string-match apropos-pattern-quoted doc) 688 (string-match apropos-all-words-regexp doc)) 689 (put-text-property (match-beginning 0) 690 (match-end 0) 691 'face apropos-match-face doc)) 692 doc)))) 634 693 635 694 (defun apropos-format-plist (pl sep &optional compare) … … 657 716 658 717 (defun apropos-documentation-check-doc-file () 659 (let (type symbol (sepa 2) sepb beg end)718 (let (type symbol (sepa 2) sepb) 660 719 (insert ?\^_) 661 720 (backward-char) … … 668 727 (if (save-restriction 669 728 (narrow-to-region (point) (1- sepb)) 670 (re-search-forward apropos-all- regexp nil t))729 (re-search-forward apropos-all-words-regexp nil t)) 671 730 (progn 672 (setq beg (match-beginning 0)673 end (point))674 731 (goto-char (1+ sepa)) 675 732 (setq type (if (eq ?F (preceding-char)) … … 677 734 3) ; variable documentation 678 735 symbol (read) 679 beg (- beg (point) 1)680 end (- end (point) 1)681 736 doc (buffer-substring (1+ (point)) (1- sepb))) 682 737 (when (apropos-true-hit-doc doc) 683 738 (or (and (setq apropos-item (assq symbol apropos-accumulator)) 684 739 (setcar (cdr apropos-item) 685 ( + (cadr apropos-item) (apropos-score-doc doc))))740 (apropos-score-doc doc))) 686 741 (setq apropos-item (list symbol 687 742 (+ (apropos-score-symbol symbol 2) … … 690 745 apropos-accumulator (cons apropos-item 691 746 apropos-accumulator))) 692 (if apropos-match-face 693 (put-text-property beg end 'face apropos-match-face doc)) 747 (when apropos-match-face 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))) 694 754 (setcar (nthcdr type apropos-item) doc)))) 695 755 (setq sepa (goto-char sepb))))) … … 711 771 ;; match ^ and $ relative to doc string 712 772 (narrow-to-region beg end) 713 (re-search-forward apropos-all- regexp nil t))773 (re-search-forward apropos-all-words-regexp nil t)) 714 774 (progn 715 775 (goto-char (+ end 2)) … … 739 799 apropos-accumulator (cons apropos-item 740 800 apropos-accumulator))) 741 (if apropos-match-face 742 (put-text-property beg end 'face apropos-match-face 743 doc)) 801 (when apropos-match-face 802 (setq doc (substitute-command-keys 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))) 744 808 (setcar (nthcdr (if this-is-a-variable 3 2) 745 809 apropos-item) … … 771 835 772 836 773 (defun apropos-print (do-keys spacing &optional text )837 (defun apropos-print (do-keys spacing &optional text nosubst) 774 838 "Output result of apropos searching into buffer `*Apropos*'. 775 839 The value of `apropos-accumulator' is the list of items to output. … … 783 847 If non-nil TEXT is a string that will be printed as a heading." 784 848 (if (null apropos-accumulator) 785 (message "No apropos matches for `%s'" apropos- orig-regexp)849 (message "No apropos matches for `%s'" apropos-pattern) 786 850 (setq apropos-accumulator 787 851 (sort apropos-accumulator … … 817 881 symbol (car apropos-item) 818 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))))) 819 889 (insert-text-button (symbol-name symbol) 820 890 'type 'apropos-symbol … … 823 893 ;; Just say `no' to variables containing faces! 824 894 'face apropos-symbol-face) 825 (if apropos-sort-by-scores 895 (if (and (eq apropos-sort-by-scores 'verbose) 896 (cadr apropos-item)) 826 897 (insert " (" (number-to-string (cadr apropos-item)) ") ")) 827 898 ;; Calculate key-bindings if we want them. … … 875 946 'apropos-macro 876 947 'apropos-function)) 877 t)878 (apropos-print-doc 3 'apropos-variable t)948 (not nosubst)) 949 (apropos-print-doc 3 'apropos-variable (not nosubst)) 879 950 (apropos-print-doc 7 'apropos-group t) 880 951 (apropos-print-doc 6 'apropos-face t)
