When we have several similar methods, try to create as few extended methods as possible.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6d77128..845c3bd 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 

+       * gnus.el (gnus-sloppily-equal-method-parameters): Refactor out.
+       (gnus-same-method-different-name): New function.
+
+       * nnimap.el (parse-time): Require.
+

        * gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
        method in the presence of many similar methods.
 
        * gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
        method in the presence of many similar methods.
 

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 97a920a..5f14209 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -705,6 +705,7 @@ the first newsgroup."
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil

+       gnus-extended-servers nil

        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.


@@ -1693,20 +1694,6 @@ If SCAN, request a scan of that group as well."
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
                                             (setq info (pop newsrc))))))
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
                                             (setq info (pop newsrc))))))

-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-
-      ;; To be more explicit:
-      ;; >0 for an active group with messages
-      ;; 0 for an active group with no unread messages
-      ;; nil for non-foreign groups that the user has requested not be checked
-      ;; t for unchecked foreign groups or bogus groups, or groups that can't
-      ;;   be checked, for one reason or other.
-

       ;; First go through all the groups, see what select methods they
       ;; belong to, and then collect them into lists per unique select
       ;; method.
       ;; First go through all the groups, see what select methods they
       ;; belong to, and then collect them into lists per unique select
       ;; method.

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 222992e..eb20575 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2681,6 +2681,7 @@ a string, be sure to use a valid format, see RFC 2616."
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-ephemeral-servers nil)
 (defvar gnus-server-method-cache nil)
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-ephemeral-servers nil)
 (defvar gnus-server-method-cache nil)

+(defvar gnus-extended-servers nil)

 
 (defvar gnus-agent-fetching nil
   "Whether Gnus agent is in fetching mode.")
 
 (defvar gnus-agent-fetching nil
   "Whether Gnus agent is in fetching mode.")


@@ -3685,32 +3686,35 @@ that that variable is buffer-local to the summary buffers."
    (and
     (eq (car m1) (car m2))
     (equal (cadr m1) (cadr m2))
    (and
     (eq (car m1) (car m2))
     (equal (cadr m1) (cadr m2))

-    ;; Check parameters for sloppy equalness.
-    (let ((p1 (copy-list (cddr m1)))
-         (p2 (copy-list (cddr m2)))
-         e1 e2)
-      (block nil
-       (while (setq e1 (pop p1))
-         (unless (setq e2 (assq (car e1) p2))
-           ;; The parameter doesn't exist in p2.
-           (return nil))
-         (setq p2 (delq e2 p2))
-         (unless (equalp e1 e2)
-           (if (not (and (stringp (cadr e1))
-                         (stringp (cadr e2))))
-               (return nil)
-             ;; Special-case string parameter comparison so that we
-             ;; can uniquify them.
-             (let ((s1 (cadr e1))
-                   (s2 (cadr e2)))
-               (when (string-match "/$" s1)
-                 (setq s1 (directory-file-name s1)))
-               (when (string-match "/$" s2)
-                 (setq s2 (directory-file-name s2)))
-               (unless (equal s1 s2)
-                 (return nil))))))
-       ;; If p2 now is empty, they were equal.
-       (null p2))))))
+    (gnus-sloppily-equal-method-parameters m1 m2))))
+
+(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
+  ;; Check parameters for sloppy equalness.
+  (let ((p1 (copy-list (cddr m1)))
+       (p2 (copy-list (cddr m2)))
+       e1 e2)
+    (block nil
+      (while (setq e1 (pop p1))
+       (unless (setq e2 (assq (car e1) p2))
+         ;; The parameter doesn't exist in p2.
+         (return nil))
+       (setq p2 (delq e2 p2))
+       (unless (equalp e1 e2)
+         (if (not (and (stringp (cadr e1))
+                       (stringp (cadr e2))))
+             (return nil)
+           ;; Special-case string parameter comparison so that we
+           ;; can uniquify them.
+           (let ((s1 (cadr e1))
+                 (s2 (cadr e2)))
+             (when (string-match "/$" s1)
+               (setq s1 (directory-file-name s1)))
+             (when (string-match "/$" s2)
+               (setq s2 (directory-file-name s2)))
+             (unless (equal s1 s2)
+               (return nil))))))
+      ;; If p2 now is empty, they were equal.
+      (null p2))))

 
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
 
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."


@@ -4199,9 +4203,12 @@ parameters."
   (if (or (not (inline (gnus-similar-server-opened method)))
          (not (cddr method)))
       method
   (if (or (not (inline (gnus-similar-server-opened method)))
          (not (cddr method)))
       method

-    `(,(car method) ,(concat (cadr method) "+" group)
-      (,(intern (format "%s-address" (car method))) ,(cadr method))
-      ,@(cddr method))))
+    (setq method
+         `(,(car method) ,(concat (cadr method) "+" group)
+           (,(intern (format "%s-address" (car method))) ,(cadr method))
+           ,@(cddr method)))
+    (push method gnus-extended-servers)
+    method))

 
 (defun gnus-server-status (method)
   "Return the status of METHOD."
 
 (defun gnus-server-status (method)
   "Return the status of METHOD."


@@ -4226,6 +4233,20 @@ parameters."
        (format "%s using %s" address (car server))
       (format "%s" (car server)))))
 
        (format "%s using %s" address (car server))
       (format "%s" (car server)))))
 

+(defun gnus-same-method-different-name (method)
+  (let ((slot (intern (concat (symbol-name (car method)) "-address"))))
+    (unless (assq slot (cddr method))
+      (setq method
+           (append method (list (list slot (nth 1 method)))))))
+  (let ((methods gnus-extended-servers)
+       open found)
+    (while (and (not found)
+               (setq open (pop methods)))
+      (when (and (eq (car method) (car open))
+                (gnus-sloppily-equal-method-parameters method open))
+       (setq found open)))
+    found))
+

 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method
 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method


@@ -4248,7 +4269,10 @@ parameters."
                (cond ((stringp method)
                       (inline (gnus-server-to-method method)))
                      ((stringp (cadr method))
                (cond ((stringp method)
                       (inline (gnus-server-to-method method)))
                      ((stringp (cadr method))

-                      (inline (gnus-server-extend-method group method)))
+                      (or
+                       (inline
+                        (gnus-same-method-different-name method))
+                       (inline (gnus-server-extend-method group method))))

                      (t
                       method)))
          (cond ((equal (cadr method) "")
                      (t
                       method)))
          (cond ((equal (cadr method) "")

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 833e211..e43cd2d 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -37,6 +37,7 @@
 (require 'gnus)
 (require 'nnoo)
 (require 'netrc)
 (require 'gnus)
 (require 'nnoo)
 (require 'netrc)

+(require 'parse-time)

 
 (nnoo-declare nnimap)
 
 
 (nnoo-declare nnimap)