[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r101527: Merge changes made in Gnus t
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r101527: Merge changes made in Gnus trunk. |
|
Date: |
Tue, 21 Sep 2010 23:13:46 +0000 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 101527
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-09-21 23:13:46 +0000
message:
Merge changes made in Gnus trunk.
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.
modified:
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
=== modified file 'doc/misc/gnus.texi'
--- a/doc/misc/gnus.texi 2010-09-20 10:16:02 +0000
+++ b/doc/misc/gnus.texi 2010-09-21 23:13:46 +0000
@@ -18384,7 +18384,7 @@
@cindex expunge
@cindex manual expunging
@kindex G x (Group)
address@hidden gnus-group-nnimap-expunge
address@hidden 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
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2010-09-21 11:48:40 +0000
+++ b/lisp/gnus/ChangeLog 2010-09-21 23:13:46 +0000
@@ -1,3 +1,57 @@
+2010-09-21 Adam Sjøgren <address@hidden>
+
+ * gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
+
+2010-09-21 Lars Magne Ingebrigtsen <address@hidden>
+
+ * 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 <address@hidden>
* gnus-html.el (gnus-html-image-cache-ttl): Add new variable.
=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el 2010-09-20 00:36:54 +0000
+++ b/lisp/gnus/gnus-group.el 2010-09-21 23:13:46 +0000
@@ -509,7 +509,10 @@
(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 @@
"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,22 +3166,18 @@
'summary 'group)))
(error "Couldn't enter %s" dir))))
-(autoload 'nnimap-expunge "nnimap")
+(defun gnus-group-expunge-group (group)
+ "Expunge deleted articles in current nnimap GROUP."
+ (interactive (list (gnus-group-group-name)))
+ (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-expunge (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))))
-
(defun gnus-group-nnimap-edit-acl (group)
"Edit the Access Control List of current nnimap GROUP."
(interactive (list (gnus-group-group-name)))
=== modified file 'lisp/gnus/gnus-int.el'
--- a/lisp/gnus/gnus-int.el 2010-09-20 00:36:54 +0000
+++ b/lisp/gnus/gnus-int.el 2010-09-21 23:13:46 +0000
@@ -275,8 +275,10 @@
(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 @@
(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."
=== modified file 'lisp/gnus/gnus-start.el'
--- a/lisp/gnus/gnus-start.el 2010-09-20 00:36:54 +0000
+++ b/lisp/gnus/gnus-start.el 2010-09-21 23:13:46 +0000
@@ -705,6 +705,7 @@
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 @@
(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))
=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el 2010-09-20 01:57:46 +0000
+++ b/lisp/gnus/gnus-sum.el 2010-09-21 23:13:46 +0000
@@ -5850,6 +5850,10 @@
(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 @@
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 @@
(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
=== modified file 'lisp/gnus/gnus.el'
--- a/lisp/gnus/gnus.el 2010-09-20 00:36:54 +0000
+++ b/lisp/gnus/gnus.el 2010-09-21 23:13:46 +0000
@@ -2682,6 +2682,7 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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) "")
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2010-09-20 23:08:33 +0000
+++ b/lisp/gnus/nnimap.el 2010-09-21 23:13:46 +0000
@@ -37,6 +37,7 @@
(require 'gnus)
(require 'nnoo)
(require 'netrc)
+(require 'parse-time)
(nnoo-declare nnimap)
@@ -77,6 +78,8 @@
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 @@
(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 @@
(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 @@
(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)
+ (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)
+ (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)
- (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
- (nnimap-delete-article article)
- result))))))))
+ 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 @@
(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 @@
(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)
=== modified file 'lisp/gnus/nnmail.el'
--- a/lisp/gnus/nnmail.el 2010-09-18 10:02:19 +0000
+++ b/lisp/gnus/nnmail.el 2010-09-21 23:13:46 +0000
@@ -1858,9 +1858,12 @@
(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 @@
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))
=== modified file 'lisp/gnus/nnml.el'
--- a/lisp/gnus/nnml.el 2010-09-19 09:16:28 +0000
+++ b/lisp/gnus/nnml.el 2010-09-21 23:13:46 +0000
@@ -942,22 +942,23 @@
(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))))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r101527: Merge changes made in Gnus trunk.,
Katsumi Yamaoka <=