diff lisp/gnus/nnimap.el @ 110615:84a76c5e1b1c

Merge changes made in Gnus trunk. sieve-manage.el (sieve-manage-default-stream): Make default stream customizable. nnimap.el (nnimap-request-accept-article): Send a "." at the end, which may or may not help. nnimap.el (nnimap-open-connection): Have the `network' nnimap connection use STARTTLS opportunistically. gnus-sum.el (gnus-summary-insert-new-articles): Copy the old-high watermark so that nothing alters it while scanning for new messages. nnimap.el (nnimap-request-accept-article): Remove the "." at the end, since some servers don't like it. nnimap.el (nnimap-open-connection): Forget credentials if the server says the password was wrong. nnimap.el (nnimap-parse-line): Protect against invalid data. gnus-art.el, gnus-sum.el, nnimap.el: Allow setting the partial fetch per server instead of globally. message.el (message-cite-prefix-regexp): Revert last edit. nnmairix.el: Make it work with latest changes in nnimap. gnus-sum.el (gnus-summary-move-article): Don't alter gnus-newsgroup-active. gnus-sum.el (gnus-summary-exit): Kill the article buffer later, so that you don't get flashes of other buffers. nnimap.el: Fix up partial nnimap fetching. gnus-sum.el: Rework the `/ N' based on the new gnus-newsgroup-highest variable.

--- a/lisp/gnus/nnimap.el	Mon Sep 27 22:53:35 2010 +0200
+++ b/lisp/gnus/nnimap.el	Mon Sep 27 23:07:47 2010 +0000
@@ -85,6 +85,13 @@
 
 (defvoo nnimap-current-infos nil)
 
+(defvoo nnimap-fetch-partial-articles nil
+  "If non-nil, Gnus will fetch partial articles.
+If t, nnimap will fetch only the first part.  If a string, it
+will fetch all parts that have types that match that string.  A
+likely value would be \"text/\" to automatically fetch all
+textual parts.")
+
 (defvar nnimap-process nil)
 
 (defvar nnimap-status-string "")
@@ -271,91 +278,110 @@
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
 					      'nnimap-keepalive)))
-  (with-current-buffer (nnimap-make-process-buffer buffer)
-    (let* ((coding-system-for-read 'binary)
-	   (coding-system-for-write 'binary)
-	   (port nil)
-	   (ports
-	    (cond
-	     ((eq nnimap-stream 'network)
-	      (open-network-stream
-	       "*nnimap*" (current-buffer) nnimap-address
-	       (setq port
-		     (or nnimap-server-port
-			 (if (netrc-find-service-number "imap")
-			     "imap"
-			   "143"))))
-	      '("143" "imap"))
-	     ((eq nnimap-stream 'shell)
-	      (nnimap-open-shell-stream
-	       "*nnimap*" (current-buffer) nnimap-address
-	       (setq port (or nnimap-server-port "imap")))
-	      '("imap"))
-	     ((eq nnimap-stream 'starttls)
-	      (starttls-open-stream
-	       "*nnimap*" (current-buffer) nnimap-address
-	       (setq port (or nnimap-server-port "imap")))
-	      '("imap"))
-	     ((eq nnimap-stream 'ssl)
-	      (open-tls-stream
-	       "*nnimap*" (current-buffer) nnimap-address
-	       (setq port
-		     (or nnimap-server-port
-			 (if (netrc-find-service-number "imaps")
-			     "imaps"
-			   "993"))))
-	      '("143" "993" "imap" "imaps"))))
-	   connection-result login-result credentials)
-      (setf (nnimap-process nnimap-object)
-	    (get-buffer-process (current-buffer)))
-      (if (not (and (nnimap-process nnimap-object)
-		    (memq (process-status (nnimap-process nnimap-object))
-			  '(open run))))
-	  (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
-			   nnimap-address port nnimap-stream)
-	(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
-	(if (not (setq connection-result (nnimap-wait-for-connection)))
-	    (nnheader-report 'nnimap
-			     "%s" (buffer-substring
-				   (point) (line-end-position)))
-	  (setf (nnimap-greeting nnimap-object)
-		(buffer-substring (line-beginning-position)
-				  (line-end-position)))
-	  (when (eq nnimap-stream 'starttls)
-	    (nnimap-command "STARTTLS")
-	    (starttls-negotiate (nnimap-process nnimap-object)))
-	  (when nnimap-server-port
-	    (push (format "%s" nnimap-server-port) ports))
-	  (unless (equal connection-result "PREAUTH")
-	    (if (not (setq credentials
-			   (if (eq nnimap-authenticator 'anonymous)
-			       (list "anonymous"
-				     (message-make-address))
-			     (or
-			      ;; First look for the credentials based
-			      ;; on the virtual server name.
-			      (nnimap-credentials
-			       (nnoo-current-server 'nnimap) ports t)
-			      ;; Then look them up based on the
-			      ;; physical address.
-			      (nnimap-credentials nnimap-address ports)))))
-		(setq nnimap-object nil)
-	      (setq login-result (nnimap-command "LOGIN %S %S"
-						 (car credentials)
-						 (cadr credentials)))
-	      (unless (car login-result)
-		(delete-process (nnimap-process nnimap-object))
-		(setq nnimap-object nil))))
-	  (when nnimap-object
+  (block nil
+    (with-current-buffer (nnimap-make-process-buffer buffer)
+      (let* ((coding-system-for-read 'binary)
+	     (coding-system-for-write 'binary)
+	     (port nil)
+	     (ports
+	      (cond
+	       ((eq nnimap-stream 'network)
+		(open-network-stream
+		 "*nnimap*" (current-buffer) nnimap-address
+		 (setq port
+		       (or nnimap-server-port
+			   (if (netrc-find-service-number "imap")
+			       "imap"
+			     "143"))))
+		'("143" "imap"))
+	       ((eq nnimap-stream 'shell)
+		(nnimap-open-shell-stream
+		 "*nnimap*" (current-buffer) nnimap-address
+		 (setq port (or nnimap-server-port "imap")))
+		'("imap"))
+	       ((eq nnimap-stream 'starttls)
+		(starttls-open-stream
+		 "*nnimap*" (current-buffer) nnimap-address
+		 (setq port (or nnimap-server-port "imap")))
+		'("imap"))
+	       ((eq nnimap-stream 'ssl)
+		(open-tls-stream
+		 "*nnimap*" (current-buffer) nnimap-address
+		 (setq port
+		       (or nnimap-server-port
+			   (if (netrc-find-service-number "imaps")
+			       "imaps"
+			     "993"))))
+		'("143" "993" "imap" "imaps"))))
+	     connection-result login-result credentials)
+	(setf (nnimap-process nnimap-object)
+	      (get-buffer-process (current-buffer)))
+	(if (not (and (nnimap-process nnimap-object)
+		      (memq (process-status (nnimap-process nnimap-object))
+			    '(open run))))
+	    (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
+			     nnimap-address port nnimap-stream)
+	  (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
+	  (if (not (setq connection-result (nnimap-wait-for-connection)))
+	      (nnheader-report 'nnimap
+			       "%s" (buffer-substring
+				     (point) (line-end-position)))
+	    ;; Store the greeting (for debugging purposes).
+	    (setf (nnimap-greeting nnimap-object)
+		  (buffer-substring (line-beginning-position)
+				    (line-end-position)))
+	    ;; Store the capabilities.
 	    (setf (nnimap-capabilities nnimap-object)
 		  (mapcar
 		   #'upcase
-		   (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
-		       (nnimap-find-parameter
-			"CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
-	    (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
-	      (nnimap-command "ENABLE QRESYNC"))
-	    t))))))
+		   (nnimap-find-parameter
+		    "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
+	    (when (eq nnimap-stream 'starttls)
+	      (nnimap-command "STARTTLS")
+	      (starttls-negotiate (nnimap-process nnimap-object)))
+	    ;; If this is a STARTTLS-capable server, then sever the
+	    ;; connection and start a STARTTLS connection instead.
+	    (when (and (eq nnimap-stream 'network)
+		       (member "STARTTLS" (nnimap-capabilities nnimap-object)))
+	      (let ((nnimap-stream 'starttls))
+		(delete-process (nnimap-process nnimap-object))
+		(kill-buffer (current-buffer))
+		(return
+		 (nnimap-open-connection buffer))))
+	    (when nnimap-server-port
+	      (push (format "%s" nnimap-server-port) ports))
+	    (unless (equal connection-result "PREAUTH")
+	      (if (not (setq credentials
+			     (if (eq nnimap-authenticator 'anonymous)
+				 (list "anonymous"
+				       (message-make-address))
+			       (or
+				;; First look for the credentials based
+				;; on the virtual server name.
+				(nnimap-credentials
+				 (nnoo-current-server 'nnimap) ports t)
+				;; Then look them up based on the
+				;; physical address.
+				(nnimap-credentials nnimap-address ports)))))
+		  (setq nnimap-object nil)
+		(setq login-result (nnimap-command "LOGIN %S %S"
+						   (car credentials)
+						   (cadr credentials)))
+		(unless (car login-result)
+		  ;; If the login failed, then forget the credentials
+		  ;; that are now possibly cached.
+		  (dolist (host (list (nnoo-current-server 'nnimap)
+				      nnimap-address))
+		    (dolist (port ports)
+		      (dolist (element '("login" "password"))
+			(auth-source-forget-user-or-password
+			 element host port))))
+		  (delete-process (nnimap-process nnimap-object))
+		  (setq nnimap-object nil))))
+	    (when nnimap-object
+	      (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+		(nnimap-command "ENABLE QRESYNC"))
+	      t)))))))
 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
@@ -395,14 +421,12 @@
 	(erase-buffer)
 	(with-current-buffer (nnimap-buffer)
 	  (erase-buffer)
-	  (when gnus-fetch-partial-articles
-	    (if (eq gnus-fetch-partial-articles t)
-		(setq parts '(1))
-	      (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
-	      (goto-char (point-min))
-	      (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
-		(setq structure (ignore-errors (read (current-buffer)))
-		      parts (nnimap-find-wanted-parts structure)))))
+	  (when nnimap-fetch-partial-articles
+	    (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
+	    (goto-char (point-min))
+	    (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
+	      (setq structure (ignore-errors (read (current-buffer)))
+		    parts (nnimap-find-wanted-parts structure))))
 	  (when (if parts
 		    (nnimap-get-partial-article article parts structure)
 		  (nnimap-get-whole-article article))
@@ -525,7 +549,9 @@
 			(number-to-string num)
 		      (format "%s.%s" prefix num))))
 	    (setcar (nthcdr 9 sub) id)
-	    (when (string-match gnus-fetch-partial-articles type)
+	    (when (if (eq nnimap-fetch-partial-articles t)
+		      (equal id "1")
+		    (string-match nnimap-fetch-partial-articles type))
 	      (push id parts))))
 	(incf num)))
     (nreverse parts)))
@@ -941,7 +967,10 @@
 			      (t
 			       ;; No articles and no uidnext.
 			       nil)))
-	  (setcdr (gnus-active group) (or high (1- uidnext))))
+	  (gnus-set-active
+	   group
+	   (cons (car (gnus-active group))
+		 (or high (1- uidnext)))))
 	(when (and (not high)
 		   uidnext)
 	  (setq high (1- uidnext)))
@@ -1193,13 +1222,18 @@
 	   (cond
 	    ((eql char ?\[)
 	     (split-string (buffer-substring
-			    (1+ (point)) (1- (search-forward "]")))))
+			    (1+ (point))
+			    (1- (search-forward "]" (line-end-position) 'move)))))
 	    ((eql char ?\()
 	     (split-string (buffer-substring
-			    (1+ (point)) (1- (search-forward ")")))))
+			    (1+ (point))
+			    (1- (search-forward ")" (line-end-position) 'move)))))
 	    ((eql char ?\")
 	     (forward-char 1)
-	     (buffer-substring (point) (1- (search-forward "\""))))
+	     (buffer-substring
+	      (point)
+	      (1- (or (search-forward "\"" (line-end-position) 'move)
+		      (point)))))
 	    (t
 	     (buffer-substring (point) (if (search-forward " " nil t)
 					   (1- (point))