Mercurial > emacs
comparison lisp/apropos.el @ 45482:7928b3acfb90
(apropos-show-scores, apropos-orig-regexp)
(apropos-all-regexp, apropos-synonyms, apropos-words)
(apropos-all-words): New variables.
(aprpos-words-to-regexp, apropos-rewrite-regexp)
(apropos-calc-scores, apropos-score-str, apropos-score-doc)
(apropos-score-symbol): New functions.
(apropos-command, apropos, apropos-value, apropos-documentation):
Allow keywords in addition to regexp. Added scoring.
(apropos-documentation-check-doc-file)
(apropos-documentation-check-elc-file): Added scoring.
(apropos-print): Sort according to score.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Thu, 23 May 2002 10:19:46 +0000 |
parents | 237374f1a28e |
children | 642d016eb216 |
comparison
equal
deleted
inserted
replaced
45481:d78e68782e6e | 45482:7928b3acfb90 |
---|---|
1 ;;; apropos.el --- apropos commands for users and programmers | 1 ;;; apropos.el --- apropos commands for users and programmers |
2 | 2 |
3 ;; Copyright (C) 1989, 1994, 1995, 2001 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1989, 1994, 1995, 2001, 2002 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Joe Wells <jbw@bigbird.bu.edu> | 5 ;; Author: Joe Wells <jbw@bigbird.bu.edu> |
6 ;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org> | 6 ;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org> |
7 ;; Keywords: help | 7 ;; Keywords: help |
8 | 8 |
117 "Keymap used in Apropos mode.") | 117 "Keymap used in Apropos mode.") |
118 | 118 |
119 (defvar apropos-mode-hook nil | 119 (defvar apropos-mode-hook nil |
120 "*Hook run when mode is turned on.") | 120 "*Hook run when mode is turned on.") |
121 | 121 |
122 (defvar apropos-show-scores nil | |
123 "*Show apropos scores if non-nil.") | |
124 | |
122 (defvar apropos-regexp nil | 125 (defvar apropos-regexp nil |
123 "Regexp used in current apropos run.") | 126 "Regexp used in current apropos run.") |
124 | 127 |
128 (defvar apropos-orig-regexp nil | |
129 "Regexp as entered by user.") | |
130 | |
131 (defvar apropos-all-regexp nil | |
132 "Regexp matching apropos-all-words.") | |
133 | |
125 (defvar apropos-files-scanned () | 134 (defvar apropos-files-scanned () |
126 "List of elc files already scanned in current run of `apropos-documentation'.") | 135 "List of elc files already scanned in current run of `apropos-documentation'.") |
127 | 136 |
128 (defvar apropos-accumulator () | 137 (defvar apropos-accumulator () |
129 "Alist of symbols already found in current apropos run.") | 138 "Alist of symbols already found in current apropos run.") |
130 | 139 |
131 (defvar apropos-item () | 140 (defvar apropos-item () |
132 "Current item in or for `apropos-accumulator'.") | 141 "Current item in or for `apropos-accumulator'.") |
142 | |
143 (defvar apropos-synonyms '( | |
144 ("find" "open" "edit") | |
145 ("kill" "cut") | |
146 ("yank" "paste")) | |
147 "List of synonyms known by apropos. | |
148 Each element is a list of words where the first word is the standard emacs | |
149 term, and the rest of the words are alternative terms.") | |
150 | |
151 (defvar apropos-words () | |
152 "Current list of words.") | |
153 | |
154 (defvar apropos-all-words () | |
155 "Current list of words and synonyms.") | |
133 | 156 |
134 | 157 |
135 ;;; Button types used by apropos | 158 ;;; Button types used by apropos |
136 | 159 |
137 (define-button-type 'apropos-symbol | 160 (define-button-type 'apropos-symbol |
217 (setq label (button-get button 'apropos-label)) | 240 (setq label (button-get button 'apropos-label)) |
218 (setq type (button-get button 'type)))) | 241 (setq type (button-get button 'type)))) |
219 (and label button))) | 242 (and label button))) |
220 | 243 |
221 | 244 |
245 (defun apropos-words-to-regexp (words wild) | |
246 "Make regexp matching any two of the words in WORDS." | |
247 (concat "\\(" | |
248 (mapconcat 'identity words "\\|") | |
249 "\\)" wild | |
250 (if (cdr words) | |
251 (concat "\\(" | |
252 (mapconcat 'identity words "\\|") | |
253 "\\)") | |
254 ""))) | |
255 | |
256 (defun apropos-rewrite-regexp (regexp) | |
257 "Rewrite a list of words to a regexp matching all permutations. | |
258 If REGEXP is already a regexp, don't modify it." | |
259 (setq apropos-orig-regexp regexp) | |
260 (setq apropos-words () apropos-all-words ()) | |
261 (if (string-equal (regexp-quote regexp) regexp) | |
262 ;; We don't actually make a regexp matching all permutations. | |
263 ;; Instead, for e.g. "a b c", we make a regexp matching | |
264 ;; any combination of two or more words like this: | |
265 ;; (a|b|c).*(a|b|c) which may give some false matches, | |
266 ;; but as long as it also gives the right ones, that's ok. | |
267 (let ((words (split-string regexp "[ \t]+"))) | |
268 (dolist (word words) | |
269 (let ((syn apropos-synonyms) (s word) (a word)) | |
270 (while syn | |
271 (if (member word (car syn)) | |
272 (progn | |
273 (setq a (mapconcat 'identity (car syn) "\\|")) | |
274 (if (member word (cdr (car syn))) | |
275 (setq s a)) | |
276 (setq syn nil)) | |
277 (setq syn (cdr syn)))) | |
278 (setq apropos-words (cons s apropos-words) | |
279 apropos-all-words (cons a apropos-all-words)))) | |
280 (setq apropos-all-regexp (apropos-words-to-regexp apropos-all-words ".+")) | |
281 (apropos-words-to-regexp apropos-words ".*?")) | |
282 (setq apropos-all-regexp regexp))) | |
283 | |
284 (defun apropos-calc-scores (str words) | |
285 "Return apropos scores for string STR matching WORDS. | |
286 Value is a list of offsets of the words into the string." | |
287 (let ((scores ()) | |
288 i) | |
289 (if words | |
290 (dolist (word words scores) | |
291 (if (setq i (string-match word str)) | |
292 (setq scores (cons i scores)))) | |
293 ;; Return list of start and end position of regexp | |
294 (string-match apropos-regexp str) | |
295 (list (match-beginning 0) (match-end 0))))) | |
296 | |
297 (defun apropos-score-str (str) | |
298 "Return apropos score for string STR." | |
299 (if str | |
300 (let ((score 0) | |
301 (l (length str)) | |
302 i) | |
303 (dolist (s (apropos-calc-scores str apropos-all-words) score) | |
304 (setq score (+ score 1000 (- (/ l 10)) (/ (* (- l s) 1000) l))))) | |
305 0)) | |
306 | |
307 (defun apropos-score-doc (doc) | |
308 "Return apropos score for documentation string DOC." | |
309 (if doc | |
310 (let ((score 0) | |
311 (l (length doc)) | |
312 i) | |
313 (dolist (s (apropos-calc-scores doc apropos-all-words) score) | |
314 (setq score (+ score 50 (/ (* (- l s) 50) l))))) | |
315 0)) | |
316 | |
317 (defun apropos-score-symbol (symbol &optional weight) | |
318 "Return apropos score for SYMBOL." | |
319 (setq symbol (symbol-name symbol)) | |
320 (let ((score 0) | |
321 (l (length symbol)) | |
322 i) | |
323 (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3))) | |
324 (setq score (+ score (- 60 l) (/ (* (- l s) 60) l)))))) | |
325 | |
222 ;;;###autoload | 326 ;;;###autoload |
223 (define-derived-mode apropos-mode fundamental-mode "Apropos" | 327 (define-derived-mode apropos-mode fundamental-mode "Apropos" |
224 "Major mode for following hyperlinks in output of apropos commands. | 328 "Major mode for following hyperlinks in output of apropos commands. |
225 | 329 |
226 \\{apropos-mode-map}") | 330 \\{apropos-mode-map}") |
233 (interactive (list (read-string | 337 (interactive (list (read-string |
234 (concat "Apropos " | 338 (concat "Apropos " |
235 (if (or current-prefix-arg apropos-do-all) | 339 (if (or current-prefix-arg apropos-do-all) |
236 "variable" | 340 "variable" |
237 "user option") | 341 "user option") |
238 " (regexp): ")) | 342 " (regexp or words): ")) |
239 current-prefix-arg)) | 343 current-prefix-arg)) |
240 (apropos-command regexp nil | 344 (apropos-command regexp nil |
241 (if (or do-all apropos-do-all) | 345 (if (or do-all apropos-do-all) |
242 #'(lambda (symbol) | 346 #'(lambda (symbol) |
243 (and (boundp symbol) | 347 (and (boundp symbol) |
258 (interactive (list (read-string (concat | 362 (interactive (list (read-string (concat |
259 "Apropos command " | 363 "Apropos command " |
260 (if (or current-prefix-arg | 364 (if (or current-prefix-arg |
261 apropos-do-all) | 365 apropos-do-all) |
262 "or function ") | 366 "or function ") |
263 "(regexp): ")) | 367 "(regexp or words): ")) |
264 current-prefix-arg)) | 368 current-prefix-arg)) |
369 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) | |
265 (let ((message | 370 (let ((message |
266 (let ((standard-output (get-buffer-create "*Apropos*"))) | 371 (let ((standard-output (get-buffer-create "*Apropos*"))) |
267 (print-help-return-message 'identity)))) | 372 (print-help-return-message 'identity)))) |
268 (or do-all (setq do-all apropos-do-all)) | 373 (or do-all (setq do-all apropos-do-all)) |
269 (setq apropos-accumulator | 374 (setq apropos-accumulator |
274 (while tem | 379 (while tem |
275 (if (get (car tem) 'apropos-inhibit) | 380 (if (get (car tem) 'apropos-inhibit) |
276 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) | 381 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) |
277 (setq tem (cdr tem)))) | 382 (setq tem (cdr tem)))) |
278 (let ((p apropos-accumulator) | 383 (let ((p apropos-accumulator) |
279 doc symbol) | 384 doc symbol score) |
280 (while p | 385 (while p |
281 (setcar p (list | 386 (setcar p (list |
282 (setq symbol (car p)) | 387 (setq symbol (car p)) |
388 (setq score (apropos-score-symbol symbol)) | |
283 (unless var-predicate | 389 (unless var-predicate |
284 (if (functionp symbol) | 390 (if (functionp symbol) |
285 (if (setq doc (documentation symbol t)) | 391 (if (setq doc (documentation symbol t)) |
286 (substring doc 0 (string-match "\n" doc)) | 392 (progn |
393 (setq score (+ score (apropos-score-doc doc))) | |
394 (substring doc 0 (string-match "\n" doc))) | |
287 "(not documented)"))) | 395 "(not documented)"))) |
288 (and var-predicate | 396 (and var-predicate |
289 (funcall var-predicate symbol) | 397 (funcall var-predicate symbol) |
290 (if (setq doc (documentation-property | 398 (if (setq doc (documentation-property |
291 symbol 'variable-documentation t)) | 399 symbol 'variable-documentation t)) |
292 (substring doc 0 | 400 (progn |
293 (string-match "\n" doc)))))) | 401 (setq score (+ score (apropos-score-doc doc))) |
402 (substring doc 0 | |
403 (string-match "\n" doc))))))) | |
404 (setcar (cdr (car p)) score) | |
294 (setq p (cdr p)))) | 405 (setq p (cdr p)))) |
295 (and (apropos-print t nil) | 406 (and (apropos-print t nil) |
296 message | 407 message |
297 (message message)))) | 408 (message message)))) |
298 | 409 |
301 (defun apropos (apropos-regexp &optional do-all) | 412 (defun apropos (apropos-regexp &optional do-all) |
302 "Show all bound symbols whose names match APROPOS-REGEXP. | 413 "Show all bound symbols whose names match APROPOS-REGEXP. |
303 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also | 414 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also |
304 show unbound symbols and key bindings, which is a little more | 415 show unbound symbols and key bindings, which is a little more |
305 time-consuming. Returns list of symbols and documentation found." | 416 time-consuming. Returns list of symbols and documentation found." |
306 (interactive "sApropos symbol (regexp): \nP") | 417 (interactive "sApropos symbol (regexp or words): \nP") |
418 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) | |
307 (setq apropos-accumulator | 419 (setq apropos-accumulator |
308 (apropos-internal apropos-regexp | 420 (apropos-internal apropos-regexp |
309 (and (not do-all) | 421 (and (not do-all) |
310 (not apropos-do-all) | 422 (not apropos-do-all) |
311 (lambda (symbol) | 423 (lambda (symbol) |
321 (let ((p apropos-accumulator) | 433 (let ((p apropos-accumulator) |
322 symbol doc properties) | 434 symbol doc properties) |
323 (while p | 435 (while p |
324 (setcar p (list | 436 (setcar p (list |
325 (setq symbol (car p)) | 437 (setq symbol (car p)) |
438 0 | |
326 (when (fboundp symbol) | 439 (when (fboundp symbol) |
327 (if (setq doc (condition-case nil | 440 (if (setq doc (condition-case nil |
328 (documentation symbol t) | 441 (documentation symbol t) |
329 (void-function | 442 (void-function |
330 "(alias for undefined function)"))) | 443 "(alias for undefined function)"))) |
368 (defun apropos-value (apropos-regexp &optional do-all) | 481 (defun apropos-value (apropos-regexp &optional do-all) |
369 "Show all symbols whose value's printed image matches APROPOS-REGEXP. | 482 "Show all symbols whose value's printed image matches APROPOS-REGEXP. |
370 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks | 483 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks |
371 at the function and at the names and values of properties. | 484 at the function and at the names and values of properties. |
372 Returns list of symbols and values found." | 485 Returns list of symbols and values found." |
373 (interactive "sApropos value (regexp): \nP") | 486 (interactive "sApropos value (regexp or words): \nP") |
487 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) | |
374 (or do-all (setq do-all apropos-do-all)) | 488 (or do-all (setq do-all apropos-do-all)) |
375 (setq apropos-accumulator ()) | 489 (setq apropos-accumulator ()) |
376 (let (f v p) | 490 (let (f v p) |
377 (mapatoms | 491 (mapatoms |
378 (lambda (symbol) | 492 (lambda (symbol) |
379 (setq f nil v nil p nil) | 493 (setq f nil v nil p nil) |
380 (or (memq symbol '(apropos-regexp do-all apropos-accumulator | 494 (or (memq symbol '(apropos-regexp |
381 symbol f v p)) | 495 apropos-orig-regexp apropos-all-regexp |
496 apropos-words apropos-all-words | |
497 do-all apropos-accumulator | |
498 symbol f v p)) | |
382 (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) | 499 (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) |
383 (if do-all | 500 (if do-all |
384 (setq f (apropos-value-internal 'fboundp symbol 'symbol-function) | 501 (setq f (apropos-value-internal 'fboundp symbol 'symbol-function) |
385 p (apropos-format-plist symbol "\n " t))) | 502 p (apropos-format-plist symbol "\n " t))) |
386 (if (or f v p) | 503 (if (or f v p) |
387 (setq apropos-accumulator (cons (list symbol f v p) | 504 (setq apropos-accumulator (cons (list symbol |
505 (+ (apropos-score-str f) | |
506 (apropos-score-str v) | |
507 (apropos-score-str p)) | |
508 f v p) | |
388 apropos-accumulator)))))) | 509 apropos-accumulator)))))) |
389 (apropos-print nil "\n----------------\n")) | 510 (apropos-print nil "\n----------------\n")) |
390 | 511 |
391 | 512 |
392 ;;;###autoload | 513 ;;;###autoload |
394 "Show symbols whose documentation contain matches for APROPOS-REGEXP. | 515 "Show symbols whose documentation contain matches for APROPOS-REGEXP. |
395 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use | 516 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use |
396 documentation that is not stored in the documentation file and show key | 517 documentation that is not stored in the documentation file and show key |
397 bindings. | 518 bindings. |
398 Returns list of symbols and documentation found." | 519 Returns list of symbols and documentation found." |
399 (interactive "sApropos documentation (regexp): \nP") | 520 (interactive "sApropos documentation (regexp or words): \nP") |
521 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) | |
400 (or do-all (setq do-all apropos-do-all)) | 522 (or do-all (setq do-all apropos-do-all)) |
401 (setq apropos-accumulator () apropos-files-scanned ()) | 523 (setq apropos-accumulator () apropos-files-scanned ()) |
402 (let ((standard-input (get-buffer-create " apropos-temp")) | 524 (let ((standard-input (get-buffer-create " apropos-temp")) |
403 f v) | 525 f v sf sv) |
404 (unwind-protect | 526 (unwind-protect |
405 (save-excursion | 527 (save-excursion |
406 (set-buffer standard-input) | 528 (set-buffer standard-input) |
407 (apropos-documentation-check-doc-file) | 529 (apropos-documentation-check-doc-file) |
408 (if do-all | 530 (if do-all |
411 (setq f (apropos-safe-documentation symbol) | 533 (setq f (apropos-safe-documentation symbol) |
412 v (get symbol 'variable-documentation)) | 534 v (get symbol 'variable-documentation)) |
413 (if (integerp v) (setq v)) | 535 (if (integerp v) (setq v)) |
414 (setq f (apropos-documentation-internal f) | 536 (setq f (apropos-documentation-internal f) |
415 v (apropos-documentation-internal v)) | 537 v (apropos-documentation-internal v)) |
538 (setq sf (apropos-score-doc f) | |
539 sv (apropos-score-doc v)) | |
416 (if (or f v) | 540 (if (or f v) |
417 (if (setq apropos-item | 541 (if (setq apropos-item |
418 (cdr (assq symbol apropos-accumulator))) | 542 (cdr (assq symbol apropos-accumulator))) |
419 (progn | 543 (progn |
420 (if f | 544 (if f |
421 (setcar apropos-item f)) | 545 (progn |
546 (setcar (nthcdr 1 apropos-item) f) | |
547 (setcar apropos-item (+ (car apropos-item) sf)))) | |
422 (if v | 548 (if v |
423 (setcar (cdr apropos-item) v))) | 549 (progn |
550 (setcar (nthcdr 2 apropos-item) v) | |
551 (setcar apropos-item (+ (car apropos-item) sv))))) | |
424 (setq apropos-accumulator | 552 (setq apropos-accumulator |
425 (cons (list symbol f v) | 553 (cons (list symbol |
554 (+ (apropos-score-symbol symbol 2) sf sv) | |
555 f v) | |
426 apropos-accumulator))))))) | 556 apropos-accumulator))))))) |
427 (apropos-print nil "\n----------------\n")) | 557 (apropos-print nil "\n----------------\n")) |
428 (kill-buffer standard-input)))) | 558 (kill-buffer standard-input)))) |
429 | 559 |
430 | 560 |
442 | 572 |
443 (defun apropos-documentation-internal (doc) | 573 (defun apropos-documentation-internal (doc) |
444 (if (consp doc) | 574 (if (consp doc) |
445 (apropos-documentation-check-elc-file (car doc)) | 575 (apropos-documentation-check-elc-file (car doc)) |
446 (and doc | 576 (and doc |
447 (string-match apropos-regexp doc) | 577 (string-match apropos-all-regexp doc) |
448 (progn | 578 (progn |
449 (if apropos-match-face | 579 (if apropos-match-face |
450 (put-text-property (match-beginning 0) | 580 (put-text-property (match-beginning 0) |
451 (match-end 0) | 581 (match-end 0) |
452 'face apropos-match-face | 582 'face apropos-match-face |
486 (setq sepb (search-forward "\^_")) | 616 (setq sepb (search-forward "\^_")) |
487 (not (eobp))) | 617 (not (eobp))) |
488 (beginning-of-line 2) | 618 (beginning-of-line 2) |
489 (if (save-restriction | 619 (if (save-restriction |
490 (narrow-to-region (point) (1- sepb)) | 620 (narrow-to-region (point) (1- sepb)) |
491 (re-search-forward apropos-regexp nil t)) | 621 (re-search-forward apropos-all-regexp nil t)) |
492 (progn | 622 (progn |
493 (setq beg (match-beginning 0) | 623 (setq beg (match-beginning 0) |
494 end (point)) | 624 end (point)) |
495 (goto-char (1+ sepa)) | 625 (goto-char (1+ sepa)) |
496 (or (setq type (if (eq ?F (preceding-char)) | 626 (or (and (setq type (if (eq ?F (preceding-char)) |
497 1 ; function documentation | 627 2 ; function documentation |
498 2) ; variable documentation | 628 3) ; variable documentation |
499 symbol (read) | 629 symbol (read) |
500 beg (- beg (point) 1) | 630 beg (- beg (point) 1) |
501 end (- end (point) 1) | 631 end (- end (point) 1) |
502 doc (buffer-substring (1+ (point)) (1- sepb)) | 632 doc (buffer-substring (1+ (point)) (1- sepb)) |
503 apropos-item (assq symbol apropos-accumulator)) | 633 apropos-item (assq symbol apropos-accumulator)) |
504 (setq apropos-item (list symbol nil nil) | 634 (setcar (cdr apropos-item) |
635 (+ (cadr apropos-item) (apropos-score-doc doc)))) | |
636 (setq apropos-item (list symbol | |
637 (+ (apropos-score-symbol symbol 2) | |
638 (apropos-score-doc doc)) | |
639 nil nil) | |
505 apropos-accumulator (cons apropos-item | 640 apropos-accumulator (cons apropos-item |
506 apropos-accumulator))) | 641 apropos-accumulator))) |
507 (if apropos-match-face | 642 (if apropos-match-face |
508 (put-text-property beg end 'face apropos-match-face doc)) | 643 (put-text-property beg end 'face apropos-match-face doc)) |
509 (setcar (nthcdr type apropos-item) doc))) | 644 (setcar (nthcdr type apropos-item) doc))) |
523 end (+ (point) end -1)) | 658 end (+ (point) end -1)) |
524 (forward-char) | 659 (forward-char) |
525 (if (save-restriction | 660 (if (save-restriction |
526 ;; match ^ and $ relative to doc string | 661 ;; match ^ and $ relative to doc string |
527 (narrow-to-region beg end) | 662 (narrow-to-region beg end) |
528 (re-search-forward apropos-regexp nil t)) | 663 (re-search-forward apropos-all-regexp nil t)) |
529 (progn | 664 (progn |
530 (goto-char (+ end 2)) | 665 (goto-char (+ end 2)) |
531 (setq doc (buffer-substring beg end) | 666 (setq doc (buffer-substring beg end) |
532 end (- (match-end 0) beg) | 667 end (- (match-end 0) beg) |
533 beg (- (match-beginning 0) beg) | 668 beg (- (match-beginning 0) beg) |
541 symbol)) | 676 symbol)) |
542 (if (if this-is-a-variable | 677 (if (if this-is-a-variable |
543 (get symbol 'variable-documentation) | 678 (get symbol 'variable-documentation) |
544 (and (fboundp symbol) (apropos-safe-documentation symbol))) | 679 (and (fboundp symbol) (apropos-safe-documentation symbol))) |
545 (progn | 680 (progn |
546 (or (setq apropos-item (assq symbol apropos-accumulator)) | 681 (or (and (setq apropos-item (assq symbol apropos-accumulator)) |
547 (setq apropos-item (list symbol nil nil) | 682 (setcar (cdr apropos-item) |
683 (+ (cadr apropos-item) (apropos-score-doc doc)))) | |
684 (setq apropos-item (list symbol | |
685 (+ (apropos-score-symbol symbol 2) | |
686 (apropos-score-doc doc)) | |
687 nil nil) | |
548 apropos-accumulator (cons apropos-item | 688 apropos-accumulator (cons apropos-item |
549 apropos-accumulator))) | 689 apropos-accumulator))) |
550 (if apropos-match-face | 690 (if apropos-match-face |
551 (put-text-property beg end 'face apropos-match-face | 691 (put-text-property beg end 'face apropos-match-face |
552 doc)) | 692 doc)) |
553 (setcar (nthcdr (if this-is-a-variable 2 1) | 693 (setcar (nthcdr (if this-is-a-variable 3 2) |
554 apropos-item) | 694 apropos-item) |
555 doc))))))))) | 695 doc))))))))) |
556 | 696 |
557 | 697 |
558 | 698 |
580 | 720 |
581 | 721 |
582 (defun apropos-print (do-keys spacing) | 722 (defun apropos-print (do-keys spacing) |
583 "Output result of apropos searching into buffer `*Apropos*'. | 723 "Output result of apropos searching into buffer `*Apropos*'. |
584 The value of `apropos-accumulator' is the list of items to output. | 724 The value of `apropos-accumulator' is the list of items to output. |
585 Each element should have the format (SYMBOL FN-DOC VAR-DOC [PLIST-DOC]). | 725 Each element should have the format |
726 (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]). | |
586 The return value is the list that was in `apropos-accumulator', sorted | 727 The return value is the list that was in `apropos-accumulator', sorted |
587 alphabetically by symbol name; but this function also sets | 728 alphabetically by symbol name; but this function also sets |
588 `apropos-accumulator' to nil before returning. | 729 `apropos-accumulator' to nil before returning. |
589 | 730 |
590 If SPACING is non-nil, it should be a string; | 731 If SPACING is non-nil, it should be a string; |
591 separate items with that string." | 732 separate items with that string." |
592 (if (null apropos-accumulator) | 733 (if (null apropos-accumulator) |
593 (message "No apropos matches for `%s'" apropos-regexp) | 734 (message "No apropos matches for `%s'" apropos-orig-regexp) |
594 (setq apropos-accumulator | 735 (setq apropos-accumulator |
595 (sort apropos-accumulator (lambda (a b) | 736 (sort apropos-accumulator (lambda (a b) |
596 (string-lessp (car a) (car b))))) | 737 (or (> (cadr a) (cadr b)) |
738 (and (= (cadr a) (cadr b)) | |
739 (string-lessp (car a) (car b))))))) | |
597 (with-output-to-temp-buffer "*Apropos*" | 740 (with-output-to-temp-buffer "*Apropos*" |
598 (let ((p apropos-accumulator) | 741 (let ((p apropos-accumulator) |
599 (old-buffer (current-buffer)) | 742 (old-buffer (current-buffer)) |
600 symbol item) | 743 symbol item) |
601 (set-buffer standard-output) | 744 (set-buffer standard-output) |
620 'type 'apropos-symbol | 763 'type 'apropos-symbol |
621 ;; Can't use default, since user may have | 764 ;; Can't use default, since user may have |
622 ;; changed the variable! | 765 ;; changed the variable! |
623 ;; Just say `no' to variables containing faces! | 766 ;; Just say `no' to variables containing faces! |
624 'face apropos-symbol-face) | 767 'face apropos-symbol-face) |
768 (if apropos-show-scores | |
769 (insert " (" (number-to-string (cadr apropos-item)) ") ")) | |
625 ;; Calculate key-bindings if we want them. | 770 ;; Calculate key-bindings if we want them. |
626 (and do-keys | 771 (and do-keys |
627 (commandp symbol) | 772 (commandp symbol) |
628 (indent-to 30 1) | 773 (indent-to 30 1) |
629 (if (let ((keys | 774 (if (let ((keys |
665 (insert " " (symbol-name symbol) " ") | 810 (insert " " (symbol-name symbol) " ") |
666 (insert "RET") | 811 (insert "RET") |
667 (put-text-property (- (point) 3) (point) | 812 (put-text-property (- (point) 3) (point) |
668 'face apropos-keybinding-face))) | 813 'face apropos-keybinding-face))) |
669 (terpri) | 814 (terpri) |
670 (apropos-print-doc 1 | 815 (apropos-print-doc 2 |
671 (if (commandp symbol) | 816 (if (commandp symbol) |
672 'apropos-command | 817 'apropos-command |
673 (if (apropos-macrop symbol) | 818 (if (apropos-macrop symbol) |
674 'apropos-macro | 819 'apropos-macro |
675 'apropos-function)) | 820 'apropos-function)) |
676 t) | 821 t) |
677 (apropos-print-doc 2 'apropos-variable t) | 822 (apropos-print-doc 3 'apropos-variable t) |
678 (apropos-print-doc 6 'apropos-group t) | 823 (apropos-print-doc 7 'apropos-group t) |
679 (apropos-print-doc 5 'apropos-face t) | 824 (apropos-print-doc 6 'apropos-face t) |
680 (apropos-print-doc 4 'apropos-widget t) | 825 (apropos-print-doc 5 'apropos-widget t) |
681 (apropos-print-doc 3 'apropos-plist nil)) | 826 (apropos-print-doc 4 'apropos-plist nil)) |
682 (setq buffer-read-only t)))) | 827 (setq buffer-read-only t)))) |
683 (prog1 apropos-accumulator | 828 (prog1 apropos-accumulator |
684 (setq apropos-accumulator ()))) ; permit gc | 829 (setq apropos-accumulator ()))) ; permit gc |
685 | 830 |
686 | 831 |