aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2011-12-27 15:59:35 -0800
committerBill Wohler2011-12-27 15:59:35 -0800
commit41b97610273b18036ae8496659d09bb69a14faea (patch)
tree4b330bf50e7b529bfa15b58033304ddacf3662ae
parentcda804cfccd10dce1fbb3ae33cc029b6f368b8a9 (diff)
downloademacs-41b97610273b18036ae8496659d09bb69a14faea.tar.gz
emacs-41b97610273b18036ae8496659d09bb69a14faea.zip
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.
-rw-r--r--lisp/mh-e/ChangeLog36
-rw-r--r--lisp/mh-e/mh-e.el56
-rw-r--r--lisp/mh-e/mh-folder.el118
-rw-r--r--lisp/mh-e/mh-junk.el112
-rw-r--r--lisp/mh-e/mh-scan.el50
-rw-r--r--lisp/mh-e/mh-search.el29
6 files changed, 343 insertions, 58 deletions
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 @@
12011-12-27 Ted Phelps <phelps@gnusto.com>
2 Postpone junk processing (closes SF #2945712). Patch submitted by
3 Ted Phelps and refined by Bill Wohler.
4
5 * mh-e.el (mh-blacklist, mh-whitelist): New variables.
6 (mh-whitelist-preserves-sequences-flag): New option.
7 (mh-before-commands-processed-hook): Update documentation.
8 (mh-blacklist-msg-hook, mh-whitelist-msg-hook): New hooks.
9 (mh-folder-blacklisted, mh-folder-whitelisted): New faces.
10 * mh-folder.el (mh-folder-message-menu): Add "Junk" to "Undo."
11 (mh-folder-font-lock-keywords): Add regexps for blacklisted and
12 whitelisted messages.
13 (mh-folder-mode): Add mh-blacklist and mh-whitelist variables.
14 (mh-execute-commands): Update documentation.
15 (mh-undo, mh-outstanding-commands-p, mh-process-commands)
16 (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle
17 blacklisted and whitelisted messages.
18 * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put
19 messages in blacklist and whitelist respectively for latter
20 processing.
21 (mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to
22 support previous functions.
23 (mh-junk-blacklist-disposition): New function.
24 (mh-junk-process-blacklist, mh-junk-process-whitelist): New
25 functions that perform the blacklisting and whitelisting
26 respectively that used to be performed by mh-junk-blacklist and
27 mh-junk-whitelist.
28 * mh-scan.el (mh-scan-blacklisted-msg-regexp)
29 (mh-scan-whitelisted-msg-regexp): New scan line regexps.
30 (mh-scan-good-msg-regexp): Add B and W characters to regexp.
31 (mh-scan-cmd-note-width): Update documentation.
32 (mh-note-blacklisted, mh-note-whitelisted): New scan line
33 characters.
34 * mh-search.el (mh-index-execute-commands): Handle blacklisted and
35 whitelisted messages.
36
12011-12-27 Bill Wohler <wohler@newt.com> 372011-12-27 Bill Wohler <wohler@newt.com>
2 38
3 * mh-e.el (mh-invisible-header-fields-internal): Add 39 * 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.")
230(defvar mh-arrow-marker nil 230(defvar mh-arrow-marker nil
231 "Marker for arrow display in fringe.") 231 "Marker for arrow display in fringe.")
232 232
233(defvar mh-blacklist nil
234 "List of messages to use to train the junk filter.
235This variable can be used by
236`mh-before-commands-processed-hook'.")
237
233(defvar mh-colors-available-flag nil 238(defvar mh-colors-available-flag nil
234 "Non-nil means colors are available.") 239 "Non-nil means colors are available.")
235 240
@@ -291,6 +296,11 @@ Elements have the form (SEQUENCE . MESSAGES).")
291 "Stack of operations that change the folder view. 296 "Stack of operations that change the folder view.
292These operations include narrowing or threading.") 297These operations include narrowing or threading.")
293 298
299(defvar mh-whitelist nil
300 "List of messages to use to train the junk filter.
301This variable can be used by
302`mh-before-commands-processed-hook'.")
303
294;; MH-Show Locals (alphabetical) 304;; MH-Show Locals (alphabetical)
295 305
296(defvar mh-globals-hash (make-hash-table) 306(defvar mh-globals-hash (make-hash-table)
@@ -2215,6 +2225,17 @@ commands."
2215 :group 'mh-sequences 2225 :group 'mh-sequences
2216 :package-version '(MH-E . "7.0")) 2226 :package-version '(MH-E . "7.0"))
2217 2227
2228(defcustom-mh mh-whitelist-preserves-sequences-flag t
2229 "*Non-nil means that sequences are preserved when messages are whitelisted.
2230
2231If a message is in any sequence (except \"Previous-Sequence:\"
2232and \"cur\") when it is whitelisted, then it will still be in
2233those sequences in the destination folder. If this behavior is
2234not desired, then turn off this option."
2235 :type 'boolean
2236 :group 'mh-sequences
2237 :package-version '(MH-E . "8.4"))
2238
2218;;; Reading Your Mail (:group 'mh-show) 2239;;; Reading Your Mail (:group 'mh-show)
2219 2240
2220(defcustom-mh mh-bury-show-buffer-flag t 2241(defcustom-mh mh-bury-show-buffer-flag t
@@ -3126,9 +3147,10 @@ annotated messages with `mh-annotate-list'."
3126(defcustom-mh mh-before-commands-processed-hook nil 3147(defcustom-mh mh-before-commands-processed-hook nil
3127 "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests. 3148 "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests.
3128 3149
3129Variables that are useful in this hook include `mh-delete-list' 3150Variables that are useful in this hook include `mh-delete-list',
3130and `mh-refile-list' which can be used to see which changes will 3151`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be
3131be made to the current folder, `mh-current-folder'." 3152used to see which changes will be made to the current folder,
3153`mh-current-folder'."
3132 :type 'hook 3154 :type 'hook
3133 :group 'mh-hooks 3155 :group 'mh-hooks
3134 :group 'mh-folder 3156 :group 'mh-folder
@@ -3158,6 +3180,13 @@ before sending, add the `ispell-message' function."
3158 :group 'mh-letter 3180 :group 'mh-letter
3159 :package-version '(MH-E . "6.0")) 3181 :package-version '(MH-E . "6.0"))
3160 3182
3183(defcustom-mh mh-blacklist-msg-hook nil
3184 "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blacklist] after marking each message for blacklisting."
3185 :type 'hook
3186 :group 'mh-hooks
3187 :group 'mh-show
3188 :package-version '(MH-E . "8.4"))
3189
3161(defcustom-mh mh-delete-msg-hook nil 3190(defcustom-mh mh-delete-msg-hook nil
3162 "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion. 3191 "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion.
3163 3192
@@ -3321,6 +3350,13 @@ sequence."
3321 :group 'mh-sequences 3350 :group 'mh-sequences
3322 :package-version '(MH-E . "6.0")) 3351 :package-version '(MH-E . "6.0"))
3323 3352
3353(defcustom-mh mh-whitelist-msg-hook nil
3354 "Hook run by \\<mh-letter-mode-map>\\[mh-junk-whitelist] after marking each message for whitelisting."
3355 :type 'hook
3356 :group 'mh-hooks
3357 :group 'mh-show
3358 :package-version '(MH-E . "8.4"))
3359
3324 3360
3325 3361
3326;;; Faces (:group 'mh-faces + group where faces described) 3362;;; Faces (:group 'mh-faces + group where faces described)
@@ -3539,6 +3575,13 @@ specified colors."
3539 :group 'mh-folder 3575 :group 'mh-folder
3540 :package-version '(MH-E . "8.0")) 3576 :package-version '(MH-E . "8.0"))
3541 3577
3578(defface-mh mh-folder-blacklisted
3579 (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
3580 "Blacklisted message face."
3581 :group 'mh-faces
3582 :group 'mh-folder
3583 :package-version '(MH-E . "8.4"))
3584
3542(defface-mh mh-folder-body 3585(defface-mh mh-folder-body
3543 (mh-face-data 'mh-folder-msg-number 3586 (mh-face-data 'mh-folder-msg-number
3544 '((((class color)) 3587 '((((class color))
@@ -3628,6 +3671,13 @@ format `mh-scan-format-nmh' and the regular expression
3628 :group 'mh-folder 3671 :group 'mh-folder
3629 :package-version '(MH-E . "8.0")) 3672 :package-version '(MH-E . "8.0"))
3630 3673
3674(defface-mh mh-folder-whitelisted
3675 (mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled))))
3676 "Whitelisted message face."
3677 :group 'mh-faces
3678 :group 'mh-folder
3679 :package-version '(MH-E . "8.4"))
3680
3631(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) 3681(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field)
3632 "Editable header field value face in draft buffers." 3682 "Editable header field value face in draft buffers."
3633 :group 'mh-faces 3683 :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.")
162 ["Go to Last Message" mh-last-msg t] 162 ["Go to Last Message" mh-last-msg t]
163 ["Go to Message by Number..." mh-goto-msg t] 163 ["Go to Message by Number..." mh-goto-msg t]
164 ["Modify Message" mh-modify t] 164 ["Modify Message" mh-modify t]
165 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
166 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)] 165 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
167 ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)] 166 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
167 ["Undo Delete/Refile/Junk" mh-undo (mh-outstanding-commands-p)]
168 ["Execute Delete/Refile" mh-execute-commands 168 ["Execute Delete/Refile" mh-execute-commands
169 (mh-outstanding-commands-p)] 169 (mh-outstanding-commands-p)]
170 "--" 170 "--"
@@ -405,12 +405,18 @@ See `mh-set-help'.")
405 ;; Folders when displaying index buffer 405 ;; Folders when displaying index buffer
406 (list "^\\+.*" 406 (list "^\\+.*"
407 '(0 'mh-search-folder)) 407 '(0 'mh-search-folder))
408 ;; Marked for deletion
409 (list (concat mh-scan-deleted-msg-regexp ".*")
410 '(0 'mh-folder-deleted))
411 ;; Marked for refile 408 ;; Marked for refile
412 (list (concat mh-scan-refiled-msg-regexp ".*") 409 (list (concat mh-scan-refiled-msg-regexp ".*")
413 '(0 'mh-folder-refiled)) 410 '(0 'mh-folder-refiled))
411 ;; Marked for deletion
412 (list (concat mh-scan-deleted-msg-regexp ".*")
413 '(0 'mh-folder-deleted))
414 ;; Marked for blacklisting
415 (list (concat mh-scan-blacklisted-msg-regexp ".*")
416 '(0 'mh-folder-blacklisted))
417 ;; Marked for whitelisting
418 (list (concat mh-scan-whitelisted-msg-regexp ".*")
419 '(0 'mh-folder-whitelisted))
414 ;; After subject 420 ;; After subject
415 (list mh-scan-body-regexp 421 (list mh-scan-body-regexp
416 '(1 'mh-folder-body nil t)) 422 '(1 'mh-folder-body nil t))
@@ -614,8 +620,10 @@ perform the operation on all messages in that region.
614 'overlay-arrow-position nil ; Allow for simultaneous display in 620 'overlay-arrow-position nil ; Allow for simultaneous display in
615 'overlay-arrow-string ">" ; different MH-E buffers. 621 'overlay-arrow-string ">" ; different MH-E buffers.
616 'mh-showing-mode nil ; Show message also? 622 'mh-showing-mode nil ; Show message also?
617 'mh-delete-list nil ; List of msgs nums to delete
618 'mh-refile-list nil ; List of folder names in mh-seq-list 623 'mh-refile-list nil ; List of folder names in mh-seq-list
624 'mh-delete-list nil ; List of msgs nums to delete
625 'mh-blacklist nil ; List of messages to process as spam
626 'mh-whitelist nil ; List of messages to process as ham
619 'mh-seq-list nil ; Alist of (seq . msgs) nums 627 'mh-seq-list nil ; Alist of (seq . msgs) nums
620 'mh-seen-list nil ; List of displayed messages 628 'mh-seen-list nil ; List of displayed messages
621 'mh-next-direction 'forward ; Direction to move to next message 629 'mh-next-direction 'forward ; Direction to move to next message
@@ -709,15 +717,15 @@ RANGE is read in interactive use."
709 717
710;;;###mh-autoload 718;;;###mh-autoload
711(defun mh-execute-commands () 719(defun mh-execute-commands ()
712 "Process outstanding delete and refile requests\\<mh-folder-mode-map>. 720 "Perform outstanding operations\\<mh-folder-mode-map>.
713 721
714If you've marked messages to be deleted or refiled and you want 722If you've marked messages to be refiled, deleted, blacklisted, or
715to go ahead and delete or refile the messages, use this command. 723whitelisted and you want to go ahead and perform these operations
716Many MH-E commands that may affect the numbering of the 724on these messages, use this command. Many MH-E commands that may
717messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder]) 725affect the numbering of the messages (such as
718will ask if you want to process refiles or deletes first and then 726\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want
719either run this command for you or undo the pending refiles and 727to perform these operations first and then either run this
720deletes. 728command for you or undo the pending operations.
721 729
722This function runs `mh-before-commands-processed-hook' before the 730This function runs `mh-before-commands-processed-hook' before the
723commands are processed and `mh-after-commands-processed-hook' 731commands are processed and `mh-after-commands-processed-hook'
@@ -1181,14 +1189,18 @@ RANGE is read in interactive use."
1181 (cond ((numberp range) 1189 (cond ((numberp range)
1182 (let ((original-position (point))) 1190 (let ((original-position (point)))
1183 (beginning-of-line) 1191 (beginning-of-line)
1184 (while (not (or (looking-at mh-scan-deleted-msg-regexp) 1192 (while (not (or (looking-at mh-scan-refiled-msg-regexp)
1185 (looking-at mh-scan-refiled-msg-regexp) 1193 (looking-at mh-scan-deleted-msg-regexp)
1194 (looking-at mh-scan-blacklisted-msg-regexp)
1195 (looking-at mh-scan-whitelisted-msg-regexp)
1186 (and (eq mh-next-direction 'forward) (bobp)) 1196 (and (eq mh-next-direction 'forward) (bobp))
1187 (and (eq mh-next-direction 'backward) 1197 (and (eq mh-next-direction 'backward)
1188 (save-excursion (forward-line) (eobp))))) 1198 (save-excursion (forward-line) (eobp)))))
1189 (forward-line (if (eq mh-next-direction 'forward) -1 1))) 1199 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1190 (if (or (looking-at mh-scan-deleted-msg-regexp) 1200 (if (or (looking-at mh-scan-refiled-msg-regexp)
1191 (looking-at mh-scan-refiled-msg-regexp)) 1201 (looking-at mh-scan-deleted-msg-regexp)
1202 (looking-at mh-scan-blacklisted-msg-regexp)
1203 (looking-at mh-scan-whitelisted-msg-regexp))
1192 (progn 1204 (progn
1193 (mh-undo-msg (mh-get-msg-num t)) 1205 (mh-undo-msg (mh-get-msg-num t))
1194 (mh-maybe-show)) 1206 (mh-maybe-show))
@@ -1520,7 +1532,7 @@ is updated."
1520 (save-excursion 1532 (save-excursion
1521 (when (eq major-mode 'mh-show-mode) 1533 (when (eq major-mode 'mh-show-mode)
1522 (set-buffer mh-show-folder-buffer)) 1534 (set-buffer mh-show-folder-buffer))
1523 (or mh-delete-list mh-refile-list))) 1535 (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist)))
1524 1536
1525;;;###mh-autoload 1537;;;###mh-autoload
1526(defun mh-set-folder-modified-p (flag) 1538(defun mh-set-folder-modified-p (flag)
@@ -1544,10 +1556,15 @@ after the commands are processed."
1544 1556
1545 (let ((redraw-needed-flag mh-index-data) 1557 (let ((redraw-needed-flag mh-index-data)
1546 (folders-changed (list mh-current-folder)) 1558 (folders-changed (list mh-current-folder))
1547 (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag 1559 (seq-map (and
1548 (mh-create-sequence-map mh-seq-list))) 1560 (or (and mh-refile-list mh-refile-preserves-sequences-flag)
1561 (and mh-whitelist
1562 mh-whitelist-preserves-sequences-flag))
1563 (mh-create-sequence-map mh-seq-list)))
1549 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag 1564 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
1550 (make-hash-table)))) 1565 (make-hash-table)))
1566 (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag
1567 (make-hash-table))))
1551 ;; Remove invalid scan lines if we are in an index folder and then remove 1568 ;; Remove invalid scan lines if we are in an index folder and then remove
1552 ;; the real messages 1569 ;; the real messages
1553 (when mh-index-data 1570 (when mh-index-data
@@ -1594,6 +1611,49 @@ after the commands are processed."
1594 (mh-delete-scan-msgs mh-delete-list) 1611 (mh-delete-scan-msgs mh-delete-list)
1595 (setq mh-delete-list nil))) 1612 (setq mh-delete-list nil)))
1596 1613
1614 ;; Blacklist messages.
1615 (when mh-blacklist
1616 (let ((msg-list (mh-coalesce-msg-list mh-blacklist))
1617 (dest (mh-junk-blacklist-disposition)))
1618 (mh-junk-process-blacklist mh-blacklist)
1619 ;; TODO I wonder why mh-exec-cmd is used instead of the following:
1620 ;; (mh-refile-a-msg nil (intern dest))
1621 ;; (mh-delete-a-msg nil)))
1622 (if (null dest)
1623 (apply 'mh-exec-cmd "rmm" folder msg-list)
1624 (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list)
1625 (push dest folders-changed))
1626 (setq redraw-needed-flag t)
1627 (mh-delete-scan-msgs mh-blacklist)
1628 (setq mh-blacklist nil)))
1629
1630 ;; Whitelist messages.
1631 (when mh-whitelist
1632 (let ((msg-list (mh-coalesce-msg-list mh-whitelist))
1633 (last (car (mh-translate-range mh-inbox "last"))))
1634 (mh-junk-process-whitelist mh-whitelist)
1635 (apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list)
1636 (push mh-inbox folders-changed)
1637 (setq redraw-needed-flag t)
1638 (mh-delete-scan-msgs mh-whitelist)
1639 (when mh-whitelist-preserves-sequences-flag
1640 (clrhash white-map)
1641 (loop for i from (1+ (or last 0))
1642 for msg in (sort (copy-sequence mh-whitelist) #'<)
1643 do (loop for seq-name in (gethash msg seq-map)
1644 do (push i (gethash seq-name white-map))))
1645 (maphash
1646 #'(lambda (seq msgs)
1647 ;; Can't be run in background, since the current
1648 ;; folder is changed by mark this could lead to a
1649 ;; race condition with the next refile/whitelist.
1650 (apply #'mh-exec-cmd "mark"
1651 "-sequence" (symbol-name seq) mh-inbox
1652 "-add" (mapcar #'(lambda(x) (format "%s" x))
1653 (mh-coalesce-msg-list msgs))))
1654 white-map))
1655 (setq mh-whitelist nil)))
1656
1597 ;; Don't need to remove sequences since delete and refile do so. 1657 ;; Don't need to remove sequences since delete and refile do so.
1598 ;; Mark cur message 1658 ;; Mark cur message
1599 (if (> (buffer-size) 0) 1659 (if (> (buffer-size) 0)
@@ -1904,6 +1964,10 @@ once when he kept statistics on his mail usage."
1904 (setq message (mh-get-msg-num t))) 1964 (setq message (mh-get-msg-num t)))
1905 (if (looking-at mh-scan-refiled-msg-regexp) 1965 (if (looking-at mh-scan-refiled-msg-regexp)
1906 (error "Message %d is refiled; undo refile before deleting" message)) 1966 (error "Message %d is refiled; undo refile before deleting" message))
1967 (if (looking-at mh-scan-blacklisted-msg-regexp)
1968 (error "Message %d is blacklisted; undo before deleting" message))
1969 (if (looking-at mh-scan-whitelisted-msg-regexp)
1970 (error "Message %d is whitelisted; undo before deleting" message))
1907 (if (looking-at mh-scan-deleted-msg-regexp) 1971 (if (looking-at mh-scan-deleted-msg-regexp)
1908 nil 1972 nil
1909 (mh-set-folder-modified-p t) 1973 (mh-set-folder-modified-p t)
@@ -1925,6 +1989,10 @@ be refiled."
1925 (setq message (mh-get-msg-num t))) 1989 (setq message (mh-get-msg-num t)))
1926 (cond ((looking-at mh-scan-deleted-msg-regexp) 1990 (cond ((looking-at mh-scan-deleted-msg-regexp)
1927 (error "Message %d is deleted; undo delete before moving" message)) 1991 (error "Message %d is deleted; undo delete before moving" message))
1992 ((looking-at mh-scan-blacklisted-msg-regexp)
1993 (error "Message %d is blacklisted; undo before moving" message))
1994 ((looking-at mh-scan-whitelisted-msg-regexp)
1995 (error "Message %d is whitelisted; undo before moving" message))
1928 ((looking-at mh-scan-refiled-msg-regexp) 1996 ((looking-at mh-scan-refiled-msg-regexp)
1929 (if (y-or-n-p 1997 (if (y-or-n-p
1930 (format "Message %d already refiled; copy to %s as well? " 1998 (format "Message %d already refiled; copy to %s as well? "
@@ -1943,7 +2011,7 @@ be refiled."
1943 (run-hooks 'mh-refile-msg-hook))))) 2011 (run-hooks 'mh-refile-msg-hook)))))
1944 2012
1945(defun mh-undo-msg (msg) 2013(defun mh-undo-msg (msg)
1946 "Undo the deletion or refile of one MSG. 2014 "Undo the deletion, refile, black- or whitelisting of one MSG.
1947If MSG is nil then act on the message at point" 2015If MSG is nil then act on the message at point"
1948 (save-excursion 2016 (save-excursion
1949 (if (numberp msg) 2017 (if (numberp msg)
@@ -1952,6 +2020,10 @@ If MSG is nil then act on the message at point"
1952 (setq msg (mh-get-msg-num t))) 2020 (setq msg (mh-get-msg-num t)))
1953 (cond ((memq msg mh-delete-list) 2021 (cond ((memq msg mh-delete-list)
1954 (setq mh-delete-list (delq msg mh-delete-list))) 2022 (setq mh-delete-list (delq msg mh-delete-list)))
2023 ((memq msg mh-blacklist)
2024 (setq mh-blacklist (delq msg mh-blacklist)))
2025 ((memq msg mh-whitelist)
2026 (setq mh-whitelist (delq msg mh-whitelist)))
1955 (t 2027 (t
1956 (dolist (folder-msg-list mh-refile-list) 2028 (dolist (folder-msg-list mh-refile-list)
1957 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) 2029 (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:
52 - `mh-bogofilter-blacklist' 52 - `mh-bogofilter-blacklist'
53 - `mh-spamprobe-blacklist'" 53 - `mh-spamprobe-blacklist'"
54 (interactive (list (mh-interactive-range "Blacklist"))) 54 (interactive (list (mh-interactive-range "Blacklist")))
55 (mh-iterate-on-range () range (mh-blacklist-a-msg nil))
56 (if (looking-at mh-scan-blacklisted-msg-regexp)
57 (mh-next-msg)))
58
59(defun mh-blacklist-a-msg (message)
60 "Blacklist MESSAGE.
61If MESSAGE is nil then the message at point is blacklisted.
62The hook `mh-blacklisted-msg-hook' is called after you mark a message
63for blacklisting."
64 (save-excursion
65 (if (numberp message)
66 (mh-goto-msg message nil t)
67 (beginning-of-line)
68 (setq message (mh-get-msg-num t)))
69 (cond ((looking-at mh-scan-refiled-msg-regexp)
70 (error "Message %d is refiled; undo refile before blacklisting"
71 message))
72 ((looking-at mh-scan-deleted-msg-regexp)
73 (error "Message %d is deleted; undo delete before blacklisting"
74 message))
75 ((looking-at mh-scan-whitelisted-msg-regexp)
76 (error "Message %d is whitelisted; undo before blacklisting"
77 message))
78 ((looking-at mh-scan-blacklisted-msg-regexp) nil)
79 (t
80 (mh-set-folder-modified-p t)
81 (setq mh-blacklist (cons message mh-blacklist))
82 (if (not (memq message mh-seen-list))
83 (setq mh-seen-list (cons message mh-seen-list)))
84 (mh-notate nil mh-note-blacklisted mh-cmd-note)
85 (run-hooks 'mh-blacklist-msg-hook)))))
86
87;;;###mh-autoload
88(defun mh-junk-blacklist-disposition ()
89 "Determines the fate of the selected spam."
90 (cond ((null mh-junk-disposition) nil)
91 ((equal mh-junk-disposition "") "+")
92 ((eq (aref mh-junk-disposition 0) ?+)
93 mh-junk-disposition)
94 ((eq (aref mh-junk-disposition 0) ?@)
95 (concat mh-current-folder "/"
96 (substring mh-junk-disposition 1)))
97 (t (concat "+" mh-junk-disposition))))
98
99;;;###mh-autoload
100(defun mh-junk-process-blacklist (range)
101 "Blacklist RANGE as spam.
102This command trains the spam program in use (see the option
103`mh-junk-program') with the content of RANGE and then handles the
104message(s) as specified by the option `mh-junk-disposition'."
55 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) 105 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
56 (unless blacklist-func 106 (unless blacklist-func
57 (error "Customize `mh-junk-program' appropriately")) 107 (error "Customize `mh-junk-program' appropriately"))
58 (let ((dest (cond ((null mh-junk-disposition) nil) 108 (mh-iterate-on-range msg range
59 ((equal mh-junk-disposition "") "+") 109 (message "Blacklisting message %d..." msg)
60 ((eq (aref mh-junk-disposition 0) ?+) 110 (funcall (symbol-function blacklist-func) msg)
61 mh-junk-disposition) 111 (message "Blacklisting message %d...done" msg))
62 ((eq (aref mh-junk-disposition 0) ?@) 112 (mh-next-msg)))
63 (concat mh-current-folder "/"
64 (substring mh-junk-disposition 1)))
65 (t (concat "+" mh-junk-disposition)))))
66 (mh-iterate-on-range msg range
67 (message "Blacklisting message %d..." msg)
68 (funcall (symbol-function blacklist-func) msg)
69 (message "Blacklisting message %d...done" msg)
70 (if (not (memq msg mh-seen-list))
71 (setq mh-seen-list (cons msg mh-seen-list)))
72 (if dest
73 (mh-refile-a-msg nil (intern dest))
74 (mh-delete-a-msg nil)))
75 (mh-next-msg))))
76 113
77;;;###mh-autoload 114;;;###mh-autoload
78(defun mh-junk-whitelist (range) 115(defun mh-junk-whitelist (range)
@@ -85,14 +122,49 @@ refiles the message into the \"+inbox\" folder.
85Check the documentation of `mh-interactive-range' to see how 122Check the documentation of `mh-interactive-range' to see how
86RANGE is read in interactive use." 123RANGE is read in interactive use."
87 (interactive (list (mh-interactive-range "Whitelist"))) 124 (interactive (list (mh-interactive-range "Whitelist")))
125 (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil))
126 (if (looking-at mh-scan-whitelisted-msg-regexp)
127 (mh-next-msg)))
128
129(defun mh-junk-whitelist-a-msg (message)
130 "Whitelist MESSAGE.
131If MESSAGE is nil then the message at point is whitelisted. The
132hook `mh-whitelist-msg-hook' is called after you mark a message
133for whitelisting."
134 (save-excursion
135 (if (numberp message)
136 (mh-goto-msg message nil t)
137 (beginning-of-line)
138 (setq message (mh-get-msg-num t)))
139 (cond ((looking-at mh-scan-refiled-msg-regexp)
140 (error "Message %d is refiled; undo refile before whitelisting"
141 message))
142 ((looking-at mh-scan-deleted-msg-regexp)
143 (error "Message %d is deleted; undo delete before whitelisting"
144 message))
145 ((looking-at mh-scan-blacklisted-msg-regexp)
146 (error "Message %d is blacklisted; undo before whitelisting"
147 message))
148 ((looking-at mh-scan-whitelisted-msg-regexp) nil)
149 (t
150 (mh-set-folder-modified-p t)
151 (setq mh-whitelist (cons message mh-whitelist))
152 (mh-notate nil mh-note-whitelisted mh-cmd-note)
153 (run-hooks 'mh-whitelist-msg-hook)))))
154
155;;;###mh-autoload
156(defun mh-junk-process-whitelist (range)
157 "Whitelist RANGE as ham.
158
159This command reclassifies the RANGE as ham if it were incorrectly
160classified as spam (see the option `mh-junk-program')."
88 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) 161 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
89 (unless whitelist-func 162 (unless whitelist-func
90 (error "Customize `mh-junk-program' appropriately")) 163 (error "Customize `mh-junk-program' appropriately"))
91 (mh-iterate-on-range msg range 164 (mh-iterate-on-range msg range
92 (message "Whitelisting message %d..." msg) 165 (message "Whitelisting message %d..." msg)
93 (funcall (symbol-function whitelist-func) msg) 166 (funcall (symbol-function whitelist-func) msg)
94 (message "Whitelisting message %d...done" msg) 167 (message "Whitelisting message %d...done" msg))
95 (mh-refile-a-msg nil (intern mh-inbox)))
96 (mh-next-msg))) 168 (mh-next-msg)))
97 169
98 170
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
111not correct, the body fragment will not be highlighted with the 111not correct, the body fragment will not be highlighted with the
112face `mh-folder-body'.") 112face `mh-folder-body'.")
113 113
114(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B"
115 "This regular expression matches blacklisted (spam) messages.
116
117It must match from the beginning of the line. Note that the
118default setting of `mh-folder-font-lock-keywords' expects this
119expression to contain at least one parenthesized expression which
120matches the message number as in the default of
121
122 \"^\\\\( *[0-9]+\\\\)B\".
123
124This expression includes the leading space within parenthesis
125since it looks better to highlight it as well. The highlighting
126is done with the face `mh-folder-blacklisted'. This regular
127expression should be correct as it is needed by non-fontification
128functions. See also `mh-note-blacklisted'.")
129
114(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" 130(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
115 "This regular expression matches the current message. 131 "This regular expression matches the current message.
116 132
@@ -155,7 +171,7 @@ is done with the face `mh-folder-deleted'. This regular
155expression should be correct as it is needed by non-fontification 171expression should be correct as it is needed by non-fontification
156functions. See also `mh-note-deleted'.") 172functions. See also `mh-note-deleted'.")
157 173
158(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" 174(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^^DBW0-9]"
159 "This regular expression matches \"good\" messages. 175 "This regular expression matches \"good\" messages.
160 176
161It must match from the beginning of the line. Note that the 177It 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
163expression to contain at least one parenthesized expression which 179expression to contain at least one parenthesized expression which
164matches the message number as in the default of 180matches the message number as in the default of
165 181
166 \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". 182 \"^\\\\( *[0-9]+\\\\)[^^DBW0-9]\".
167 183
168This expression includes the leading space within the parenthesis 184This expression includes the leading space within the parenthesis
169since it looks better to highlight it as well. The highlighting 185since it looks better to highlight it as well. The highlighting
@@ -277,6 +293,22 @@ non-fontification functions.")
277This is used to eliminate error messages that are occasionally 293This is used to eliminate error messages that are occasionally
278produced by \"inc\".") 294produced by \"inc\".")
279 295
296(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W"
297 "This regular expression matches whitelisted (non-spam) messages.
298
299It must match from the beginning of the line. Note that the
300default setting of `mh-folder-font-lock-keywords' expects this
301expression to contain at least one parenthesized expression which
302matches the message number as in the default of
303
304 \"^\\\\( *[0-9]+\\\\)W\".
305
306This expression includes the leading space within parenthesis
307since it looks better to highlight it as well. The highlighting
308is done with the face `mh-folder-whitelisted'. This regular
309expression should be correct as it is needed by non-fontification
310functions. See also `mh-note-whitelisted'.")
311
280 312
281 313
282;;; Widths, Offsets and Columns 314;;; Widths, Offsets and Columns
@@ -294,11 +326,13 @@ Note that columns in Emacs start with 0.")
294(defvar mh-scan-cmd-note-width 1 326(defvar mh-scan-cmd-note-width 1
295 "Number of columns consumed by the cmd-note field in `mh-scan-format'. 327 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
296 328
297This column will have one of the values: \" \", \"D\", \"^\", \"+\", where 329This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"W\", \"+\", where
298 330
299 \" \" is the default value, 331 \" \" is the default value,
332 \"^\" is the `mh-note-refiled' character,
300 \"D\" is the `mh-note-deleted' character, 333 \"D\" is the `mh-note-deleted' character,
301 \"^\" is the `mh-note-refiled' character, and 334 \"B\" is the `mh-note-blacklisted' character,
335 \"W\" is the `mh-note-whitelisted' character, and
302 \"+\" is the `mh-note-cur' character.") 336 \"+\" is the `mh-note-cur' character.")
303 337
304(defvar mh-scan-destination-width 1 338(defvar mh-scan-destination-width 1
@@ -363,6 +397,10 @@ This column will only ever have spaces in it.")
363 397
364;; Alphabetical. 398;; Alphabetical.
365 399
400(defvar mh-note-blacklisted ?B
401 "Messages that have been blacklisted are marked by this character.
402See also `mh-scan-blacklisted-msg-regexp'.")
403
366(defvar mh-note-cur ?+ 404(defvar mh-note-cur ?+
367 "The current message (in MH, not in MH-E) is marked by this character. 405 "The current message (in MH, not in MH-E) is marked by this character.
368See also `mh-scan-cur-msg-number-regexp'.") 406See also `mh-scan-cur-msg-number-regexp'.")
@@ -396,6 +434,10 @@ See also `mh-scan-refiled-msg-regexp'.")
396Messages in the \"search\" sequence are marked by this character as 434Messages in the \"search\" sequence are marked by this character as
397well.") 435well.")
398 436
437(defvar mh-note-whitelisted ?W
438 "Messages that have been whitelisted are marked by this character.
439See also `mh-scan-whitelisted-msg-regexp'.")
440
399 441
400 442
401;;; Utilities 443;;; 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."
1449 1449
1450;;;###mh-autoload 1450;;;###mh-autoload
1451(defun mh-index-execute-commands () 1451(defun mh-index-execute-commands ()
1452 "Delete/refile the actual messages. 1452 "Perform the outstanding operations on the actual messages.
1453The copies in the searched folder are then deleted/refiled to get 1453The copies in the searched folder are then deleted, refiled,
1454the desired result. Before deleting the messages we make sure 1454blacklisted and whitelisted to get the desired result. Before
1455that the message being deleted is identical to the one that the 1455processing the messages we make sure that the message is
1456user has marked in the index buffer." 1456identical to the one that the user has marked in the index
1457buffer."
1457 (save-excursion 1458 (save-excursion
1458 (let ((folders ()) 1459 (let ((folders ())
1459 (mh-speed-flists-inhibit-flag t)) 1460 (mh-speed-flists-inhibit-flag t))
@@ -1466,9 +1467,13 @@ user has marked in the index buffer."
1466 ;; Otherwise delete the messages in the source buffer... 1467 ;; Otherwise delete the messages in the source buffer...
1467 (with-current-buffer folder 1468 (with-current-buffer folder
1468 (let ((old-refile-list mh-refile-list) 1469 (let ((old-refile-list mh-refile-list)
1469 (old-delete-list mh-delete-list)) 1470 (old-delete-list mh-delete-list)
1471 (old-blacklist mh-blacklist)
1472 (old-whitelist mh-whitelist))
1470 (setq mh-refile-list nil 1473 (setq mh-refile-list nil
1471 mh-delete-list msgs) 1474 mh-delete-list msgs
1475 mh-blacklist nil
1476 mh-whitelist nil)
1472 (unwind-protect (mh-execute-commands) 1477 (unwind-protect (mh-execute-commands)
1473 (setq mh-refile-list 1478 (setq mh-refile-list
1474 (mapcar (lambda (x) 1479 (mapcar (lambda (x)
@@ -1478,13 +1483,21 @@ user has marked in the index buffer."
1478 old-refile-list) 1483 old-refile-list)
1479 mh-delete-list 1484 mh-delete-list
1480 (loop for x in old-delete-list 1485 (loop for x in old-delete-list
1486 unless (memq x msgs) collect x)
1487 mh-blacklist
1488 (loop for x in old-blacklist
1489 unless (memq x msgs) collect x)
1490 mh-whitelist
1491 (loop for x in old-whitelist
1481 unless (memq x msgs) collect x)) 1492 unless (memq x msgs) collect x))
1482 (mh-set-folder-modified-p (mh-outstanding-commands-p)) 1493 (mh-set-folder-modified-p (mh-outstanding-commands-p))
1483 (when (mh-outstanding-commands-p) 1494 (when (mh-outstanding-commands-p)
1484 (mh-notate-deleted-and-refiled))))))) 1495 (mh-notate-deleted-and-refiled)))))))
1485 (mh-index-matching-source-msgs (append (loop for x in mh-refile-list 1496 (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
1486 append (cdr x)) 1497 append (cdr x))
1487 mh-delete-list) 1498 mh-delete-list
1499 mh-blacklist
1500 mh-whitelist)
1488 t)) 1501 t))
1489 folders))) 1502 folders)))
1490 1503