[Gnus] Miscellaneous fixes by Dave Abrahams

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index b167686..b3aeb96 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,19 @@
+2012-08-31  Dave Abrahams  <dave@boostpro.com>
+
+       * auth-source.el (auth-sources): Fix macos keychain access.
+
+       * gnus-int.el (gnus-request-head): When gnus-override-method is set,
+       allow the backend `request-head' function to determine the group
+       name on its own.
+       (gnus-request-expire-articles): Filter out negative article numbers
+       during expiry (Bug#11980).
+
+       * gnus-range.el (gnus-set-difference): Change gnus-set-difference from
+       O(N^2) to O(N).  This makes warping into huge groups tolerable.
+
+       * gnus-registry.el (gnus-try-warping-via-registry): Don't act as though
+       you've found the article when you haven't.
+
 2012-08-31  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * gnus-notifications.el (gnus-notifications-action): Avoid CL-ism.

diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 262da44..4c5e5ff 100644 (file)
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -256,10 +256,10 @@ can get pretty complex."
                   (const :tag "Temp Secrets API Collection" "secrets:session")
 
                   (const :tag "Default internet Mac OS Keychain"
-                         'macos-keychain-internet)
+                         macos-keychain-internet)
 
                   (const :tag "Default generic Mac OS Keychain"
-                         'macos-keychain-generic)
+                         macos-keychain-generic)
 
                   (list :tag "Source definition"
                         (const :format "" :value :source)

diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 339e3d9..bc3ba18 100644 (file)
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -599,7 +599,8 @@ real group. Does nothing on a real group."
            clean-up t))
      ;; Use `head' function.
      ((fboundp head)
-      (setq res (funcall head article (gnus-group-real-name group)
+      (setq res (funcall head article
+                         (and (not gnus-override-method) (gnus-group-real-name group))
                         (nth 1 gnus-command-method))))
      ;; Use `article' function.
      (t
@@ -706,6 +707,10 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
 
 (defun gnus-request-expire-articles (articles group &optional force)
   (let* ((gnus-command-method (gnus-find-method-for-group group))
+         ;; Filter out any negative article numbers; they can't be
+         ;; expired here.
+         (articles
+          (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
         (gnus-inhibit-demon t)
         (not-deleted
          (funcall

diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 68729da..091276e 100644 (file)
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -52,11 +52,13 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
 
 (defun gnus-set-difference (list1 list2)
   "Return a list of elements of LIST1 that do not appear in LIST2."
-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1))
+  (let ((hash2 (make-hash-table :test 'eq))
+        (result nil))
+    (dolist (elt list2) (puthash elt t hash2))
+    (dolist (elt list1)
+      (unless (gethash elt hash2)
+        (setq result (cons elt result))))
+    (nreverse result)))
 
 (defun gnus-range-nconcat (&rest ranges)
   "Return a range comprising all the RANGES, which are pre-sorted.

diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 8aecc98..71e0096 100644 (file)
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1169,9 +1169,10 @@ data stored in the registry."
 
             ;; Try to activate the group.  If that fails, just move
             ;; along.  We may have more groups to work with
-            (ignore-errors
-             (gnus-select-group-with-message-id group message-id))
-            (throw 'found t)))))))
+            (when
+                (ignore-errors
+                  (gnus-select-group-with-message-id group message-id) t)
+              (throw 'found t))))))))
 
 ;; TODO: a few things