[gnus git] branch master updated: n0-15-45-g8333075 =1= Fix gnus-registry splitting bugs and provide better messaging.
Ted Zlatanov <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 8333075d7f2ca6e0a3680e165f3cdbfc6bc463ab (commit)
from dd2c57ddd13e84e2909950f05092fbc76515a57c (commit)
- Log -----------------------------------------------------------------
commit 8333075d7f2ca6e0a3680e165f3cdbfc6bc463ab
Author: Ted Zlatanov <[email protected]>
Date: Wed Apr 6 13:40:35 2011 -0500
Fix gnus-registry splitting bugs and provide better messaging.
* gnus-registry.el (gnus-registry-post-process-groups)
(gnus-registry--split-fancy-with-parent-internal): Fix splitting bugs
and provide better messaging.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 480969b..8d6e711 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2011-04-06 Teodor Zlatanov <[email protected]>
+
+ * gnus-registry.el (gnus-registry-post-process-groups)
+ (gnus-registry--split-fancy-with-parent-internal): Fix splitting bugs
+ and provide better messaging.
+
2011-04-06 David Engster <[email protected]>
* Makefile.in (fail-on-warning): New rule to compile with warnings as
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 6c660b1..02b98f0 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -395,35 +395,32 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
&allow-other-keys)
(gnus-message
10
- "gnus-registry--split-fancy-with-parent-internal: %S" spec)
+ "gnus-registry--split-fancy-with-parent-internal %S" spec)
(let ((db gnus-registry-db)
found)
- ;; this is a big if-else statement. it uses
+ ;; this is a big chain of statements. it uses
;; gnus-registry-post-process-groups to filter the results after
;; every step.
- (cond
;; the references string must be valid and parse to valid references
- (references
- (dolist (reference (nreverse references))
+ (when references
(gnus-message
9
- "%s is looking for matches for reference %s from [%s]"
- log-agent reference refstr)
- (setq found
+ "%s is tracing references %s"
+ log-agent refstr)
+ (dolist (reference (nreverse references))
+ (gnus-message 9 "%s is looking up %s" log-agent reference)
(loop for group in (gnus-registry-get-id-key reference 'group)
when (gnus-registry-follow-group-p group)
- do (gnus-message
- 7
- "%s traced the reference %s from [%s] to group %s"
- log-agent reference refstr group)
- collect group)))
+ do (gnus-message 7 "%s traced %s to %s" log-agent reference group)
+ do (push group found)))
;; filter the found groups and return them
;; the found groups are the full groups
(setq found (gnus-registry-post-process-groups
"references" refstr found)))
;; else: there were no matches, try the extra tracking by sender
- ((and (memq 'sender gnus-registry-track-extra)
+ (when (and (null found)
+ (memq 'sender gnus-registry-track-extra)
sender
(gnus-grep-in-list
sender
@@ -438,10 +435,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
- ;; raise level of messaging if gnus-registry-track-extra
+ ;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced sender '%s' to groups %s"
- log-agent sender found)
+ "%s (extra tracking) traced sender '%s' to %s"
+ log-agent sender group)
collect group)))
;; filter the found groups and return them
@@ -450,7 +447,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
"sender" sender found)))
;; else: there were no matches, now try the extra tracking by subject
- ((and (memq 'subject gnus-registry-track-extra)
+ (when (and (null found)
+ (memq 'subject gnus-registry-track-extra)
subject
(< gnus-registry-minimum-subject-length (length subject)))
(let ((groups (apply
@@ -463,15 +461,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
- ;; raise level of messaging if gnus-registry-track-extra
+ ;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced subject '%s' to groups %s"
- log-agent subject found)
+ "%s (extra tracking) traced subject '%s' to %s"
+ log-agent subject group)
collect group))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
- "subject" subject found)))))
+ "subject" subject found))))
;; after the (cond) we extract the actual value safely
(car-safe found)))
@@ -490,25 +488,48 @@ Foreign methods are not supported so they are rejected.
Reduces the list to a single group, or complains if that's not
possible. Uses `gnus-registry-split-strategy'."
(let ((log-agent "gnus-registry-post-process-group")
- out)
-
- ;; the strategy can be nil, in which case groups is nil
- (setq groups
+ (desc (format "%d groups" (length groups)))
+ out chosen)
+ ;; the strategy can be nil, in which case chosen is nil
+ (setq chosen
(case gnus-registry-split-strategy
- ;; first strategy
+ ;; default, take only one-element lists into chosen
+ ((nil)
+ (and (= (length groups) 1)
+ (car-safe groups)))
+
((first)
- (and groups (list (car-safe groups))))
+ (car-safe groups))
((majority)
(let ((freq (make-hash-table
:size 256
:test 'equal)))
- (mapc (lambda (x) (puthash x (1+ (gethash x freq 0)) freq))
+ (mapc (lambda (x) (let ((x (gnus-group-short-name x)))
+ (puthash x (1+ (gethash x freq 0)) freq)))
groups)
- (list (car-safe
- (sort groups (lambda (a b)
- (> (gethash a freq 0)
- (gethash b freq 0))))))))))
+ (setq desc (format "%d groups, %d unique"
+ (length groups)
+ (hash-table-count freq)))
+ (car-safe
+ (sort groups
+ (lambda (a b)
+ (> (gethash (gnus-group-short-name a) freq 0)
+ (gethash (gnus-group-short-name b) freq 0)))))))))
+
+ (if chosen
+ (gnus-message
+ 9
+ "%s: strategy %s on %s produced %s"
+ log-agent gnus-registry-split-strategy desc chosen)
+ (gnus-message
+ 9
+ "%s: strategy %s on %s did not produce an answer"
+ log-agent
+ (or gnus-registry-split-strategy "default")
+ desc))
+
+ (setq groups (and chosen (list chosen)))
(dolist (group groups)
(let ((m1 (gnus-find-method-for-group group))
@@ -518,18 +539,20 @@ possible. Uses `gnus-registry-split-strategy'."
(if (gnus-methods-equal-p m1 m2)
(progn
;; this is REALLY just for debugging
+ (when (not (equal group short-name))
(gnus-message
10
- "%s stripped group %s to %s"
- log-agent group short-name)
+ "%s: stripped group %s to %s"
+ log-agent group short-name))
(add-to-list 'out short-name))
;; else...
(gnus-message
7
- "%s ignored foreign group %s"
+ "%s: ignored foreign group %s"
log-agent group))))
- ;; is there just one group?
+ (setq out (delq nil out))
+
(cond
((= (length out) 1) out)
((null out)
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 6 ++
lisp/gnus-registry.el | 189 +++++++++++++++++++++++++++---------------------
2 files changed, 112 insertions(+), 83 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project