Merge from emacs--devo--0
[gnus] / lisp / nnimap.el
index 6c4183c..49166b8 100644 (file)
@@ -1,7 +1,7 @@
 ;;; nnimap.el --- imap backend for Gnus
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008  Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <jas@pdc.kth.se>
 ;;         Jim Radford <radford@robby.caltech.edu>
@@ -9,20 +9,18 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -73,6 +71,8 @@
 
 (eval-when-compile (require 'cl))
 
+(autoload 'auth-source-user-or-password "auth-source")
+
 (nnoo-declare nnimap)
 
 (defconst nnimap-version "nnimap 1.0")
@@ -208,7 +208,7 @@ This is generally not required, and will slow things down considerably.
 You may need it if you want to use an advanced splitting function that
 analyzes the body before splitting the article.
 If this variable is nil, bodies will not be downloaded; if this
-variable is the symbol `default' the default behaviour is
+variable is the symbol `default' the default behavior is
 used (which currently is nil, unless you use a statistical
 spam.el test); if this variable is another non-nil value bodies
 will be downloaded."
@@ -250,10 +250,15 @@ it O(n).  If p is small, then the default is probably faster."
   :type 'boolean
   :group 'nnimap)
 
-(defvoo nnimap-need-unselect-to-notice-new-mail nil
+(defvoo nnimap-need-unselect-to-notice-new-mail t
   "Unselect mailboxes before looking for new mail in them.
 Some servers seem to need this under some circumstances.")
 
+(defvoo nnimap-logout-timeout nil
+  "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes.  This variable
+overrides `imap-logout-timeout' on a per-server basis.")
+
 ;; Authorization / Privacy variables
 
 (defvoo nnimap-auth-method nil
@@ -419,8 +424,8 @@ restrict visible folders.")
 
 (defcustom nnimap-id nil
   "Plist with client identity to send to server upon login.
-Nil means no information is sent, symbol `no' to disable ID query
-alltogheter, or plist with identifier-value pairs to send to
+A nil value means no information is sent, symbol `no' to disable ID query
+altogether, or plist with identifier-value pairs to send to
 server.  RFC 2971 describes the list as follows:
 
    Any string may be sent as a field, but the following are defined to
@@ -550,7 +555,8 @@ If EXAMINE is non-nil the group is selected read-only."
              (imap-mailbox-select group examine))
       (let (minuid maxuid)
        (when (> (imap-mailbox-get 'exists) 0)
-         (imap-fetch "1,*" "UID" nil 'nouidfetch)
+         (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*")
+                     "UID" nil 'nouidfetch)
          (imap-message-map (lambda (uid Uid)
                              (setq minuid (if minuid (min minuid uid) uid)
                                    maxuid (if maxuid (max maxuid uid) uid)))
@@ -611,7 +617,9 @@ If EXAMINE is non-nil the group is selected read-only."
              lines (imap-body-lines (imap-message-body imap-current-message))
              chars (imap-message-get imap-current-message 'RFC822.SIZE)))
       (nnheader-insert-nov
-       (with-temp-buffer
+       ;; At this stage, we only have bytes, so let's use unibyte buffers
+       ;; to make it more clear.
+       (mm-with-unibyte-buffer
         (buffer-disable-undo)
         (insert headers)
         (let ((head (nnheader-parse-naked-head uid)))
@@ -775,6 +783,8 @@ If EXAMINE is non-nil the group is selected read-only."
       'nov)))
 
 (defun nnimap-open-connection (server)
+  ;; Note: `nnimap-open-server' that calls this function binds
+  ;; `imap-logout-timeout' to `nnimap-logout-timeout'.
   (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
                      nnimap-authenticator nnimap-server-buffer))
       (nnheader-report 'nnimap "Can't open connection to server %s" server)
@@ -788,22 +798,26 @@ If EXAMINE is non-nil the group is selected read-only."
           (port (if nnimap-server-port
                     (int-to-string nnimap-server-port)
                   "imap"))
-          (user (netrc-machine-user-or-password
-                 "login"
-                 list
-                 (list server
-                       (or nnimap-server-address
-                           nnimap-address))
-                 (list port)
-                 (list "imap" "imaps")))
-          (passwd (netrc-machine-user-or-password
-                   "password"
-                   list
-                   (list server
-                         (or nnimap-server-address
-                             nnimap-address))
-                   (list port)
-                   (list "imap" "imaps"))))
+          (user (or
+                 (auth-source-user-or-password "login" server port) ; this is preferred to netrc-*
+                 (netrc-machine-user-or-password
+                  "login"
+                  list
+                  (list server
+                        (or nnimap-server-address
+                            nnimap-address))
+                  (list port)
+                  (list "imap" "imaps" "143" "993"))))
+          (passwd (or
+                   (auth-source-user-or-password "password" server port) ; this is preferred to netrc-*
+                   (netrc-machine-user-or-password
+                    "password"
+                    list
+                    (list server
+                          (or nnimap-server-address
+                              nnimap-address))
+                    (list port)
+                    (list "imap" "imaps" "143" "993")))))
       (if (imap-authenticate user passwd nnimap-server-buffer)
          (prog2
              (setq nnimap-server-buffer-alist
@@ -836,14 +850,15 @@ If EXAMINE is non-nil the group is selected read-only."
        (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
     (with-current-buffer (get-buffer-create nnimap-server-buffer)
       (nnoo-change-server 'nnimap server defs))
-    (or (and nnimap-server-buffer
-            (imap-opened nnimap-server-buffer)
-            (if (with-current-buffer nnimap-server-buffer
-                  (memq imap-state '(auth selected examine)))
-                t
-              (imap-close nnimap-server-buffer)
-              (nnimap-open-connection server)))
-       (nnimap-open-connection server))))
+    (let ((imap-logout-timeout nnimap-logout-timeout))
+      (or (and nnimap-server-buffer
+              (imap-opened nnimap-server-buffer)
+              (if (with-current-buffer nnimap-server-buffer
+                    (memq imap-state '(auth selected examine)))
+                  t
+                (imap-close nnimap-server-buffer)
+                (nnimap-open-connection server)))
+         (nnimap-open-connection server)))))
 
 (deffoo nnimap-server-opened (&optional server)
   "Whether SERVER is opened.
@@ -858,7 +873,8 @@ SERVER is nil, it is treated as the current server."
 (deffoo nnimap-close-server (&optional server)
   "Close connection to server and free all resources connected to it.
 Return nil if the server couldn't be closed for some reason."
-  (let ((server (or server nnimap-current-server)))
+  (let ((server (or server nnimap-current-server))
+       (imap-logout-timeout nnimap-logout-timeout))
     (when (or (nnimap-server-opened server)
              (imap-opened (nnimap-get-server-buffer server)))
       (imap-close (nnimap-get-server-buffer server))
@@ -1198,20 +1214,19 @@ function is generally only called when Gnus is shutting down."
                         seen))
            (gnus-info-set-read info seen)))
 
-       (mapcar (lambda (pred)
-                 (when (or (eq (cdr pred) 'recent)
-                           (and (nnimap-mark-permanent-p (cdr pred))
-                                (member (nnimap-mark-to-flag (cdr pred))
-                                        (imap-mailbox-get 'flags))))
-                   (gnus-info-set-marks
-                    info
-                    (gnus-update-alist-soft
-                     (cdr pred)
-                     (gnus-compress-sequence
-                      (imap-search (nnimap-mark-to-predicate (cdr pred))))
-                     (gnus-info-marks info))
-                    t)))
-               gnus-article-mark-lists)
+       (dolist (pred gnus-article-mark-lists)
+         (when (or (eq (cdr pred) 'recent)
+                   (and (nnimap-mark-permanent-p (cdr pred))
+                        (member (nnimap-mark-to-flag (cdr pred))
+                                (imap-mailbox-get 'flags))))
+           (gnus-info-set-marks
+            info
+            (gnus-update-alist-soft
+             (cdr pred)
+             (gnus-compress-sequence
+              (imap-search (nnimap-mark-to-predicate (cdr pred))))
+             (gnus-info-marks info))
+            t)))
 
        (when nnimap-importantize-dormant
          ;; nnimap mark dormant article as ticked too (for other clients)
@@ -1544,8 +1559,7 @@ function is generally only called when Gnus is shutting down."
        ;; request the article only when the move is NOT internal
        (and (or move-is-internal
                 (nnimap-request-article article group server))
-            (save-excursion
-              (set-buffer buf)
+            (with-current-buffer buf
               (buffer-disable-undo (current-buffer))
               (insert-buffer-substring nntp-server-buffer)
               (setq result (eval accept-form))
@@ -1594,6 +1608,8 @@ function is generally only called when Gnus is shutting down."
 
 (deffoo nnimap-request-delete-group (group force &optional server)
   (when (nnimap-possibly-change-server server)
+    (when (string= group (imap-current-mailbox nnimap-server-buffer))
+      (imap-mailbox-unselect nnimap-server-buffer))
     (with-current-buffer nnimap-server-buffer
       (if force
          (or (null (imap-mailbox-status group 'uidvalidity))
@@ -1707,70 +1723,70 @@ be used in a STORE FLAGS command."
       result)))
 
 (defun nnimap-mark-permanent-p (mark &optional group)
-  "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
+  "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
   (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
 
 (when nnimap-debug
   (require 'trace)
   (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
-  (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
-         '(
-           nnimap-possibly-change-server
-           nnimap-verify-uidvalidity
-           nnimap-find-minmax-uid
-           nnimap-before-find-minmax-bugworkaround
-           nnimap-possibly-change-group
-           ;;nnimap-replace-whitespace
-           nnimap-retrieve-headers-progress
-           nnimap-retrieve-which-headers
-           nnimap-group-overview-filename
-           nnimap-retrieve-headers-from-file
-           nnimap-retrieve-headers-from-server
-           nnimap-retrieve-headers
-           nnimap-open-connection
-           nnimap-open-server
-           nnimap-server-opened
-           nnimap-close-server
-           nnimap-request-close
-           nnimap-status-message
-           ;;nnimap-demule
-           nnimap-request-article-part
-           nnimap-request-article
-           nnimap-request-head
-           nnimap-request-body
-           nnimap-request-group
-           nnimap-close-group
-           nnimap-pattern-to-list-arguments
-           nnimap-request-list
-           nnimap-request-post
-           nnimap-retrieve-groups
-           nnimap-request-update-info-internal
-           nnimap-request-type
-           nnimap-request-set-mark
-           nnimap-split-to-groups
-           nnimap-split-find-rule
-           nnimap-split-find-inbox
-           nnimap-split-articles
-           nnimap-request-scan
-           nnimap-request-newgroups
-           nnimap-request-create-group
-           nnimap-time-substract
-           nnimap-date-days-ago
-           nnimap-request-expire-articles-progress
-           nnimap-request-expire-articles
-           nnimap-request-move-article
-           nnimap-request-accept-article
-           nnimap-request-delete-group
-           nnimap-request-rename-group
-           gnus-group-nnimap-expunge
-           gnus-group-nnimap-edit-acl
-           gnus-group-nnimap-edit-acl-done
-           nnimap-group-mode-hook
-           nnimap-mark-to-predicate
-           nnimap-mark-to-flag-1
-           nnimap-mark-to-flag
-           nnimap-mark-permanent-p
-           )))
+  (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
+       '(
+         nnimap-possibly-change-server
+         nnimap-verify-uidvalidity
+         nnimap-find-minmax-uid
+         nnimap-before-find-minmax-bugworkaround
+         nnimap-possibly-change-group
+         ;;nnimap-replace-whitespace
+         nnimap-retrieve-headers-progress
+         nnimap-retrieve-which-headers
+         nnimap-group-overview-filename
+         nnimap-retrieve-headers-from-file
+         nnimap-retrieve-headers-from-server
+         nnimap-retrieve-headers
+         nnimap-open-connection
+         nnimap-open-server
+         nnimap-server-opened
+         nnimap-close-server
+         nnimap-request-close
+         nnimap-status-message
+         ;;nnimap-demule
+         nnimap-request-article-part
+         nnimap-request-article
+         nnimap-request-head
+         nnimap-request-body
+         nnimap-request-group
+         nnimap-close-group
+         nnimap-pattern-to-list-arguments
+         nnimap-request-list
+         nnimap-request-post
+         nnimap-retrieve-groups
+         nnimap-request-update-info-internal
+         nnimap-request-type
+         nnimap-request-set-mark
+         nnimap-split-to-groups
+         nnimap-split-find-rule
+         nnimap-split-find-inbox
+         nnimap-split-articles
+         nnimap-request-scan
+         nnimap-request-newgroups
+         nnimap-request-create-group
+         nnimap-time-substract
+         nnimap-date-days-ago
+         nnimap-request-expire-articles-progress
+         nnimap-request-expire-articles
+         nnimap-request-move-article
+         nnimap-request-accept-article
+         nnimap-request-delete-group
+         nnimap-request-rename-group
+         gnus-group-nnimap-expunge
+         gnus-group-nnimap-edit-acl
+         gnus-group-nnimap-edit-acl-done
+         nnimap-group-mode-hook
+         nnimap-mark-to-predicate
+         nnimap-mark-to-flag-1
+         nnimap-mark-to-flag
+         nnimap-mark-permanent-p
+         )))
 
 (provide 'nnimap)