Fix a speed regression based in methods that were similar weren't the same.

* gnus.el (gnus-similar-server-opened): Refactor a bit and add
comments.
(gnus-methods-sloppily-equal): New function.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 31e0338..c115bba 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,7 @@
 
        * gnus.el (gnus-similar-server-opened): Refactor a bit and add
        comments.
+       (gnus-methods-sloppily-equal): New function.
 
        * gnus-start.el (gnus-get-unread-articles): Make sure that we call
        `gnus-open-server' on each method before trying to scan them etc.  This

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 24102d0..2f2e2a4 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -1760,7 +1760,8 @@ If SCAN, request a scan of that group as well."
       (destructuring-bind (method method-type infos dummy) elem
        (when (and method infos
                   (not (gnus-method-denied-p method)))
-         (gnus-open-server method)
+         (unless (gnus-server-opened method)
+           (gnus-open-server method))
          (when (gnus-check-backend-function
                 'retrieve-group-data-early (car method))
            (when (gnus-check-backend-function 'request-scan (car method))

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 9b35dd4..a02c6be 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -3677,6 +3677,41 @@ that that variable is buffer-local to the summary buffers."
                                            gnus-valid-select-methods)))
                 (equal (nth 1 m1) (nth 1 m2)))))))
 
+(defun gnus-methods-sloppily-equal (m1 m2)
+  ;; Same method.
+  (or
+   (eq m1 m2)
+   ;; Type and name are equal.
+   (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))))))
+
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
   (let ((m1 (cond ((null m1) gnus-select-method)
@@ -4152,7 +4187,7 @@ parameters."
       (when (and (equal (car method) (car open))
                 (equal (cadr method) (cadr open))
                 ;; ... but the rest of the parameters differ.
-                (not (equal method open)))
+                (not (gnus-methods-sloppily-equal method open)))
        (setq method nil)))
     (not method)))