]> git.eshelyaron.com Git - emacs.git/commitdiff
Merge changes made in Gnus trunk.
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Tue, 21 Sep 2010 23:13:46 +0000 (23:13 +0000)
committerKatsumi Yamaoka <yamaoka@jpl.org>
Tue, 21 Sep 2010 23:13:46 +0000 (23:13 +0000)
gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen) spec inserr "*" if the group isn't active instead of 0.
nnimap.el (nnimap-request-create-group): Implement.
nnimap.el: Use the IMAP version of utf7-encode throughout.
nnimap.el: Implement the nnimap article expunging interface method, and make it more general.
gnus-group.el: Put back the nnimap autoloads needed to do the acl stuff.
gnus-sum.el (gnus-summary-move-article): When respooling to the same method, this would bug out.
nnimap.el (nnimap-request-group): When we have zero articles, return the right data to Gnus.
nnimap.el (nnimap-request-expire-articles): Only delete articles immediately if the target is 'delete.
nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time for oldness in addition to being a predicate.
nnimap.el: Implement nnimap expiry.
nnimap.el (nnimap-request-move-article): Request the article before looking at what the Message-ID is.
nnimap.el (nnimap-mark-and-expunge-incoming): Wait for the last sequence.
gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to find out whether methods are equal.
nnimap.el (nnimap-find-expired-articles): Don't refer to nnml-inhibit-expiry.
nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract.
gnus-start.el (gnus-get-unread-articles): Fix the prefixed select method in the presence of many similar methods.
When we have several similar methods, try to create as few extended methods as possible.
gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting marks for nnimap, which is seldom the right thing to do.
gnus-int.el (gnus-open-server): Give a better error message in the "go offline" case.
gnus-sum.el (gnus-adjust-marked-articles): Fix another typo.
nnml.el (nnml-generate-nov-file): Fix variable name clobbering from previous patch.
gnus-start.el (gnus-get-unread-articles): Get the extended method slightly later to avoid double-getting it.

doc/misc/gnus.texi
lisp/gnus/ChangeLog
lisp/gnus/gnus-group.el
lisp/gnus/gnus-int.el
lisp/gnus/gnus-start.el
lisp/gnus/gnus-sum.el
lisp/gnus/gnus.el
lisp/gnus/nnimap.el
lisp/gnus/nnmail.el
lisp/gnus/nnml.el

index 841cf8c510c8db8f36be776c8f71a26f676e5953..52c8bb642f0c3037388cac8420d6285bcea82b4b 100644 (file)
@@ -18384,7 +18384,7 @@ INBOX.mailbox).
 @cindex expunge
 @cindex manual expunging
 @kindex G x (Group)
-@findex gnus-group-nnimap-expunge
+@findex gnus-group-expunge-group
 
 If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
 you may want the option of expunging all deleted articles in a mailbox
index 6ca3a0198c6ef1efda6f65aa28a29b11d8f811f0..eeba68f81a2be8eb4ca61f2292c8dfa1b0d4515b 100644 (file)
@@ -1,3 +1,57 @@
+2010-09-21  Adam Sjøgren  <asjo@koldfront.dk>
+
+       * gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
+
+2010-09-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-int.el (gnus-open-server): Give a better error message in the
+       "go offline" case.
+
+       * gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting
+       marks for nnimap, which is seldom the right thing to do.
+
+       * gnus.el (gnus-sloppily-equal-method-parameters): Refactor out.
+       (gnus-same-method-different-name): New function.
+
+       * nnimap.el (parse-time): Require.
+
+       * gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
+       method in the presence of many similar methods.
+
+       * nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract.
+
+       * nnimap.el (nnimap-find-expired-articles): Don't refer to
+       nnml-inhibit-expiry.
+
+       * gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to
+       find out whether methods are equal.
+
+       * nnimap.el (nnimap-find-expired-articles): New function.
+       (nnimap-process-expiry-targets): New function.
+       (nnimap-request-move-article): Request the article before looking at
+       what the Message-ID is.  Fix found by Andrew Cohen.
+       (nnimap-mark-and-expunge-incoming): Wait for the last sequence.
+
+       * nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time
+       for oldness in addition to being a predicate.
+
+       * nnimap.el (nnimap-request-group): When we have zero articles, return
+       the right data to Gnus.
+       (nnimap-request-expire-articles): Only delete articles immediately if
+       the target is 'delete.
+
+       * gnus-sum.el (gnus-summary-move-article): When respooling to the same
+       method, this would bug out.
+
+       * gnus-group.el (gnus-group-expunge-group): Renamed from
+       gnus-group-nnimap-expunge, and implemented as a normal interface
+       function.
+
+       * gnus-int.el (gnus-request-expunge-group): New function.
+
+       * nnimap.el (nnimap-request-create-group): Implement.
+       (nnimap-request-expunge-group): New function.
+
 2010-09-21  Julien Danjou  <julien@danjou.info>
 
        * gnus-html.el (gnus-html-image-cache-ttl): Add new variable.
index fa6ae51886c70105ae7a44dbc5591d42a40ebdb7..80cf580b84aaee3c330ee2b386b0001e50aac961 100644 (file)
@@ -509,7 +509,10 @@ simple manner.")
                   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
              (t number)) ?s)
     (?R gnus-tmp-number-of-read ?s)
-    (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
+    (?U (if (gnus-active gnus-tmp-group)
+           (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
+         "*")
+       ?s)
     (?t gnus-tmp-number-total ?d)
     (?y gnus-tmp-number-of-unread ?s)
     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
@@ -675,7 +678,7 @@ simple manner.")
   "R" gnus-group-make-rss-group
   "c" gnus-group-customize
   "z" gnus-group-compact-group
-  "x" gnus-group-nnimap-expunge
+  "x" gnus-group-expunge-group
   "\177" gnus-group-delete-group
   [delete] gnus-group-delete-group)
 
@@ -3163,21 +3166,17 @@ mail messages or news articles in files that have numeric names."
                       'summary 'group)))
       (error "Couldn't enter %s" dir))))
 
-(autoload 'nnimap-expunge "nnimap")
-(autoload 'nnimap-acl-get "nnimap")
-(autoload 'nnimap-acl-edit "nnimap")
-
-(defun gnus-group-nnimap-expunge (group)
+(defun gnus-group-expunge-group (group)
   "Expunge deleted articles in current nnimap GROUP."
   (interactive (list (gnus-group-group-name)))
-  (let ((mailbox (gnus-group-real-name group)) method)
-    (unless group
-      (error "No group on current line"))
-    (unless (gnus-get-info group)
-      (error "Killed group; can't be edited"))
-    (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
-      (error "%s is not an nnimap group" group))
-    (nnimap-expunge mailbox (cadr method))))
+  (let ((method (gnus-find-method-for-group group)))
+    (if (not (gnus-check-backend-function
+             'request-expunge-group (car method)))
+       (error "%s does not support expunging" (car method))
+      (gnus-request-expunge-group group method))))
+
+(autoload 'nnimap-acl-get "nnimap")
+(autoload 'nnimap-acl-edit "nnimap")
 
 (defun gnus-group-nnimap-edit-acl (group)
   "Edit the Access Control List of current nnimap GROUP."
index f245907ed1b7c24449ff4136a4059a27903e91a4..5ef58834df70e9ec98207b4aaf0bc1f44ab295e6 100644 (file)
@@ -275,8 +275,10 @@ If it is down, start it up (again)."
                               (not gnus-batch-mode)
                               (gnus-y-or-n-p
                                (format
-                                "Unable to open server %s, go offline? "
-                                server)))
+                                "Unable to open server %s (%s), go offline? "
+                                server
+                                (nnheader-get-report
+                                 (car gnus-command-method)))))
                               (setq open-offline t)
                               'offline)
                              (t
@@ -552,6 +554,14 @@ If BUFFER, insert the article in that group."
   (funcall (gnus-get-function gnus-command-method 'request-post)
           (nth 1 gnus-command-method)))
 
+(defun gnus-request-expunge-group (group gnus-command-method)
+  "Expunge GROUP, which is removing articles that have been marked as deleted."
+  (when (stringp gnus-command-method)
+    (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+  (funcall (gnus-get-function gnus-command-method 'request-expunge-group)
+          (gnus-group-real-name group)
+          (nth 1 gnus-command-method)))
+
 (defun gnus-request-scan (group gnus-command-method)
   "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
 If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
index f4745c184e5db8b790c9c493c65ae08d30204159..c2f09a83c07b8e6ac4fec05ec2b304c18729064c 100644 (file)
@@ -705,6 +705,7 @@ the first newsgroup."
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
+       gnus-extended-servers nil
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -1693,28 +1694,19 @@ If SCAN, request a scan of that group as well."
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
                                             (setq info (pop newsrc))))))
-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-
-      ;; To be more explicit:
-      ;; >0 for an active group with messages
-      ;; 0 for an active group with no unread messages
-      ;; nil for non-foreign groups that the user has requested not be checked
-      ;; t for unchecked foreign groups or bogus groups, or groups that can't
-      ;;   be checked, for one reason or other.
-
       ;; First go through all the groups, see what select methods they
       ;; belong to, and then collect them into lists per unique select
       ;; method.
       (if (not (setq method (gnus-info-method info)))
          (setq method gnus-select-method)
+       ;; There may be several similar methods.  Possibly extend the
+       ;; method.
        (if (setq cmethod (assoc method methods-cache))
            (setq method (cdr cmethod))
-         (setq cmethod (inline (gnus-server-get-method nil method)))
+         (setq cmethod (if (stringp method)
+                           (gnus-server-to-method method)
+                         (inline (gnus-find-method-for-group
+                                  (gnus-info-group info) info))))
          (push (cons method cmethod) methods-cache)
          (setq method cmethod)))
       (setq method-group-list (assoc method type-cache))
index d0c50c8fec0ae663138f7285275c0f099c8a2b35..5997339a335e50c81eb6f91e5603be7116f43c76 100644 (file)
@@ -5850,6 +5850,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
         (types gnus-article-mark-lists)
         marks var articles article mark mark-type
          bgn end)
+    ;; Hack to avoid adjusting marks for imap.
+    (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
+             'nnimap)
+      (setq min 1))
 
     (dolist (marks marked-lists)
       (setq mark (car marks)
@@ -9681,7 +9685,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                              gnus-newsgroup-name))
                (to-method (or select-method
                               (gnus-find-method-for-group to-newsgroup)))
-               (move-is-internal (gnus-method-equal from-method to-method)))
+               (move-is-internal (gnus-server-equal from-method to-method)))
           (gnus-request-move-article
            article                     ; Article to move
            gnus-newsgroup-name         ; From newsgroup
@@ -9692,7 +9696,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                  (not articles) t)     ; Accept form
            (not articles)              ; Only save nov last time
            (and move-is-internal
-                (gnus-group-real-name to-newsgroup))))) ; is this move internal?
+                to-newsgroup           ; Not respooling
+                (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
        ;; Copy the article.
        ((eq action 'copy)
         (with-current-buffer copy-buf
index 68f7f5f5e1a7ea289bb735ad878a65adb15b3a92..3f18858fc64e8828da0c620caaa5eb99f7921b75 100644 (file)
@@ -2682,6 +2682,7 @@ a string, be sure to use a valid format, see RFC 2616."
 (defvar gnus-newsgroup-name nil)
 (defvar gnus-ephemeral-servers nil)
 (defvar gnus-server-method-cache nil)
+(defvar gnus-extended-servers nil)
 
 (defvar gnus-agent-fetching nil
   "Whether Gnus agent is in fetching mode.")
@@ -3686,32 +3687,35 @@ that that variable is buffer-local to the summary buffers."
    (and
     (eq (car m1) (car m2))
     (equal (cadr m1) (cadr m2))
-    ;; Check parameters for sloppy equalness.
-    (let ((p1 (copy-list (cddr m1)))
-         (p2 (copy-list (cddr m2)))
-         e1 e2)
-      (block nil
-       (while (setq e1 (pop p1))
-         (unless (setq e2 (assq (car e1) p2))
-           ;; The parameter doesn't exist in p2.
-           (return nil))
-         (setq p2 (delq e2 p2))
-         (unless (equalp e1 e2)
-           (if (not (and (stringp (cadr e1))
-                         (stringp (cadr e2))))
-               (return nil)
-             ;; Special-case string parameter comparison so that we
-             ;; can uniquify them.
-             (let ((s1 (cadr e1))
-                   (s2 (cadr e2)))
-               (when (string-match "/$" s1)
-                 (setq s1 (directory-file-name s1)))
-               (when (string-match "/$" s2)
-                 (setq s2 (directory-file-name s2)))
-               (unless (equal s1 s2)
-                 (return nil))))))
-       ;; If p2 now is empty, they were equal.
-       (null p2))))))
+    (gnus-sloppily-equal-method-parameters m1 m2))))
+
+(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
+  ;; Check parameters for sloppy equalness.
+  (let ((p1 (copy-list (cddr m1)))
+       (p2 (copy-list (cddr m2)))
+       e1 e2)
+    (block nil
+      (while (setq e1 (pop p1))
+       (unless (setq e2 (assq (car e1) p2))
+         ;; The parameter doesn't exist in p2.
+         (return nil))
+       (setq p2 (delq e2 p2))
+       (unless (equalp e1 e2)
+         (if (not (and (stringp (cadr e1))
+                       (stringp (cadr e2))))
+             (return nil)
+           ;; Special-case string parameter comparison so that we
+           ;; can uniquify them.
+           (let ((s1 (cadr e1))
+                 (s2 (cadr e2)))
+             (when (string-match "/$" s1)
+               (setq s1 (directory-file-name s1)))
+             (when (string-match "/$" s2)
+               (setq s2 (directory-file-name s2)))
+             (unless (equal s1 s2)
+               (return nil))))))
+      ;; If p2 now is empty, they were equal.
+      (null p2))))
 
 (defun gnus-server-equal (m1 m2)
   "Say whether two methods are equal."
@@ -4200,9 +4204,12 @@ parameters."
   (if (or (not (inline (gnus-similar-server-opened method)))
          (not (cddr method)))
       method
-    `(,(car method) ,(concat (cadr method) "+" group)
-      (,(intern (format "%s-address" (car method))) ,(cadr method))
-      ,@(cddr method))))
+    (setq method
+         `(,(car method) ,(concat (cadr method) "+" group)
+           (,(intern (format "%s-address" (car method))) ,(cadr method))
+           ,@(cddr method)))
+    (push method gnus-extended-servers)
+    method))
 
 (defun gnus-server-status (method)
   "Return the status of METHOD."
@@ -4227,6 +4234,20 @@ parameters."
        (format "%s using %s" address (car server))
       (format "%s" (car server)))))
 
+(defun gnus-same-method-different-name (method)
+  (let ((slot (intern (concat (symbol-name (car method)) "-address"))))
+    (unless (assq slot (cddr method))
+      (setq method
+           (append method (list (list slot (nth 1 method)))))))
+  (let ((methods gnus-extended-servers)
+       open found)
+    (while (and (not found)
+               (setq open (pop methods)))
+      (when (and (eq (car method) (car open))
+                (gnus-sloppily-equal-method-parameters method open))
+       (setq found open)))
+    found))
+
 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method
@@ -4249,7 +4270,10 @@ parameters."
                (cond ((stringp method)
                       (inline (gnus-server-to-method method)))
                      ((stringp (cadr method))
-                      (inline (gnus-server-extend-method group method)))
+                      (or
+                       (inline
+                        (gnus-same-method-different-name method))
+                       (inline (gnus-server-extend-method group method))))
                      (t
                       method)))
          (cond ((equal (cadr method) "")
index 434ad01bc190a28155602a07c6608f5fedba9e92..e43cd2d8afbdcaadd124b3f99c8a880fb787e139 100644 (file)
@@ -37,6 +37,7 @@
 (require 'gnus)
 (require 'nnoo)
 (require 'netrc)
+(require 'parse-time)
 
 (nnoo-declare nnimap)
 
@@ -77,6 +78,8 @@ will fetch all parts that have types that match that string.  A
 likely value would be \"text/\" to automatically fetch all
 textual parts.")
 
+(defvoo nnimap-expunge nil)
+
 (defvoo nnimap-connection-alist nil)
 
 (defvoo nnimap-current-infos nil)
@@ -405,7 +408,7 @@ textual parts.")
          (with-current-buffer (nnimap-buffer)
            (erase-buffer)
            (let ((group-sequence
-                  (nnimap-send-command "SELECT %S" (utf7-encode group)))
+                  (nnimap-send-command "SELECT %S" (utf7-encode group t)))
                  (flag-sequence
                   (nnimap-send-command "UID FETCH 1:* FLAGS")))
              (nnimap-wait-for-response flag-sequence)
@@ -421,20 +424,28 @@ textual parts.")
                (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))
+               (setq high (1- (string-to-number (match-string 1)))
                      low 1)))))
          (erase-buffer)
          (insert
           (format
-           "211 %d %d %d %S\n"
-           (1+ (- high low))
-           low high group))))
-      t)))
+           "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
+       t))))
+
+(deffoo nnimap-request-create-group (group &optional server args)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
-      (car (nnimap-command "DELETE %S" (utf7-encode group))))))
+      (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+
+(deffoo nnimap-request-expunge-group (group &optional server)
+  (when (nnimap-possibly-change-group group server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "EXPUNGE")))))
 
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
@@ -456,38 +467,95 @@ textual parts.")
 
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)
-  (when (nnimap-possibly-change-group group server)
-    ;; If the move is internal (on the same server), just do it the easy
-    ;; way.
-    (let ((message-id (message-field-value "message-id")))
-      (if internal-move-group
-         (let ((result
-                (with-current-buffer (nnimap-buffer)
-                  (nnimap-command "UID COPY %d %S"
-                                  article
-                                  (utf7-encode internal-move-group t)))))
-           (when (car result)
-             (nnimap-delete-article article)
-             (cons internal-move-group
-                   (nnimap-find-article-by-message-id
-                    internal-move-group message-id))))
-       (with-temp-buffer
-         (when (nnimap-request-article article group server (current-buffer))
-           (let ((result (eval accept-form)))
-             (when result
+  (with-temp-buffer
+    (when (nnimap-request-article article group server (current-buffer))
+      ;; If the move is internal (on the same server), just do it the easy
+      ;; way.
+      (let ((message-id (message-field-value "message-id")))
+       (if internal-move-group
+           (let ((result
+                  (with-current-buffer (nnimap-buffer)
+                    (nnimap-command "UID COPY %d %S"
+                                    article
+                                    (utf7-encode internal-move-group t)))))
+             (when (car result)
                (nnimap-delete-article article)
-               result))))))))
+               (cons internal-move-group
+                     (nnimap-find-article-by-message-id
+                      internal-move-group message-id))))
+         ;; Move the article to a different method.
+         (let ((result (eval accept-form)))
+           (when result
+             (nnimap-delete-article article)
+             result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
   (cond
+   ((null articles)
+    nil)
    ((not (nnimap-possibly-change-group group server))
     articles)
-   (force
+   ((and force
+        (eq nnmail-expiry-target 'delete))
     (unless (nnimap-delete-article articles)
       (message "Article marked for deletion, but not expunged."))
     nil)
    (t
-    articles)))
+    (let ((deletable-articles
+          (if force
+              articles
+            (gnus-sorted-intersection
+             articles
+             (nnimap-find-expired-articles group)))))
+      (if (null deletable-articles)
+         articles
+       (if (eq nnmail-expiry-target 'delete)
+           (nnimap-delete-article deletable-articles)
+         (setq deletable-articles
+               (nnimap-process-expiry-targets
+                deletable-articles group server)))
+       ;; Return the articles we didn't delete.
+       (gnus-sorted-complement articles deletable-articles))))))
+
+(defun nnimap-process-expiry-targets (articles group server)
+  (let ((deleted-articles nil))
+    (dolist (article articles)
+      (let ((target nnmail-expiry-target))
+       (with-temp-buffer
+         (when (nnimap-request-article article group server (current-buffer))
+           (message "Expiring article %s:%d" group article)
+           (when (functionp target)
+             (setq target (funcall target group)))
+           (when (and target
+                      (not (eq target 'delete)))
+             (if (or (gnus-request-group target t)
+                     (gnus-request-create-group target))
+                 (nnmail-expiry-target-group target group)
+               (setq target nil)))
+           (when target
+             (push article deleted-articles))))))
+    ;; Change back to the current group again.
+    (nnimap-possibly-change-group group server)
+    (setq deleted-articles (nreverse deleted-articles))
+    (nnimap-delete-article deleted-articles)
+    deleted-articles))
+
+(defun nnimap-find-expired-articles (group)
+  (let ((cutoff (nnmail-expired-article-p group nil nil)))
+    (with-current-buffer (nnimap-buffer)
+      (let ((result
+            (nnimap-command
+             "UID SEARCH SENTBEFORE %s"
+             (format-time-string
+              (format "%%d-%s-%%Y"
+                      (upcase
+                       (car (rassoc (nth 4 (decode-time cutoff))
+                                    parse-time-months))))
+              cutoff))))
+       (and (car result)
+            (delete 0 (mapcar #'string-to-number
+                              (cdr (assoc "SEARCH" (cdr result))))))))))
+
 
 (defun nnimap-find-article-by-message-id (group message-id)
   (when (nnimap-possibly-change-group group nil)
@@ -505,10 +573,14 @@ textual parts.")
   (with-current-buffer (nnimap-buffer)
     (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
                    (nnimap-article-ranges articles))
-    (when (member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s"
-                          (nnimap-article-ranges articles))
-      t)))
+    (cond
+     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+      (nnimap-command "UID EXPUNGE %s"
+                     (nnimap-article-ranges articles))
+      t)
+     (nnimap-expunge
+      (nnimap-command "EXPUNGE")
+      t))))
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
@@ -1040,17 +1112,19 @@ textual parts.")
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
     (setq range (nnimap-article-ranges range))
-    (nnimap-send-command
-     "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)
-    (cond
-     ;; If the server supports it, we now delete the message we have
-     ;; just copied over.
-     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s" range))
-     ;; If it doesn't support UID EXPUNGE, then we only expunge if the
-     ;; user has configured it.
-     (nnimap-expunge-inbox
-      (nnimap-send-command "EXPUNGE")))))
+    (let ((sequence
+          (nnimap-send-command
+           "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
+      (cond
+       ;; If the server supports it, we now delete the message we have
+       ;; just copied over.
+       ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+       (setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
+       ;; If it doesn't support UID EXPUNGE, then we only expunge if the
+       ;; user has configured it.
+       (nnimap-expunge-inbox
+       (setq sequence (nnimap-send-command "EXPUNGE"))))
+      (nnimap-wait-for-response sequence))))
 
 (defun nnimap-parse-copied-articles (sequences)
   (let (sequence copied range)
index 3e6cee82521b48379276a4acbba72416445e2c44..95a98352f00c38b8c6d86ffb7c9d69d7b6bfcd21 100644 (file)
@@ -1858,9 +1858,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (run-hooks 'nnmail-post-get-new-mail-hook))))
 
 (defun nnmail-expired-article-p (group time force &optional inhibit)
-  "Say whether an article that is TIME old in GROUP should be expired."
+  "Say whether an article that is TIME old in GROUP should be expired.
+If TIME is nil, then return the cutoff time for oldness instead."
   (if force
-      t
+      (if (null time)
+         (current-time)
+       t)
     (let ((days (or (and nnmail-expiry-wait-function
                         (funcall nnmail-expiry-wait-function group))
                    nnmail-expiry-wait)))
@@ -1871,14 +1874,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
             nil)
            ((eq days 'immediate)
             ;; We expire all articles on sight.
-            t)
+            (if (null time)
+                (current-time)
+              t))
            ((equal time '(0 0))
            ;; This is an ange-ftp group, and we don't have any dates.
             nil)
            ((numberp days)
             (setq days (days-to-time days))
             ;; Compare the time with the current time.
-            (ignore-errors (time-less-p days (time-since time))))))))
+            (if (null time)
+                (time-subtract (current-time) days)
+              (ignore-errors (time-less-p days (time-since time)))))))))
 
 (declare-function gnus-group-mark-article-read "gnus-group" (group article))
 
index 11cdfd768c3b5893247f967cd96acad98bbdcc92..d05485b32f319cbcbdc41a664b42a2238337ec9e 100644 (file)
@@ -942,22 +942,23 @@ Unless no-active is non-nil, update the active file too."
       (when (file-exists-p nov)
        (funcall nnmail-delete-file-function nov))
       (dolist (file files)
-       (unless (file-directory-p (setq file (concat dir (cdr file))))
-         (erase-buffer)
-         (nnheader-insert-file-contents file)
-         (narrow-to-region
-          (goto-char (point-min))
-          (progn
-            (re-search-forward "\n\r?\n" nil t)
-            (setq chars (- (point-max) (point)))
-            (max (point-min) (1- (point)))))
-         (unless (zerop (buffer-size))
-           (goto-char (point-min))
-           (setq headers (nnml-parse-head chars (car file)))
-           (with-current-buffer nov-buffer
-             (goto-char (point-max))
-             (nnheader-insert-nov headers)))
-         (widen)))
+       (let ((path (concat dir (cdr file))))
+         (unless (file-directory-p path)
+           (erase-buffer)
+           (nnheader-insert-file-contents path)
+           (narrow-to-region
+            (goto-char (point-min))
+            (progn
+              (re-search-forward "\n\r?\n" nil t)
+              (setq chars (- (point-max) (point)))
+              (max (point-min) (1- (point)))))
+           (unless (zerop (buffer-size))
+             (goto-char (point-min))
+             (setq headers (nnml-parse-head chars (car file)))
+             (with-current-buffer nov-buffer
+               (goto-char (point-max))
+               (nnheader-insert-nov headers)))
+           (widen))))
       (with-current-buffer nov-buffer
        (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
        (kill-buffer (current-buffer))))))