Merge from gnus--devo--0

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1537

11 files changed, 121 insertions, 44 deletions

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index d67f4d3a1b8..df6e4f88bfc 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
+2009-02-04  Reiner Steib  <Reiner.Steib@gmx.de>
+
+        * gnus-news.texi: Print version about Incoming*.
+
 2009-02-02  Carsten Dominik  <dominik@science.uva.nl>
 
         * org.texi (Structure editing, Handling links)
diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi
index f17850113de..09d7be56a7a 100644
--- a/doc/misc/gnus-news.texi
+++ b/doc/misc/gnus-news.texi
@@ -91,7 +91,7 @@ EasyPG is included in Emacs 23 and available separately as well.
 Old intermediate incoming mail files (@file{Incoming*}) are deleted
 after a couple of days, not immediately.  @xref{Mail Source
 Customization}.
-@c New in Gnus 5.10.10 / No Gnus 0.8
+(New in Gnus 5.10.10 / No Gnus 0.8)
 @c This entry is also present in the node "Oort Gnus".
 
 @end itemize
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS
index 836c47a62aa..808db0de7b3 100644
--- a/etc/GNUS-NEWS
+++ b/etc/GNUS-NEWS
@@ -83,7 +83,7 @@ with `K H'.  *Note MIME Commands::.
 
 ** International host names (IDNA) can now be decoded inside article bodies
 using `W i' (`gnus-summary-idna-message').  This requires that GNU Libidn
-(<http://www.gnu.org/software/libidn/>) has been installed.
+(`http://www.gnu.org/software/libidn/') has been installed.
 
 ** The non-ASCII group names handling has been much improved.  The back
 ends that fully support non-ASCII group names are now `nntp', `nnml',
@@ -131,7 +131,7 @@ From Newsgroups::.
 
 ** You can replace MIME parts with external bodies.  See
 `gnus-mime-replace-part' and `gnus-article-replace-part'.  *Note MIME
-Commands::, *Note Using MIME::.
+Commands::, *note Using MIME::.
 
 ** The option `mm-fill-flowed' can be used to disable treatment of
 format=flowed messages.  Also, flowed text is disabled when sending
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a8343d9e12e..dadc4e735dd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2009-02-04  Dave Love  <fx@gnu.org>
+
+        * net/imap.el (imap-fetch-safe): Bind debug-on-error.
+        (imap-debug): Add imap-fetch-safe.
+
+2009-02-04  Teodor Zlatanov  <tzlatanov@jumptrading.com>
+
+        * net/netrc.el (netrc-machine-user-or-password): Use list of
+        auth-source modes.
+
 2009-02-04  Nick Roberts  <nickrob@snap.net.nz>
 
         * vc-svn.el (vc-svn-diff): Revert previous change but add a test
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index aefb2fd4cbb..4f244d71522 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -3,6 +3,25 @@
         * gnus-sum.el (gnus-summary-next-article): XEmacs-friendly version of
         2009-01-09 change.
 
+2009-01-26  Teodor Zlatanov  <tzlatanov@jumptrading.com>
+
+        * auth-source.el (auth-source-forget-user-or-password): Clarify docs.
+        (auth-source-forget-all-cached): New convenience function.
+        (auth-source-user-or-password): Accept list of modes or a single mode.
+
+        * mail-source.el (mail-source-bind, mail-source-set-1): Use list of
+        auth-source modes.
+
+        * nnimap.el (nnimap-open-connection): Use list of
+        auth-source modes.
+
+        * nntp.el (nntp-send-authinfo): Use list of
+        auth-source modes.
+
+2009-01-26  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * nntp.el (nntp-send-authinfo): 
+
 2009-01-16  Teodor Zlatanov  <tzz@lifelogs.com>
 
         * auth-source.el: Update docs to reflect epa-file-enable is to be used
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 27de702b976..1bec08f076f 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -163,12 +163,20 @@ Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
   (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
   (remhash (format "%s %s:%s" mode host protocol) auth-source-cache))
 
+(defun auth-source-forget-all-cached ()
+  "Forget all cached auth-source authentication tokens."
+  (interactive)
+  (setq auth-source-cache (make-hash-table :test 'equal)))
+
 (defun auth-source-user-or-password (mode host protocol)
-  "Find user or password (from the string MODE) matching HOST and PROTOCOL."
+  "Find MODE (string or list of strings) matching HOST and PROTOCOL.
+MODE can be \"login\" or \"password\" for example."
   (gnus-message 9
                 "auth-source-user-or-password: get %s for %s (%s)"
                 mode host protocol)
-  (let* ((cname (format "%s %s:%s" mode host protocol))
+  (let* ((listy (listp mode))
+         (mode (if listy mode (list mode)))
+         (cname (format "%s %s:%s" mode host protocol))
          (found (gethash cname auth-source-cache)))
     (if found
         (progn
@@ -176,7 +184,7 @@ Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
                         "auth-source-user-or-password: cached %s=%s for %s (%s)"
                         mode
                         ;; don't show the password
-                        (if (equal mode "password") "SECRET" found)
+                        (if (member "password" mode) "SECRET" found)
                         host protocol)
           found)
       (dolist (choice (auth-source-pick host protocol))
@@ -191,8 +199,9 @@ Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
                         "auth-source-user-or-password: found %s=%s for %s (%s)"
                         mode
                         ;; don't show the password
-                        (if (equal mode "password") "SECRET" found)
+                        (if (member "password" mode) "SECRET" found)
                         host protocol)
+          (setq found (if listy found (car-safe found)))
           (when auth-source-do-cache
             (puthash cname found auth-source-cache)))
         (return found)))))
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index f144e910410..7dbe30b91d8 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -453,10 +453,11 @@ the `mail-source-keyword-map' variable."
 (put 'mail-source-bind 'lisp-indent-function 1)
 (put 'mail-source-bind 'edebug-form-spec '(sexp body))
 
+;; TODO: use the list format for auth-source-user-or-password modes
 (defun mail-source-set-1 (source)
   (let* ((type (pop source))
          (defaults (cdr (assq type mail-source-keyword-map)))
-         default value keyword user-auth pass-auth)
+         default value keyword auth-info user-auth pass-auth)
     (while (setq default (pop defaults))
       ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
       ;; using `mail-source-value' to evaluate the plist value
@@ -469,20 +470,21 @@ the `mail-source-keyword-map' variable."
             ((and
              (eq keyword :user)
              (setq user-auth 
-                   (auth-source-user-or-password
-                    "login"
-                    ;; this is "host" in auth-sources
-                    (if (boundp 'server) (symbol-value 'server) "")
-                    type)))
+                   (nth 0 (auth-source-user-or-password
+                           '("login" "password")
+                           ;; this is "host" in auth-sources
+                           (if (boundp 'server) (symbol-value 'server) "")
+                           type))))
              user-auth)
             ((and
-             (eq keyword :password)
-             (setq pass-auth 
-                   (auth-source-user-or-password
-                    "password"
-                    ;; this is "host" in auth-sources
-                    (if (boundp 'server) (symbol-value 'server) "")
-                    type)))
+              (eq keyword :password)
+              (setq pass-auth
+                    (nth 1
+                         (auth-source-user-or-password
+                          '("login" "password")
+                          ;; this is "host" in auth-sources
+                          (if (boundp 'server) (symbol-value 'server) "")
+                          type))))
              pass-auth)
             (t (if (setq value (plist-get source keyword))
                  (mail-source-value value)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 87edde6a77b..cfcad522b45 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -805,8 +805,12 @@ If EXAMINE is non-nil the group is selected read-only."
            (port (if nnimap-server-port
                      (int-to-string nnimap-server-port)
                    "imap"))
+           (auth-info 
+            (auth-source-user-or-password '("login" "password") server port))
+           (auth-user (nth 0 auth-info))
+           (auth-passwd (nth 1 auth-info))
            (user (or
-                  (auth-source-user-or-password "login" server port) ; this is preferred to netrc-*
+                  auth-user ; this is preferred to netrc-*
                   (netrc-machine-user-or-password
                    "login"
                    list
@@ -816,7 +820,7 @@ If EXAMINE is non-nil the group is selected read-only."
                    (list port)
                    (list "imap" "imaps" "143" "993"))))
            (passwd (or
-                    (auth-source-user-or-password "password" server port) ; this is preferred to netrc-*
+                    auth-passwd ; this is preferred to netrc-*
                     (netrc-machine-user-or-password
                      "password"
                      list
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 6e9978d4c32..8a6c9a2d78a 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1179,14 +1179,18 @@ If SEND-IF-FORCE, only send authinfo to the server if the
   (let* ((list (netrc-parse nntp-authinfo-file))
          (alist (netrc-machine list nntp-address "nntp"))
          (force (or (netrc-get alist "force") nntp-authinfo-force))
+         (auth-info 
+          (auth-source-user-or-password '("login" "password") nntp-address "nntp"))
+         (auth-user (nth 0 auth-info))
+         (auth-passwd (nth 1 auth-info))
          (user (or
                 ;; this is preferred to netrc-*
-                (auth-source-user-or-password "login" nntp-address "nntp")
+                auth-user
                 (netrc-get alist "login")
                 nntp-authinfo-user))
          (passwd (or
                   ;; this is preferred to netrc-*
-                  (auth-source-user-or-password "password" nntp-address "nntp")
+                  auth-passwd
                   (netrc-get alist "password"))))
     (when (or (not send-if-force)
               force)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 6f2b2d11f97..88e897fa32e 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1798,25 +1798,38 @@ However, UIDS here is a cons, where the car is the canonical form
 of the UIDS specification, and the cdr is the one which works with
 Exchange 2007 or, potentially, other buggy servers.
 See `imap-enable-exchange-bug-workaround'."
-  ;; We don't unconditionally use the alternative (valid) form, since
-  ;; this is said to be significantly inefficient.  The first time we
-  ;; get here for a given, we'll try the canonical form.  If we get
-  ;; the known error from the buggy server, set the flag
-  ;; buffer-locally (to account for connections to multiple servers),
-  ;; then re-try with the alternative UIDS spec.
+  ;; The first time we get here for a given, we'll try the canonical
+  ;; form.  If we get the known error from the buggy server, set the
+  ;; flag buffer-locally (to account for connections to multiple
+  ;; servers), then re-try with the alternative UIDS spec.  We don't
+  ;; unconditionally use the alternative form, since the
+  ;; currently-used alternatives are seriously inefficient with some
+  ;; servers (although they are valid).
+  ;;
+  ;; FIXME:  Maybe it would be cleaner to have a flag to not signal
+  ;; the error (which otherwise gives a message), and test
+  ;; `imap-failed-tags'.  Also, Other IMAP clients use other forms of
+  ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
+  ;; (UID)" rather than "FETCH UID 1,*".  Is there a good reason not
+  ;; to do the same?
   (condition-case data
-      (imap-fetch (if imap-enable-exchange-bug-workaround
-                      (cdr uids)
-                    (car uids))
-                  props receive nouidfetch buffer)
+      ;; Binding `debug-on-error' allows us to get the error from
+      ;; `imap-parse-response' -- it's normally caught by Emacs around
+      ;; execution of a process filter.
+      (let ((debug-on-error t))
+        (imap-fetch (if imap-enable-exchange-bug-workaround
+                        (cdr uids)
+                      (car uids))
+                    props receive nouidfetch buffer))
     (error
      (if (and (not imap-enable-exchange-bug-workaround)
-              (string-match
-               "The specified message set is invalid"
-               (cadr data)))
+              ;; This is the Exchange 2007 response.  It may be more
+              ;; robust just to check for a BAD response to the
+              ;; attempted fetch.
+              (string-match "The specified message set is invalid"
+                            (cadr data)))
          (with-current-buffer (or buffer (current-buffer))
-           (set (make-local-variable
-                 'imap-enable-exchange-bug-workaround)
+           (set (make-local-variable 'imap-enable-exchange-bug-workaround)
                 t)
            (imap-fetch (cdr uids) props receive nouidfetch))
        (signal (car data) (cdr data))))))
@@ -3027,6 +3040,7 @@ Return nil if no complete line has arrived."
           imap-list-to-message-set
           imap-fetch-asynch
           imap-fetch
+          imap-fetch-safe
           imap-message-put
           imap-message-get
           imap-message-map
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 9c7f0176ef8..80ae1b57ba3 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -158,11 +158,22 @@ MODE can be \"login\" or \"password\", suitable for passing to
         (ports (or ports '(nil)))
         (defaults (or defaults '(nil)))
         info)
-    (dolist (machine machines)
-      (dolist (default defaults)
-        (dolist (port ports)
-          (let ((alist (netrc-machine authinfo-list machine port default)))
-            (setq info (or (netrc-get alist mode) info))))))
+    (if (listp mode)
+        (setq info 
+              (mapcar 
+               (lambda (mode-element) 
+                 (netrc-machine-user-or-password
+                  mode-element
+                  authinfo-list
+                  machines
+                  ports
+                  defaults))
+               mode))
+      (dolist (machine machines)
+        (dolist (default defaults)
+          (dolist (port ports)
+            (let ((alist (netrc-machine authinfo-list machine port default)))
+              (setq info (or (netrc-get alist mode) info)))))))
     info))
 
 (defun netrc-get (alist type)