changeset 57284:5293cc67f41d

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
author Miles Bader <miles@gnu.org>
date Wed, 29 Sep 2004 22:52:05 +0000
parents 4bdc0f6258ec
children 9093a2e9c3fd 6c1af301b455
files lisp/gnus/ChangeLog lisp/gnus/gnus.el
diffstat 2 files changed, 36 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Wed Sep 29 22:23:43 2004 +0000
+++ b/lisp/gnus/ChangeLog	Wed Sep 29 22:52:05 2004 +0000
@@ -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.
--- a/lisp/gnus/gnus.el	Wed Sep 29 22:23:43 2004 +0000
+++ b/lisp/gnus/gnus.el	Wed Sep 29 22:52:05 2004 +0000
@@ -3261,6 +3261,38 @@
 				   (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)