Mercurial > emacs
changeset 110465:b7b7e970d807
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 21 Sep 2010 23:13:46 +0000 |
| parents | 27917ce150c1 |
| children | cc5ae72924f3 |
| files | 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 |
| diffstat | 10 files changed, 295 insertions(+), 129 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/gnus.texi Tue Sep 21 23:18:08 2010 +0200 +++ b/doc/misc/gnus.texi Tue Sep 21 23:13:46 2010 +0000 @@ -18384,7 +18384,7 @@ @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
--- a/lisp/gnus/ChangeLog Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/ChangeLog Tue Sep 21 23:13:46 2010 +0000 @@ -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.
--- a/lisp/gnus/gnus-group.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/gnus-group.el Tue Sep 21 23:13:46 2010 +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,21 +3166,17 @@ '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."
--- a/lisp/gnus/gnus-int.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/gnus-int.el Tue Sep 21 23:13:46 2010 +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."
--- a/lisp/gnus/gnus-start.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/gnus-start.el Tue Sep 21 23:13:46 2010 +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))
--- a/lisp/gnus/gnus-sum.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Tue Sep 21 23:13:46 2010 +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
--- a/lisp/gnus/gnus.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/gnus.el Tue Sep 21 23:13:46 2010 +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) "")
--- a/lisp/gnus/nnimap.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/nnimap.el Tue Sep 21 23:13:46 2010 +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)
--- a/lisp/gnus/nnmail.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/nnmail.el Tue Sep 21 23:13:46 2010 +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))
--- a/lisp/gnus/nnml.el Tue Sep 21 23:18:08 2010 +0200 +++ b/lisp/gnus/nnml.el Tue Sep 21 23:13:46 2010 +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))))))