summaryrefslogtreecommitdiff
path: root/lisp/mh-e
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mh-e')
-rw-r--r--lisp/mh-e/ChangeLog133
-rw-r--r--lisp/mh-e/mh-comp.el179
-rw-r--r--lisp/mh-e/mh-compat.el40
-rw-r--r--lisp/mh-e/mh-e.el128
-rw-r--r--lisp/mh-e/mh-folder.el127
-rw-r--r--lisp/mh-e/mh-junk.el112
-rw-r--r--lisp/mh-e/mh-letter.el130
-rw-r--r--lisp/mh-e/mh-mime.el125
-rw-r--r--lisp/mh-e/mh-scan.el50
-rw-r--r--lisp/mh-e/mh-search.el29
-rw-r--r--lisp/mh-e/mh-show.el16
-rw-r--r--lisp/mh-e/mh-thread.el27
12 files changed, 858 insertions, 238 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 6794ff8bbfb..8f81182b52d 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,136 @@
+2012-11-25 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.4.
+
+ * mh-e.el (Version, mh-version): Update for release 8.4.
+
+ * mh-comp.el (mh-regexp-in-field-syntax-table): Fix docstring.
+ (mh-edit-again): Format.
+ (mh-components-to-list): Fix docstring.
+ (mh-regexp-in-field-p): Remove unused variable `field'.
+
+ * mh-compat.el (mh-define-obsolete-variable-alias)
+ (mh-make-obsolete-variable): New macros to fix XEmacs compiler
+ warnings.
+
+ * mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable
+ macro.
+
+ * mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use
+ new mh-define-obsolete-variable-alias macro.
+
+ * mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and
+ flet elsewhere.
+
+ * mh-thread.el (mh-thread-set-tables): Replace flet with new alias
+ mh-cl-flet.
+
+ * mh-show.el (mh-gnus-article-highlight-citation):
+ Replace flet with new alias mh-cl-flet.
+
+ * mh-mime.el (mh-display-with-external-viewer, mh-mime-display)
+ (mh-press-button, mh-push-button, mh-display-emphasis): Replace
+ flet with new alias mh-cl-flet.
+
+ * mh-e.el (mh-invisible-header-fields-internal):
+ Remove trailing whitespace.
+
+2012-11-25 Jeffrey C Honig <jch@honig.net>
+
+ * mh-comp.el: (mh-edit-again): Use the components file to specify
+ default values for missing headers in the draft.
+ (mh-regexp-in-field-syntax-table, mh-fcc-syntax-table)
+ (mh-addr-syntax-table, mh-regexp-in-field-p): Use a syntax table
+ so we'll properly parse non-address fields.
+ (mh-components-to-list, mh-extract-header-field): New functions to
+ read components file.
+ (mh-find-components, mh-send-sub): Move code to locate components
+ file into a new function.
+ (mh-insert-auto-fields, mh-modify-header-field): New syntax for
+ calling mh-regexp-in-field-p (closes SF #1708292).
+
+ * mh-e.el (mh-invisible-header-fields-internal): Added: X-xsi.
+ (addresses SF #1916032).
+
+ * mh-folder.el (mh-inc-folder): Call mh-process-or-undo-commands
+ before running to insure we do not lose any pending changes.
+ (closes SF #2321115).
+
+2012-11-25 Ted Phelps <phelps@gnusto.com>
+
+ 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.
+
+2012-11-25 Jeffrey C Honig <jch@honig.net>
+
+ * mh-e.el (mh-invisible-header-fields-internal): Added:
+ Bounces-To:, Bounces_to:, X-ACL-Warn:, X-BFI:, X-BPS1:, X-BPS2:,
+ X-Campaign-Id:, X-Campaign:, X-Cloudmark-SP-, X-Destination-ID:,
+ X-detected-operating-system:, X-DocGen-Version:, X-EM-,
+ X-Email-Type-Id:, X-FB-SS:, X-FuHaFi:, X-MailFlowPolicy:,
+ X-mail_abuse-inquires, X-MailingID:, X-Match:,
+ X-MaxCode-Template:, X-ME-Bayesian:, X-Sendergroup:, X-SFDC-,
+ X-SMFBL:, X-SMHeaderMap:, X-VGI-OESCD:, X-VirtualServer:,
+ X-VirtualServerGroup:, X-XPT-XSL-Name:, X-Y-GMX-Trusted:,
+ X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-. Updated
+ the comment. (addresses SF #1916032).
+
+2012-11-25 Bill Wohler <wohler@newt.com>
+
+ * mh-e.el (mh-invisible-header-fields-internal): Add
+ X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress,
+ X-Bayes-Prob, X-Cam-, X-CanIt-Geo, X-Completed, X-Facebook,
+ X-Forwarded-, X-Generated-By, X-Headers-End, X-IEEE-UCE,
+ X-Jira-Fingerprint, X-Junkmail-, X-Launchpad-, X-MXL-Hash,
+ X-Notification-, X-Notifications, X-Oracle-Calendar. Replace
+ X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032).
+
+2012-11-25 Jeffrey C Honig <jch@honig.net>
+
+ * mh-letter.el (mh-yank-cur-msg): Replace usage of set-buffer with
+ with-current-buffer in mh-yang-cur-msg, semantics changed in emacs
+ 23 and we do not want to use set-buffer unless we actually want to
+ change the buffer the user is looking at (closes SF #2830504).
+
+ * mh-show.el (mh-show-folder-map): Add missing key binding for
+ mh-show-pack-folder (closes SF #3466086).
+
+2012-11-25 Bill Wohler <wohler@newt.com>
+
+ * mh-e.el (Version, mh-version): Add +bzr to version.
+
2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
* mh-letter.el (mh-yank-hooks): Use make-obsolete-variable.
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index f5aa0db7d7f..fbfc1207a5a 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -122,6 +122,42 @@ Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.")
syntax-table)
"Syntax table used by MH-E while in MH-Letter mode.")
+(defvar mh-regexp-in-field-syntax-table nil
+ "Specify a syntax table for `mh-regexp-in-field-p' to use.")
+
+(defvar mh-fcc-syntax-table
+ (let ((syntax-table (make-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?+ "w" syntax-table)
+ (modify-syntax-entry ?/ "w" syntax-table)
+ syntax-table)
+ "Syntax table used by MH-E while searching an Fcc field.")
+
+(defvar mh-addr-syntax-table
+ (let ((syntax-table (make-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?! "w" syntax-table)
+ (modify-syntax-entry ?# "w" syntax-table)
+ (modify-syntax-entry ?$ "w" syntax-table)
+ (modify-syntax-entry ?% "w" syntax-table)
+ (modify-syntax-entry ?& "w" syntax-table)
+ (modify-syntax-entry ?' "w" syntax-table)
+ (modify-syntax-entry ?* "w" syntax-table)
+ (modify-syntax-entry ?+ "w" syntax-table)
+ (modify-syntax-entry ?- "w" syntax-table)
+ (modify-syntax-entry ?/ "w" syntax-table)
+ (modify-syntax-entry ?= "w" syntax-table)
+ (modify-syntax-entry ?? "w" syntax-table)
+ (modify-syntax-entry ?^ "w" syntax-table)
+ (modify-syntax-entry ?_ "w" syntax-table)
+ (modify-syntax-entry ?` "w" syntax-table)
+ (modify-syntax-entry ?{ "w" syntax-table)
+ (modify-syntax-entry ?| "w" syntax-table)
+ (modify-syntax-entry ?} "w" syntax-table)
+ (modify-syntax-entry ?~ "w" syntax-table)
+ (modify-syntax-entry ?. "w" syntax-table)
+ (modify-syntax-entry ?@ "w" syntax-table)
+ syntax-table)
+ "Syntax table used by MH-E while searching an address field.")
+
(defvar mh-send-args ""
"Extra args to pass to \"send\" command.")
@@ -392,13 +428,81 @@ See also `mh-send'."
(mh-read-draft "clean-up" (mh-msg-filename message) nil)))))
(mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
(mh-insert-header-separator)
+ ;; Merge in components
+ (mh-mapc
+ (function
+ (lambda (header-field)
+ (let ((field (car header-field))
+ (value (cdr header-field))
+ (case-fold-search t))
+ (cond
+ ;; Address field
+ ((string-match field "^To$\\|^Cc$\\|^From$")
+ (cond
+ ((not (mh-goto-header-field (concat field ":")))
+ ;; Header field does not exist, add it
+ (mh-goto-header-end 0)
+ (insert field ": " value "\n"))
+ ((string-equal value "")
+ ;; Header field already exists and no value
+ )
+ (t
+ ;; Header field exists and we have a value
+ (let (address mailbox (alias (mh-alias-expand value)))
+ (and alias
+ (setq address (ietf-drums-parse-address alias))
+ (setq mailbox (car address)))
+ ;; XXX - Need to parse all addresses out of field
+ (if (and
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote value) "\\b") field))
+ mailbox
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote mailbox) "\\b") field)))
+ (insert " " value ","))
+ ))))
+ ((string-match field "^Fcc$")
+ ;; Folder reference
+ (mh-modify-header-field field value))
+ ;; Text field, that's an easy case
+ (t
+ (mh-modify-header-field field value))))))
+ (mh-components-to-list (mh-find-components)))
(goto-char (point-min))
(save-buffer)
- (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
- config)
+ (mh-compose-and-send-mail
+ draft "" from-folder nil nil nil nil nil nil config)
(mh-letter-mode-message)
(mh-letter-adjust-point)))
+(defun mh-extract-header-field ()
+ "Extract field name and field value from the field at point.
+Returns a list of field name and value (which may be null)."
+ (let ((end (save-excursion (mh-header-field-end)
+ (point))))
+ (if (looking-at mh-letter-header-field-regexp)
+ (save-excursion
+ (goto-char (match-end 1))
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (cons (match-string-no-properties 1) (buffer-substring-no-properties (point) end))))))
+
+
+(defun mh-components-to-list (components)
+ "Convert the COMPONENTS file to a list of field names and values."
+ (with-current-buffer (get-buffer-create mh-temp-buffer)
+ (erase-buffer)
+ (insert-file-contents components)
+ (goto-char (point-min))
+ (let
+ ((header-fields nil))
+ (while (mh-in-header-p)
+ (setq header-fields (append header-fields (list (mh-extract-header-field))))
+ (mh-header-field-end)
+ (forward-char 1)
+ )
+ header-fields)))
+
;;;###mh-autoload
(defun mh-extract-rejected-mail (message)
"Edit a MESSAGE that was returned by the mail system.
@@ -774,6 +878,22 @@ Optional argument BUFFER can be used to specify the buffer."
(t
nil))))
+(defun mh-find-components ()
+ "Return the path to the components file."
+ (let (components)
+ (cond
+ ((file-exists-p
+ (setq components
+ (expand-file-name mh-comp-formfile mh-user-path)))
+ components)
+ ((file-exists-p
+ (setq components
+ (expand-file-name mh-comp-formfile mh-lib)))
+ components)
+ (t
+ (error "Can't find %s in %s or %s"
+ mh-comp-formfile mh-user-path mh-lib)))))
+
(defun mh-send-sub (to cc subject config)
"Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
@@ -783,19 +903,7 @@ CONFIG is the window configuration before sending mail."
(message "Composing a message...")
(let ((draft (mh-read-draft
"message"
- (let (components)
- (cond
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-user-path)))
- components)
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-lib)))
- components)
- (t
- (error "Can't find %s in %s or %s"
- mh-comp-formfile mh-user-path mh-lib))))
+ (mh-find-components)
nil)))
(mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
(goto-char (point-max))
@@ -1072,7 +1180,7 @@ discarded."
(insert " " value)
(delete-region (point) (mh-line-end-position)))
((and (not overwrite-flag)
- (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
+ (mh-regexp-in-field-p (concat "\\b" (regexp-quote value) "\\b") field))
;; Already there, do nothing.
)
((and (not overwrite-flag)
@@ -1084,18 +1192,33 @@ discarded."
(defun mh-regexp-in-field-p (regexp &rest fields)
"Non-nil means REGEXP was found in FIELDS."
- (save-excursion
- (let ((search-result nil)
- (field))
- (while fields
- (setq field (car fields))
- (if (and (mh-goto-header-field field)
- (re-search-forward
- regexp (save-excursion (mh-header-field-end)(point)) t))
- (setq fields nil
- search-result t)
- (setq fields (cdr fields))))
- search-result)))
+ (let ((old-syntax-table (syntax-table)))
+ (unwind-protect
+ (save-excursion
+ (let ((search-result nil))
+ (while fields
+ (let ((field (car fields))
+ (syntax-table mh-regexp-in-field-syntax-table))
+ (if (null syntax-table)
+ (let ((case-fold-search t))
+ (cond
+ ((string-match field "^To$\\|^[BD]?cc$\\|^From$")
+ (setq syntax-table mh-addr-syntax-table))
+ ((string-match field "^Fcc$")
+ (setq syntax-table mh-fcc-syntax-table))
+ (t
+ (setq syntax-table (syntax-table)))
+ )))
+ (if (and (mh-goto-header-field field)
+ (set-syntax-table syntax-table)
+ (re-search-forward
+ regexp (save-excursion (mh-header-field-end)(point)) t))
+ (setq fields nil
+ search-result t)
+ (setq fields (cdr fields)))
+ (set-syntax-table old-syntax-table)))
+ search-result))
+ (set-syntax-table old-syntax-table))))
(defun mh-ascii-buffer-p ()
"Check if current buffer is entirely composed of ASCII.
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 2ebe370205f..b755572c957 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -75,6 +75,12 @@ introduced in Emacs 22."
'cancel-timer
'delete-itimer))
+;; Emacs 24 renamed flet to cl-flet.
+(defalias 'mh-cl-flet
+ (if (fboundp 'cl-flet)
+ 'cl-flet
+ 'flet))
+
(defun mh-display-color-cells (&optional display)
"Return the number of color cells supported by DISPLAY.
This function is used by XEmacs to return 2 when `device-color-cells'
@@ -242,6 +248,40 @@ This function returns nil on those systems."
This function returns nil on those systems."
nil)
+(defmacro mh-define-obsolete-variable-alias
+ (obsolete-name current-name &optional when docstring)
+ "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
+See documentation for `define-obsolete-variable-alias' for a description
+of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
+and DOCSTRING. This macro is used by XEmacs that lacks WHEN and
+DOCSTRING arguments."
+ (if (featurep 'xemacs)
+ `(define-obsolete-variable-alias ,obsolete-name ,current-name)
+ `(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring)))
+
+(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type)
+ "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+See documentation for `make-obsolete-variable' for a description
+of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
+and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and
+ACCESS-TYPE arguments."
+ (if (featurep 'xemacs)
+ `(make-obsolete-variable ,obsolete-name ,current-name)
+ `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type)))
+
+(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type)
+ "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+See documentation for `make-obsolete-variable' for a description
+of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN
+and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and
+ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE,
+introduced in Emacs 24."
+ (if (featurep 'xemacs)
+ `(make-obsolete-variable ,obsolete-name ,current-name)
+ (if (< emacs-major-version 24)
+ `(make-obsolete-variable ,obsolete-name ,current-name ,when)
+ `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))))
+
(defun-mh mh-match-string-no-properties
match-string-no-properties (num &optional string)
"Return string of text matched by last search, without text properties.
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 4f42242c288..334f73ff7ed 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -5,7 +5,7 @@
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 8.3.1
+;; Version: 8.4
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -127,7 +127,7 @@
;; Try to keep variables local to a single file. Provide accessors if
;; variables are shared. Use this section as a last resort.
-(defconst mh-version "8.3.1" "Version number of MH-E.")
+(defconst mh-version "8.4" "Version number of MH-E.")
;; Variants
@@ -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
@@ -2400,7 +2421,8 @@ of citations entirely, choose \"None\"."
;; "X-Mailer:" ;
;; "X-Operator:" ; Similar to X-Mailer, so display it
-;; Keep fields alphabetized (set sort-fold-case to t first).
+;; Keep fields alphabetized with case folding. Use M-:(setq
+;; sort-fold-case t) from the minibuffer to accomplish this.
;; Mention source, if known.
(defvar mh-invisible-header-fields-internal
'(
@@ -2418,6 +2440,8 @@ of citations entirely, choose \"None\"."
"Auto-forwarded:" ; RFC 2156
"Autoforwarded:" ; RFC 2156
"Bestservhost:"
+ "Bounces-To:"
+ "Bounces_to:"
"Bytes:"
"Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Cancel-Lock:" ; NNTP posts
@@ -2523,9 +2547,11 @@ of citations entirely, choose \"None\"."
"X-Abuse-Info:"
"X-Accept-Language:" ; Netscape/Mozilla
"X-Ack:"
+ "X-ACL-Warn:" ; http://www.exim.org
"X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Administrivia-To:"
"X-AMAZON" ; Amazon.com
+ "X-AnalysisOut:" ; Exchange
"X-AntiAbuse:" ; cPanel
"X-Antivirus-Scanner:"
"X-AOL-IP:" ; AOL WebMail
@@ -2535,18 +2561,30 @@ of citations entirely, choose \"None\"."
"X-AuditID:"
"X-Authenticated-Info:" ; Verizon.net?
"X-Authenticated-Sender:" ; AT&T Message Center (webmail)
+ "X-Authentication-Info:" ; verizon.net?
"X-Authentication-Warning:" ; sendmail
"X-Authority-Analysis:"
+ "X-Auto-Response-Suppress:" ; Exchange
"X-Barracuda-" ; Barracuda spam scores
+ "X-Bayes-Prob:" ; IEEE spam filter
"X-Beenthere:" ; Mailman mailing list manager
+ "X-BFI:"
"X-Bigfish:"
"X-Bogosity:" ; bogofilter
+ "X-BPS1:" ; http://www.boggletools.com
+ "X-BPS2:" ; http://www.boggletools.com
"X-Brightmail-Tracker:" ; Brightmail
"X-BrightmailFiltered:" ; Brightmail
"X-Bugzilla-" ; Bugzilla
+ "X-Cam-" ; Cambridge scanners
+ "X-Campaign-Id:"
+ "X-Campaign:"
"X-Campaignid:"
+ "X-CanIt-Geo:" ; IEEE spam filter
+ "X-Cloudmark-SP-" ; Cloudmark (www.cloudmark.com)
"X-Comment:" ; AT&T Mailennium
"X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Completed:"
"X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Content-Filtered-By:"
"X-ContentStamp:" ; NetZero
@@ -2554,18 +2592,23 @@ of citations entirely, choose \"None\"."
"X-Cr-Hashedpuzzle:"
"X-Cr-Puzzleid:"
"X-Cron-Env:"
- "X-DCC-Usenix-Metrics:"
+ "X-DCC-" ; SpamAssassin
"X-Declude-" ; http://www.declude.com/x-note.htm
"X-Dedicated:"
"X-Delivered"
+ "X-Destination-ID:"
+ "X-detected-operating-system:" ; GNU.ORG?
"X-DH-Virus-"
"X-DMCA"
+ "X-DocGen-Version:" ; DocGen
"X-Domain:"
"X-Echelon-Distraction"
"X-EFL-Spamscore:" ; MIT alumni spam filtering
"X-eGroups-" ; Egroups/yahoogroups mailing list manager
"X-EID:"
"X-ELNK-Trace:" ; Earthlink mailer
+ "X-EM-" ; Some ecommerce software
+ "X-Email-Type-Id:" ; Paypal http://www.paypal.com
"X-Enigmail-Version:"
"X-Envelope-Date:" ; GNU mailutils
"X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -2575,29 +2618,39 @@ of citations entirely, choose \"None\"."
"X-Evolution:" ; Evolution mail client
"X-ExtLoop"
"X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Facebook" ; Facebook
+ "X-FB-SS:"
"X-fmx-"
"X-Folder:" ; Spam
+ "X-Forwarded-" ; Google+
"X-From-Line"
+ "X-FuHaFi:" ; http://www.gmx.net/
+ "X-Generated-By:" ; launchpad.net
"X-Gmail-" ; Gmail
"X-Gnus-Mail-Source:" ; gnus
"X-Google-" ; Google mail
"X-Google-Sender-Auth:"
"X-Greylist:" ; milter-greylist-1.2.1
- "X-Habeas-SWE-" ; Spam
+ "X-Habeas-" ; http://www.returnpath.net
"X-Hashcash:" ; hashcash
+ "X-Headers-End:" ; SpamCop
"X-HPL-"
"X-HR-"
"X-HTTP-UserAgent:"
"X-Hz" ; Hertz
"X-Identity:" ; http://www.declude.com/x-note.htm
+ "X-IEEE-UCE-" ; IEEE spam filter
"X-Image-URL:"
"X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Info:" ; NTMail
"X-IronPort-" ; IronPort AV
"X-ISI-4-30-3-MailScanner:"
"X-J2-"
+ "X-Jira-Fingerprint:" ; JIRA
+ "X-Junkmail-" ; RCN?
"X-Juno-" ; Juno
"X-Key:"
+ "X-Launchpad-" ; plaunchpad.net
"X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-List-Subscribe:" ; Unknown mailing list managers
"X-List-Unsubscribe:" ; Unknown mailing list managers
@@ -2606,18 +2659,24 @@ of citations entirely, choose \"None\"."
"X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Lrde-Mailscanner:"
"X-Lumos-SenderID:" ; Roving ConstantContact
+ "X-mail_abuse_inquiries:" ; http://www.salesforce.com
"X-Mail-from:" ; fastmail.fm
"X-MAIL-INFO:" ; NetZero
"X-Mailer_"
+ "X-MailFlowPolicy:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com)
"X-Mailing-List:" ; Unknown mailing list managers
+ "X-MailingID:"
"X-Mailman-Approved-At:" ; Mailman mailing list manager
"X-Mailman-Version:" ; Mailman mailing list manager
"X-MailScanner" ; ListProc(tm) by CREN
"X-Mailutils-Message-Id" ; GNU Mailutils
"X-Majordomo:" ; Majordomo mailing list manager
+ "X-Match:"
+ "X-MaxCode-Template:" ; Paypal http://www.paypal.com
"X-MB-Message-" ; AOL WebMail
"X-MDaemon-Deliver-To:"
"X-MDRemoteIP:"
+ "X-ME-Bayesian:" ; http://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/
"X-Message-Id"
"X-Message-Type:"
"X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
@@ -2630,12 +2689,16 @@ of citations entirely, choose \"None\"."
"X-MS-" ; MS Outlook
"X-Msmail-" ; MS Outlook
"X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-MXL-Hash:"
"X-NAI-Spam-" ; Network Associates Inc. SpamKiller
"X-News:" ; News
"X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Notes-Item:" ; Lotus Notes Domino structured header
+ "X-Notification-" ; Google+
+ "X-Notifications:" ; Google+
"X-OperatingSystem:"
+ "X-Oracle-Calendar:" ; Oracle calendar invitations
"X-ORBL:"
"X-Orcl-Content-Type:"
"X-Organization:"
@@ -2652,6 +2715,7 @@ of citations entirely, choose \"None\"."
"X-PID:"
"X-PMG-"
"X-PMX-Version:"
+ "X-Policyd-Weight:" ; policyd-weight (Postfix)
"X-Postfilter:"
"X-Priority:" ; MS Outlook
"X-Proofpoint-" ; Proofpoint mail filter
@@ -2677,14 +2741,20 @@ of citations entirely, choose \"None\"."
"X-SBRS:"
"X-SBRule:" ; Spam
"X-Scanned-By:"
+ "X-Sender-ID:" ; Google+
"X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com)
"X-Server-Date:"
"X-Server-Uuid:"
"X-Service-Code:"
+ "X-SFDC-" ; http://www.salesforce.com
"X-Sieve:" ; Sieve filtering
+ "X-SMFBL:"
+ "X-SMHeaderMap:"
"X-SMTP-"
"X-Source"
- "X-Spam-" ; Spamassassin
+ "X-Spam-" ; SpamAssassin
+ "X-Spam:" ; Exchange
"X-SpamBouncer:" ; Spam
"X-SPF-"
"X-Status"
@@ -2692,6 +2762,7 @@ of citations entirely, choose \"None\"."
"X-Submissions-To:"
"X-Sun-Charset:"
"X-Telecom-Digest"
+ "X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com
"X-Trace:"
"X-UID"
"X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -2702,15 +2773,23 @@ of citations entirely, choose \"None\"."
"X-USANET-" ; usa.net
"X-Usenet-Provider"
"X-UserInfo1:"
+ "X-VGI-OESCD:"
+ "X-VirtualServer:"
+ "X-VirtualServerGroup:"
"X-Virus-" ;
"X-Vms-To:"
"X-VSMLoop:" ; NTMail
"X-WebTV-Signature:"
"X-Wss-Id:" ; Worldtalk gateways
"X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-XPT-XSL-Name:" ; Paypal http://www.paypal.com
+ "X-xsi-"
+ "X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm
+ "X-Y-GMX-Trusted:" ; http://www.gmx.net/
"X-Yahoo"
"X-Yahoo-Newman-"
"X-YMail-"
+ "X-ZixNet:"
"X400-" ; X400
"Xref:" ; RFC 1036
)
@@ -3104,9 +3183,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
@@ -3136,6 +3216,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.
@@ -3189,7 +3276,7 @@ function used to insert the signature with
:group 'mh-letter
:package-version '(MH-E . "8.0"))
-(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
+(mh-define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks
'mh-kill-folder-suppress-prompt-functions "24.3")
(defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p)
"Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder].
@@ -3301,6 +3388,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)
@@ -3519,6 +3613,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))
@@ -3608,6 +3709,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 f891997d7bc..f3ea8003ed0 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'
@@ -766,7 +774,7 @@ the message."
return-value))
;;;###mh-autoload
-(defun mh-inc-folder (&optional file folder)
+(defun mh-inc-folder (&optional file folder dont-exec-pending)
"Incorporate new mail into a folder.
You can incorporate mail from any file into the current folder by
@@ -777,7 +785,10 @@ The hook `mh-inc-folder-hook' is run after incorporating new
mail.
Do not call this function from outside MH-E; use \\[mh-rmail]
-instead."
+instead.
+
+In a program, the processing of outstanding commands is not performed
+if DONT-EXEC-PENDING is non-nil."
(interactive (list (if current-prefix-arg
(expand-file-name
(read-file-name "inc mail from file: "
@@ -786,6 +797,8 @@ instead."
(mh-prompt-for-folder "inc mail into" mh-inbox t))))
(if (not folder)
(setq folder mh-inbox))
+ (unless dont-exec-pending
+ (mh-process-or-undo-commands folder))
(let ((threading-needed-flag nil))
(let ((config (current-window-configuration)))
(when (and mh-show-buffer (get-buffer mh-show-buffer))
@@ -1181,14 +1194,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 +1537,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 +1561,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 +1616,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 +1969,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 +1994,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 +2016,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 +2025,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 9f42d2581d0..d7632ffc729 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-letter.el b/lisp/mh-e/mh-letter.el
index b2db25f674a..b4d8b625586 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -69,7 +69,7 @@ citation text as modified.
This is a normal hook, misnamed for historical reasons.
It is obsolete and is only used if `mail-citation-hook' is nil.")
-(make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
+(mh-make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
@@ -725,69 +725,71 @@ not inserted. If the option `mh-yank-behavior' is set to one of
the supercite flavors, the hook `mail-citation-hook' is ignored
and `mh-ins-buf-prefix' is not inserted."
(interactive)
- (if (and mh-sent-from-folder
- (with-current-buffer mh-sent-from-folder mh-show-buffer)
- (with-current-buffer mh-sent-from-folder
- (get-buffer mh-show-buffer))
- mh-sent-from-msg)
- (let ((to-point (point))
- (to-buffer (current-buffer)))
- (set-buffer mh-sent-from-folder)
- (if mh-delete-yanked-msg-window-flag
- (delete-windows-on mh-show-buffer))
- (set-buffer mh-show-buffer) ; Find displayed message
- (let* ((from-attr (mh-extract-from-attribution))
- (yank-region (mh-mark-active-p nil))
- (mh-ins-str
- (cond ((and yank-region
- (or (eq 'supercite mh-yank-behavior)
- (eq 'autosupercite mh-yank-behavior)
- (eq t mh-yank-behavior)))
- ;; supercite needs the full header
- (concat
- (buffer-substring (point-min) (mh-mail-header-end))
- "\n"
- (buffer-substring (region-beginning) (region-end))))
- (yank-region
- (buffer-substring (region-beginning) (region-end)))
- ((or (eq 'body mh-yank-behavior)
- (eq 'attribution mh-yank-behavior)
- (eq 'autoattrib mh-yank-behavior))
- (buffer-substring
- (save-excursion
- (goto-char (point-min))
- (mh-goto-header-end 1)
- (point))
- (point-max)))
- ((or (eq 'supercite mh-yank-behavior)
- (eq 'autosupercite mh-yank-behavior)
- (eq t mh-yank-behavior))
- (buffer-substring (point-min) (point-max)))
- (t
- (buffer-substring (point) (point-max))))))
- (set-buffer to-buffer)
- (save-restriction
- (narrow-to-region to-point to-point)
- (insert (mh-filter-out-non-text mh-ins-str))
- (goto-char (point-max)) ;Needed for sc-cite-original
- (push-mark) ;Needed for sc-cite-original
- (goto-char (point-min)) ;Needed for sc-cite-original
- (mh-insert-prefix-string mh-ins-buf-prefix)
- (when (or (eq 'attribution mh-yank-behavior)
- (eq 'autoattrib mh-yank-behavior))
- (insert from-attr)
- (mh-identity-insert-attribution-verb nil)
- (insert "\n\n"))
- ;; If the user has selected a region, he has already "edited" the
- ;; text, so leave the cursor at the end of the yanked text. In
- ;; either case, leave a mark at the opposite end of the included
- ;; text to make it easy to jump or delete to the other end of the
- ;; text.
- (push-mark)
- (goto-char (point-max))
- (if (null yank-region)
- (mh-exchange-point-and-mark-preserving-active-mark)))))
- (error "There is no current message")))
+ (let ((show-buffer))
+ (if (and mh-sent-from-folder
+ (with-current-buffer mh-sent-from-folder mh-show-buffer)
+ (setq show-buffer (with-current-buffer mh-sent-from-folder
+ (get-buffer mh-show-buffer)))
+ mh-sent-from-msg)
+ (let ((to-point (point))
+ (to-buffer (current-buffer)))
+ (if mh-delete-yanked-msg-window-flag
+ (with-current-buffer mh-sent-from-folder
+ (delete-windows-on show-buffer)))
+ ;; Find displayed message
+ (with-current-buffer show-buffer
+ (let* ((from-attr (mh-extract-from-attribution))
+ (yank-region (mh-mark-active-p nil))
+ (mh-ins-str
+ (cond ((and yank-region
+ (or (eq 'supercite mh-yank-behavior)
+ (eq 'autosupercite mh-yank-behavior)
+ (eq t mh-yank-behavior)))
+ ;; supercite needs the full header
+ (concat
+ (buffer-substring (point-min) (mh-mail-header-end))
+ "\n"
+ (buffer-substring (region-beginning) (region-end))))
+ (yank-region
+ (buffer-substring (region-beginning) (region-end)))
+ ((or (eq 'body mh-yank-behavior)
+ (eq 'attribution mh-yank-behavior)
+ (eq 'autoattrib mh-yank-behavior))
+ (buffer-substring
+ (save-excursion
+ (goto-char (point-min))
+ (mh-goto-header-end 1)
+ (point))
+ (point-max)))
+ ((or (eq 'supercite mh-yank-behavior)
+ (eq 'autosupercite mh-yank-behavior)
+ (eq t mh-yank-behavior))
+ (buffer-substring (point-min) (point-max)))
+ (t
+ (buffer-substring (point) (point-max))))))
+ (with-current-buffer to-buffer
+ (save-restriction
+ (narrow-to-region to-point to-point)
+ (insert (mh-filter-out-non-text mh-ins-str))
+ (goto-char (point-max)) ;Needed for sc-cite-original
+ (push-mark) ;Needed for sc-cite-original
+ (goto-char (point-min)) ;Needed for sc-cite-original
+ (mh-insert-prefix-string mh-ins-buf-prefix)
+ (when (or (eq 'attribution mh-yank-behavior)
+ (eq 'autoattrib mh-yank-behavior))
+ (insert from-attr)
+ (mh-identity-insert-attribution-verb nil)
+ (insert "\n\n"))
+ ;; If the user has selected a region, he has already "edited" the
+ ;; text, so leave the cursor at the end of the yanked text. In
+ ;; either case, leave a mark at the opposite end of the included
+ ;; text to make it easy to jump or delete to the other end of the
+ ;; text.
+ (push-mark)
+ (goto-char (point-max))
+ (if (null yank-region)
+ (mh-exchange-point-and-mark-preserving-active-mark)))))))
+ (error "There is no current message"))))
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 4af3c452cc0..046f03d5255 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -268,10 +268,12 @@ usually reads the file \"/etc/mailcap\"."
(buffer-read-only nil))
(when (string-match "^[^% \t]+$" method)
(setq method (concat method " %s")))
- (flet ((mm-handle-set-external-undisplayer (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (unwind-protect (mm-display-external part method)
- (set-buffer-modified-p nil)))))
+ (mh-cl-flet
+ ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (unwind-protect (mm-display-external part method)
+ (set-buffer-modified-p nil)))))
nil))
;;;###mh-autoload
@@ -523,47 +525,48 @@ parsed and then displayed."
(let ((handles ())
(folder mh-show-folder-buffer)
(raw-message-data (buffer-string)))
- (flet ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max))
- (insert "\n\n"))
-
- (condition-case err
- (progn
- ;; If needed dissect the current buffer
- (if pre-dissected-handles
- (setq handles pre-dissected-handles)
- (if (setq handles (mm-dissect-buffer nil))
- (mh-mm-uu-dissect-text-parts handles)
- (setq handles (mm-uu-dissect)))
- (setf (mh-mime-handles (mh-buffer-data))
- (mh-mm-merge-handles handles
- (mh-mime-handles (mh-buffer-data))))
- (unless handles
- (mh-decode-message-body)))
-
- (cond ((and handles
- (or (not (stringp (car handles)))
- (cdr handles)))
- ;; Go to start of message body
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t)
- (goto-char (point-max)))
-
- ;; Delete the body
- (delete-region (point) (point-max))
-
- ;; Display the MIME handles
- (mh-mime-display-part handles))
- (t
- (mh-signature-highlight))))
- (error
- (message "Could not display body: %s" (error-message-string err))
- (delete-region (point-min) (point-max))
- (insert raw-message-data))))))
+ (mh-cl-flet
+ ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max))
+ (insert "\n\n"))
+
+ (condition-case err
+ (progn
+ ;; If needed dissect the current buffer
+ (if pre-dissected-handles
+ (setq handles pre-dissected-handles)
+ (if (setq handles (mm-dissect-buffer nil))
+ (mh-mm-uu-dissect-text-parts handles)
+ (setq handles (mm-uu-dissect)))
+ (setf (mh-mime-handles (mh-buffer-data))
+ (mh-mm-merge-handles handles
+ (mh-mime-handles (mh-buffer-data))))
+ (unless handles
+ (mh-decode-message-body)))
+
+ (cond ((and handles
+ (or (not (stringp (car handles)))
+ (cdr handles)))
+ ;; Go to start of message body
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+
+ ;; Delete the body
+ (delete-region (point) (point-max))
+
+ ;; Display the MIME handles
+ (mh-mime-display-part handles))
+ (t
+ (mh-signature-highlight))))
+ (error
+ (message "Could not display body: %s" (error-message-string err))
+ (delete-region (point-min) (point-max))
+ (insert raw-message-data))))))
(defun mh-decode-message-body ()
"Decode message based on charset.
@@ -1046,13 +1049,14 @@ attachment, the attachment is hidden."
(function (get-text-property (point) 'mh-callback))
(buffer-read-only nil)
(folder mh-show-folder-buffer))
- (flet ((mm-handle-set-external-undisplayer
- (handle function)
- (mh-handle-set-external-undisplayer folder handle function)))
- (when (and function (eolp))
- (backward-char))
- (unwind-protect (and function (funcall function data))
- (set-buffer-modified-p nil)))))
+ (mh-cl-flet
+ ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (when (and function (eolp))
+ (backward-char))
+ (unwind-protect (and function (funcall function data))
+ (set-buffer-modified-p nil)))))
(defun mh-push-button (event)
"Click MIME button for EVENT.
@@ -1066,9 +1070,11 @@ to click the MIME button."
(mm-inline-media-tests mh-mm-inline-media-tests)
(data (get-text-property (point) 'mh-data))
(function (get-text-property (point) 'mh-callback)))
- (flet ((mm-handle-set-external-undisplayer (handle func)
- (mh-handle-set-external-undisplayer folder handle func)))
- (and function (funcall function data))))))
+ (mh-cl-flet
+ ((mm-handle-set-external-undisplayer
+ (handle func)
+ (mh-handle-set-external-undisplayer folder handle func)))
+ (and function (funcall function data))))))
(defun mh-handle-set-external-undisplayer (folder handle function)
"Replacement for `mm-handle-set-external-undisplayer'.
@@ -1160,10 +1166,11 @@ this ;-)"
(defun mh-display-emphasis ()
"Display graphical emphasis."
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
- (flet ((article-goto-body ())) ; shadow this function to do nothing
- (save-excursion
- (goto-char (point-min))
- (article-emphasize)))))
+ (mh-cl-flet
+ ((article-goto-body ())) ; shadow this function to do nothing
+ (save-excursion
+ (goto-char (point-min))
+ (article-emphasize)))))
(defun mh-small-show-buffer-p ()
"Check if show buffer is small.
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 1f46c63b14c..e06c02b92b8 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -112,6 +112,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.
@@ -156,7 +172,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
@@ -164,7 +180,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
@@ -278,6 +294,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
@@ -295,11 +327,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
@@ -364,6 +398,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'.")
@@ -397,6 +435,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 d4fa0df3140..a8860263531 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)))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 92b9625fc43..87b048dbd60 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -612,6 +612,7 @@ still visible.\n")
"l" mh-show-list-folders
"n" mh-index-new-messages
"o" mh-show-visit-folder
+ "p" mh-show-pack-folder
"q" mh-show-index-sequenced-messages
"r" mh-show-rescan-folder
"s" mh-search
@@ -899,13 +900,14 @@ See also `mh-folder-mode'.
(interactive)
;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
;; style?
- (flet ((gnus-article-add-button (&rest args) nil))
- (let* ((modified (buffer-modified-p))
- (gnus-article-buffer (buffer-name))
- (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
- ,(car gnus-cite-face-list))))
- (gnus-article-highlight-citation t)
- (set-buffer-modified-p modified))))
+ (mh-cl-flet
+ ((gnus-article-add-button (&rest args) nil))
+ (let* ((modified (buffer-modified-p))
+ (gnus-article-buffer (buffer-name))
+ (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
+ ,(car gnus-cite-face-list))))
+ (gnus-article-highlight-citation t)
+ (set-buffer-modified-p modified))))
(provide 'mh-show)
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index bb9ea94732a..d80e9f3ae53 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -645,19 +645,20 @@ Only information about messages in MSG-LIST are added to the tree."
(defun mh-thread-set-tables (folder)
"Use the tables of FOLDER in current buffer."
- (flet ((mh-get-table (symbol)
- (with-current-buffer folder
- (symbol-value symbol))))
- (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
- (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
- (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
- (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
- (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
- (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
- (setq mh-thread-subject-container-hash
- (mh-get-table 'mh-thread-subject-container-hash))
- (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
- (setq mh-thread-history (mh-get-table 'mh-thread-history))))
+ (mh-cl-flet
+ ((mh-get-table (symbol)
+ (with-current-buffer folder
+ (symbol-value symbol))))
+ (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
+ (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
+ (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
+ (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
+ (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
+ (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
+ (setq mh-thread-subject-container-hash
+ (mh-get-table 'mh-thread-subject-container-hash))
+ (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
+ (setq mh-thread-history (mh-get-table 'mh-thread-history))))
(defun mh-thread-process-in-reply-to (reply-to-header)
"Extract message id's from REPLY-TO-HEADER.
View Lorry Controller Status