diff options
| author | Bill Wohler | 2011-12-27 15:59:35 -0800 |
|---|---|---|
| committer | Bill Wohler | 2011-12-27 15:59:35 -0800 |
| commit | 41b97610273b18036ae8496659d09bb69a14faea (patch) | |
| tree | 4b330bf50e7b529bfa15b58033304ddacf3662ae | |
| parent | cda804cfccd10dce1fbb3ae33cc029b6f368b8a9 (diff) | |
| download | emacs-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/ChangeLog | 36 | ||||
| -rw-r--r-- | lisp/mh-e/mh-e.el | 56 | ||||
| -rw-r--r-- | lisp/mh-e/mh-folder.el | 118 | ||||
| -rw-r--r-- | lisp/mh-e/mh-junk.el | 112 | ||||
| -rw-r--r-- | lisp/mh-e/mh-scan.el | 50 | ||||
| -rw-r--r-- | lisp/mh-e/mh-search.el | 29 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-12-27 Bill Wohler <wohler@newt.com> | 37 | 2011-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. | ||
| 235 | This 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. |
| 292 | These operations include narrowing or threading.") | 297 | These operations include narrowing or threading.") |
| 293 | 298 | ||
| 299 | (defvar mh-whitelist nil | ||
| 300 | "List of messages to use to train the junk filter. | ||
| 301 | This 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 | |||
| 2231 | If a message is in any sequence (except \"Previous-Sequence:\" | ||
| 2232 | and \"cur\") when it is whitelisted, then it will still be in | ||
| 2233 | those sequences in the destination folder. If this behavior is | ||
| 2234 | not 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 | ||
| 3129 | Variables that are useful in this hook include `mh-delete-list' | 3150 | Variables that are useful in this hook include `mh-delete-list', |
| 3130 | and `mh-refile-list' which can be used to see which changes will | 3151 | `mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be |
| 3131 | be made to the current folder, `mh-current-folder'." | 3152 | used 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 | ||
| 714 | If you've marked messages to be deleted or refiled and you want | 722 | If you've marked messages to be refiled, deleted, blacklisted, or |
| 715 | to go ahead and delete or refile the messages, use this command. | 723 | whitelisted and you want to go ahead and perform these operations |
| 716 | Many MH-E commands that may affect the numbering of the | 724 | on these messages, use this command. Many MH-E commands that may |
| 717 | messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder]) | 725 | affect the numbering of the messages (such as |
| 718 | will 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 |
| 719 | either run this command for you or undo the pending refiles and | 727 | to perform these operations first and then either run this |
| 720 | deletes. | 728 | command for you or undo the pending operations. |
| 721 | 729 | ||
| 722 | This function runs `mh-before-commands-processed-hook' before the | 730 | This function runs `mh-before-commands-processed-hook' before the |
| 723 | commands are processed and `mh-after-commands-processed-hook' | 731 | commands 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. |
| 1947 | If MSG is nil then act on the message at point" | 2015 | If 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. | ||
| 61 | If MESSAGE is nil then the message at point is blacklisted. | ||
| 62 | The hook `mh-blacklisted-msg-hook' is called after you mark a message | ||
| 63 | for 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. | ||
| 102 | This command trains the spam program in use (see the option | ||
| 103 | `mh-junk-program') with the content of RANGE and then handles the | ||
| 104 | message(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. | |||
| 85 | Check the documentation of `mh-interactive-range' to see how | 122 | Check the documentation of `mh-interactive-range' to see how |
| 86 | RANGE is read in interactive use." | 123 | RANGE 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. | ||
| 131 | If MESSAGE is nil then the message at point is whitelisted. The | ||
| 132 | hook `mh-whitelist-msg-hook' is called after you mark a message | ||
| 133 | for 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 | |||
| 159 | This command reclassifies the RANGE as ham if it were incorrectly | ||
| 160 | classified 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 | |||
| 111 | not correct, the body fragment will not be highlighted with the | 111 | not correct, the body fragment will not be highlighted with the |
| 112 | face `mh-folder-body'.") | 112 | face `mh-folder-body'.") |
| 113 | 113 | ||
| 114 | (defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B" | ||
| 115 | "This regular expression matches blacklisted (spam) messages. | ||
| 116 | |||
| 117 | It must match from the beginning of the line. Note that the | ||
| 118 | default setting of `mh-folder-font-lock-keywords' expects this | ||
| 119 | expression to contain at least one parenthesized expression which | ||
| 120 | matches the message number as in the default of | ||
| 121 | |||
| 122 | \"^\\\\( *[0-9]+\\\\)B\". | ||
| 123 | |||
| 124 | This expression includes the leading space within parenthesis | ||
| 125 | since it looks better to highlight it as well. The highlighting | ||
| 126 | is done with the face `mh-folder-blacklisted'. This regular | ||
| 127 | expression should be correct as it is needed by non-fontification | ||
| 128 | functions. 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 | |||
| 155 | expression should be correct as it is needed by non-fontification | 171 | expression should be correct as it is needed by non-fontification |
| 156 | functions. See also `mh-note-deleted'.") | 172 | functions. 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 | ||
| 161 | It must match from the beginning of the line. Note that the | 177 | 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 | |||
| 163 | expression to contain at least one parenthesized expression which | 179 | expression to contain at least one parenthesized expression which |
| 164 | matches the message number as in the default of | 180 | matches the message number as in the default of |
| 165 | 181 | ||
| 166 | \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". | 182 | \"^\\\\( *[0-9]+\\\\)[^^DBW0-9]\". |
| 167 | 183 | ||
| 168 | This expression includes the leading space within the parenthesis | 184 | This expression includes the leading space within the parenthesis |
| 169 | since it looks better to highlight it as well. The highlighting | 185 | since it looks better to highlight it as well. The highlighting |
| @@ -277,6 +293,22 @@ non-fontification functions.") | |||
| 277 | This is used to eliminate error messages that are occasionally | 293 | This is used to eliminate error messages that are occasionally |
| 278 | produced by \"inc\".") | 294 | produced by \"inc\".") |
| 279 | 295 | ||
| 296 | (defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W" | ||
| 297 | "This regular expression matches whitelisted (non-spam) messages. | ||
| 298 | |||
| 299 | It must match from the beginning of the line. Note that the | ||
| 300 | default setting of `mh-folder-font-lock-keywords' expects this | ||
| 301 | expression to contain at least one parenthesized expression which | ||
| 302 | matches the message number as in the default of | ||
| 303 | |||
| 304 | \"^\\\\( *[0-9]+\\\\)W\". | ||
| 305 | |||
| 306 | This expression includes the leading space within parenthesis | ||
| 307 | since it looks better to highlight it as well. The highlighting | ||
| 308 | is done with the face `mh-folder-whitelisted'. This regular | ||
| 309 | expression should be correct as it is needed by non-fontification | ||
| 310 | functions. 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 | ||
| 297 | This column will have one of the values: \" \", \"D\", \"^\", \"+\", where | 329 | This 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. | ||
| 402 | See 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. |
| 368 | See also `mh-scan-cur-msg-number-regexp'.") | 406 | See also `mh-scan-cur-msg-number-regexp'.") |
| @@ -396,6 +434,10 @@ See also `mh-scan-refiled-msg-regexp'.") | |||
| 396 | Messages in the \"search\" sequence are marked by this character as | 434 | Messages in the \"search\" sequence are marked by this character as |
| 397 | well.") | 435 | well.") |
| 398 | 436 | ||
| 437 | (defvar mh-note-whitelisted ?W | ||
| 438 | "Messages that have been whitelisted are marked by this character. | ||
| 439 | See 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. |
| 1453 | The copies in the searched folder are then deleted/refiled to get | 1453 | The copies in the searched folder are then deleted, refiled, |
| 1454 | the desired result. Before deleting the messages we make sure | 1454 | blacklisted and whitelisted to get the desired result. Before |
| 1455 | that the message being deleted is identical to the one that the | 1455 | processing the messages we make sure that the message is |
| 1456 | user has marked in the index buffer." | 1456 | identical to the one that the user has marked in the index |
| 1457 | buffer." | ||
| 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 | ||