(nnoo): Required, so that other packages can require nnimap.
[gnus] / lisp / nnimap.el
index 93b0de4..63b468c 100644 (file)
 (eval-when-compile
   (require 'cl))
 
+(require 'nnheader)
+(require 'gnus-util)
+(require 'gnus)
+(require 'nnoo)
 (require 'netrc)
 
 (nnoo-declare nnimap)
@@ -202,7 +206,7 @@ not done by default on servers that doesn't support that command.")
                                  ?p port)))))
     process))
 
-(defun nnimap-credentials (address &rest ports)
+(defun nnimap-credentials (address ports)
   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the
     ;; last port if all the previous ones have failed.
@@ -217,45 +221,52 @@ not done by default on servers that doesn't support that command.")
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)
-          (credentials
+          (ports
            (cond
             ((eq nnimap-stream 'network)
-             (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-                                  (or nnimap-server-port
-                                      (if (netrc-find-service-number "imap")
-                                          "imap"
-                                        "143")))
-             (nnimap-credentials nnimap-address "143" "imap"))
+             (open-network-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (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
               (or nnimap-server-port "imap"))
-             (nnimap-credentials nnimap-address "imap"))
+             '("imap"))
             ((eq nnimap-stream 'ssl)
-             (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-                              (or nnimap-server-port
-                                  (if (netrc-find-service-number "imaps")
-                                      "imaps"
-                                    "993")))
-             (nnimap-credentials nnimap-address "143" "993" "imap" "imaps")))))
+             (open-tls-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (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)))
-      (unless credentials
-       (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))))
-         (if (not (car result))
-             (progn
+       (when (setq connection-result (nnimap-wait-for-connection))
+         (unless (equal connection-result "PREAUTH")
+           (if (not (setq credentials
+                          (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))
-               nil)
+               (setq nnimap-object nil))))
+         (when nnimap-object
            (setf (nnimap-capabilities nnimap-object)
                  (mapcar
                   #'upcase
-                  (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+                  (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
                       (nnimap-find-parameter
                        "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
            (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
@@ -321,7 +332,7 @@ not done by default on servers that doesn't support that command.")
 (deffoo nnimap-request-group (group &optional server dont-check info)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
-         articles active marks)
+         articles active marks high low)
       (when result
        (if (and dont-check
                 (setq active (nth 2 (assoc group nnimap-current-infos))))
@@ -342,16 +353,22 @@ not done by default on servers that doesn't support that command.")
                     (nnimap-parse-flags
                      (list (list group-sequence flag-sequence 1 group)))))
              (when info
-               (nnimap-update-infos marks (list info)))))
+               (nnimap-update-infos marks (list info)))
+             (goto-char (point-max))
+             (cond
+              (marks
+               (setq high (nth 3 (car marks))
+                     low (nth 4 (car marks))))
+              ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
+               (setq high (string-to-number (match-string 1))
+                     low 1)))))
          (erase-buffer)
-         (let ((high (nth 3 (car marks)))
-               (low (nth 4 (car marks))))
-           (insert
-            (format
-             "211 %d %d %d %S\n"
-             (1+ (- high low))
-             low high group))))
-       t))))
+         (insert
+          (format
+           "211 %d %d %d %S\n"
+           (1+ (- high low))
+           low high group))))
+      t)))
 
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
@@ -624,9 +641,11 @@ not done by default on servers that doesn't support that command.")
          (when (> start-article 1)
            (setq read
                  (gnus-range-nconcat
-                  (gnus-sorted-range-intersection
-                   (cons 1 start-article)
-                   (gnus-info-read info))
+                  (if (> start-article 1)
+                      (gnus-sorted-range-intersection
+                       (cons 1 (1- start-article))
+                       (gnus-info-read info))
+                    (gnus-info-read info))
                   read)))
          (gnus-info-set-read info read)
          ;; Update the marks.
@@ -645,8 +664,8 @@ not done by default on servers that doesn't support that command.")
              (when (and old-marks
                         (> start-article 1))
                (setq old-marks (gnus-range-difference
-                                (cons start-article high)
-                                old-marks))
+                                old-marks
+                                (cons start-article high)))
                (setq new-marks (gnus-range-nconcat old-marks new-marks)))
              (when new-marks
                (push (cons (car type) new-marks) marks)))
@@ -779,6 +798,17 @@ not done by default on servers that doesn't support that command.")
   (nnimap-wait-for-response sequence)
   (nnimap-parse-response))
 
+(defun nnimap-wait-for-connection ()
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-min))
+    (while (and (memq (process-status process)
+                     '(open run))
+               (not (re-search-forward "^\\* " nil t)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-min)))
+    (and (looking-at "[A-Z0-9]+")
+        (match-string 0))))
+
 (defun nnimap-wait-for-response (sequence &optional messagep)
   (goto-char (point-max))
   (while (or (bobp)