diff options
| author | Teodor Zlatanov | 2011-04-15 14:29:02 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-04-15 14:29:02 +0000 |
| commit | ba3bd5b6c3771010fa37ec48170eee8323b55bf1 (patch) | |
| tree | 0b8febdebbb1da4bcc92b612d990c36b4d89c9d4 | |
| parent | daca8ba5e3ceb52928a88379a5e7bd18a0a215a3 (diff) | |
| download | emacs-ba3bd5b6c3771010fa37ec48170eee8323b55bf1.tar.gz emacs-ba3bd5b6c3771010fa37ec48170eee8323b55bf1.zip | |
nus-registry.el (gnus-registry--split-fancy-with-parent-internal): Track by subject first, then sender.
| -rw-r--r-- | lisp/gnus/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 49 |
2 files changed, 32 insertions, 25 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6522e57198d..be6f3737ae1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,8 +1,14 @@ | |||
| 1 | 2011-04-15 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 2 | |||
| 3 | * gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): | ||
| 4 | Track by subject first, then sender. | ||
| 5 | |||
| 1 | 2011-04-15 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2011-04-15 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | * message.el (message-bogus-system-names): Replace ^...$ => \`...\'. | 8 | * message.el (message-bogus-system-names): Replace ^...$ => \`...\'. |
| 4 | 9 | ||
| 5 | * gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from Lisp. | 10 | * gnus.el (gnus-splash-svg-color-symbols): Don't use insert-file from |
| 11 | Lisp. | ||
| 6 | 12 | ||
| 7 | * gnus-draft.el (gnus-draft-setup): New arg `dont-pop'. | 13 | * gnus-draft.el (gnus-draft-setup): New arg `dont-pop'. |
| 8 | (gnus-draft-send): Use it to avoid popping | 14 | (gnus-draft-send): Use it to avoid popping |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 9f95ce756ab..77ed5a55aed 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -425,6 +425,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 425 | (setq found (gnus-registry-post-process-groups | 425 | (setq found (gnus-registry-post-process-groups |
| 426 | "references" refstr found))) | 426 | "references" refstr found))) |
| 427 | 427 | ||
| 428 | ;; else: there were no matches, now try the extra tracking by subject | ||
| 429 | (when (and (null found) | ||
| 430 | (memq 'subject gnus-registry-track-extra) | ||
| 431 | subject | ||
| 432 | (< gnus-registry-minimum-subject-length (length subject))) | ||
| 433 | (let ((groups (apply | ||
| 434 | 'append | ||
| 435 | (mapcar | ||
| 436 | (lambda (reference) | ||
| 437 | (gnus-registry-get-id-key reference 'group)) | ||
| 438 | (registry-lookup-secondary-value db 'subject subject))))) | ||
| 439 | (setq found | ||
| 440 | (loop for group in groups | ||
| 441 | when (gnus-registry-follow-group-p group) | ||
| 442 | do (gnus-message | ||
| 443 | ;; warn more if gnus-registry-track-extra | ||
| 444 | (if gnus-registry-track-extra 7 9) | ||
| 445 | "%s (extra tracking) traced subject '%s' to %s" | ||
| 446 | log-agent subject group) | ||
| 447 | collect group)) | ||
| 448 | ;; filter the found groups and return them | ||
| 449 | ;; the found groups are NOT the full groups | ||
| 450 | (setq found (gnus-registry-post-process-groups | ||
| 451 | "subject" subject found)))) | ||
| 452 | |||
| 428 | ;; else: there were no matches, try the extra tracking by sender | 453 | ;; else: there were no matches, try the extra tracking by sender |
| 429 | (when (and (null found) | 454 | (when (and (null found) |
| 430 | (memq 'sender gnus-registry-track-extra) | 455 | (memq 'sender gnus-registry-track-extra) |
| @@ -453,30 +478,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 453 | (setq found (gnus-registry-post-process-groups | 478 | (setq found (gnus-registry-post-process-groups |
| 454 | "sender" sender found))) | 479 | "sender" sender found))) |
| 455 | 480 | ||
| 456 | ;; else: there were no matches, now try the extra tracking by subject | ||
| 457 | (when (and (null found) | ||
| 458 | (memq 'subject gnus-registry-track-extra) | ||
| 459 | subject | ||
| 460 | (< gnus-registry-minimum-subject-length (length subject))) | ||
| 461 | (let ((groups (apply | ||
| 462 | 'append | ||
| 463 | (mapcar | ||
| 464 | (lambda (reference) | ||
| 465 | (gnus-registry-get-id-key reference 'group)) | ||
| 466 | (registry-lookup-secondary-value db 'subject subject))))) | ||
| 467 | (setq found | ||
| 468 | (loop for group in groups | ||
| 469 | when (gnus-registry-follow-group-p group) | ||
| 470 | do (gnus-message | ||
| 471 | ;; warn more if gnus-registry-track-extra | ||
| 472 | (if gnus-registry-track-extra 7 9) | ||
| 473 | "%s (extra tracking) traced subject '%s' to %s" | ||
| 474 | log-agent subject group) | ||
| 475 | collect group)) | ||
| 476 | ;; filter the found groups and return them | ||
| 477 | ;; the found groups are NOT the full groups | ||
| 478 | (setq found (gnus-registry-post-process-groups | ||
| 479 | "subject" subject found)))) | ||
| 480 | ;; after the (cond) we extract the actual value safely | 481 | ;; after the (cond) we extract the actual value safely |
| 481 | (car-safe found))) | 482 | (car-safe found))) |
| 482 | 483 | ||