mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-04 06:31:13 -08:00
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.
This commit is contained in:
Lars Magne Ingebrigtsen
Katsumi Yamaoka
parent
4ddea91b84
commit
0617bb00a4
10 changed files with 295 additions and 129 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) "")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue