Merge branch 'master' of https://git.gnus.org/gnus
[gnus] / lisp / nnimap.el
index 086cabb..73a7335 100644 (file)
@@ -51,7 +51,7 @@ it will default to `imap'.")
 
 (defvoo nnimap-stream 'ssl
   "How nnimap will talk to the IMAP server.
 
 (defvoo nnimap-stream 'ssl
   "How nnimap will talk to the IMAP server.
-Values are `ssl' and `network'.")
+Values are `ssl', `network' or `shell'.")
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
@@ -91,7 +91,7 @@ not done by default on servers that doesn't support that command.")
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
-  group process commands capabilities select-result newlinep)
+  group process commands capabilities select-result newlinep server)
 
 (defvar nnimap-object nil)
 
 
 (defvar nnimap-object nil)
 
@@ -212,7 +212,8 @@ not done by default on servers that doesn't support that command.")
     (buffer-disable-undo)
     (gnus-add-buffer)
     (set (make-local-variable 'after-change-functions) nil)
     (buffer-disable-undo)
     (gnus-add-buffer)
     (set (make-local-variable 'after-change-functions) nil)
-    (set (make-local-variable 'nnimap-object) (make-nnimap))
+    (set (make-local-variable 'nnimap-object)
+        (make-nnimap :server (nnoo-current-server 'nnimap)))
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
@@ -418,13 +419,11 @@ not done by default on servers that doesn't support that command.")
              (when info
                (nnimap-update-infos marks (list info)))
              (goto-char (point-max))
              (when 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 (1- (string-to-number (match-string 1)))
-                     low 1)))))
+             (let ((uidnext (nth 5 (car marks))))
+               (setq high (if uidnext
+                              (1- uidnext)
+                            (nth 3 (car marks)))
+                     low (or (nth 4 (car marks)) uidnext)))))
          (erase-buffer)
          (insert
           (format
          (erase-buffer)
          (insert
           (format
@@ -501,7 +500,8 @@ not done by default on servers that doesn't support that command.")
     nil)
    (t
     (let ((deletable-articles
     nil)
    (t
     (let ((deletable-articles
-          (if force
+          (if (or force
+                  (eq nnmail-expiry-wait 'immediate))
               articles
             (gnus-sorted-intersection
              articles
               articles
             (gnus-sorted-intersection
              articles
@@ -586,7 +586,6 @@ not done by default on servers that doesn't support that command.")
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
-            (equal group nnimap-inbox)
             nnimap-inbox
             nnimap-split-methods)
     (message "nnimap %s splitting mail..." server)
             nnimap-inbox
             nnimap-split-methods)
     (message "nnimap %s splitting mail..." server)
@@ -775,19 +774,24 @@ not done by default on servers that doesn't support that command.")
 
 (defun nnimap-update-info (info marks)
   (when marks
 
 (defun nnimap-update-info (info marks)
   (when marks
-    (destructuring-bind (existing flags high low uidnext start-article) marks
+    (destructuring-bind (existing flags high low uidnext start-article
+                                 permanent-flags) marks
       (let ((group (gnus-info-group info))
            (completep (and start-article
                            (= start-article 1))))
       (let ((group (gnus-info-group info))
            (completep (and start-article
                            (= start-article 1))))
+       (when uidnext
+         (setq high (1- uidnext)))
        ;; First set the active ranges based on high/low.
        (if (or completep
                (not (gnus-active group)))
            (gnus-set-active group
        ;; First set the active ranges based on high/low.
        (if (or completep
                (not (gnus-active group)))
            (gnus-set-active group
-                            (if high
+                            (if (and low high)
                                 (cons low high)
                               ;; No articles in this group.
                                 (cons low high)
                               ;; No articles in this group.
-                              (cons (1- uidnext) uidnext)))
-         (setcdr (gnus-active group) high))
+                              (cons uidnext (1- uidnext))))
+         (setcdr (gnus-active group) (or high (1- uidnext))))
+       (unless high
+         (setq high (1- uidnext)))
        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence
        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence
@@ -820,6 +824,7 @@ not done by default on servers that doesn't support that command.")
                  (new-marks
                   (gnus-compress-sequence
                    (cdr (or (assoc (caddr type) flags)     ; %Flagged
                  (new-marks
                   (gnus-compress-sequence
                    (cdr (or (assoc (caddr type) flags)     ; %Flagged
+                            (assoc (intern (cadr type) obarray) flags)
                             (assoc (cadr type) flags)))))) ; "\Flagged"
              (setq marks (delq old-marks marks))
              (pop old-marks)
                             (assoc (cadr type) flags)))))) ; "\Flagged"
              (setq marks (delq old-marks marks))
              (pop old-marks)
@@ -842,7 +847,7 @@ not done by default on servers that doesn't support that command.")
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
-  (let (data group totalp uidnext articles start-article mark)
+  (let (data group totalp uidnext articles start-article mark permanent-flags)
     (dolist (elem groups)
       (setq group (car elem)
            uidnext (nth 1 elem)
     (dolist (elem groups)
       (setq group (car elem)
            uidnext (nth 1 elem)
@@ -858,9 +863,10 @@ not done by default on servers that doesn't support that command.")
            (setq mark (assoc flag marks))
            (if (not mark)
                (push (list flag (car article)) marks)
            (setq mark (assoc flag marks))
            (if (not mark)
                (push (list flag (car article)) marks)
-             (setcdr mark (cons (car article) (cdr mark)))))
-         (push (list group existing marks high low uidnext start-article)
-               data))))
+             (setcdr mark (cons (car article) (cdr mark))))))
+       (push (list group existing marks high low uidnext start-article
+                   permanent-flags)
+             data)))
     data))
 
 (defun nnimap-parse-flags (sequences)
     data))
 
 (defun nnimap-parse-flags (sequences)
@@ -878,15 +884,17 @@ not done by default on servers that doesn't support that command.")
                     (forward-line 1)
                     (setq end (point))
                     (goto-char start)
                     (forward-line 1)
                     (setq end (point))
                     (goto-char start)
-                    (setq permanent-forward
+                    (setq permanent-flags
                           (and (search-forward "PERMANENTFLAGS "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))
                           (and (search-forward "PERMANENTFLAGS "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))
+                    (goto-char start)
                     (setq uidnext
                           (and (search-forward "UIDNEXT "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))
                     (setq uidnext
                           (and (search-forward "UIDNEXT "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))
-                    (goto-char end))
+                    (goto-char end)
+                    (forward-line -1))
                   ;; The UID FETCH FLAGS was successful.
                   (search-forward (format "\n%d OK " flag-sequence) nil t))
          (setq start (point))
                   ;; The UID FETCH FLAGS was successful.
                   (search-forward (format "\n%d OK " flag-sequence) nil t))
          (setq start (point))