aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTeodor Zlatanov2011-04-15 14:29:02 +0000
committerKatsumi Yamaoka2011-04-15 14:29:02 +0000
commitba3bd5b6c3771010fa37ec48170eee8323b55bf1 (patch)
tree0b8febdebbb1da4bcc92b612d990c36b4d89c9d4
parentdaca8ba5e3ceb52928a88379a5e7bd18a0a215a3 (diff)
downloademacs-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/ChangeLog8
-rw-r--r--lisp/gnus/gnus-registry.el49
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 @@
12011-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
12011-04-15 Stefan Monnier <monnier@iro.umontreal.ca> 62011-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