[Emacs-diffs] Changes to emacs/lisp/gnus/nnimap.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/10/28 09:18:40

Index: lisp/gnus/nnimap.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/nnimap.el,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- lisp/gnus/nnimap.el 13 Aug 2007 13:41:20 -0000      1.36
+++ lisp/gnus/nnimap.el 28 Oct 2007 09:18:32 -0000      1.37
@@ -250,10 +250,15 @@
   :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
@@ -417,6 +422,43 @@
 If this is 'imap-mailbox-lsub, then use a server-side subscription list to
 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
+server.  RFC 2971 describes the list as follows:
+
+   Any string may be sent as a field, but the following are defined to
+   describe certain values that might be sent.  Implementations are free
+   to send none, any, or all of these.  Strings are not case-sensitive.
+   Field strings MUST NOT be longer than 30 octets.  Value strings MUST
+   NOT be longer than 1024 octets.  Implementations MUST NOT send more
+   than 30 field-value pairs.
+
+     name            Name of the program
+     version         Version number of the program
+     os              Name of the operating system
+     os-version      Version of the operating system
+     vendor          Vendor of the client/server
+     support-url     URL to contact for support
+     address         Postal address of contact/vendor
+     date            Date program was released, specified as a date-time
+                       in IMAP4rev1
+     command         Command used to start the program
+     arguments       Arguments supplied on the command line, if any
+                       if any
+     environment     Description of environment, i.e., UNIX environment
+                       variables or Windows registry settings
+
+   Implementations MUST NOT send the same field name more than once.
+
+An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
+\"os\" system-configuration \"vendor\" \"GNU\")."
+  :group 'nnimap
+  :type '(choice (const :tag "No information" nil)
+                (const :tag "Disable ID query" no)
+                (plist :key-type string :value-type string)))
+
 (defcustom nnimap-debug nil
   "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
 Note that username, passwords and other privacy sensitive
@@ -451,6 +493,14 @@
   "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."
@@ -569,7 +619,7 @@
        (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)
@@ -730,6 +780,8 @@
       '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)
@@ -739,26 +791,35 @@
       (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
     (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
                                      nnimap-authinfo-file)
-                       (gnus-parse-netrc nnimap-authinfo-file)))
+                       (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 server port "imaps")
-                     (gnus-netrc-machine list
+          (user (netrc-machine-user-or-password
+                 "login"
+                 list
+                 (list server
                                          (or nnimap-server-address
-                                             nnimap-address)
-                                         port "imap")
-                     (gnus-netrc-machine list
+                           nnimap-address))
+                 (list port)
+                 (list "imap" "imaps")))
+          (passwd (netrc-machine-user-or-password
+                   "password"
+                   list
+                   (list server
                                          (or nnimap-server-address
-                                             nnimap-address)
-                                         port "imaps")))
-          (user (gnus-netrc-get alist "login"))
-          (passwd (gnus-netrc-get alist "password")))
+                             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)
            (nnimap-possibly-change-server server))
        (imap-close nnimap-server-buffer)
        (kill-buffer nnimap-server-buffer)
@@ -782,14 +843,15 @@
        (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))
+    (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 select examine)))
+                    (memq imap-state '(auth selected examine)))
                 t
               (imap-close nnimap-server-buffer)
               (nnimap-open-connection server)))
-       (nnimap-open-connection server))))
+         (nnimap-open-connection server)))))
 
 (deffoo nnimap-server-opened (&optional server)
   "Whether SERVER is opened.
@@ -804,7 +866,8 @@
 (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))
@@ -812,7 +875,9 @@
       (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 ()
@@ -820,7 +885,7 @@
 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)))
+  (mapc (lambda (server) (nnimap-close-server (car server)))
          nnimap-server-buffer-alist)
   (setq nnimap-server-buffer-alist nil))
 
@@ -1142,7 +1207,7 @@
                         seen))
            (gnus-info-set-read info seen)))
 
-       (mapcar (lambda (pred)
+       (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))
@@ -1155,7 +1220,6 @@
                       (imap-search (nnimap-mark-to-predicate (cdr pred))))
                      (gnus-info-marks info))
                     t)))
-               gnus-article-mark-lists)
 
        (when nnimap-importantize-dormant
          ;; nnimap mark dormant article as ticked too (for other clients)
@@ -1207,7 +1271,7 @@
              (if (memq 'dormant cmdmarks)
                  (setq cmdmarks (cons 'tick cmdmarks))))
            ;; remove stuff we are forbidden to store
-           (mapcar (lambda (mark)
+           (mapc (lambda (mark)
                      (if (imap-message-flag-permanent-p
                           (nnimap-mark-to-flag mark))
                          (setq marks (cons mark marks))))
@@ -1472,8 +1536,8 @@
   ;; return articles not deleted
   articles)
 
-(deffoo nnimap-request-move-article (article group server
-                                            accept-form &optional last)
+(deffoo nnimap-request-move-article (article group server accept-form
+                                            &optional last move-is-internal)
   (when (nnimap-possibly-change-server server)
     (save-excursion
       (let ((buf (get-buffer-create " *nnimap move*"))
@@ -1481,7 +1545,13 @@
            (nnimap-current-move-group group)
            (nnimap-current-move-server nnimap-current-server)
            result)
-       (and (nnimap-request-article article group server)
+       (gnus-message 10 "nnimap-request-move-article: this is an %s move"
+                     (if move-is-internal
+                         "internal"
+                       "external"))
+       ;; 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)
               (buffer-disable-undo (current-buffer))
@@ -1558,13 +1628,13 @@
       (error "Your server does not support ACL editing"))
     (with-current-buffer nnimap-server-buffer
       ;; delete all removed identifiers
-      (mapcar (lambda (old-acl)
+      (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)
+      (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
@@ -1651,7 +1721,7 @@
 (when nnimap-debug
   (require 'trace)
   (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
-  (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
+  (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
          '(
            nnimap-possibly-change-server
            nnimap-verify-uidvalidity