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." |