From: Bill Wohler Date: Tue, 27 Dec 2011 23:59:35 +0000 (-0800) Subject: Postpone junk processing (closes SF #2945712). Patch submitted by Ted X-Git-Tag: emacs-24.3.90~173^2~25 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=41b97610273b18036ae8496659d09bb69a14faea;p=emacs.git Postpone junk processing (closes SF #2945712). Patch submitted by Ted Phelps and refined by Bill Wohler. * mh-e.el (mh-blacklist, mh-whitelist): New variables. (mh-whitelist-preserves-sequences-flag): New option. (mh-before-commands-processed-hook): Update documentation. (mh-blacklist-msg-hook, mh-whitelist-msg-hook): New hooks. (mh-folder-blacklisted, mh-folder-whitelisted): New faces. * mh-folder.el (mh-folder-message-menu): Add "Junk" to "Undo." (mh-folder-font-lock-keywords): Add regexps for blacklisted and whitelisted messages. (mh-folder-mode): Add mh-blacklist and mh-whitelist variables. (mh-execute-commands): Update documentation. (mh-undo, mh-outstanding-commands-p, mh-process-commands) (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle blacklisted and whitelisted messages. * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put messages in blacklist and whitelist respectively for latter processing. (mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to support previous functions. (mh-junk-blacklist-disposition): New function. (mh-junk-process-blacklist, mh-junk-process-whitelist): New functions that perform the blacklisting and whitelisting respectively that used to be performed by mh-junk-blacklist and mh-junk-whitelist. * mh-scan.el (mh-scan-blacklisted-msg-regexp) (mh-scan-whitelisted-msg-regexp): New scan line regexps. (mh-scan-good-msg-regexp): Add B and W characters to regexp. (mh-scan-cmd-note-width): Update documentation. (mh-note-blacklisted, mh-note-whitelisted): New scan line characters. * mh-search.el (mh-index-execute-commands): Handle blacklisted and whitelisted messages. --- diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 7ace28f2920..989e9981940 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,39 @@ +2011-12-27 Ted Phelps + Postpone junk processing (closes SF #2945712). Patch submitted by + Ted Phelps and refined by Bill Wohler. + + * mh-e.el (mh-blacklist, mh-whitelist): New variables. + (mh-whitelist-preserves-sequences-flag): New option. + (mh-before-commands-processed-hook): Update documentation. + (mh-blacklist-msg-hook, mh-whitelist-msg-hook): New hooks. + (mh-folder-blacklisted, mh-folder-whitelisted): New faces. + * mh-folder.el (mh-folder-message-menu): Add "Junk" to "Undo." + (mh-folder-font-lock-keywords): Add regexps for blacklisted and + whitelisted messages. + (mh-folder-mode): Add mh-blacklist and mh-whitelist variables. + (mh-execute-commands): Update documentation. + (mh-undo, mh-outstanding-commands-p, mh-process-commands) + (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle + blacklisted and whitelisted messages. + * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put + messages in blacklist and whitelist respectively for latter + processing. + (mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to + support previous functions. + (mh-junk-blacklist-disposition): New function. + (mh-junk-process-blacklist, mh-junk-process-whitelist): New + functions that perform the blacklisting and whitelisting + respectively that used to be performed by mh-junk-blacklist and + mh-junk-whitelist. + * mh-scan.el (mh-scan-blacklisted-msg-regexp) + (mh-scan-whitelisted-msg-regexp): New scan line regexps. + (mh-scan-good-msg-regexp): Add B and W characters to regexp. + (mh-scan-cmd-note-width): Update documentation. + (mh-note-blacklisted, mh-note-whitelisted): New scan line + characters. + * mh-search.el (mh-index-execute-commands): Handle blacklisted and + whitelisted messages. + 2011-12-27 Bill Wohler * mh-e.el (mh-invisible-header-fields-internal): Add diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 284473df474..edd98f30582 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -230,6 +230,11 @@ User's mail folder directory.") (defvar mh-arrow-marker nil "Marker for arrow display in fringe.") +(defvar mh-blacklist nil + "List of messages to use to train the junk filter. +This variable can be used by +`mh-before-commands-processed-hook'.") + (defvar mh-colors-available-flag nil "Non-nil means colors are available.") @@ -291,6 +296,11 @@ Elements have the form (SEQUENCE . MESSAGES).") "Stack of operations that change the folder view. These operations include narrowing or threading.") +(defvar mh-whitelist nil + "List of messages to use to train the junk filter. +This variable can be used by +`mh-before-commands-processed-hook'.") + ;; MH-Show Locals (alphabetical) (defvar mh-globals-hash (make-hash-table) @@ -2215,6 +2225,17 @@ commands." :group 'mh-sequences :package-version '(MH-E . "7.0")) +(defcustom-mh mh-whitelist-preserves-sequences-flag t + "*Non-nil means that sequences are preserved when messages are whitelisted. + +If a message is in any sequence (except \"Previous-Sequence:\" +and \"cur\") when it is whitelisted, then it will still be in +those sequences in the destination folder. If this behavior is +not desired, then turn off this option." + :type 'boolean + :group 'mh-sequences + :package-version '(MH-E . "8.4")) + ;;; Reading Your Mail (:group 'mh-show) (defcustom-mh mh-bury-show-buffer-flag t @@ -3126,9 +3147,10 @@ annotated messages with `mh-annotate-list'." (defcustom-mh mh-before-commands-processed-hook nil "Hook run by \\\\[mh-execute-commands] before performing outstanding refile and delete requests. -Variables that are useful in this hook include `mh-delete-list' -and `mh-refile-list' which can be used to see which changes will -be made to the current folder, `mh-current-folder'." +Variables that are useful in this hook include `mh-delete-list', +`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be +used to see which changes will be made to the current folder, +`mh-current-folder'." :type 'hook :group 'mh-hooks :group 'mh-folder @@ -3158,6 +3180,13 @@ before sending, add the `ispell-message' function." :group 'mh-letter :package-version '(MH-E . "6.0")) +(defcustom-mh mh-blacklist-msg-hook nil + "Hook run by \\\\[mh-junk-blacklist] after marking each message for blacklisting." + :type 'hook + :group 'mh-hooks + :group 'mh-show + :package-version '(MH-E . "8.4")) + (defcustom-mh mh-delete-msg-hook nil "Hook run by \\\\[mh-delete-msg] after marking each message for deletion. @@ -3321,6 +3350,13 @@ sequence." :group 'mh-sequences :package-version '(MH-E . "6.0")) +(defcustom-mh mh-whitelist-msg-hook nil + "Hook run by \\\\[mh-junk-whitelist] after marking each message for whitelisting." + :type 'hook + :group 'mh-hooks + :group 'mh-show + :package-version '(MH-E . "8.4")) + ;;; Faces (:group 'mh-faces + group where faces described) @@ -3539,6 +3575,13 @@ specified colors." :group 'mh-folder :package-version '(MH-E . "8.0")) +(defface-mh mh-folder-blacklisted + (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) + "Blacklisted message face." + :group 'mh-faces + :group 'mh-folder + :package-version '(MH-E . "8.4")) + (defface-mh mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) @@ -3628,6 +3671,13 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) +(defface-mh mh-folder-whitelisted + (mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled)))) + "Whitelisted message face." + :group 'mh-faces + :group 'mh-folder + :package-version '(MH-E . "8.4")) + (defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 40febd641de..878e3be3d1b 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -162,9 +162,9 @@ annotation.") ["Go to Last Message" mh-last-msg t] ["Go to Message by Number..." mh-goto-msg t] ["Modify Message" mh-modify t] - ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] ["Refile Message" mh-refile-msg (mh-get-msg-num nil)] - ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)] + ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] + ["Undo Delete/Refile/Junk" mh-undo (mh-outstanding-commands-p)] ["Execute Delete/Refile" mh-execute-commands (mh-outstanding-commands-p)] "--" @@ -405,12 +405,18 @@ See `mh-set-help'.") ;; Folders when displaying index buffer (list "^\\+.*" '(0 'mh-search-folder)) - ;; Marked for deletion - (list (concat mh-scan-deleted-msg-regexp ".*") - '(0 'mh-folder-deleted)) ;; Marked for refile (list (concat mh-scan-refiled-msg-regexp ".*") '(0 'mh-folder-refiled)) + ;; Marked for deletion + (list (concat mh-scan-deleted-msg-regexp ".*") + '(0 'mh-folder-deleted)) + ;; Marked for blacklisting + (list (concat mh-scan-blacklisted-msg-regexp ".*") + '(0 'mh-folder-blacklisted)) + ;; Marked for whitelisting + (list (concat mh-scan-whitelisted-msg-regexp ".*") + '(0 'mh-folder-whitelisted)) ;; After subject (list mh-scan-body-regexp '(1 'mh-folder-body nil t)) @@ -614,8 +620,10 @@ perform the operation on all messages in that region. 'overlay-arrow-position nil ; Allow for simultaneous display in 'overlay-arrow-string ">" ; different MH-E buffers. 'mh-showing-mode nil ; Show message also? - 'mh-delete-list nil ; List of msgs nums to delete 'mh-refile-list nil ; List of folder names in mh-seq-list + 'mh-delete-list nil ; List of msgs nums to delete + 'mh-blacklist nil ; List of messages to process as spam + 'mh-whitelist nil ; List of messages to process as ham 'mh-seq-list nil ; Alist of (seq . msgs) nums 'mh-seen-list nil ; List of displayed messages 'mh-next-direction 'forward ; Direction to move to next message @@ -709,15 +717,15 @@ RANGE is read in interactive use." ;;;###mh-autoload (defun mh-execute-commands () - "Process outstanding delete and refile requests\\. + "Perform outstanding operations\\. -If you've marked messages to be deleted or refiled and you want -to go ahead and delete or refile the messages, use this command. -Many MH-E commands that may affect the numbering of the -messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder]) -will ask if you want to process refiles or deletes first and then -either run this command for you or undo the pending refiles and -deletes. +If you've marked messages to be refiled, deleted, blacklisted, or +whitelisted and you want to go ahead and perform these operations +on these messages, use this command. Many MH-E commands that may +affect the numbering of the messages (such as +\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want +to perform these operations first and then either run this +command for you or undo the pending operations. This function runs `mh-before-commands-processed-hook' before the commands are processed and `mh-after-commands-processed-hook' @@ -1181,14 +1189,18 @@ RANGE is read in interactive use." (cond ((numberp range) (let ((original-position (point))) (beginning-of-line) - (while (not (or (looking-at mh-scan-deleted-msg-regexp) - (looking-at mh-scan-refiled-msg-regexp) + (while (not (or (looking-at mh-scan-refiled-msg-regexp) + (looking-at mh-scan-deleted-msg-regexp) + (looking-at mh-scan-blacklisted-msg-regexp) + (looking-at mh-scan-whitelisted-msg-regexp) (and (eq mh-next-direction 'forward) (bobp)) (and (eq mh-next-direction 'backward) (save-excursion (forward-line) (eobp))))) (forward-line (if (eq mh-next-direction 'forward) -1 1))) - (if (or (looking-at mh-scan-deleted-msg-regexp) - (looking-at mh-scan-refiled-msg-regexp)) + (if (or (looking-at mh-scan-refiled-msg-regexp) + (looking-at mh-scan-deleted-msg-regexp) + (looking-at mh-scan-blacklisted-msg-regexp) + (looking-at mh-scan-whitelisted-msg-regexp)) (progn (mh-undo-msg (mh-get-msg-num t)) (mh-maybe-show)) @@ -1520,7 +1532,7 @@ is updated." (save-excursion (when (eq major-mode 'mh-show-mode) (set-buffer mh-show-folder-buffer)) - (or mh-delete-list mh-refile-list))) + (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist))) ;;;###mh-autoload (defun mh-set-folder-modified-p (flag) @@ -1544,10 +1556,15 @@ after the commands are processed." (let ((redraw-needed-flag mh-index-data) (folders-changed (list mh-current-folder)) - (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag - (mh-create-sequence-map mh-seq-list))) + (seq-map (and + (or (and mh-refile-list mh-refile-preserves-sequences-flag) + (and mh-whitelist + mh-whitelist-preserves-sequences-flag)) + (mh-create-sequence-map mh-seq-list))) (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag - (make-hash-table)))) + (make-hash-table))) + (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag + (make-hash-table)))) ;; Remove invalid scan lines if we are in an index folder and then remove ;; the real messages (when mh-index-data @@ -1594,6 +1611,49 @@ after the commands are processed." (mh-delete-scan-msgs mh-delete-list) (setq mh-delete-list nil))) + ;; Blacklist messages. + (when mh-blacklist + (let ((msg-list (mh-coalesce-msg-list mh-blacklist)) + (dest (mh-junk-blacklist-disposition))) + (mh-junk-process-blacklist mh-blacklist) + ;; TODO I wonder why mh-exec-cmd is used instead of the following: + ;; (mh-refile-a-msg nil (intern dest)) + ;; (mh-delete-a-msg nil))) + (if (null dest) + (apply 'mh-exec-cmd "rmm" folder msg-list) + (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list) + (push dest folders-changed)) + (setq redraw-needed-flag t) + (mh-delete-scan-msgs mh-blacklist) + (setq mh-blacklist nil))) + + ;; Whitelist messages. + (when mh-whitelist + (let ((msg-list (mh-coalesce-msg-list mh-whitelist)) + (last (car (mh-translate-range mh-inbox "last")))) + (mh-junk-process-whitelist mh-whitelist) + (apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list) + (push mh-inbox folders-changed) + (setq redraw-needed-flag t) + (mh-delete-scan-msgs mh-whitelist) + (when mh-whitelist-preserves-sequences-flag + (clrhash white-map) + (loop for i from (1+ (or last 0)) + for msg in (sort (copy-sequence mh-whitelist) #'<) + do (loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name white-map)))) + (maphash + #'(lambda (seq msgs) + ;; Can't be run in background, since the current + ;; folder is changed by mark this could lead to a + ;; race condition with the next refile/whitelist. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) mh-inbox + "-add" (mapcar #'(lambda(x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + white-map)) + (setq mh-whitelist nil))) + ;; Don't need to remove sequences since delete and refile do so. ;; Mark cur message (if (> (buffer-size) 0) @@ -1904,6 +1964,10 @@ once when he kept statistics on his mail usage." (setq message (mh-get-msg-num t))) (if (looking-at mh-scan-refiled-msg-regexp) (error "Message %d is refiled; undo refile before deleting" message)) + (if (looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before deleting" message)) + (if (looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before deleting" message)) (if (looking-at mh-scan-deleted-msg-regexp) nil (mh-set-folder-modified-p t) @@ -1925,6 +1989,10 @@ be refiled." (setq message (mh-get-msg-num t))) (cond ((looking-at mh-scan-deleted-msg-regexp) (error "Message %d is deleted; undo delete before moving" message)) + ((looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before moving" message)) + ((looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before moving" message)) ((looking-at mh-scan-refiled-msg-regexp) (if (y-or-n-p (format "Message %d already refiled; copy to %s as well? " @@ -1943,7 +2011,7 @@ be refiled." (run-hooks 'mh-refile-msg-hook))))) (defun mh-undo-msg (msg) - "Undo the deletion or refile of one MSG. + "Undo the deletion, refile, black- or whitelisting of one MSG. If MSG is nil then act on the message at point" (save-excursion (if (numberp msg) @@ -1952,6 +2020,10 @@ If MSG is nil then act on the message at point" (setq msg (mh-get-msg-num t))) (cond ((memq msg mh-delete-list) (setq mh-delete-list (delq msg mh-delete-list))) + ((memq msg mh-blacklist) + (setq mh-blacklist (delq msg mh-blacklist))) + ((memq msg mh-whitelist) + (setq mh-whitelist (delq msg mh-whitelist))) (t (dolist (folder-msg-list mh-refile-list) (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 897f7518b1e..9f265ddaef7 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -52,27 +52,64 @@ program, see: - `mh-bogofilter-blacklist' - `mh-spamprobe-blacklist'" (interactive (list (mh-interactive-range "Blacklist"))) + (mh-iterate-on-range () range (mh-blacklist-a-msg nil)) + (if (looking-at mh-scan-blacklisted-msg-regexp) + (mh-next-msg))) + +(defun mh-blacklist-a-msg (message) + "Blacklist MESSAGE. +If MESSAGE is nil then the message at point is blacklisted. +The hook `mh-blacklisted-msg-hook' is called after you mark a message +for blacklisting." + (save-excursion + (if (numberp message) + (mh-goto-msg message nil t) + (beginning-of-line) + (setq message (mh-get-msg-num t))) + (cond ((looking-at mh-scan-refiled-msg-regexp) + (error "Message %d is refiled; undo refile before blacklisting" + message)) + ((looking-at mh-scan-deleted-msg-regexp) + (error "Message %d is deleted; undo delete before blacklisting" + message)) + ((looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before blacklisting" + message)) + ((looking-at mh-scan-blacklisted-msg-regexp) nil) + (t + (mh-set-folder-modified-p t) + (setq mh-blacklist (cons message mh-blacklist)) + (if (not (memq message mh-seen-list)) + (setq mh-seen-list (cons message mh-seen-list))) + (mh-notate nil mh-note-blacklisted mh-cmd-note) + (run-hooks 'mh-blacklist-msg-hook))))) + +;;;###mh-autoload +(defun mh-junk-blacklist-disposition () + "Determines the fate of the selected spam." + (cond ((null mh-junk-disposition) nil) + ((equal mh-junk-disposition "") "+") + ((eq (aref mh-junk-disposition 0) ?+) + mh-junk-disposition) + ((eq (aref mh-junk-disposition 0) ?@) + (concat mh-current-folder "/" + (substring mh-junk-disposition 1))) + (t (concat "+" mh-junk-disposition)))) + +;;;###mh-autoload +(defun mh-junk-process-blacklist (range) + "Blacklist RANGE as spam. +This command trains the spam program in use (see the option +`mh-junk-program') with the content of RANGE and then handles the +message(s) as specified by the option `mh-junk-disposition'." (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) (unless blacklist-func (error "Customize `mh-junk-program' appropriately")) - (let ((dest (cond ((null mh-junk-disposition) nil) - ((equal mh-junk-disposition "") "+") - ((eq (aref mh-junk-disposition 0) ?+) - mh-junk-disposition) - ((eq (aref mh-junk-disposition 0) ?@) - (concat mh-current-folder "/" - (substring mh-junk-disposition 1))) - (t (concat "+" mh-junk-disposition))))) - (mh-iterate-on-range msg range - (message "Blacklisting message %d..." msg) - (funcall (symbol-function blacklist-func) msg) - (message "Blacklisting message %d...done" msg) - (if (not (memq msg mh-seen-list)) - (setq mh-seen-list (cons msg mh-seen-list))) - (if dest - (mh-refile-a-msg nil (intern dest)) - (mh-delete-a-msg nil))) - (mh-next-msg)))) + (mh-iterate-on-range msg range + (message "Blacklisting message %d..." msg) + (funcall (symbol-function blacklist-func) msg) + (message "Blacklisting message %d...done" msg)) + (mh-next-msg))) ;;;###mh-autoload (defun mh-junk-whitelist (range) @@ -85,14 +122,49 @@ refiles the message into the \"+inbox\" folder. Check the documentation of `mh-interactive-range' to see how RANGE is read in interactive use." (interactive (list (mh-interactive-range "Whitelist"))) + (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil)) + (if (looking-at mh-scan-whitelisted-msg-regexp) + (mh-next-msg))) + +(defun mh-junk-whitelist-a-msg (message) + "Whitelist MESSAGE. +If MESSAGE is nil then the message at point is whitelisted. The +hook `mh-whitelist-msg-hook' is called after you mark a message +for whitelisting." + (save-excursion + (if (numberp message) + (mh-goto-msg message nil t) + (beginning-of-line) + (setq message (mh-get-msg-num t))) + (cond ((looking-at mh-scan-refiled-msg-regexp) + (error "Message %d is refiled; undo refile before whitelisting" + message)) + ((looking-at mh-scan-deleted-msg-regexp) + (error "Message %d is deleted; undo delete before whitelisting" + message)) + ((looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before whitelisting" + message)) + ((looking-at mh-scan-whitelisted-msg-regexp) nil) + (t + (mh-set-folder-modified-p t) + (setq mh-whitelist (cons message mh-whitelist)) + (mh-notate nil mh-note-whitelisted mh-cmd-note) + (run-hooks 'mh-whitelist-msg-hook))))) + +;;;###mh-autoload +(defun mh-junk-process-whitelist (range) + "Whitelist RANGE as ham. + +This command reclassifies the RANGE as ham if it were incorrectly +classified as spam (see the option `mh-junk-program')." (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) (unless whitelist-func (error "Customize `mh-junk-program' appropriately")) (mh-iterate-on-range msg range (message "Whitelisting message %d..." msg) (funcall (symbol-function whitelist-func) msg) - (message "Whitelisting message %d...done" msg) - (mh-refile-a-msg nil (intern mh-inbox))) + (message "Whitelisting message %d...done" msg)) (mh-next-msg))) diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 8a3e1632e2e..9d6aec9c2ed 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -111,6 +111,22 @@ expression which matches the body text as in the default of not correct, the body fragment will not be highlighted with the face `mh-folder-body'.") +(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B" + "This regular expression matches blacklisted (spam) messages. + +It must match from the beginning of the line. Note that the +default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which +matches the message number as in the default of + + \"^\\\\( *[0-9]+\\\\)B\". + +This expression includes the leading space within parenthesis +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-blacklisted'. This regular +expression should be correct as it is needed by non-fontification +functions. See also `mh-note-blacklisted'.") + (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" "This regular expression matches the current message. @@ -155,7 +171,7 @@ is done with the face `mh-folder-deleted'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-deleted'.") -(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" +(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^^DBW0-9]" "This regular expression matches \"good\" messages. It must match from the beginning of the line. Note that the @@ -163,7 +179,7 @@ default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of - \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". + \"^\\\\( *[0-9]+\\\\)[^^DBW0-9]\". This expression includes the leading space within the parenthesis since it looks better to highlight it as well. The highlighting @@ -277,6 +293,22 @@ non-fontification functions.") This is used to eliminate error messages that are occasionally produced by \"inc\".") +(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W" + "This regular expression matches whitelisted (non-spam) messages. + +It must match from the beginning of the line. Note that the +default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which +matches the message number as in the default of + + \"^\\\\( *[0-9]+\\\\)W\". + +This expression includes the leading space within parenthesis +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-whitelisted'. This regular +expression should be correct as it is needed by non-fontification +functions. See also `mh-note-whitelisted'.") + ;;; Widths, Offsets and Columns @@ -294,11 +326,13 @@ Note that columns in Emacs start with 0.") (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. -This column will have one of the values: \" \", \"D\", \"^\", \"+\", where +This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"W\", \"+\", where \" \" is the default value, + \"^\" is the `mh-note-refiled' character, \"D\" is the `mh-note-deleted' character, - \"^\" is the `mh-note-refiled' character, and + \"B\" is the `mh-note-blacklisted' character, + \"W\" is the `mh-note-whitelisted' character, and \"+\" is the `mh-note-cur' character.") (defvar mh-scan-destination-width 1 @@ -363,6 +397,10 @@ This column will only ever have spaces in it.") ;; Alphabetical. +(defvar mh-note-blacklisted ?B + "Messages that have been blacklisted are marked by this character. +See also `mh-scan-blacklisted-msg-regexp'.") + (defvar mh-note-cur ?+ "The current message (in MH, not in MH-E) is marked by this character. See also `mh-scan-cur-msg-number-regexp'.") @@ -396,6 +434,10 @@ See also `mh-scan-refiled-msg-regexp'.") Messages in the \"search\" sequence are marked by this character as well.") +(defvar mh-note-whitelisted ?W + "Messages that have been whitelisted are marked by this character. +See also `mh-scan-whitelisted-msg-regexp'.") + ;;; Utilities diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index c06bc6649a5..911ba1240df 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1449,11 +1449,12 @@ being the list of messages originally from that folder." ;;;###mh-autoload (defun mh-index-execute-commands () - "Delete/refile the actual messages. -The copies in the searched folder are then deleted/refiled to get -the desired result. Before deleting the messages we make sure -that the message being deleted is identical to the one that the -user has marked in the index buffer." + "Perform the outstanding operations on the actual messages. +The copies in the searched folder are then deleted, refiled, +blacklisted and whitelisted to get the desired result. Before +processing the messages we make sure that the message is +identical to the one that the user has marked in the index +buffer." (save-excursion (let ((folders ()) (mh-speed-flists-inhibit-flag t)) @@ -1466,9 +1467,13 @@ user has marked in the index buffer." ;; Otherwise delete the messages in the source buffer... (with-current-buffer folder (let ((old-refile-list mh-refile-list) - (old-delete-list mh-delete-list)) + (old-delete-list mh-delete-list) + (old-blacklist mh-blacklist) + (old-whitelist mh-whitelist)) (setq mh-refile-list nil - mh-delete-list msgs) + mh-delete-list msgs + mh-blacklist nil + mh-whitelist nil) (unwind-protect (mh-execute-commands) (setq mh-refile-list (mapcar (lambda (x) @@ -1478,13 +1483,21 @@ user has marked in the index buffer." old-refile-list) mh-delete-list (loop for x in old-delete-list + unless (memq x msgs) collect x) + mh-blacklist + (loop for x in old-blacklist + unless (memq x msgs) collect x) + mh-whitelist + (loop for x in old-whitelist unless (memq x msgs) collect x)) (mh-set-folder-modified-p (mh-outstanding-commands-p)) (when (mh-outstanding-commands-p) (mh-notate-deleted-and-refiled))))))) (mh-index-matching-source-msgs (append (loop for x in mh-refile-list append (cdr x)) - mh-delete-list) + mh-delete-list + mh-blacklist + mh-whitelist) t)) folders)))