Synch to No Gnus 200502152159.
[elisp/gnus.git-] / lisp / nnimap.el
index f23a001..80d9b1b 100644 (file)
@@ -1,5 +1,5 @@
 ;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <jas@pdc.kth.se>
@@ -61,7 +61,6 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
 (require 'imap)
 
 (require 'nnoo)
@@ -213,6 +212,7 @@ variable is the symbol `default' the default behaviour 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."
+  :version "22.1"
   :group 'nnimap
   :type '(choice (const :tag "Let system decide" deault)
                 boolean))
@@ -221,9 +221,10 @@ will be downloaded."
 
 (defcustom nnimap-close-asynchronous t
   "Close mailboxes asynchronously in `nnimap-close-group'.
-This means that errors cought by nnimap when closing the mailbox will
+This means that errors caught by nnimap when closing the mailbox will
 not prevent Gnus from updating the group status, which may be harmful.
 However, it increases speed."
+  :version "22.1"
   :type 'boolean
   :group 'nnimap)
 
@@ -232,6 +233,7 @@ However, it increases speed."
 This increases the speed of closing mailboxes (quiting group) but may
 decrease the speed of selecting another mailbox later.  Re-selecting
 the same mailbox will be faster though."
+  :version "22.1"
   :type 'boolean
   :group 'nnimap)
 
@@ -244,6 +246,7 @@ more carefully for new mail.
 
 In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
 it O(n).  If p is small, then the default is probably faster."
+  :version "22.1"
   :type 'boolean
   :group 'nnimap)
 
@@ -393,11 +396,13 @@ just like \"ticked\" articles, in other IMAP clients.")
                                          (string :format "Login: %v"))
                                    (cons :format "%v"
                                          (const :format "" "password")
-                                         (string :format "Password: %v")))))))
+                                         (string :format "Password: %v"))))))
+  :group 'nnimap)
 
 (defcustom nnimap-prune-cache t
   "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache."
-  :type 'boolean)
+  :type 'boolean
+  :group 'nnimap)
 
 (defvar nnimap-request-list-method 'imap-mailbox-list
   "Method to use to request a list of all folders from the server.
@@ -442,7 +447,11 @@ An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
                 (plist :key-type string :value-type string)))
 
 (defcustom nnimap-debug nil
-  "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+  "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the *nnimap-debug*
+buffer.  It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that."
   :group 'nnimap
   :type 'boolean)
 
@@ -471,6 +480,14 @@ An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
   "Return buffer for SERVER, if nil use current server."
   (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
 
+(defun nnimap-remove-server-from-buffer-alist (server list)
+  "Remove SERVER from LIST."
+  (let (l)
+    (dolist (e list)
+      (unless (equal server (car-safe e))
+       (push e l)))
+    l))
+
 (defun nnimap-possibly-change-server (server)
   "Return buffer for SERVER, changing the current server as a side-effect.
 If SERVER is nil, uses the current server."
@@ -589,7 +606,7 @@ If EXAMINE is non-nil the group is selected read-only."
        (with-temp-buffer
         (buffer-disable-undo)
         (insert headers)
-        (let ((head (nnheader-parse-naked-head)))
+        (let ((head (nnheader-parse-naked-head uid)))
           (mail-header-set-number head uid)
           (mail-header-set-chars head chars)
           (mail-header-set-lines head lines)
@@ -755,19 +772,32 @@ If EXAMINE is non-nil the group is selected read-only."
                (imap-capability 'IMAP4rev1 nnimap-server-buffer))
       (imap-close nnimap-server-buffer)
       (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
-    (let* ((list (gnus-parse-netrc nnimap-authinfo-file))
+    (let* ((list (netrc-parse nnimap-authinfo-file))
           (port (if nnimap-server-port
                     (int-to-string nnimap-server-port)
                   "imap"))
-          (alist (or (gnus-netrc-machine list server port "imap")
-                     (gnus-netrc-machine list
-                                         (or nnimap-server-address
-                                             nnimap-address)
-                                         port "imap")))
-          (user (gnus-netrc-get alist "login"))
-          (passwd (gnus-netrc-get alist "password")))
+          (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"))))
       (if (imap-authenticate user passwd nnimap-server-buffer)
-         (prog1
+         (prog2
+             (setq nnimap-server-buffer-alist
+                   (nnimap-remove-server-from-buffer-alist
+                    server
+                    nnimap-server-buffer-alist))
              (push (list server nnimap-server-buffer)
                    nnimap-server-buffer-alist)
            (imap-id nnimap-id nnimap-server-buffer)
@@ -824,7 +854,9 @@ Return nil if the server couldn't be closed for some reason."
       (setq nnimap-server-buffer nil
            nnimap-current-server nil
            nnimap-server-buffer-alist
-           (delq server nnimap-server-buffer-alist)))
+           (nnimap-remove-server-from-buffer-alist
+            server
+            nnimap-server-buffer-alist)))
     (nnoo-close-server 'nnimap server)))
 
 (deffoo nnimap-request-close ()
@@ -832,8 +864,8 @@ Return nil if the server couldn't be closed for some reason."
 All buffers that have been created by that
 backend should be killed.  (Not the nntp-server-buffer, though.) This
 function is generally only called when Gnus is shutting down."
-  (mapcar (lambda (server) (nnimap-close-server (car server)))
-         nnimap-server-buffer-alist)
+  (mapc (lambda (server) (nnimap-close-server (car server)))
+       nnimap-server-buffer-alist)
   (setq nnimap-server-buffer-alist nil))
 
 (deffoo nnimap-status-message (&optional server)
@@ -842,6 +874,11 @@ function is generally only called when Gnus is shutting down."
     (nnoo-status-message 'nnimap server)))
 
 (defun nnimap-demule (string)
+  ;; BEWARE: we used to use string-as-multibyte here which is braindead
+  ;; because it will turn accidental emacs-mule-valid byte sequences
+  ;; into multibyte chars.  --Stef
+  ;; Reverted, braindead got 7.5 out of 10 on imdb, so it can't be
+  ;; that bad. --Simon
   (funcall (if (and (fboundp 'string-as-multibyte)
                    (subrp (symbol-function 'string-as-multibyte)))
               'string-as-multibyte
@@ -1219,11 +1256,11 @@ function is generally only called when Gnus is shutting down."
              (if (memq 'dormant cmdmarks)
                  (setq cmdmarks (cons 'tick cmdmarks))))
            ;; remove stuff we are forbidden to store
-           (mapcar (lambda (mark)
-                     (if (imap-message-flag-permanent-p
-                          (nnimap-mark-to-flag mark))
-                         (setq marks (cons mark marks))))
-                   cmdmarks)
+           (mapc (lambda (mark)
+                   (if (imap-message-flag-permanent-p
+                        (nnimap-mark-to-flag mark))
+                       (setq marks (cons mark marks))))
+                 cmdmarks)
            (when (and range marks)
              (cond ((eq what 'del)
                     (imap-message-flags-del
@@ -1333,7 +1370,7 @@ function is generally only called when Gnus is shutting down."
                             (let (msgid)
                               (and (setq msgid
                                          (nnmail-fetch-field "message-id"))
-                                   (nnmail-cache-insert msgid 
+                                   (nnmail-cache-insert msgid
                                                         to-group
                                                         (nnmail-fetch-field "subject"))))))
                         ;; Add the group-art list to the history list.
@@ -1552,21 +1589,21 @@ function is generally only called when Gnus is shutting down."
       (error "Your server does not support ACL editing"))
     (with-current-buffer nnimap-server-buffer
       ;; delete all removed identifiers
-      (mapcar (lambda (old-acl)
-               (unless (assoc (car old-acl) new-acls)
-                 (or (imap-mailbox-acl-delete (car old-acl) mailbox)
-                     (error "Can't delete ACL for %s" (car old-acl)))))
-             old-acls)
+      (mapc (lambda (old-acl)
+             (unless (assoc (car old-acl) new-acls)
+               (or (imap-mailbox-acl-delete (car old-acl) mailbox)
+                   (error "Can't delete ACL for %s" (car old-acl)))))
+           old-acls)
       ;; set all changed acl's
-      (mapcar (lambda (new-acl)
-               (let ((new-rights (cdr new-acl))
-                     (old-rights (cdr (assoc (car new-acl) old-acls))))
-                 (unless (and old-rights new-rights
-                              (string= old-rights new-rights))
-                   (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
-                       (error "Can't set ACL for %s to %s" (car new-acl)
-                              new-rights)))))
-             new-acls)
+      (mapc (lambda (new-acl)
+             (let ((new-rights (cdr new-acl))
+                   (old-rights (cdr (assoc (car new-acl) old-acls))))
+               (unless (and old-rights new-rights
+                            (string= old-rights new-rights))
+                 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
+                     (error "Can't set ACL for %s to %s" (car new-acl)
+                            new-rights)))))
+           new-acls)
       t)))
 
 \f