Mercurial > emacs
comparison lisp/gnus/gnus-registry.el @ 97898:5b7eb18818c1
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1392
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 31 Aug 2008 10:43:43 +0000 |
| parents | c3512b2085a0 |
| children | 30636ed66b80 |
comparison
equal
deleted
inserted
replaced
| 97897:170486ace2df | 97898:5b7eb18818c1 |
|---|---|
| 146 | 146 |
| 147 (defcustom gnus-registry-use-long-group-names nil | 147 (defcustom gnus-registry-use-long-group-names nil |
| 148 "Whether the registry should use long group names (BUGGY)." | 148 "Whether the registry should use long group names (BUGGY)." |
| 149 :group 'gnus-registry | 149 :group 'gnus-registry |
| 150 :type 'boolean) | 150 :type 'boolean) |
| 151 | |
| 152 (defcustom gnus-registry-max-track-groups 20 | |
| 153 "The maximum number of non-unique group matches to check for a message ID." | |
| 154 :group 'gnus-registry | |
| 155 :type '(radio (const :format "Unlimited " nil) | |
| 156 (integer :format "Maximum non-unique matches: %v"))) | |
| 151 | 157 |
| 152 (defcustom gnus-registry-track-extra nil | 158 (defcustom gnus-registry-track-extra nil |
| 153 "Whether the registry should track extra data about a message. | 159 "Whether the registry should track extra data about a message. |
| 154 The Subject and Sender (From:) headers are currently tracked this | 160 The Subject and Sender (From:) headers are currently tracked this |
| 155 way." | 161 way." |
| 504 (dolist (reference (nreverse (gnus-extract-references refstr))) | 510 (dolist (reference (nreverse (gnus-extract-references refstr))) |
| 505 (gnus-message | 511 (gnus-message |
| 506 9 | 512 9 |
| 507 "%s is looking for matches for reference %s from [%s]" | 513 "%s is looking for matches for reference %s from [%s]" |
| 508 log-agent reference refstr) | 514 log-agent reference refstr) |
| 509 (dolist (group (gnus-registry-fetch-groups reference)) | 515 (dolist (group (gnus-registry-fetch-groups |
| 516 reference | |
| 517 gnus-registry-max-track-groups)) | |
| 510 (when (and group (gnus-registry-follow-group-p group)) | 518 (when (and group (gnus-registry-follow-group-p group)) |
| 511 (gnus-message | 519 (gnus-message |
| 512 7 | 520 7 |
| 513 "%s traced the reference %s from [%s] to group %s" | 521 "%s traced the reference %s from [%s] to group %s" |
| 514 log-agent reference refstr group) | 522 log-agent reference refstr group) |
| 528 (let ((this-sender (cdr | 536 (let ((this-sender (cdr |
| 529 (gnus-registry-fetch-extra key 'sender))) | 537 (gnus-registry-fetch-extra key 'sender))) |
| 530 matches) | 538 matches) |
| 531 (when (and this-sender | 539 (when (and this-sender |
| 532 (equal sender this-sender)) | 540 (equal sender this-sender)) |
| 533 (let ((groups (gnus-registry-fetch-groups key))) | 541 (let ((groups (gnus-registry-fetch-groups |
| 542 key | |
| 543 gnus-registry-max-track-groups))) | |
| 534 (dolist (group groups) | 544 (dolist (group groups) |
| 535 (push group found-full) | 545 (push group found-full) |
| 536 (setq found (append (list group) (delete group found))))) | 546 (setq found (append (list group) (delete group found))))) |
| 537 (push key matches) | 547 (push key matches) |
| 538 (gnus-message | 548 (gnus-message |
| 555 (let ((this-subject (cdr | 565 (let ((this-subject (cdr |
| 556 (gnus-registry-fetch-extra key 'subject))) | 566 (gnus-registry-fetch-extra key 'subject))) |
| 557 matches) | 567 matches) |
| 558 (when (and this-subject | 568 (when (and this-subject |
| 559 (equal subject this-subject)) | 569 (equal subject this-subject)) |
| 560 (let ((groups (gnus-registry-fetch-groups key))) | 570 (let ((groups (gnus-registry-fetch-groups |
| 571 key | |
| 572 gnus-registry-max-track-groups))) | |
| 561 (dolist (group groups) | 573 (dolist (group groups) |
| 562 (push group found-full) | 574 (push group found-full) |
| 563 (setq found (append (list group) (delete group found))))) | 575 (setq found (append (list group) (delete group found))))) |
| 564 (push key matches) | 576 (push key matches) |
| 565 (gnus-message | 577 (gnus-message |
| 1000 (when (stringp crumb) | 1012 (when (stringp crumb) |
| 1001 (return (if gnus-registry-use-long-group-names | 1013 (return (if gnus-registry-use-long-group-names |
| 1002 crumb | 1014 crumb |
| 1003 (gnus-group-short-name crumb)))))))) | 1015 (gnus-group-short-name crumb)))))))) |
| 1004 | 1016 |
| 1005 (defun gnus-registry-fetch-groups (id) | 1017 (defun gnus-registry-fetch-groups (id &optional max) |
| 1006 "Get the groups of a message, based on the message ID." | 1018 "Get the groups (up to MAX, if given) of a message, based on the message ID." |
| 1007 (let ((trail (gethash id gnus-registry-hashtb)) | 1019 (let ((trail (gethash id gnus-registry-hashtb)) |
| 1008 groups) | 1020 groups) |
| 1009 (dolist (crumb trail) | 1021 (dolist (crumb trail) |
| 1010 (when (stringp crumb) | 1022 (when (stringp crumb) |
| 1011 ;; push the group name into the list | 1023 ;; push the group name into the list |
| 1013 groups | 1025 groups |
| 1014 (cons | 1026 (cons |
| 1015 (if (or (not (stringp crumb)) gnus-registry-use-long-group-names) | 1027 (if (or (not (stringp crumb)) gnus-registry-use-long-group-names) |
| 1016 crumb | 1028 crumb |
| 1017 (gnus-group-short-name crumb)) | 1029 (gnus-group-short-name crumb)) |
| 1018 groups)))) | 1030 groups)) |
| 1031 (when (and max (> (length groups) max)) | |
| 1032 (return)))) | |
| 1019 ;; return the list of groups | 1033 ;; return the list of groups |
| 1020 groups)) | 1034 groups)) |
| 1021 | 1035 |
| 1022 (defun gnus-registry-group-count (id) | 1036 (defun gnus-registry-group-count (id) |
| 1023 "Get the number of groups of a message, based on the message ID." | 1037 "Get the number of groups of a message, based on the message ID." |