X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=e7bf0f376a85d4fc7b40ba2f37a1611ab76f6fa4;hb=e30eea990653d6353d56ab877b739aeab7be195d;hp=c744796d2fb01141f658b79268c92194999e6bd1;hpb=9f640dd5f4e300be05de5aeba7e9025851926072;p=gnus

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index c744796d2..e7bf0f376 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -32,6 +32,8 @@
 (eval-when-compile
   (require 'cl))
 
+(require 'netrc)
+
 (nnoo-declare nnimap)
 
 (defvoo nnimap-address nil
@@ -89,10 +91,6 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
-(defmacro nnimap-with-process-buffer (&rest body)
-  `(with-current-buffer (nnimap-find-process-buffer (current-buffer))
-     ,@body))
-
 (defun nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
@@ -209,41 +207,52 @@ not done by default on servers that doesn't support that command.")
 	    (cond
 	     ((eq nnimap-stream 'network)
 	      (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-				   (or nnimap-server-port "imap"))
-	      (netrc-credentials nnimap-address "imap"))
+				   (or nnimap-server-port
+				       (if (netrc-find-service-number "imap")
+					   "imap"
+					 "143")))
+	      (auth-source-user-or-password
+	       '("login" "password") nnimap-address "imap" nil t))
 	     ((eq nnimap-stream 'stream)
 	      (nnimap-open-shell-stream
 	       "*nnimap*" (current-buffer) nnimap-address
 	       (or nnimap-server-port "imap"))
-	      (netrc-credentials nnimap-address "imap"))
+	      (auth-source-user-or-password
+	       '("login" "password") nnimap-address "imap" nil t))
 	     ((eq nnimap-stream 'ssl)
 	      (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-			       (or nnimap-server-port "imaps"))
-	      (netrc-credentials nnimap-address "imaps" "imap")))))
+			       (or nnimap-server-port
+				   (if (netrc-find-service-number "imaps")
+				       "imaps"
+				     "993")))
+	      (or
+	       (auth-source-user-or-password
+		'("login" "password") nnimap-address "imap")
+	       (auth-source-user-or-password
+		'("login" "password") nnimap-address "imaps" nil t))))))
       (setf (nnimap-process nnimap-object)
 	    (get-buffer-process (current-buffer)))
       (unless credentials
-	(delete-process (nnimap-process nnimap-object))
-	(error "Can't find user name/password for %s" nnimap-address))
+	(delete-process (nnimap-process nnimap-object)))
       (when (and (nnimap-process nnimap-object)
 		 (memq (process-status (nnimap-process nnimap-object))
 		       '(open run)))
 	(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
 	(let ((result (nnimap-command "LOGIN %S %S"
 				      (car credentials) (cadr credentials))))
-	  (unless (car result)
-	    (delete-process (nnimap-process nnimap-object))
-	    (error "Unable to login to the server: %s"
-		   (mapconcat #'identity (cadr result) " ")))
-	  (setf (nnimap-capabilities nnimap-object)
-		(mapcar
-		 #'upcase
-		 (or (nnimap-find-parameter "CAPABILITY" (cdr result))
-		     (nnimap-find-parameter
-		      "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
-	  (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
-	    (nnimap-command "ENABLE QRESYNC"))
-	  t)))))
+	  (if (not (car result))
+	      (progn
+		(delete-process (nnimap-process nnimap-object))
+		nil)
+	    (setf (nnimap-capabilities nnimap-object)
+		  (mapcar
+		   #'upcase
+		   (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+		       (nnimap-find-parameter
+			"CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
+	    (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+	      (nnimap-command "ENABLE QRESYNC"))
+	    t))))))
 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
@@ -280,14 +289,14 @@ not done by default on servers that doesn't support that command.")
       (when (and result
 		 article)
 	(erase-buffer)
-	(nnimap-with-process-buffer
-	 (erase-buffer)
-	 (setq result
-	       (nnimap-command
-		(if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
-		    "UID FETCH %d BODY.PEEK[]"
-		  "UID FETCH %d RFC822.PEEK")
-		article)))
+	(with-current-buffer (nnimap-buffer)
+	  (erase-buffer)
+	  (setq result
+		(nnimap-command
+		 (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
+		     "UID FETCH %d BODY.PEEK[]"
+		   "UID FETCH %d RFC822.PEEK")
+		 article)))
 	(let ((buffer (nnimap-find-process-buffer (current-buffer))))
 	  (when (car result)
 	    (with-current-buffer to-buffer
@@ -407,7 +416,7 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-request-set-mark (group actions &optional server)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)
-      (with-current-buffer (nnimap-find-process-buffer nntp-server-buffer)
+      (with-current-buffer (nnimap-buffer)
 	;; Just send all the STORE commands without waiting for
 	;; response.  If they're successful, they're successful.
 	(dolist (action actions)
@@ -431,17 +440,16 @@ not done by default on servers that doesn't support that command.")
     (let ((message (buffer-string))
 	  (message-id (message-field-value "message-id"))
 	  sequence)
-      (with-current-buffer nntp-server-buffer
-	(nnimap-with-process-buffer
-	 (setq sequence (nnimap-send-command
-			 "APPEND %S {%d}" (utf7-encode group t)
-			 (length message)))
-	 (process-send-string (get-buffer-process (current-buffer)) message)
-	 (process-send-string (get-buffer-process (current-buffer)) "\r\n")
-	 (let ((result (nnimap-get-response sequence)))
-	   (when result
-	     (cons group
-		   (nnimap-find-article-by-message-id group message-id)))))))))
+      (with-current-buffer (nnimap-buffer)
+	(setq sequence (nnimap-send-command
+			"APPEND %S {%d}" (utf7-encode group t)
+			(length message)))
+	(process-send-string (get-buffer-process (current-buffer)) message)
+	(process-send-string (get-buffer-process (current-buffer)) "\r\n")
+	(let ((result (nnimap-get-response sequence)))
+	  (when result
+	    (cons group
+		  (nnimap-find-article-by-message-id group message-id))))))))
 
 (defun nnimap-add-cr ()
   (goto-char (point-min))
@@ -464,18 +472,18 @@ not done by default on servers that doesn't support that command.")
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (let ((groups
-	   (nnimap-with-process-buffer
-	    (nnimap-get-groups)))
+	   (with-current-buffer (nnimap-buffer)
+	     (nnimap-get-groups)))
 	  sequences responses)
       (when groups
-	(nnimap-with-process-buffer
-	 (dolist (group groups)
-	   (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
-		       group)
-		 sequences))
-	 (nnimap-wait-for-response (caar sequences))
-	 (setq responses
-	       (nnimap-get-responses (mapcar #'car sequences))))
+	(with-current-buffer (nnimap-buffer)
+	  (dolist (group groups)
+	    (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+			group)
+		  sequences))
+	  (nnimap-wait-for-response (caar sequences))
+	  (setq responses
+		(nnimap-get-responses (mapcar #'car sequences))))
 	(dolist (response responses)
 	  (let* ((sequence (car response))
 		 (response (cadr response))
@@ -543,7 +551,8 @@ not done by default on servers that doesn't support that command.")
 	sequences))))
 
 (defun nnimap-finish-retrieve-group-infos (server infos sequences)
-  (when (nnimap-possibly-change-group nil server)
+  (when (and sequences
+	     (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (nnimap-wait-for-response (cadar sequences))
@@ -567,7 +576,8 @@ not done by default on servers that doesn't support that command.")
 	    (completep (and start-article
 			    (= start-article 1))))
 	;; First set the active ranges based on high/low.
-	(if completep
+	(if (or completep
+		(not (gnus-active group)))
 	    (gnus-set-active group
 			     (if high
 				 (cons low high)
@@ -672,18 +682,23 @@ not done by default on servers that doesn't support that command.")
   nil)
 
 (defun nnimap-possibly-change-group (group server)
-  (when (and server
-	     (not (nnimap-server-opened server)))
-    (nnimap-open-server server))
-  (if (not group)
-      t
-    (with-current-buffer (nnimap-buffer)
-      (if (equal group (nnimap-group nnimap-object))
-	  t
-	(let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
-	  (when (car result)
-	    (setf (nnimap-group nnimap-object) group)
-	    result))))))
+  (let ((open-result t))
+    (when (and server
+	       (not (nnimap-server-opened server)))
+      (setq open-result (nnimap-open-server server)))
+    (cond
+     ((not open-result)
+      nil)
+     ((not group)
+      t)
+     (t
+      (with-current-buffer (nnimap-buffer)
+	(if (equal group (nnimap-group nnimap-object))
+	    t
+	  (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
+	    (when (car result)
+	      (setf (nnimap-group nnimap-object) group)
+	      result))))))))
 
 (defun nnimap-find-connection (buffer)
   "Find the connection delivering to BUFFER."