Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

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

1 files changed, 195 insertions, 125 deletions

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ba23280658a..28938e4c0a6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -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
@@ -417,6 +422,43 @@ just like \"ticked\" articles, in other IMAP clients.")
 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 @@ variable unless you are comfortable with that."
   "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 @@ 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)
@@ -730,6 +780,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)
@@ -739,26 +791,35 @@ If EXAMINE is non-nil the group is selected read-only."
       (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)))
-	   (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
-					  (or nnimap-server-address
-					      nnimap-address)
-					  port "imap")
-		      (gnus-netrc-machine list
-					  (or nnimap-server-address
-					      nnimap-address)
-					  port "imaps")))
-	   (user (gnus-netrc-get alist "login"))
-	   (passwd (gnus-netrc-get alist "password")))
+			(netrc-parse nnimap-authinfo-file)))
+ 	   (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"))))
       (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 @@ 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 select 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.
@@ -804,7 +866,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))
@@ -812,7 +875,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 ()
@@ -820,8 +885,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)
@@ -1142,20 +1207,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)
@@ -1207,11 +1271,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
@@ -1472,8 +1536,8 @@ function is generally only called when Gnus is shutting down."
   ;; 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 @@ function is generally only called when Gnus is shutting down."
 	    (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,21 +1628,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)))
 
 
@@ -1651,64 +1721,64 @@ be used in a STORE FLAGS command."
 (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)