Synch to Gnus 200311062232.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index de0b984..776f89e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,13 +1,25 @@
-2003-11-06  Teodor Zlatanov  <tzz@lifelogs.com> suggested by Jean-Marc Lasgouttes <Jean-Marc.Lasgouttes@inria.fr>
+2003-11-06  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnus.el (gnus-group-guess-full-name-from-command-method): new function
+
+       * gnus-registry.el (gnus-registry-fetch-group): use long names if
+       requested 
+       (gnus-registry-split-fancy-with-parent): when long names are in
+       use, strip the name if we're in the native server, or else return nothing
+       (gnus-registry-spool-action, gnus-registry-action): use
+       gnus-group-guess-full-name-from-command-method instead of
+       gnus-group-guess-full-name
 
        * spam.el (spam-mark-spam-as-expired-and-move-routine)
        (spam-ham-copy-or-move-routine): prevent article deletions or
        moves unless the backend allows it
 
        * gnus.el (gnus-install-group-spam-parameters): fixed parameters
-       to list spamoracle as well
+       to list spamoracle as well, suggested by Jean-Marc Lasgouttes
+       <Jean-Marc.Lasgouttes@inria.fr>
 
-       * spam.el (spam-spamoracle): doc change
+       * spam.el (spam-spamoracle): doc change, suggested by Jean-Marc
+       Lasgouttes <Jean-Marc.Lasgouttes@inria.fr>
 
 2003-11-04  Katsumi Yamaoka  <yamaoka@jpl.org>
 

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 64040ae..18f6121 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -301,8 +301,8 @@ tracked this way."
   (let* ((id (mail-header-id data-header))
         (subject (gnus-registry-simplify-subject 
                   (mail-header-subject data-header)))
-       (from (gnus-group-guess-full-name from))
-       (to (if to (gnus-group-guess-full-name to) nil))
+       (from (gnus-group-guess-full-name-from-command-method from))
+       (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
        (to-name (if to to "the Bit Bucket"))
        (old-entry (gethash id gnus-registry-hashtb)))
     (gnus-message 5 "Registry: article %s %s from %s to %s"
@@ -320,16 +320,13 @@ tracked this way."
     (gnus-registry-add-group id to subject)))
 
 (defun gnus-registry-spool-action (id group &optional subject)
-  ;; do not process the draft IDs
-;  (unless (string-match "totally-fudged-out-message-id" id)
-;    (let ((group (gnus-group-guess-full-name group)))
-  (when (and (stringp id) (string-match "\r$" id))
-    (setq id (substring id 0 -1)))
-  (gnus-message 5 "Registry: article %s spooled to %s"
-               id
-               group)
-  (gnus-registry-add-group id group subject))
-;)
+  (let ((group (gnus-group-guess-full-name-from-command-method group)))
+    (when (and (stringp id) (string-match "\r$" id))
+      (setq id (substring id 0 -1)))
+    (gnus-message 5 "Registry: article %s spooled to %s"
+                 id
+                 group)
+    (gnus-registry-add-group id group subject)))
 
 ;; Function for nn{mail|imap}-split-fancy: look up all references in
 ;; the cache and if a match is found, return that group.
@@ -379,7 +376,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                   (setq res (gnus-registry-fetch-group key))
                   (gnus-message
                    ;; raise level of messaging if gnus-registry-track-extra
-                   (if gnus-registry-track-extra 5 9) 
+                   (if gnus-registry-track-extra 5 9)
                    "%s (extra tracking) traced subject %s to group %s"
                    "gnus-registry-split-fancy-with-parent"
                    subject
@@ -389,6 +386,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
      5 
      "gnus-registry-split-fancy-with-parent traced %s to group %s"
      refstr (if res res "nil"))
+
+    (when (and res gnus-registry-use-long-group-names)
+      (let ((m1 (gnus-find-method-for-group res))
+           (m2 (or gnus-command-method 
+                   (gnus-find-method-for-group gnus-newsgroup-name)))
+           (short-res (gnus-group-short-name res)))
+      (if (gnus-methods-equal-p m1 m2)
+         (progn
+           (gnus-message
+            9 
+            "gnus-registry-split-fancy-with-parent stripped group %s to %s"
+            res
+            short-res)
+           (setq res short-res))
+       ;; else...
+       (gnus-message
+        5 
+        "gnus-registry-split-fancy-with-parent ignored foreign group %s"
+        res)
+       (setq res nil))))
     res))
 
 (defun gnus-registry-register-message-ids ()
@@ -506,7 +523,9 @@ Returns the first place where the trail finds a group name."
     (let ((trail (gethash id gnus-registry-hashtb)))
       (dolist (crumb trail)
        (when (stringp crumb)
-         (return (gnus-group-short-name crumb)))))))
+         (return (if gnus-registry-use-long-group-names 
+                      crumb 
+                    (gnus-group-short-name crumb))))))))
 
 (defun gnus-registry-group-count (id)
   "Get the number of groups of a message, based on the message ID."
@@ -543,7 +562,6 @@ Returns the first place where the trail finds a group name."
 
 (defun gnus-registry-add-group (id group &optional subject)
   "Add a group for a message, based on the message ID."
-  ;; make sure there are no duplicate entries
   (when group
     (when (and id
               (not (string-match "totally-fudged-out-message-id" id)))
@@ -552,8 +570,10 @@ Returns the first place where the trail finds a group name."
                       group 
                     (gnus-group-short-name group))))
        (gnus-registry-delete-group id group)
-       (unless gnus-registry-use-long-group-names 
+
+       (unless gnus-registry-use-long-group-names ;; unnecessary in this case
          (gnus-registry-delete-group id full-group))
+
        (let ((trail (gethash id gnus-registry-hashtb)))
          (puthash id (if trail
                          (cons group trail)

diff --git a/lisp/gnus.el b/lisp/gnus.el
index ffacd8f..8e3fd57 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -3355,6 +3355,12 @@ server is native)."
       group
     (gnus-group-full-name group (gnus-find-method-for-group group))))
 
+(defun gnus-group-guess-full-name-from-command-method (group)
+  "Guess the full name from GROUP, even if the method is native."
+  (if (gnus-group-prefixed-p group)
+      group
+    (gnus-group-full-name group gnus-command-method)))
+
 (defun gnus-group-real-prefix (group)
   "Return the prefix of the current group name."
   (if (string-match "^[^:]+:" group)