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.

6 files changed, 343 insertions, 58 deletions

diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 7ace28f292..989e998194 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,39 @@
+2011-12-27  Ted Phelps  <[email protected]>
+	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  <[email protected]>
 
 	* 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 284473df47..edd98f3058 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-folder-mode-map>\\[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-letter-mode-map>\\[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-letter-mode-map>\\[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-letter-mode-map>\\[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 40febd641d..878e3be3d1 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\\<mh-folder-mode-map>.
+  "Perform outstanding operations\\<mh-folder-mode-map>.
 
-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 897f7518b1..9f265ddaef 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 8a3e1632e2..9d6aec9c2e 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 c06bc6649a..911ba1240d 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)))