Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-585

Merge from gnus--rel--5.10

Patches applied:

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-38
   Update from CVS

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 3cdda661e86a3567ebde84e5dd4770dd3cf1d630..6ac6d46e28f5527fc7e6873af0488f9b6a39a104 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
+2004-09-29  Jesper Harder  <harder@ifa.au.dk>
+
+       * gnus.el (gnus-method-to-server): Oops, move it don't delete it.
+
 2004-09-28  Jesper Harder  <harder@ifa.au.dk>
 
        * gnus-picon.el: Require cl.

diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 28ef2c22a15c9f9fdfac7f6d1151386d9e4de066..979ee2a7c24bc225ce9ebc8855cbc7fbb6b58f45 100644 (file)
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3261,6 +3261,38 @@ that that variable is buffer-local to the summary buffers."
                                   (nth 1 method))))
       method)))
 
+(defsubst gnus-method-to-server (method)
+  (catch 'server-name
+    (setq method (or method gnus-select-method))
+
+    ;; Perhaps it is already in the cache.
+    (mapc (lambda (name-method)
+            (if (equal (cdr name-method) method)
+                (throw 'server-name (car name-method))))
+          gnus-server-method-cache)
+
+    (mapc
+     (lambda (server-alist)
+       (mapc (lambda (name-method)
+               (when (gnus-methods-equal-p (cdr name-method) method)
+                 (unless (member name-method gnus-server-method-cache)
+                   (push name-method gnus-server-method-cache))
+                 (throw 'server-name (car name-method))))
+             server-alist))
+     (let ((alists (list gnus-server-alist
+                         gnus-predefined-server-alist)))
+       (if gnus-select-method
+           (push (list (cons "native" gnus-select-method)) alists))
+       alists))
+
+    (let* ((name (if (member (cadr method) '(nil ""))
+                     (format "%s" (car method))
+                   (format "%s:%s" (car method) (cadr method))))
+           (name-method (cons name method)))
+      (unless (member name-method gnus-server-method-cache)
+        (push name-method gnus-server-method-cache))
+      name)))
+
 (defsubst gnus-server-to-method (server)
   "Map virtual server names to select methods."
   (or (and server (listp server) server)