+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)
+
2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
* mh-letter.el (mh-yank-hooks): Use make-obsolete-variable.
* mh-folder.el (top): Check whether which-func-modes is t before
adding mh-folder-mode.
+2012-01-07 Jeffrey C Honig <jch@honig.net>
+
+ * mh-e.el (mh-invisible-header-fields-internal): Added: X-xsi.
+ (addresses SF #1916032).
+
+2011-12-28 Jeffrey C Honig <jch@honig.net>
+
+ * 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).
+
+2011-12-27 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.
+
+2011-12-27 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).
+
+2011-12-27 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).
+
+2011-12-27 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).
+
+2011-12-25 Bill Wohler <wohler@newt.com>
+
+ * mh-e.el (Version, mh-version): Add +bzr to version.
+
2011-11-20 Bill Wohler <wohler@newt.com>
* Release MH-E version 8.3.1.
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 instead of determining")
+
+(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.")
(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
(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)
+ "Read in the components file and convert 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.
(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.
(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))
(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)
(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)
+ (field))
+ (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.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 8.3.1
+;; Version: 8.3.1+bzr
;; Keywords: mail
;; This file is part of GNU Emacs.
;; 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.3.1+bzr" "Version number of MH-E.")
;; Variants
(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.")
"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)
: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
;; "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
'(
"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
"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
"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
"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/
"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
"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:" ; Cicso 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
"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:"
"X-PID:"
"X-PMG-"
"X-PMX-Version:"
+ "X-Policyd-Weight:" ; policyd-weight (Postfix)
"X-Postfilter:"
"X-Priority:" ; MS Outlook
"X-Proofpoint-" ; Proofpoint mail filter
"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:" ; Cicso 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"
"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/
"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
)
(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
: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.
: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"))
+
\f
;;; Faces (:group 'mh-faces + group where faces described)
: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))
: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
["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)]
"--"
;; 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))
'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
;;;###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'
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
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: "
(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))
(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))
(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)
(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
(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)
(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)
(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? "
(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)
(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))))
- `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)
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)))
\f
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"))))
\f
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.
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
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
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'.")
+
\f
;;; Widths, Offsets and Columns
(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
;; 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'.")
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'.")
+
\f
;;; Utilities
;;;###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))
;; 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)
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)))
"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