From 9a4eaff63fd45d9226baa4d953280c15f594c693 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Wed, 22 Sep 2010 19:56:07 +0200 Subject: [PATCH] Allow nnimap to just delete 'junk messages when splitting. --- lisp/ChangeLog | 6 ++++++ lisp/nnimap.el | 32 +++++++++++++++++++++----------- lisp/nnmail.el | 24 ++++++++++++++---------- 3 files changed, 41 insertions(+), 21 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4743ebe6d..b64e13820 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2010-09-22 Lars Magne Ingebrigtsen + * nnimap.el (nnimap-split-incoming-mail): Delete 'junk. + (nnimap-request-list): Nix out group in the correct buffer. + + * nnmail.el (nnmail-split-incoming): Take an optional junk-func + parameter, and propagate this downwards. + * nnimap.el (nnimap-request-list): Set the current nnimap group to nil, since EXAMINE changes it on the server. diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 904c0fec3..f325b0fd4 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -589,6 +589,7 @@ not done by default on servers that doesn't support that command.") (equal group nnimap-inbox) nnimap-inbox nnimap-split-methods) + (message "nnimap %s splitting mail..." server) (nnimap-split-incoming-mail))) (defun nnimap-marks-to-flags (marks) @@ -665,8 +666,8 @@ not done by default on servers that doesn't support that command.") (nnimap-get-groups))) sequences responses) (when groups - (setf (nnimap-group nnimap-object) nil) (with-current-buffer (nnimap-buffer) + (setf (nnimap-group nnimap-object) nil) (dolist (group groups) (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) group) @@ -1086,32 +1087,38 @@ not done by default on servers that doesn't support that command.") (nnmail-split-incoming (current-buffer) #'nnimap-save-mail-spec nil nil - #'nnimap-dummy-active-number) + #'nnimap-dummy-active-number + #'nnimap-save-mail-spec) (when nnimap-incoming-split-list (let ((specs (nnimap-make-split-specs nnimap-incoming-split-list)) - sequences) + sequences junk-articles) ;; Create any groups that doesn't already exist on the ;; server first. (dolist (spec specs) - (unless (member (car spec) groups) + (when (and (not (member (car spec) groups)) + (not (eq (car spec) 'junk))) (nnimap-command "CREATE %S" (utf7-encode (car spec) t)))) ;; Then copy over all the messages. (erase-buffer) (dolist (spec specs) (let ((group (car spec)) (ranges (cdr spec))) - (push (list (nnimap-send-command "UID COPY %s %S" - (nnimap-article-ranges ranges) - (utf7-encode group t)) - ranges) - sequences))) + (if (eq group 'junk) + (setq junk-articles ranges) + (push (list (nnimap-send-command + "UID COPY %s %S" + (nnimap-article-ranges ranges) + (utf7-encode group t)) + ranges) + sequences)))) ;; Wait for the last COPY response... (when sequences (nnimap-wait-for-response (caar sequences)) ;; And then mark the successful copy actions as deleted, ;; and possibly expunge them. (nnimap-mark-and-expunge-incoming - (nnimap-parse-copied-articles sequences))))))))) + (nnimap-parse-copied-articles sequences)) + (nnimap-mark-and-expunge-incoming junk-articles)))))))) (defun nnimap-mark-and-expunge-incoming (range) (when range @@ -1191,7 +1198,10 @@ not done by default on servers that doesn't support that command.") (if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t)) (error "Invalid nnimap mail") (setq article (string-to-number (match-string 1)))) - (push (list article group-art) + (push (list article + (if (eq group-art 'junk) + (list (cons 'junk 1)) + group-art)) nnimap-incoming-split-list))) (provide 'nnimap) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 95a98352f..731d85b53 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -963,7 +963,7 @@ If SOURCE is a directory spec, try to return the group name component." (goto-char end))) count)) -(defun nnmail-process-mmdf-mail-format (func artnum-func) +(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func) (let ((delim "^\^A\^A\^A\^A$") (case-fold-search t) (count 0) @@ -1011,7 +1011,7 @@ If SOURCE is a directory spec, try to return the group name component." (narrow-to-region start (point)) (goto-char (point-min)) (incf count) - (nnmail-check-duplication message-id func artnum-func) + (nnmail-check-duplication message-id func artnum-func junk-func) (setq end (point-max)))) (goto-char end) (forward-line 2))) @@ -1056,7 +1056,7 @@ If SOURCE is a directory spec, try to return the group name component." "Non-nil means group names are not encoded.") (defun nnmail-split-incoming (incoming func &optional exit-func - group artnum-func) + group artnum-func junk-func) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail. INCOMING can also be a buffer object. In that case, the mail @@ -1087,7 +1087,8 @@ will be copied over from that buffer." (looking-at "BABYL OPTIONS:")) (nnmail-process-babyl-mail-format func artnum-func)) ((looking-at "\^A\^A\^A\^A") - (nnmail-process-mmdf-mail-format func artnum-func)) + (nnmail-process-mmdf-mail-format + func artnum-func junk-func)) ((looking-at "Return-Path:") (nnmail-process-maildir-mail-format func artnum-func)) (t @@ -1096,7 +1097,7 @@ will be copied over from that buffer." (funcall exit-func)) (kill-buffer (current-buffer)))))) -(defun nnmail-article-group (func &optional trace) +(defun nnmail-article-group (func &optional trace junk-func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." (let ((methods (or nnmail-split-methods '(("bogus" "")))) @@ -1163,9 +1164,10 @@ FUNC will be called with the group name to determine the article number." ;; The article may be "cross-posted" to `junk'. What ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... - (let (elem) - (while (setq elem (car (memq 'junk split))) - (setq split (delq elem split)))) + (when (and (memq 'junk split) + junk-func) + (funcall junk-func 'junk)) + (setq split (delq 'junk split)) (when split (setq group-art (mapcar @@ -1714,7 +1716,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (message-narrow-to-head) (message-fetch-field header)))) -(defun nnmail-check-duplication (message-id func artnum-func) +(defun nnmail-check-duplication (message-id func artnum-func + &optional junk-func) (run-hooks 'nnmail-prepare-incoming-message-hook) ;; If this is a duplicate message, then we do not save it. (let* ((duplication (nnmail-cache-id-exists-p message-id)) @@ -1739,7 +1742,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (cond ((not duplication) (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func)))) + (nreverse (nnmail-article-group + artnum-func nil junk-func)))) (nnmail-cache-insert message-id (caar group-art))) ((eq action 'delete) (setq group-art nil)) -- 2.25.1