X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d169946261347a11f80680f4deda7d0a62816f39..b95d0a24338da4f92ea8c216d4b7d5ac3c00ad4f:/lisp/mh-e/mh-e.el diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el dissimilarity index 92% index e0a8c3a004..26743b927a 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1,2756 +1,3357 @@ -;;; mh-e.el --- GNU Emacs interface to the MH mail system - -;; Copyright (C) 1985, 1986, 1987, 1988, -;; 1990, 1992, 1993, 1994, 1995, 1997, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. - -;; Author: Bill Wohler -;; Maintainer: Bill Wohler -;; Version: 7.85+cvs -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; How to Use: -;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. -;; C-u M-x mh-rmail to visit any folder. -;; M-x mh-smail to send mail. From within the mail reader, "m" works, too. - -;; Your .emacs might benefit from these bindings: -;; (global-set-key "\C-cr" 'mh-rmail) -;; (global-set-key "\C-xm" 'mh-smail) -;; (global-set-key "\C-x4m" 'mh-smail-other-window) - -;; MH (Message Handler) is a powerful mail reader. - -;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu -;; (send to mh-users-request to be added). See the monthly Frequently Asked -;; Questions posting there for information on getting MH and MH-E: -;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html - -;; N.B. MH must have been compiled with the MHE compiler flag or several -;; features necessary for MH-E will be missing from MH commands, specifically -;; the -build switch to repl and forw. - -;; MH-E is an Emacs interface to the MH mail system. - -;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4. - -;; Mailing Lists: -;; mh-e-users@lists.sourceforge.net -;; mh-e-announce@lists.sourceforge.net -;; mh-e-devel@lists.sourceforge.net -;; -;; Subscribe by sending a "subscribe" message to -;; -request@lists.sourceforge.net, or by using the web interface at -;; https://sourceforge.net/mail/?group_id=13357 - -;; Bug Reports: -;; https://sourceforge.net/tracker/?group_id=13357&atid=113357 -;; Include the output of M-x mh-version in any bug report. - -;; Feature Requests: -;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse - -;; Support: -;; https://sourceforge.net/tracker/?group_id=13357&atid=213357 - -;;; Change Log: - -;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. -;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. -;; Rewritten for GNU Emacs, James Larus, 1985. -;; Modified by Stephen Gildea, 1988. -;; Maintenance picked up by Bill Wohler and the -;; SourceForge Crew , 2001. - -;;; Code: - -(provide 'mh-e) - -(eval-when-compile (require 'mh-acros)) -(mh-require-cl) -(require 'mh-utils) -(require 'mh-init) -(require 'mh-inc) -(require 'mh-seq) -(require 'gnus-util) -(require 'easymenu) - -;; Shush the byte-compiler -(defvar font-lock-auto-fontify) -(defvar font-lock-defaults) - -(defconst mh-version "7.85+cvs" "Version number of MH-E.") - -(defvar mh-partial-folder-mode-line-annotation "select" - "Annotation when displaying part of a folder. -The string is displayed after the folder's name. nil for no annotation.") - - - -;;; Scan Line Formats - -;; Parameterize MH-E to work with different scan formats. The defaults work -;; with the standard MH scan listings, in which the first 4 characters on -;; the line are the message number, followed by two places for notations. - -;; The following scan formats are passed to the scan program if the setting of -;; `mh-scan-format-file' is t. They are identical except the later one makes -;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just -;; want to change the column of the notations, use the `mh-set-cmd-note' -;; function. - -(defvar mh-scan-format-mh - (concat - "%4(msg)" - "%<(cur)+%| %>" - "%<{replied}-" - "%?(nonnull(comp{to}))%<(mymbox{to})t%>" - "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>" - "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>" - "%?(nonnull(comp{newsgroups}))n%>" - "%<(zero) %>" - "%02(mon{date})/%02(mday{date})%<{date} %|*%>" - "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>" - "%<(zero)%17(friendly{from})%> " - "%{subject}%<{body}<<%{body}%>") - "*Scan format string for MH. -This string is passed to the scan program via the -format argument. -This format is identical to the default except that additional hints for -fontification have been added to the fifth column (remember that in Emacs, the -first column is 0). - -The values of the fifth column, in priority order, are: `-' if the message has -been replied to, t if an address on the To: line matches one of the -mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc: -line matches, and `n' if a non-empty Newsgroups: header is present.") - -(defvar mh-scan-format-nmh - (concat - "%4(msg)" - "%<(cur)+%| %>" - "%<{replied}-" - "%?(nonnull(comp{to}))%<(mymbox{to})t%>" - "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>" - "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>" - "%?(nonnull(comp{newsgroups}))n%>" - "%<(zero) %>" - "%02(mon{date})/%02(mday{date})%<{date} %|*%>" - "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>" - "%<(zero)%17(decode(friendly{from}))%> " - "%(decode{subject})%<{body}<<%{body}%>") - "*Scan format string for nmh. -This string is passed to the scan program via the -format arg. -This format is identical to the default except that additional hints for -fontification have been added to the fifth column (remember that in Emacs, the -first column is 0). - -The values of the fifth column, in priority order, are: `-' if the message has -been replied to, t if an address on the To: field matches one of the -mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc: -field matches, and `n' if a non-empty Newsgroups: field is present.") - -(defvar mh-note-deleted ?D - "Messages that have been deleted are marked by this character. -See also `mh-scan-deleted-msg-regexp'.") - -(defvar mh-note-refiled ?^ - "Messages that have been refiled are marked by this character. -See also `mh-scan-refiled-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'.") - -(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" - "This regular expression matches \"good\" 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]+\\\\)[^D^0-9]\". This expression includes the leading space -within the parenthesis since it looks better to highlight it as well. This -regular expression should be correct as it is needed by non-fontification -functions.") - -(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D" - "This regular expression matches deleted 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]+\\\\)D\". This expression includes the leading space within -the parenthesis since it looks better to highlight it as well. This regular -expression should be correct as it is needed by non-fontification functions. -See also `mh-note-deleted'.") - -(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^" - "This regular expression matches refiled 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]+\\\\)\\\\^\". This expression includes the leading space -within the parenthesis since it looks better to highlight it as well. This -regular expression should be correct as it is needed by non-fontification -functions. See also `mh-note-refiled'.") - -(defvar mh-scan-valid-regexp "^ *[0-9]" - "This regular expression describes a valid scan line. -This is used to eliminate error messages that are occasionally produced by -\"inc\".") - -(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" - "This regular expression matches the current message. -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]+\\\\+\\\\).*\". This expression includes the leading space and -current message marker \"+\" within the parenthesis since it looks better to -highlight these items as well. This regular expression should be correct as it -is needed by non-fontification functions. See also `mh-note-cur'.") - -(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" - "This regular expression matches a valid date. -It must not be anchored to the beginning or the end of the line. Note that the -default setting of `mh-folder-font-lock-keywords' expects this expression to -contain only one parenthesized expression which matches the date field as in -the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular -expression is not correct, the date will not be highlighted. See also -`mh-scan-format-regexp'.") - -(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)" - "This regular expression specifies the recipient in messages you sent. -Note that the default setting of `mh-folder-font-lock-keywords' -expects this expression to contain two parenthesized expressions. The -first is expected to match the `To:' that the default scan format -file generates. The second is expected to match the recipient's name -as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\". If this -regular expression is not correct, the recipient will not be highlighted.") - -(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)" - "This regular expression matches the message body fragment. -Note that the default setting of `mh-folder-font-lock-keywords' expects this -expression to contain at least one parenthesized expression which matches the -body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this -regular expression is not correct, the body fragment will not be highlighted.") - -(defvar mh-scan-subject-regexp - "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" - "This regular expression matches the subject. -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 -three parenthesized expressions. The first is expected to match the `Re:' -string, if any. The second matches an optional bracketed number after `Re:', -such as in `Re[2]:' (and is thus a sub-expression of the first expression) and -the third is expected to match the subject line itself as in the default of -\(broken on multiple lines for readability): - ^ *[0-9]+........[ ]*................... - \\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)* - \\\\([^<\\n]*\\\\) -This regular expression should be correct as it is needed by non-fontification -functions.") - -(defvar mh-scan-format-regexp - (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)") - "This regular expression matches the output of scan. -Note that the default setting of `mh-folder-font-lock-keywords' expects this -expression to contain at least three parenthesized expressions. The first -should match the fontification hint (see `mh-scan-format-nmh'), the second is -found in `mh-scan-date-regexp', and the third should match the user name as in -the default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp - \"*\\\\(..................\\\\)\")\". -If this regular expression is not correct, the notation hints and the sender -will not be highlighted.") - - - -(defvar mh-folder-font-lock-keywords - (list - ;; Folders when displaying index buffer - (list "^\\+.*" - '(0 mh-index-folder-face)) - ;; Marked for deletion - (list (concat mh-scan-deleted-msg-regexp ".*") - '(0 mh-folder-deleted-face)) - ;; Marked for refile - (list (concat mh-scan-refiled-msg-regexp ".*") - '(0 mh-folder-refiled-face)) - ;;after subj - (list mh-scan-body-regexp '(1 mh-folder-body-face nil t)) - '(mh-folder-font-lock-subject - (1 mh-folder-followup-face append t) - (2 mh-folder-subject-face append t)) - ;;current msg - (list mh-scan-cur-msg-number-regexp - '(1 mh-folder-cur-msg-number-face)) - (list mh-scan-good-msg-regexp - '(1 mh-folder-msg-number-face)) ;; Msg number - (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date - (list mh-scan-rcpt-regexp - '(1 mh-folder-to-face) ;; To: - '(2 mh-folder-address-face)) ;; address - ;; scan font-lock name - (list mh-scan-format-regexp - '(1 mh-folder-date-face) - '(3 mh-folder-scan-format-face))) - "Keywords (regular expressions) used to fontify the MH-Folder buffer.") - -(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', `^', `+' and where -` ' is the default value, -`D' is the `mh-note-deleted' character, -`^' is the `mh-note-refiled' character, and -`+' is the `mh-note-cur' character.") - -(defvar mh-scan-destination-width 1 - "Number of columns consumed by the destination field in `mh-scan-format'. -This column will have one of ' ', '%', '-', 't', 'c', 'b', or `n' in it. -A ' ' blank space is the default character. -A '%' indicates that the message in in a named MH sequence. -A '-' indicates that the message has been annotated with a replied field. -A 't' indicates that the message contains mymbox in the To: field. -A 'c' indicates that the message contains mymbox in the Cc: field. -A 'b' indicates that the message contains mymbox in the Bcc: field. -A 'n' indicates that the message contains a Newsgroups: field.") - -(defvar mh-scan-date-width 5 - "Number of columns consumed by the date field in `mh-scan-format'. -This column will typically be of the form mm/dd.") - -(defvar mh-scan-date-flag-width 1 - "Number of columns consumed to flag (in)valid dates in `mh-scan-format'. -This column will have ` ' for valid and `*' for invalid or missing dates.") - -(defvar mh-scan-from-mbox-width 17 - "Number of columns consumed with the \"From:\" line in `mh-scan-format'. -This column will have a friendly name or e-mail address of the -originator, or a \"To: address\" for outgoing e-mail messages.") - -(defvar mh-scan-from-mbox-sep-width 2 - "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'. -This column will only ever have spaces in it.") - -(defvar mh-scan-field-destination-offset - (+ mh-scan-cmd-note-width) - "The offset from the `mh-cmd-note' for the destination column.") - -(defvar mh-scan-field-from-start-offset - (+ mh-scan-cmd-note-width - mh-scan-destination-width - mh-scan-date-width - mh-scan-date-flag-width) - "The offset from the `mh-cmd-note' to find the start of \"From:\" address.") - -(defvar mh-scan-field-from-end-offset - (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width) - "The offset from the `mh-cmd-note' to find the end of \"From:\" address.") - -(defvar mh-scan-field-subject-start-offset - (+ mh-scan-cmd-note-width - mh-scan-destination-width - mh-scan-date-width - mh-scan-date-flag-width - mh-scan-from-mbox-width - mh-scan-from-mbox-sep-width) - "The offset from the `mh-cmd-note' to find the start of the subject.") - -(defun mh-folder-font-lock-subject (limit) - "Return MH-E scan subject strings to font-lock between point and LIMIT." - (if (not (re-search-forward mh-scan-subject-regexp limit t)) - nil - (if (match-beginning 1) - (set-match-data (list (match-beginning 1) (match-end 3) - (match-beginning 1) (match-end 3) nil nil)) - (set-match-data (list (match-beginning 3) (match-end 3) - nil nil (match-beginning 3) (match-end 3)))) - t)) - - - -;; Fontifify unseen mesages in bold. - -(defmacro mh-generate-sequence-font-lock (seq prefix face) - "Generate the appropriate code to fontify messages in SEQ. -PREFIX is used to generate unique names for the variables and functions -defined by the macro. So a different prefix should be provided for every -invocation. -FACE is the font-lock face used to display the matching scan lines." - (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix))) - (func (intern (format "mh-folder-font-lock-%s" prefix)))) - `(progn - (defvar ,cache nil - "Internal cache variable used for font-lock in MH-E. -Should only be non-nil through font-lock stepping, and nil once font-lock -is done highlighting.") - (make-variable-buffer-local ',cache) - - (defun ,func (limit) - "Return unseen message lines to font-lock between point and LIMIT." - (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq)))) - (let ((cur-msg (mh-get-msg-num nil))) - (cond ((not ,cache) - nil) - ((>= (point) limit) ;Presumably at end of buffer - (setq ,cache nil) - nil) - ((member cur-msg ,cache) - (let ((bpoint (progn (beginning-of-line)(point))) - (epoint (progn (forward-line 1)(point)))) - (if (<= limit (point)) (setq ,cache nil)) - (set-match-data (list bpoint epoint bpoint epoint)) - t)) - (t - ;; move forward one line at a time, checking each message - (while (and (= 0 (forward-line 1)) - (> limit (point)) - (not (member (mh-get-msg-num nil) ,cache)))) - ;; Examine how we must have exited the loop... - (let ((cur-msg (mh-get-msg-num nil))) - (cond ((or (<= limit (point)) - (not (member cur-msg ,cache))) - (setq ,cache nil) - nil) - ((member cur-msg ,cache) - (let ((bpoint (progn (beginning-of-line) (point))) - (epoint (progn (forward-line 1) (point)))) - (if (<= limit (point)) (setq ,cache nil)) - (set-match-data - (list bpoint epoint bpoint epoint)) - t)))))))) - - (setq mh-folder-font-lock-keywords - (append mh-folder-font-lock-keywords - (list (list ',func (list 1 '',face 'prepend t)))))))) - -(mh-generate-sequence-font-lock mh-unseen-seq unseen bold) -(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick) - - - -;;; Internal variables: - -(defvar mh-last-destination nil - "Destination of last refile or write command.") - -(defvar mh-last-destination-folder nil - "Destination of last refile command.") - -(defvar mh-last-destination-write nil - "Destination of last write command.") - -(defvar mh-folder-mode-map (make-keymap) - "Keymap for MH folders.") - -(defvar mh-arrow-marker nil - "Marker for arrow display in fringe.") - -(defvar mh-delete-list nil - "List of message numbers to delete. -This variable can be used by `mh-before-commands-processed-hook'.") - -(defvar mh-refile-list nil - "List of folder names in `mh-seq-list'. -This variable can be used by `mh-before-commands-processed-hook'.") - -(defvar mh-folders-changed nil - "Lists which folders were affected by deletes and refiles. -This list will always include the current folder `mh-current-folder'. -This variable can be used by `mh-before-commands-processed-hook'.") - -(defvar mh-next-direction 'forward - "Direction to move to next message.") - -(defvar mh-view-ops () - "Stack of operations that change the folder view. -These operations include narrowing or threading.") - -(defvar mh-folder-view-stack () - "Stack of previous folder views.") - -(defvar mh-index-data nil - "Info about index search results.") - -(defvar mh-index-previous-search nil) -(defvar mh-index-msg-checksum-map nil) -(defvar mh-index-checksum-origin-map nil) -(defvar mh-index-sequence-search-flag nil) - -(defvar mh-first-msg-num nil - "Number of first message in buffer.") - -(defvar mh-last-msg-num nil - "Number of last msg in buffer.") - -(defvar mh-mode-line-annotation nil - "Message range displayed in buffer.") - -(defvar mh-sequence-notation-history nil - "Remember original notation that is overwritten by `mh-note-seq'.") - -(defvar mh-colors-available-flag nil - "Non-nil means colors are available.") - - - -;;; Macros and generic functions: - -(defun mh-mapc (function list) - "Apply FUNCTION to each element of LIST for side effects only." - (while list - (funcall function (car list)) - (setq list (cdr list)))) - -(defun mh-scan-format () - "Return the output format argument for the scan program." - (if (equal mh-scan-format-file t) - (list "-format" (if (mh-variant-p 'nmh 'mu-mh) - (list (mh-update-scan-format - mh-scan-format-nmh mh-cmd-note)) - (list (mh-update-scan-format - mh-scan-format-mh mh-cmd-note)))) - (if (not (equal mh-scan-format-file nil)) - (list "-form" mh-scan-format-file)))) - - - -;;; Entry points: - -;;;###autoload -(defun mh-rmail (&optional arg) - "Inc(orporate) new mail with MH. -Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, -the Emacs interface to the MH mail system." - (interactive "P") - (mh-find-path) - (if arg - (call-interactively 'mh-visit-folder) - (unless (get-buffer mh-inbox) - (mh-visit-folder mh-inbox (symbol-name mh-unseen-seq))) - (mh-inc-folder))) - -;;;###autoload -(defun mh-nmail (&optional arg) - "Check for new mail in inbox folder. -Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, -the Emacs interface to the MH mail system." - (interactive "P") - (mh-find-path) ; init mh-inbox - (if arg - (call-interactively 'mh-visit-folder) - (mh-visit-folder mh-inbox))) - - - -;;; User executable MH-E commands: - -(defun mh-delete-msg (range) - "Delete RANGE\\. - -To mark a message for deletion, use this command. A \"D\" is placed by the -message in the scan window, and the next undeleted message is displayed. If -the previous command had been \\[mh-previous-undeleted-msg], then the next -message displayed is the first undeleted message previous to the message just -deleted. Use \\[mh-next-undeleted-msg] to force subsequent \\[mh-delete-msg] -commands to move forward to the next undeleted message after deleting the -message under the cursor. - -The hook `mh-delete-msg-hook' is called after you mark a message for deletion. -For example, a past maintainer of MH-E used this once when he kept statistics -on his mail usage. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." - (interactive (list (mh-interactive-range "Delete"))) - (mh-delete-msg-no-motion range) - (if (looking-at mh-scan-deleted-msg-regexp) - (mh-next-msg))) - -(defun mh-delete-msg-no-motion (range) - "Delete RANGE, don't move to next message. - -This command marks the RANGE for deletion but leaves the cursor at the current -message in case you wish to perform other operations on the message. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." - (interactive (list (mh-interactive-range "Delete"))) - (mh-iterate-on-range () range - (mh-delete-a-msg nil))) - -(defun mh-execute-commands () - "Process outstanding delete and refile requests\\. - -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, which are lost. - -This function runs `mh-before-commands-processed-hook' before the commands are -processed and `mh-after-commands-processed-hook' after the commands are -processed." - (interactive) - (if mh-folder-view-stack (mh-widen t)) - (mh-process-commands mh-current-folder) - (mh-set-scan-mode) - (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency - (mh-make-folder-mode-line) - t) ; return t for write-file-functions - -(defun mh-first-msg () - "Display first message." - (interactive) - (goto-char (point-min)) - (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp))) - (forward-line 1))) - -(defun mh-header-display () - "Display message with all header fields\\. - -Use the command \\[mh-show] to show the message normally again." - (interactive) - (and (not mh-showing-with-headers) - (or mh-mhl-format-file mh-clean-message-header-flag) - (mh-invalidate-show-buffer)) - (let ((mh-decode-mime-flag nil) - (mh-mhl-format-file nil) - (mh-clean-message-header-flag nil)) - (mh-show-msg nil) - (mh-in-show-buffer (mh-show-buffer) - (goto-char (point-min)) - (mh-recenter 0)) - (setq mh-showing-with-headers t))) - -(defun mh-inc-folder (&optional maildrop-name folder) - "Incorporate new mail into a folder. - -You can incorporate mail from any file into the current folder by -specifying a prefix argument; you'll be prompted for the name of the -file to use as well as the destination folder - -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. - -In a program optional argument MAILDROP-NAME specifies an alternate -maildrop from the default. The optional argument FOLDER specifies -where to incorporate mail instead of the default named by `mh-inbox'." - (interactive (list (if current-prefix-arg - (expand-file-name - (read-file-name "inc mail from file: " - mh-user-path))) - (if current-prefix-arg - (mh-prompt-for-folder "inc mail into" mh-inbox t)))) - (if (not folder) - (setq folder mh-inbox)) - (let ((threading-needed-flag nil)) - (let ((config (current-window-configuration))) - (when (and mh-show-buffer (get-buffer mh-show-buffer)) - (delete-windows-on mh-show-buffer)) - (cond ((not (get-buffer folder)) - (mh-make-folder folder) - (setq threading-needed-flag mh-show-threads-flag) - (setq mh-previous-window-config config)) - ((not (eq (current-buffer) (get-buffer folder))) - (switch-to-buffer folder) - (setq mh-previous-window-config config)))) - (mh-get-new-mail maildrop-name) - (when (and threading-needed-flag - (save-excursion - (goto-char (point-min)) - (or (null mh-large-folder) - (not (equal (forward-line (1+ mh-large-folder)) 0)) - (and (message "Not threading since the number of messages exceeds `mh-large-folder'") - nil)))) - (mh-toggle-threads)) - (beginning-of-line) - (if (and mh-showing-mode (looking-at mh-scan-valid-regexp)) (mh-show)) - (run-hooks 'mh-inc-folder-hook))) - -(defun mh-last-msg () - "Display last message." - (interactive) - (goto-char (point-max)) - (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp))) - (forward-line -1)) - (mh-recenter nil)) - -(defun mh-next-undeleted-msg (&optional count wait-after-complaining-flag) - "Display next message. - -This command can be given a prefix argument COUNT to specify how many unread -messages to skip. - -In a program, pause for a second after printing message if we are at the last -undeleted message and optional argument WAIT-AFTER-COMPLAINING-FLAG is -non-nil." - (interactive "p") - (setq mh-next-direction 'forward) - (forward-line 1) - (cond ((re-search-forward mh-scan-good-msg-regexp nil t count) - (beginning-of-line) - (mh-maybe-show)) - (t (forward-line -1) - (message "No more undeleted messages") - (if wait-after-complaining-flag (sit-for 1))))) - -(defun mh-folder-from-address () - "Derive folder name from sender. - -The name of the folder is derived as follows: - - a) The folder name associated with the first address found in the list - `mh-default-folder-list' is used. Each element in this list contains a - `Check Recipient' item. If this item is turned on, then the address is - checked against the recipient instead of the sender. This is useful for - mailing lists. - - b) An alias prefixed by `mh-default-folder-prefix' corresponding to the - address is used. The prefix is used to prevent clutter in your mail - directory. - -Return nil if a folder name was not derived, or if the variable -`mh-default-folder-must-exist-flag' is t and the folder does not exist." - ;; Loop for all entries in mh-default-folder-list - (save-restriction - (goto-char (point-min)) - (re-search-forward "\n\n" nil 'limit) - (narrow-to-region (point-min) (point)) - (let ((to/cc (concat (or (message-fetch-field "to") "") ", " - (or (message-fetch-field "cc") ""))) - (from (or (message-fetch-field "from") "")) - folder-name) - (setq folder-name - (loop for list in mh-default-folder-list - when (string-match (nth 0 list) (if (nth 2 list) to/cc from)) - return (nth 1 list) - finally return nil)) - - ;; Make sure a result from `mh-default-folder-list' begins with "+" - ;; since 'mh-expand-file-name below depends on it - (when (and folder-name (not (eq (aref folder-name 0) ?+))) - (setq folder-name (concat "+" folder-name))) - - ;; If not, is there an alias for the address? - (when (not folder-name) - (let* ((from-header (mh-extract-from-header-value)) - (address (and from-header - (nth 1 (mail-extract-address-components - from-header)))) - (alias (and address (mh-alias-address-to-alias address)))) - (when alias - (setq folder-name - (and alias (concat "+" mh-default-folder-prefix alias)))))) - - ;; If mh-default-folder-must-exist-flag set, check that folder exists. - (if (and folder-name - (or (not mh-default-folder-must-exist-flag) - (file-exists-p (mh-expand-file-name folder-name)))) - folder-name)))) - -(defun mh-prompt-for-refile-folder () - "Prompt the user for a folder in which the message should be filed. -The folder is returned as a string. - -The default folder name is generated by the option -`mh-default-folder-for-message-function' if it is non-nil or -`mh-folder-from-address'." - (mh-prompt-for-folder - "Destination" - (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t))))) - (if (null refile-file) "" - (save-excursion - (set-buffer (get-buffer-create mh-temp-buffer)) - (erase-buffer) - (insert-file-contents refile-file) - (or (and mh-default-folder-for-message-function - (let ((buffer-file-name refile-file)) - (funcall mh-default-folder-for-message-function))) - (mh-folder-from-address) - (and (eq 'refile (car mh-last-destination-folder)) - (symbol-name (cdr mh-last-destination-folder))) - "")))) - t)) - -(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag) - "Refile (output) RANGE into FOLDER. - -You are prompted for the folder name. Note that this command can also be used -to create folders. If you specify a folder that does not exist, you will be -prompted to create it. - -The hook `mh-refile-msg-hook' is called after a message is marked to be -refiled. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -In a program, the variables `mh-last-destination' and -`mh-last-destination-folder' are not updated if -DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil." - (interactive (list (mh-interactive-range "Refile") - (intern (mh-prompt-for-refile-folder)))) - (unless dont-update-last-destination-flag - (setq mh-last-destination (cons 'refile folder) - mh-last-destination-folder mh-last-destination)) - (mh-iterate-on-range () range - (mh-refile-a-msg nil folder)) - (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg))) - -(defun mh-refile-or-write-again (range &optional interactive-flag) - "Repeat last output command. - -If you are refiling several messages into the same folder, you can use this -command to repeat the last refile or write. You can use a range. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -In a program, a non-nil INTERACTIVE-FLAG means that the function was called -interactively." - (interactive (list (mh-interactive-range "Redo") t)) - (if (null mh-last-destination) - (error "No previous refile or write")) - (cond ((eq (car mh-last-destination) 'refile) - (mh-refile-msg range (cdr mh-last-destination)) - (message "%s" (format "Destination folder: %s" - (cdr mh-last-destination)))) - (t - (mh-iterate-on-range msg range - (apply 'mh-write-msg-to-file msg (cdr mh-last-destination))) - (mh-next-msg interactive-flag)))) - -(defun mh-quit () - "Quit the current MH-E folder. - -When you want to quit using MH-E and go back to editing, you can use this -command. This buries the buffers of the current MH-E folder and restores the -buffers that were present when you first ran \\[mh-rmail]. It also removes any -MH-E working buffers whose name begins with \" *mh-\" or \"*MH-E \". You can -later restore your MH-E session by selecting the \"+inbox\" buffer or by -running \\[mh-rmail] again. - -The two hooks `mh-before-quit-hook' and `mh-quit-hook' are called by this -function. The former one is called before the quit occurs, so you might use it -to perform any MH-E operations; you could perform some query and abort the -quit or call `mh-execute-commands', for example. The latter is not run in an -MH-E context, so you might use it to modify the window setup." - (interactive) - (run-hooks 'mh-before-quit-hook) - (let ((show-buffer (get-buffer mh-show-buffer))) - (when show-buffer - (kill-buffer show-buffer))) - (mh-update-sequences) - (mh-destroy-postponed-handles) - (bury-buffer (current-buffer)) - - ;; Delete all MH-E temporary and working buffers. - (dolist (buffer (buffer-list)) - (when (or (string-match "^ \\*mh-" (buffer-name buffer)) - (string-match "^\\*MH-E " (buffer-name buffer))) - (kill-buffer buffer))) - - (if mh-previous-window-config - (set-window-configuration mh-previous-window-config)) - (run-hooks 'mh-quit-hook)) - -(defun mh-page-msg (&optional lines) - "Display next page in message. - -You can give this command a prefix argument that specifies the number of LINES -to scroll. This command will also show the next undeleted message if it is -used at the bottom of a message." - (interactive "P") - (if mh-showing-mode - (if mh-page-to-next-msg-flag - (if (equal mh-next-direction 'backward) - (mh-previous-undeleted-msg) - (mh-next-undeleted-msg)) - (if (mh-in-show-buffer (mh-show-buffer) - (pos-visible-in-window-p (point-max))) - (progn - (message - "End of message (Type %s to read %s undeleted message)" - (single-key-description last-input-event) - (if (equal mh-next-direction 'backward) - "previous" - "next")) - (setq mh-page-to-next-msg-flag t)) - (scroll-other-window lines))) - (mh-show))) - -(defun mh-previous-page (&optional lines) - "Display next page in message. - -You can give this command a prefix argument that specifies the number of LINES -to scroll." - (interactive "P") - (mh-in-show-buffer (mh-show-buffer) - (scroll-down lines))) - -(defun mh-previous-undeleted-msg (&optional count wait-after-complaining-flag) - "Display previous message. - -This command can be given a prefix argument COUNT to specify how many unread -messages to skip. - -In a program, pause for a second after printing message if we are at the last -undeleted message and optional argument WAIT-AFTER-COMPLAINING-FLAG is -non-nil." - (interactive "p") - (setq mh-next-direction 'backward) - (beginning-of-line) - (cond ((re-search-backward mh-scan-good-msg-regexp nil t count) - (mh-maybe-show)) - (t (message "No previous undeleted message") - (if wait-after-complaining-flag (sit-for 1))))) - -(defun mh-previous-unread-msg (&optional count) - "Display previous unread message. - -This command can be given a prefix argument COUNT to specify how many unread -messages to skip." - (interactive "p") - (unless (> count 0) - (error "The function mh-previous-unread-msg expects positive argument")) - (setq count (1- count)) - (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list))) - (cur-msg (mh-get-msg-num nil))) - (cond ((and (not cur-msg) (not (bobp)) - ;; If we are at the end of the buffer back up one line and go - ;; to unread message after that. - (progn - (forward-line -1) - (setq cur-msg (mh-get-msg-num nil))) - nil)) - ((or (null unread-sequence) (not cur-msg)) - ;; No unread message or there aren't any messages in buffer... - (message "No more unread messages")) - ((progn - ;; Skip count messages... - (while (and unread-sequence (>= (car unread-sequence) cur-msg)) - (setq unread-sequence (cdr unread-sequence))) - (while (> count 0) - (setq unread-sequence (cdr unread-sequence)) - (setq count (1- count))) - (not (car unread-sequence))) - (message "No more unread messages")) - (t (loop for msg in unread-sequence - when (mh-goto-msg msg t) return nil - finally (message "No more unread messages")))))) - -(defun mh-goto-next-button (backward-flag &optional criterion) - "Search for next button satisfying criterion. -If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If -CRITERION is a function or a symbol which has a function binding then that -function must return non-nil at the button we stop." - (unless (or (and (symbolp criterion) (fboundp criterion)) - (functionp criterion)) - (setq criterion (lambda (x) t))) - ;; Move to the next button in the buffer satisfying criterion - (goto-char (or (save-excursion - (beginning-of-line) - ;; Find point before current button - (let ((point-before-current-button - (save-excursion - (while (get-text-property (point) 'mh-data) - (unless (= (forward-line - (if backward-flag 1 -1)) - 0) - (if backward-flag - (goto-char (point-min)) - (goto-char (point-max))))) - (point)))) - ;; Skip over current button - (while (and (get-text-property (point) 'mh-data) - (not (if backward-flag (bobp) (eobp)))) - (forward-line (if backward-flag -1 1))) - ;; Stop at next MIME button if any exists. - (block loop - (while (/= (progn - (unless (= (forward-line - (if backward-flag -1 1)) - 0) - (if backward-flag - (goto-char (point-max)) - (goto-char (point-min))) - (beginning-of-line)) - (point)) - point-before-current-button) - (when (and (get-text-property (point) 'mh-data) - (funcall criterion (point))) - (return-from loop (point)))) - nil))) - (point)))) - -(defun mh-next-button (&optional backward-flag) - "Go to the next button. - -If the end of the buffer is reached then the search wraps over to the start of -the buffer. - -If an optional prefix argument BACKWARD-FLAG is given, the cursor will move to -the previous button." - (interactive (list current-prefix-arg)) - (unless mh-showing-mode - (mh-show)) - (mh-in-show-buffer (mh-show-buffer) - (mh-goto-next-button backward-flag))) - -(defun mh-prev-button () - "Go to the previous button. - -If the beginning of the buffer is reached then the search wraps over to the -end of the buffer." - (interactive) - (mh-next-button t)) - -(defun mh-folder-mime-action (part-index action include-security-flag) - "Go to PART-INDEX and carry out ACTION. -If PART-INDEX is nil then go to the next part in the buffer. The search for -the next buffer wraps around if end of buffer is reached. If argument -INCLUDE-SECURITY-FLAG is non-nil then include security info buttons when -searching for a suitable parts." - (unless mh-showing-mode - (mh-show)) - (mh-in-show-buffer (mh-show-buffer) - (let ((criterion - (cond (part-index - (lambda (p) - (let ((part (get-text-property p 'mh-part))) - (and (integerp part) (= part part-index))))) - (t (lambda (p) - (if include-security-flag - (get-text-property p 'mh-data) - (integerp (get-text-property p 'mh-part))))))) - (point (point))) - (cond ((and (get-text-property point 'mh-part) - (or (null part-index) - (= (get-text-property point 'mh-part) part-index))) - (funcall action)) - ((and (get-text-property point 'mh-data) - include-security-flag - (null part-index)) - (funcall action)) - (t - (mh-goto-next-button nil criterion) - (if (= (point) point) - (message "No matching MIME part found") - (funcall action))))))) - -(defun mh-folder-toggle-mime-part (part-index) - "View attachment. - -This command displays (or hides) the attachment associated with the button -under the cursor. If the cursor is not located over a button, then the cursor -first moves to the next button, wrapping to the beginning of the message if -necessary. This command has the advantage over related commands of working -from the MH-Folder buffer. - -You can also provide a numeric prefix argument PART-INDEX to view the -attachment labeled with that number. If Emacs does not know how to display the -attachment, then Emacs offers to save the attachment in a file." - (interactive "P") - (when (consp part-index) (setq part-index (car part-index))) - (mh-folder-mime-action part-index #'mh-press-button t)) - -(defun mh-folder-inline-mime-part (part-index) - "Show attachment verbatim. - -You can view the raw contents of an attachment with this command. This command -displays (or hides) the contents of the attachment associated with the button -under the cursor verbatim. If the cursor is not located over a button, then -the cursor first moves to the next button, wrapping to the beginning of the -message if necessary. - -You can also provide a numeric prefix argument PART-INDEX to view the -attachment labeled with that number." - (interactive "P") - (when (consp part-index) (setq part-index (car part-index))) - (mh-folder-mime-action part-index #'mh-mime-inline-part nil)) - -(defun mh-folder-save-mime-part (part-index) - "Save (output) attachment. - -This command saves the attachment associated with the button under the cursor. -If the cursor is not located over a button, then the cursor first moves to the -next button, wrapping to the beginning of the message if necessary. - -You can also provide a numeric prefix argument PART-INDEX to save the -attachment labeled with that number. - -This command prompts you for a filename and suggests a specific name if it is -available." - (interactive "P") - (when (consp part-index) (setq part-index (car part-index))) - (mh-folder-mime-action part-index #'mh-mime-save-part nil)) - -(defvar mh-thread-scan-line-map-stack) - -(defun mh-reset-threads-and-narrowing () - "Reset all variables pertaining to threads and narrowing. -Also removes all content from the folder buffer." - (setq mh-view-ops ()) - (setq mh-folder-view-stack ()) - (setq mh-thread-scan-line-map-stack ()) - (let ((buffer-read-only nil)) (erase-buffer))) - -(defun mh-rescan-folder (&optional range dont-exec-pending) - "Rescan folder\\. - -This command is useful to grab all messages in your \"+inbox\" after -processing your new mail for the first time. If you don't want to rescan the -entire folder, this command will accept a RANGE. Check the documentation of -`mh-interactive-range' to see how RANGE is read in interactive use. - -This command will ask if you want to process refiles or deletes first and then -either run \\[mh-execute-commands] for you or undo the pending refiles and -deletes, which are lost. - -In a program, the processing of outstanding commands is not performed if -DONT-EXEC-PENDING is non-nil." - (interactive (list (if current-prefix-arg - (mh-read-range "Rescan" mh-current-folder t nil t - mh-interpret-number-as-range-flag) - nil))) - (setq mh-next-direction 'forward) - (let ((threaded-flag (memq 'unthread mh-view-ops))) - (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending) - (cond (threaded-flag (mh-toggle-threads)) - (mh-index-data (mh-index-insert-folder-headers))))) - -(defun mh-write-msg-to-file (message file no-header) - "Append MESSAGE to end of FILE\\. - -You are prompted for the filename. If the file already exists, the message is -appended to it. You can also write the message to the file without the header -by specifying a prefix argument NO-HEADER. Subsequent writes to the same file -can be made with the command \\[mh-refile-or-write-again]." - (interactive - (list (mh-get-msg-num t) - (let ((default-dir (if (eq 'write (car mh-last-destination-write)) - (file-name-directory - (car (cdr mh-last-destination-write))) - default-directory))) - (read-file-name (format "Save message%s in file: " - (if current-prefix-arg " body" "")) - default-dir - (if (eq 'write (car mh-last-destination-write)) - (car (cdr mh-last-destination-write)) - (expand-file-name "mail.out" default-dir)))) - current-prefix-arg)) - (let ((msg-file-to-output (mh-msg-filename message)) - (output-file (mh-expand-file-name file))) - (setq mh-last-destination (list 'write file (if no-header 'no-header)) - mh-last-destination-write mh-last-destination) - (save-excursion - (set-buffer (get-buffer-create mh-temp-buffer)) - (erase-buffer) - (insert-file-contents msg-file-to-output) - (goto-char (point-min)) - (if no-header (search-forward "\n\n")) - (append-to-file (point) (point-max) output-file)))) - -(defun mh-toggle-showing () - "Toggle the scanning mode/showing mode of displaying messages." - (interactive) - (if mh-showing-mode - (mh-set-scan-mode) - (mh-show))) - -(defun mh-undo (range) - "Undo pending deletes or refiles in RANGE. - -If you've deleted a message or refiled it, but changed your mind, you can -cancel the action before you've executed it. Use this command to undo a refile -on or deletion of a single message. You can also undo refiles and deletes for -messages that are found in a given RANGE. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." - (interactive (list (mh-interactive-range "Undo"))) - (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) - (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)) - (progn - (mh-undo-msg (mh-get-msg-num t)) - (mh-maybe-show)) - (goto-char original-position) - (error "Nothing to undo")))) - (t (mh-iterate-on-range () range - (mh-undo-msg nil)))) - (if (not (mh-outstanding-commands-p)) - (mh-set-folder-modified-p nil))) - - -(defun mh-folder-line-matches-show-buffer-p () - "Return t if the message under point in folder-mode is in the show buffer. -Return nil in any other circumstance (no message under point, no show buffer, -the message in the show buffer doesn't match." - (and (eq major-mode 'mh-folder-mode) - (mh-get-msg-num nil) - mh-show-buffer - (get-buffer mh-show-buffer) - (buffer-file-name (get-buffer mh-show-buffer)) - (string-match ".*/\\([0-9]+\\)$" - (buffer-file-name (get-buffer mh-show-buffer))) - (string-equal - (match-string 1 (buffer-file-name (get-buffer mh-show-buffer))) - (int-to-string (mh-get-msg-num nil))))) - -(eval-when-compile (require 'gnus)) - -(defmacro mh-macro-expansion-time-gnus-version () - "Return Gnus version available at macro expansion time. -The macro evaluates the Gnus version at macro expansion time. If MH-E was -compiled then macro expansion happens at compile time." - gnus-version) - -(defun mh-run-time-gnus-version () - "Return Gnus version available at run time." - (require 'gnus) - gnus-version) - -;;;###autoload -(defun mh-version () - "Display version information about MH-E and the MH mail handling system." - (interactive) - (set-buffer (get-buffer-create mh-info-buffer)) - (erase-buffer) - ;; MH-E version. - (insert "MH-E " mh-version "\n\n") - ;; MH-E compilation details. - (insert "MH-E compilation details:\n") - (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version))) - (gnus-compiled-version (if compiled-mhe - (mh-macro-expansion-time-gnus-version) - "N/A"))) - (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n" - " Gnus (compile-time):\t" gnus-compiled-version "\n" - " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n")) - ;; Emacs version. - (insert (emacs-version) "\n\n") - ;; MH version. - (if mh-variant-in-use - (insert mh-variant-in-use "\n" - " mh-progs:\t" mh-progs "\n" - " mh-lib:\t" mh-lib "\n" - " mh-lib-progs:\t" mh-lib-progs "\n\n") - (insert "No MH variant detected\n")) - ;; Linux version. - (condition-case () - (call-process "uname" nil t nil "-a") - (file-error)) - (goto-char (point-min)) - (display-buffer mh-info-buffer)) - -(defun mh-parse-flist-output-line (line &optional current-folder) - "Parse LINE to generate folder name, unseen messages and total messages. -If CURRENT-FOLDER is non-nil then it contains the current folder name and it is -used to avoid problems in corner cases involving folders whose names end with a -'+' character." - (with-temp-buffer - (insert line) - (goto-char (point-max)) - (let (folder unseen total p) - (when (search-backward " out of " (point-min) t) - (setq total (read-from-string - (buffer-substring-no-properties - (match-end 0) (line-end-position)))) - (when (search-backward " in sequence " (point-min) t) - (setq p (point)) - (when (search-backward " has " (point-min) t) - (setq unseen (read-from-string (buffer-substring-no-properties - (match-end 0) p))) - (while (eq (char-after) ? ) - (backward-char)) - (setq folder (buffer-substring-no-properties - (point-min) (1+ (point)))) - (when (and (equal (aref folder (1- (length folder))) ?+) - (equal current-folder folder)) - (setq folder (substring folder 0 (1- (length folder))))) - (values (format "+%s" folder) (car unseen) (car total)))))))) - -(defun mh-folder-size-folder (folder) - "Find size of FOLDER using `folder'." - (with-temp-buffer - (let ((u (length (cdr (assoc mh-unseen-seq - (mh-read-folder-sequences folder nil)))))) - (call-process (expand-file-name "folder" mh-progs) nil t nil - "-norecurse" folder) - (goto-char (point-min)) - (if (re-search-forward " has \\([0-9]+\\) " nil t) - (values (car (read-from-string (match-string 1))) u folder) - (values 0 u folder))))) - -(defun mh-folder-size-flist (folder) - "Find size of FOLDER using `flist'." - (with-temp-buffer - (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero" - "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) - (goto-char (point-min)) - (multiple-value-bind (folder unseen total) - (mh-parse-flist-output-line - (buffer-substring (point) (line-end-position))) - (values total unseen folder)))) - -(defun mh-folder-size (folder) - "Find size of FOLDER." - (if mh-flists-present-flag - (mh-folder-size-flist folder) - (mh-folder-size-folder folder))) - -(defun mh-visit-folder (folder &optional range index-data) - "Visit FOLDER. - -When you want to read the messages that you have refiled into folders, use -this command to visit the folder. You are prompted for the folder name. - -The folder buffer will show just unseen messages if there are any; otherwise, -it will show all the messages in the buffer as long there are fewer than -`mh-large-folder' messages. If there are more, then you are prompted for a -range of messages to scan. - -You can provide a prefix argument in order to specify a RANGE of messages to -show when you visit the folder. In this case, regions are not used to specify -the range and `mh-large-folder' is ignored. Check the documentation of -`mh-interactive-range' to see how RANGE is read in interactive use. - -Note that this command can also be used to create folders. If you specify a -folder that does not exist, you will be prompted to create it. - -Do not call this function from outside MH-E; use \\[mh-rmail] instead. - -If, in a program, RANGE is nil (the default), then all messages in FOLDER are -displayed. If an index buffer is being created then INDEX-DATA is used to -initialize the index buffer specific data structures." - (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) - (list folder-name - (mh-read-range "Scan" folder-name t nil - current-prefix-arg - mh-interpret-number-as-range-flag)))) - (let ((config (current-window-configuration)) - (current-buffer (current-buffer)) - (threaded-view-flag mh-show-threads-flag)) - (delete-other-windows) - (save-excursion - (when (get-buffer folder) - (set-buffer folder) - (setq threaded-view-flag (memq 'unthread mh-view-ops)))) - (when index-data - (mh-make-folder folder) - (setq mh-index-data (car index-data) - mh-index-msg-checksum-map (make-hash-table :test #'equal) - mh-index-checksum-origin-map (make-hash-table :test #'equal)) - (mh-index-update-maps folder (cadr index-data)) - (mh-index-create-sequences)) - (mh-scan-folder folder (or range "all")) - (cond ((and threaded-view-flag - (save-excursion - (goto-char (point-min)) - (or (null mh-large-folder) - (not (equal (forward-line (1+ mh-large-folder)) 0)) - (and (message "Not threading since the number of messages exceeds `mh-large-folder'") - nil)))) - (mh-toggle-threads)) - (mh-index-data - (mh-index-insert-folder-headers))) - (unless (eq current-buffer (current-buffer)) - (setq mh-previous-window-config config))) - nil) - - -(defun mh-update-sequences () - "Flush MH-E's state out to MH. -This function updates the sequence specified by your \"Unseen-Sequence:\" -profile component, \"cur\", and the sequence listed by the `mh-tick-seq' -option which is \"tick\" by default. The message at the cursor is used for -\"cur\"." - (interactive) - ;; mh-update-sequences is the opposite of mh-read-folder-sequences, - ;; which updates MH-E's state from MH. - (let ((folder-set (mh-update-unseen)) - (new-cur (mh-get-msg-num nil))) - (if new-cur - (let ((seq-entry (mh-find-seq 'cur))) - (mh-remove-cur-notation) - (setcdr seq-entry - (list new-cur)) ;delete-seq-locally, add-msgs-to-seq - (mh-define-sequence 'cur (list new-cur)) - (beginning-of-line) - (if (looking-at mh-scan-good-msg-regexp) - (mh-notate-cur))) - (or folder-set - (save-excursion - ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! - ;; So I added this sanity check. - (if (stringp mh-current-folder) - (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast") - (mh-exec-cmd-quiet t "folder" "-fast"))))))) - - - -;;; Support routines. - -(defun mh-delete-a-msg (message) - "Delete MESSAGE. -If MESSAGE is nil then the message at point is deleted. - -The hook `mh-delete-msg-hook' is called after you mark a message for deletion. -For example, a past maintainer of MH-E used this once when he kept statistics -on his mail usage." - (save-excursion - (if (numberp message) - (mh-goto-msg message nil t) - (beginning-of-line) - (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-deleted-msg-regexp) - nil - (mh-set-folder-modified-p t) - (setq mh-delete-list (cons message mh-delete-list)) - (mh-notate nil mh-note-deleted mh-cmd-note) - (run-hooks 'mh-delete-msg-hook)))) - -(defun mh-refile-a-msg (message folder) - "Refile MESSAGE in FOLDER. -If MESSAGE is nil then the message at point is refiled. - -Folder is a symbol, not a string. -The hook `mh-refile-msg-hook' is called after a message is marked to be -refiled." - (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-deleted-msg-regexp) - (error "Message %d is deleted. Undo delete 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? " - message folder)) - (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" - "-src" mh-current-folder - (symbol-name folder)) - (message "Message not copied"))) - (t - (mh-set-folder-modified-p t) - (cond ((null (assoc folder mh-refile-list)) - (push (list folder message) mh-refile-list)) - ((not (member message (cdr (assoc folder mh-refile-list)))) - (push message (cdr (assoc folder mh-refile-list))))) - (mh-notate nil mh-note-refiled mh-cmd-note) - (run-hooks 'mh-refile-msg-hook))))) - -(defun mh-next-msg (&optional wait-after-complaining-flag) - "Move backward or forward to the next undeleted message in the buffer. -If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and we are at the -last message, then wait for a second after telling the user that there aren't -any more unread messages." - (if (eq mh-next-direction 'forward) - (mh-next-undeleted-msg 1 wait-after-complaining-flag) - (mh-previous-undeleted-msg 1 wait-after-complaining-flag))) - -(defun mh-next-unread-msg (&optional count) - "Display next unread message. - -This command can be given a prefix argument COUNT to specify how many unread -messages to skip." - (interactive "p") - (unless (> count 0) - (error "The function mh-next-unread-msg expects positive argument")) - (setq count (1- count)) - (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list)))) - (cur-msg (mh-get-msg-num nil))) - (cond ((and (not cur-msg) (not (bobp)) - ;; If we are at the end of the buffer back up one line and go - ;; to unread message after that. - (progn - (forward-line -1) - (setq cur-msg (mh-get-msg-num nil))) - nil)) - ((or (null unread-sequence) (not cur-msg)) - ;; No unread message or there aren't any messages in buffer... - (message "No more unread messages")) - ((progn - ;; Skip messages - (while (and unread-sequence (>= cur-msg (car unread-sequence))) - (setq unread-sequence (cdr unread-sequence))) - (while (> count 0) - (setq unread-sequence (cdr unread-sequence)) - (setq count (1- count))) - (not (car unread-sequence))) - (message "No more unread messages")) - (t (loop for msg in unread-sequence - when (mh-goto-msg msg t) return nil - finally (message "No more unread messages")))))) - -(defun mh-set-scan-mode () - "Display the scan listing buffer, but do not show a message." - (if (get-buffer mh-show-buffer) - (delete-windows-on mh-show-buffer)) - (mh-showing-mode 0) - (force-mode-line-update) - (if mh-recenter-summary-flag - (mh-recenter nil))) - -(defun mh-undo-msg (msg) - "Undo the deletion or refile of one MSG. -If MSG is nil then act on the message at point" - (save-excursion - (if (numberp msg) - (mh-goto-msg msg t t) - (beginning-of-line) - (setq msg (mh-get-msg-num t))) - (cond ((memq msg mh-delete-list) - (setq mh-delete-list (delq msg mh-delete-list))) - (t - (dolist (folder-msg-list mh-refile-list) - (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) - (setq mh-refile-list (loop for x in mh-refile-list - unless (null (cdr x)) collect x)))) - (mh-notate nil ? mh-cmd-note))) - - - -;;; The folder data abstraction. - -(defvar mh-index-data-file ".mhe_index" - "MH-E specific file where index seach info is stored.") - -(defun mh-make-folder (name) - "Create a new mail folder called NAME. -Make it the current folder." - (switch-to-buffer name) - (setq buffer-read-only nil) - (erase-buffer) - (if mh-adaptive-cmd-note-flag - (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width name)))) - (setq buffer-read-only t) - (mh-folder-mode) - (mh-set-folder-modified-p nil) - (setq buffer-file-name mh-folder-filename) - (when (and (not mh-index-data) - (file-exists-p (concat buffer-file-name mh-index-data-file))) - (mh-index-read-data)) - (mh-make-folder-mode-line)) - -;; Ensure new buffers won't get this mode if default-major-mode is nil. -(put 'mh-folder-mode 'mode-class 'special) - - - -;;; Build mh-folder-mode menu - -;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) -;; Menus for folder mode: folder, message, sequence (in that order) -;; folder-mode "Sequence" menu -(easy-menu-define - mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence." - '("Sequence" - ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)] - ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)] - ["Delete Message from Sequence..." mh-delete-msg-from-seq - (mh-get-msg-num nil)] - ["List Sequences in Folder..." mh-list-sequences t] - ["Delete Sequence..." mh-delete-seq t] - ["Narrow to Sequence..." mh-narrow-to-seq t] - ["Widen from Sequence" mh-widen mh-folder-view-stack] - "--" - ["Narrow to Subject Sequence" mh-narrow-to-subject t] - ["Narrow to Tick Sequence" mh-narrow-to-tick - (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))] - ["Delete Rest of Same Subject" mh-delete-subject t] - ["Toggle Tick Mark" mh-toggle-tick t] - "--" - ["Push State Out to MH" mh-update-sequences t])) - -;; folder-mode "Message" menu -(easy-menu-define - mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message." - '("Message" - ["Show Message" mh-show (mh-get-msg-num nil)] - ["Show Message with Header" mh-header-display (mh-get-msg-num nil)] - ["Next Message" mh-next-undeleted-msg t] - ["Previous Message" mh-previous-undeleted-msg t] - ["Go to First Message" mh-first-msg t] - ["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)] - ["Execute Delete/Refile" mh-execute-commands - (mh-outstanding-commands-p)] - "--" - ["Compose a New Message" mh-send t] - ["Reply to Message..." mh-reply (mh-get-msg-num nil)] - ["Forward Message..." mh-forward (mh-get-msg-num nil)] - ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)] - ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)] - ["Re-edit a Bounced Message" mh-extract-rejected-mail t] - "--" - ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)] - ["Print Message" mh-print-msg (mh-get-msg-num nil)] - ["Write Message to File..." mh-write-msg-to-file - (mh-get-msg-num nil)] - ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)] - ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)] - ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)])) - -;; folder-mode "Folder" menu -(easy-menu-define - mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder." - '("Folder" - ["Incorporate New Mail" mh-inc-folder t] - ["Toggle Show/Folder" mh-toggle-showing t] - ["Execute Delete/Refile" mh-execute-commands - (mh-outstanding-commands-p)] - ["Rescan Folder" mh-rescan-folder t] - ["Thread Folder" mh-toggle-threads - (not (memq 'unthread mh-view-ops))] - ["Pack Folder" mh-pack-folder t] - ["Sort Folder" mh-sort-folder t] - "--" - ["List Folders" mh-list-folders t] - ["Visit a Folder..." mh-visit-folder t] - ["View New Messages" mh-index-new-messages t] - ["Search a Folder..." mh-search-folder t] - ["Indexed Search..." mh-index-search t] - "--" - ["Quit MH-E" mh-quit t])) - - - -(defmacro mh-remove-xemacs-horizontal-scrollbar () - "Get rid of the horizontal scrollbar that XEmacs insists on putting in." - (when mh-xemacs-flag - `(if (and (featurep 'scrollbar) - (fboundp 'set-specifier)) - (set-specifier horizontal-scrollbar-visible-p nil - (cons (current-buffer) nil))))) - -(defmacro mh-write-file-functions-compat () - "Return `write-file-functions' if it exists. -Otherwise return `local-write-file-hooks'. This macro exists purely for -compatibility. The former symbol is used in Emacs 21.4 onward while the latter -is used in previous versions and XEmacs." - (if (boundp 'write-file-functions) - ''write-file-functions ;Emacs 21.4 - ''local-write-file-hooks)) ; - -You can show the message the cursor is pointing to, and step through the -messages. Messages can be marked for deletion or refiling into another -folder; these commands are executed all at once with a separate command. - -Options that control this mode can be changed with \\[customize-group]; -specify the \"mh\" group. In particular, please see the `mh-scan-format-file' -option if you wish to modify scan's format. - -When a folder is visited, the hook `mh-folder-mode-hook' is run. - -Ranges -====== -Many commands that operate on individual messages, such as `mh-forward' or -`mh-refile-msg' take a RANGE argument. This argument can be used in several -ways. - -If you provide the prefix argument (\\[universal-argument]) to these commands, -then you will be prompted for the message range. This can be any valid MH -range which can include messages, sequences, and the abbreviations (described -in the mh(1) man page): - -- - Indicates all messages in the range to , inclusive. The range - must be nonempty. - -`:N' -`:+N' -`:-N' - Up to N messages beginning with (or ending with) message num. Num may be - any of the predefined symbols: first, prev, cur, next or last. - -`first:N' -`prev:N' -`next:N' -`last:N' - The first, previous, next or last messages, if they exist. - -`all' - All of the messages. - -For example, a range that shows all of these things is `1 2 3 5-10 last:5 -unseen'. - -If the option `transient-mark-mode' is set to t and you set a region in the -MH-Folder buffer, then the MH-E command will perform the operation on all -messages in that region. - -\\{mh-folder-mode-map}" - (mh-do-in-gnu-emacs - (unless mh-folder-buttons-init-flag - (mh-tool-bar-folder-buttons-init) - (setq mh-folder-buttons-init-flag t))) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) - (make-local-variable 'desktop-save-buffer) - (setq desktop-save-buffer t) - (mh-make-local-vars - 'mh-colors-available-flag (mh-colors-available-p) - ; Do we have colors available - 'mh-current-folder (buffer-name) ; Name of folder, a string - 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs - 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" - (file-name-as-directory (mh-expand-file-name (buffer-name))) - 'mh-display-buttons-for-inline-parts-flag - mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to - ; be toggled. - 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed - '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-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-view-ops () ; Stack that keeps track of the order - ; in which narrowing/threading has been - ; carried out. - 'mh-folder-view-stack () ; Stack of previous views of the - ; folder. - 'mh-index-data nil ; If the folder was created by a call - ; to mh-index-search this contains info - ; about the search results. - 'mh-index-previous-search nil ; Previous folder and search-regexp - 'mh-index-msg-checksum-map nil ; msg -> checksum map - 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) - 'mh-index-sequence-search-flag nil ; folder resulted from sequence search - 'mh-first-msg-num nil ; Number of first msg in buffer - 'mh-last-msg-num nil ; Number of last msg in buffer - 'mh-msg-count nil ; Number of msgs in buffer - 'mh-mode-line-annotation nil ; Indicates message range - 'mh-sequence-notation-history (make-hash-table) - ; Remember what is overwritten by - ; mh-note-seq. - 'imenu-create-index-function 'mh-index-create-imenu-index - ; Setup imenu support - 'mh-previous-window-config nil) ; Previous window configuration - (mh-remove-xemacs-horizontal-scrollbar) - (setq truncate-lines t) - (auto-save-mode -1) - (setq buffer-offer-save t) - (mh-make-local-hook (mh-write-file-functions-compat)) - (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) - (make-local-variable 'revert-buffer-function) - (make-local-variable 'hl-line-mode) ; avoid pollution - (mh-funcall-if-exists hl-line-mode 1) - (setq revert-buffer-function 'mh-undo-folder) - (or (assq 'mh-showing-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(mh-showing-mode " Show") minor-mode-alist))) - (easy-menu-add mh-folder-sequence-menu) - (easy-menu-add mh-folder-message-menu) - (easy-menu-add mh-folder-folder-menu) - (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) - (mh-funcall-if-exists mh-tool-bar-init :folder) - (if (and mh-xemacs-flag - font-lock-auto-fontify) - (turn-on-font-lock))) ; Force font-lock in XEmacs. - -(defun mh-toggle-mime-buttons () - "Toggle option `mh-display-buttons-for-inline-parts-flag'." - (interactive) - (setq mh-display-buttons-for-inline-parts-flag - (not mh-display-buttons-for-inline-parts-flag)) - (mh-show nil t)) - -(defun mh-colors-available-p () - "Check if colors are available in the Emacs being used." - (or mh-xemacs-flag - (let ((color-cells - (or (ignore-errors (mh-funcall-if-exists display-color-cells)) - (ignore-errors (mh-funcall-if-exists - x-display-color-cells))))) - (and (numberp color-cells) (>= color-cells 8))))) - -(defun mh-colors-in-use-p () - "Check if colors are being used in the folder buffer." - (and mh-colors-available-flag font-lock-mode)) - -(defun mh-make-local-vars (&rest pairs) - "Initialize local variables according to the variable-value PAIRS." - - (while pairs - (set (make-local-variable (car pairs)) (car (cdr pairs))) - (setq pairs (cdr (cdr pairs))))) - -(defun mh-restore-desktop-buffer (desktop-buffer-file-name - desktop-buffer-name - desktop-buffer-misc) - "Restore an MH folder buffer specified in a desktop file. -When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the file name to -visit, DESKTOP-BUFFER-NAME holds the desired buffer name, and -DESKTOP-BUFFER-MISC holds a list of miscellaneous info used by the -`desktop-buffer-handlers' functions." - (mh-find-path) - (mh-visit-folder desktop-buffer-name) - (current-buffer)) - -;; desktop-buffer-mode-handlers appeared in Emacs 22. -(if (fboundp 'desktop-buffer-mode-handlers) - (add-to-list 'desktop-buffer-mode-handlers - '(mh-folder-mode . mh-restore-desktop-buffer))) - -(defun mh-scan-folder (folder range &optional dont-exec-pending) - "Scan FOLDER over RANGE. - -After the scan is performed, switch to the buffer associated with FOLDER. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -The processing of outstanding commands is not performed if DONT-EXEC-PENDING -is non-nil." - (when (stringp range) - (setq range (delete "" (split-string range "[ \t\n]")))) - (cond ((null (get-buffer folder)) - (mh-make-folder folder)) - (t - (unless dont-exec-pending - (mh-process-or-undo-commands folder) - (mh-reset-threads-and-narrowing)) - (switch-to-buffer folder))) - (mh-regenerate-headers range) - (if (zerop (buffer-size)) - (if (equal range "all") - (message "Folder %s is empty" folder) - (message "No messages in %s, range %s" folder range)) - (mh-goto-cur-msg)) - (when (mh-outstanding-commands-p) - (mh-notate-deleted-and-refiled))) - -(defun mh-msg-num-width-to-column (width) - "Return the column for notations given message number WIDTH. -Note that columns in Emacs start with 0. - -If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this means that -either `mh-scan-format-mh' or `mh-scan-format-nmh' are in use. This function -therefore assumes that the first column is empty (to provide room for the -cursor), the following WIDTH columns contain the message number, and the -column for notations comes after that." - (if (eq mh-scan-format-file t) - (max (1+ width) 2) - (error "%s %s" "Can't call mh-msg-num-width-to-column" - "when mh-scan-format-file is not t"))) - -(defun mh-set-cmd-note (column) - "Set `mh-cmd-note' to COLUMN. -Note that columns in Emacs start with 0." - (setq mh-cmd-note column)) - -(defun mh-regenerate-headers (range &optional update) - "Scan folder over RANGE. -If UPDATE, append the scan lines, otherwise replace." - (let ((folder mh-current-folder) - (range (if (and range (atom range)) (list range) range)) - scan-start) - (message "Scanning %s..." folder) - (mh-remove-all-notation) - (with-mh-folder-updating (nil) - (if update - (goto-char (point-max)) - (delete-region (point-min) (point-max)) - (if mh-adaptive-cmd-note-flag - (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width - folder))))) - (setq scan-start (point)) - (apply #'mh-exec-cmd-output - mh-scan-prog nil - (mh-scan-format) - "-noclear" "-noheader" - "-width" (window-width) - folder range) - (goto-char scan-start) - (cond ((looking-at "scan: no messages in") - (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines - ((looking-at (if (mh-variant-p 'mu-mh) - "scan: message set .* does not exist" - "scan: bad message list ")) - (keep-lines mh-scan-valid-regexp)) - ((looking-at "scan: ")) ; Keep error messages - (t - (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines - (setq mh-seq-list (mh-read-folder-sequences folder nil)) - (mh-notate-user-sequences) - (or update - (setq mh-mode-line-annotation - (if (equal range '("all")) - nil - mh-partial-folder-mode-line-annotation))) - (mh-make-folder-mode-line)) - (message "Scanning %s...done" folder))) - -(defun mh-generate-new-cmd-note (folder) - "Fix the `mh-cmd-note' value for this FOLDER. - -After doing an `mh-get-new-mail' operation in this FOLDER, at least -one line that looks like a truncated message number was found. - -Remove the text added by the last `mh-inc' command. It should be the messages -cur-last. Call `mh-set-cmd-note', adjusting the notation column with the width -of the largest message number in FOLDER. - -Reformat the message number width on each line in the buffer and trim -the line length to fit in the window. - -Rescan the FOLDER in the range cur-last in order to display the -messages that were removed earlier. They should all fit in the scan -line now with no message truncation." - (save-excursion - (let ((maxcol (1- (window-width))) - (old-cmd-note mh-cmd-note) - mh-cmd-note-fmt - msgnum) - ;; Nuke all of the lines just added by the last inc - (delete-char (- (point-max) (point))) - ;; Update the current buffer to reflect the new mh-cmd-note - ;; value needed to display messages. - (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width folder))) - (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d")) - ;; Cleanup the messages that are in the buffer right now - (goto-char (point-min)) - (cond ((memq 'unthread mh-view-ops) - (mh-thread-add-spaces (- mh-cmd-note old-cmd-note))) - (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1) - ;; reformat the number to fix in mh-cmd-note columns - (setq msgnum (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (replace-match (format mh-cmd-note-fmt msgnum)) - ;; trim the line to fix in the window - (end-of-line) - (let ((eol (point))) - (move-to-column maxcol) - (if (<= (point) eol) - (delete-char (- eol (point)))))))) - ;; now re-read the lost messages - (goto-char (point-max)) - (prog1 (point) - (mh-regenerate-headers "cur-last" t))))) - -(defun mh-get-new-mail (maildrop-name) - "Read new mail from MAILDROP-NAME into the current buffer. -Return in the current buffer." - (let ((point-before-inc (point)) - (folder mh-current-folder) - (new-mail-flag nil)) - (with-mh-folder-updating (t) - (if maildrop-name - (message "inc %s -file %s..." folder maildrop-name) - (message "inc %s..." folder)) - (setq mh-next-direction 'forward) - (goto-char (point-max)) - (mh-remove-cur-notation) - (let ((start-of-inc (point))) - (if maildrop-name - ;; I think MH 5 used "-ms-file" instead of "-file", - ;; which would make inc'ing from maildrops fail. - (mh-exec-cmd-output mh-inc-prog nil folder - (mh-scan-format) - "-file" (expand-file-name maildrop-name) - "-width" (window-width) - "-truncate") - (mh-exec-cmd-output mh-inc-prog nil - (mh-scan-format) - "-width" (window-width))) - (if maildrop-name - (message "inc %s -file %s...done" folder maildrop-name) - (message "inc %s...done" folder)) - (goto-char start-of-inc) - (cond ((save-excursion - (re-search-forward "^inc: no mail" nil t)) - (message "No new mail%s%s" (if maildrop-name " in " "") - (if maildrop-name maildrop-name ""))) - ((and (when mh-folder-view-stack - (let ((saved-text (buffer-substring-no-properties - start-of-inc (point-max)))) - (delete-region start-of-inc (point-max)) - (unwind-protect (mh-widen t) - (mh-remove-cur-notation) - (goto-char (point-max)) - (setq start-of-inc (point)) - (insert saved-text) - (goto-char start-of-inc)))) - nil)) - ((re-search-forward "^inc:" nil t) ; Error messages - (error "Error incorporating mail")) - ((and - (equal mh-scan-format-file t) - mh-adaptive-cmd-note-flag - ;; Have we reached an edge condition? - (save-excursion - (re-search-forward mh-scan-msg-overflow-regexp nil 0 1)) - (setq start-of-inc (mh-generate-new-cmd-note folder)) - nil)) - (t - (setq new-mail-flag t))) - (keep-lines mh-scan-valid-regexp) ; Flush random scan lines - (let* ((sequences (mh-read-folder-sequences folder t)) - (new-cur (assoc 'cur sequences)) - (new-unseen (assoc mh-unseen-seq sequences))) - (unless (assoc 'cur mh-seq-list) - (push (list 'cur) mh-seq-list)) - (unless (assoc mh-unseen-seq mh-seq-list) - (push (list mh-unseen-seq) mh-seq-list)) - (setcdr (assoc 'cur mh-seq-list) (cdr new-cur)) - (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen))) - (when (equal (point-max) start-of-inc) - (mh-notate-cur)) - (if new-mail-flag - (progn - (mh-make-folder-mode-line) - (when (mh-speed-flists-active-p) - (mh-speed-flists t mh-current-folder)) - (when (memq 'unthread mh-view-ops) - (mh-thread-inc folder start-of-inc)) - (mh-goto-cur-msg)) - (goto-char point-before-inc)) - (mh-notate-user-sequences (cons start-of-inc (point-max))))))) - -(defun mh-make-folder-mode-line (&optional ignored) - "Set the fields of the mode line for a folder buffer. -The optional argument is now obsolete and IGNORED. It used to be used to pass -in what is now stored in the buffer-local variable `mh-mode-line-annotation'." - (save-excursion - (save-window-excursion - (mh-first-msg) - (let ((new-first-msg-num (mh-get-msg-num nil))) - (when (or (not (memq 'unthread mh-view-ops)) - (null mh-first-msg-num) - (null new-first-msg-num) - (< new-first-msg-num mh-first-msg-num)) - (setq mh-first-msg-num new-first-msg-num))) - (mh-last-msg) - (let ((new-last-msg-num (mh-get-msg-num nil))) - (when (or (not (memq 'unthread mh-view-ops)) - (null mh-last-msg-num) - (null new-last-msg-num) - (> new-last-msg-num mh-last-msg-num)) - (setq mh-last-msg-num new-last-msg-num))) - (setq mh-msg-count (if mh-first-msg-num - (count-lines (point-min) (point-max)) - 0)) - (setq mode-line-buffer-identification - (list (format " {%%b%s} %s msg%s" - (if mh-mode-line-annotation - (format "/%s" mh-mode-line-annotation) - "") - (if (zerop mh-msg-count) - "no" - (format "%d" mh-msg-count)) - (if (zerop mh-msg-count) - "s" - (cond ((> mh-msg-count 1) - (format "s (%d-%d)" mh-first-msg-num - mh-last-msg-num)) - (mh-first-msg-num - (format " (%d)" mh-first-msg-num)) - ("")))))) - (mh-logo-display)))) - -(defun mh-add-sequence-notation (msg internal-seq-flag) - "Add sequence notation to the MSG on the current line. -If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if font-lock is -turned on." - (with-mh-folder-updating (t) - (save-excursion - (beginning-of-line) - (if internal-seq-flag - (progn - ;; Change the buffer so that if transient-mark-mode is active - ;; and there is an active region it will get deactivated as in - ;; the case of user sequences. - (mh-notate nil nil mh-cmd-note) - (when font-lock-mode - (font-lock-fontify-region (point) (line-end-position)))) - (forward-char (+ mh-cmd-note mh-scan-field-destination-offset)) - (let ((stack (gethash msg mh-sequence-notation-history))) - (setf (gethash msg mh-sequence-notation-history) - (cons (char-after) stack))) - (mh-notate nil mh-note-seq - (+ mh-cmd-note mh-scan-field-destination-offset)))))) - -(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all) - "Remove sequence notation from the MSG on the current line. -If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the -sequence. In that case, no notation needs to be removed. Otherwise the effect -of inserting `mh-note-seq' needs to be reversed. -If ALL is non-nil, then all sequence marks on the scan line are removed." - (with-mh-folder-updating (t) - ;; This takes care of internal sequences... - (mh-notate nil nil mh-cmd-note) - (unless internal-seq-flag - ;; ... and this takes care of user sequences. - (let ((stack (gethash msg mh-sequence-notation-history))) - (while (and all (cdr stack)) - (setq stack (cdr stack))) - (when stack - (save-excursion - (beginning-of-line) - (forward-char (+ mh-cmd-note mh-scan-field-destination-offset)) - (delete-char 1) - (insert (car stack)))) - (setf (gethash msg mh-sequence-notation-history) (cdr stack)))))) - -(defun mh-remove-cur-notation () - "Remove old cur notation." - (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) - (save-excursion - (when (and cur-msg - (mh-goto-msg cur-msg t t) - (looking-at mh-scan-cur-msg-number-regexp)) - (mh-notate nil ? mh-cmd-note) - (setq overlay-arrow-position nil))))) - -(defun mh-remove-all-notation () - "Remove all notations on all scan lines that MH-E introduces." - (save-excursion - (setq overlay-arrow-position nil) - (goto-char (point-min)) - (mh-iterate-on-range msg (cons (point-min) (point-max)) - (mh-notate nil ? mh-cmd-note) - (mh-remove-sequence-notation msg nil t)) - (clrhash mh-sequence-notation-history))) - - -(defun mh-goto-cur-msg (&optional minimal-changes-flag) - "Position the cursor at the current message. -When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't -recenter the folder buffer." - (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) - (cond ((and cur-msg - (mh-goto-msg cur-msg t t)) - (unless minimal-changes-flag - (mh-notate-cur) - (mh-recenter 0) - (mh-maybe-show cur-msg))) - (t - (setq overlay-arrow-position nil) - (message "No current message"))))) - -(defun mh-process-or-undo-commands (folder) - "If FOLDER has outstanding commands, then either process or discard them. -Called by functions like `mh-sort-folder', so also invalidate show buffer." - (set-buffer folder) - (if (mh-outstanding-commands-p) - (if (or mh-do-not-confirm-flag - (y-or-n-p - "Process outstanding deletes and refiles? ")) - (mh-process-commands folder) - (set-buffer folder) - (mh-undo-folder))) - (mh-update-unseen) - (mh-invalidate-show-buffer)) - -(defun mh-process-commands (folder) - "Process outstanding commands for FOLDER. - -This function runs `mh-before-commands-processed-hook' before the commands are -processed and `mh-after-commands-processed-hook' after the commands are -processed." - (message "Processing deletes and refiles for %s..." folder) - (set-buffer folder) - (with-mh-folder-updating (nil) - ;; Run the before hook -- the refile and delete lists are still valid - (run-hooks 'mh-before-commands-processed-hook) - - ;; Update the unseen sequence if it exists - (mh-update-unseen) - - (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))) - (dest-map (and mh-refile-list mh-refile-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-index-delete-folder-headers) - (setq folders-changed - (append folders-changed (mh-index-execute-commands)))) - - ;; Then refile messages - (mh-mapc #'(lambda (folder-msg-list) - (let* ((dest-folder (symbol-name (car folder-msg-list))) - (last (car (mh-translate-range dest-folder "last"))) - (msgs (cdr folder-msg-list))) - (push dest-folder folders-changed) - (setq redraw-needed-flag t) - (apply #'mh-exec-cmd - "refile" "-src" folder dest-folder - (mh-coalesce-msg-list msgs)) - (mh-delete-scan-msgs msgs) - ;; Preserve sequences in destination folder... - (when mh-refile-preserves-sequences-flag - (clrhash dest-map) - (loop for i from (1+ (or last 0)) - for msg in (sort (copy-sequence msgs) #'<) - do (loop for seq-name in (gethash msg seq-map) - do (push i (gethash seq-name dest-map)))) - (maphash - #'(lambda (seq msgs) - ;; Can't be run in the background, since the - ;; current folder is changed by mark this could - ;; lead to a race condition with the next refile. - (apply #'mh-exec-cmd "mark" - "-sequence" (symbol-name seq) dest-folder - "-add" (mapcar #'(lambda (x) (format "%s" x)) - (mh-coalesce-msg-list msgs)))) - dest-map)))) - mh-refile-list) - (setq mh-refile-list ()) - - ;; Now delete messages - (cond (mh-delete-list - (setq redraw-needed-flag t) - (apply 'mh-exec-cmd "rmm" folder - (mh-coalesce-msg-list mh-delete-list)) - (mh-delete-scan-msgs mh-delete-list) - (setq mh-delete-list nil))) - - ;; Don't need to remove sequences since delete and refile do so. - ;; Mark cur message - (if (> (buffer-size) 0) - (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) - - ;; Redraw folder buffer if needed - (when (and redraw-needed-flag) - (when (mh-speed-flists-active-p) - (apply #'mh-speed-flists t folders-changed)) - (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) - (mh-index-data (mh-index-insert-folder-headers)))) - - (and (buffer-file-name (get-buffer mh-show-buffer)) - (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) - ;; If "inc" were to put a new msg in this file, - ;; we would not notice, so mark it invalid now. - (mh-invalidate-show-buffer)) - - (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) - (mh-remove-all-notation) - (mh-notate-user-sequences) - - ;; Run the after hook -- now folders-changed is valid, - ;; but not the lists of specific messages. - (let ((mh-folders-changed folders-changed)) - (run-hooks 'mh-after-commands-processed-hook))) - - (message "Processing deletes and refiles for %s...done" folder))) - -(defun mh-update-unseen () - "Synchronize the unseen sequence with MH. -Return non-nil iff the MH folder was set. -The hook `mh-unseen-updated-hook' is called after the unseen sequence -is updated." - (if mh-seen-list - (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) - (unseen-msgs (mh-seq-msgs unseen-seq))) - (if unseen-msgs - (progn - (mh-undefine-sequence mh-unseen-seq mh-seen-list) - (run-hooks 'mh-unseen-updated-hook) - (while mh-seen-list - (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) - (setq mh-seen-list (cdr mh-seen-list))) - (setcdr unseen-seq unseen-msgs) - t) ;since we set the folder - (setq mh-seen-list nil))))) - -(defun mh-delete-scan-msgs (msgs) - "Delete the scan listing lines for MSGS." - (save-excursion - (while msgs - (when (mh-goto-msg (car msgs) t t) - (when (memq 'unthread mh-view-ops) - (mh-thread-forget-message (car msgs))) - (mh-delete-line 1)) - (setq msgs (cdr msgs))))) - -(defun mh-outstanding-commands-p () - "Return non-nil if there are outstanding deletes or refiles." - (save-excursion - (when (eq major-mode 'mh-show-mode) - (set-buffer mh-show-folder-buffer)) - (or mh-delete-list mh-refile-list))) - -(defun mh-coalesce-msg-list (messages) - "Given a list of MESSAGES, return a list of message number ranges. -This is the inverse of `mh-read-msg-list', which expands ranges. -Message lists passed to MH programs should be processed by this function -to avoid exceeding system command line argument limits." - (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) - (range-high nil) - (prev -1) - (ranges nil)) - (while prev - (if range-high - (if (or (not (numberp prev)) - (not (equal (car msgs) (1- prev)))) - (progn ;non-sequential, flush old range - (if (eq prev range-high) - (setq ranges (cons range-high ranges)) - (setq ranges (cons (format "%s-%s" prev range-high) ranges))) - (setq range-high nil)))) - (or range-high - (setq range-high (car msgs))) ;start new or first range - (setq prev (car msgs)) - (setq msgs (cdr msgs))) - ranges)) - -(defun mh-greaterp (msg1 msg2) - "Return the greater of two message indicators MSG1 and MSG2. -Strings are \"smaller\" than numbers. -Valid values are things like \"cur\", \"last\", 1, and 1820." - (if (numberp msg1) - (if (numberp msg2) - (> msg1 msg2) - t) - (if (numberp msg2) - nil - (string-lessp msg2 msg1)))) - -(defun mh-lessp (msg1 msg2) - "Return the lesser of two message indicators MSG1 and MSG2. -Strings are \"smaller\" than numbers. -Valid values are things like \"cur\", \"last\", 1, and 1820." - (not (mh-greaterp msg1 msg2))) - - - -;;; Basic sequence handling - -(defun mh-delete-seq-locally (seq) - "Remove MH-E's record of SEQ." - (let ((entry (mh-find-seq seq))) - (setq mh-seq-list (delq entry mh-seq-list)))) - -(defun mh-read-folder-sequences (folder save-refiles) - "Read and return the predefined sequences for a FOLDER. -If SAVE-REFILES is non-nil, then keep the sequences -that note messages to be refiled." - (let ((seqs ())) - (cond (save-refiles - (mh-mapc (function (lambda (seq) ; Save the refiling sequences - (if (mh-folder-name-p (mh-seq-name seq)) - (setq seqs (cons seq seqs))))) - mh-seq-list))) - (save-excursion - (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) - (progn - ;; look for name in line of form "cur: 4" or "myseq (private): 23" - (while (re-search-forward "^[^: ]+" nil t) - (setq seqs (cons (mh-make-seq (intern (buffer-substring - (match-beginning 0) - (match-end 0))) - (mh-read-msg-list)) - seqs))) - (delete-region (point-min) (point))))) ; avoid race with - ; mh-process-daemon - seqs)) - -(defun mh-read-msg-list () - "Return a list of message numbers from point to the end of the line. -Expands ranges into set of individual numbers." - (let ((msgs ()) - (end-of-line (save-excursion (end-of-line) (point))) - num) - (while (re-search-forward "[0-9]+" end-of-line t) - (setq num (string-to-number (buffer-substring (match-beginning 0) - (match-end 0)))) - (cond ((looking-at "-") ; Message range - (forward-char 1) - (re-search-forward "[0-9]+" end-of-line t) - (let ((num2 (string-to-number - (buffer-substring (match-beginning 0) - (match-end 0))))) - (if (< num2 num) - (error "Bad message range: %d-%d" num num2)) - (while (<= num num2) - (setq msgs (cons num msgs)) - (setq num (1+ num))))) - ((not (zerop num)) ;"pick" outputs "0" to mean no match - (setq msgs (cons num msgs))))) - msgs)) - -(defun mh-notate-user-sequences (&optional range) - "Mark user-defined sequences in RANGE. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use; if nil all messages are notated." - (unless range - (setq range (cons (point-min) (point-max)))) - (let ((seqs mh-seq-list) - (msg-hash (make-hash-table))) - (dolist (seq seqs) - (dolist (msg (mh-seq-msgs seq)) - (push (car seq) (gethash msg msg-hash)))) - (mh-iterate-on-range msg range - (loop for seq in (gethash msg msg-hash) - do (mh-add-sequence-notation msg (mh-internal-seq seq)))))) - -(defvar mh-internal-seqs '(answered cur deleted forwarded printed)) - -(defun mh-internal-seq (name) - "Return non-nil if NAME is the name of an internal MH-E sequence." - (or (memq name mh-internal-seqs) - (eq name mh-unseen-seq) - (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq)) - (eq name mh-previous-seq) - (mh-folder-name-p name))) - -(defun mh-valid-seq-p (name) - "Return non-nil if NAME is a valid MH sequence name." - (and (symbolp name) - (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name)))) - -(defun mh-delete-msg-from-seq (range sequence &optional internal-flag) - "Delete RANGE from SEQUENCE. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -In a program, non-nil INTERNAL-FLAG means do not inform MH of the change." - (interactive (list (mh-interactive-range "Delete") - (mh-read-seq-default "Delete from" t) - nil)) - (let ((entry (mh-find-seq sequence)) - (user-sequence-flag (not (mh-internal-seq sequence))) - (folders-changed (list mh-current-folder)) - (msg-list ())) - (when entry - (mh-iterate-on-range msg range - (push msg msg-list) - ;; Calling "mark" repeatedly takes too long. So we will pretend here - ;; that we are just modifying an internal sequence... - (when (memq msg (cdr entry)) - (mh-remove-sequence-notation msg (not user-sequence-flag))) - (mh-delete-a-msg-from-seq msg sequence t)) - ;; ... and here we will "mark" all the messages at one go. - (unless internal-flag (mh-undefine-sequence sequence msg-list)) - (when (and mh-index-data (not internal-flag)) - (setq folders-changed - (append folders-changed - (mh-index-delete-from-sequence sequence msg-list)))) - (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) - (apply #'mh-speed-flists t folders-changed))))) - -(defun mh-catchup (range) - "Delete RANGE from the \"unseen\" sequence. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." - (interactive (list (mh-interactive-range "Catchup" - (cons (point-min) (point-max))))) - (mh-delete-msg-from-seq range mh-unseen-seq)) - -(defun mh-delete-a-msg-from-seq (msg sequence internal-flag) - "Delete MSG from SEQUENCE. -If INTERNAL-FLAG is non-nil, then do not inform MH of the change." - (let ((entry (mh-find-seq sequence))) - (when (and entry (memq msg (mh-seq-msgs entry))) - (if (not internal-flag) - (mh-undefine-sequence sequence (list msg))) - (setcdr entry (delq msg (mh-seq-msgs entry)))))) - -(defun mh-undefine-sequence (seq msgs) - "Remove from the SEQ the list of MSGS." - (when (and (mh-valid-seq-p seq) msgs) - (apply #'mh-exec-cmd "mark" mh-current-folder "-delete" - "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs)))) - -(defun mh-define-sequence (seq msgs) - "Define the SEQ to contain the list of MSGS. -Do not mark pseudo-sequences or empty sequences. -Signals an error if SEQ is an invalid name." - (if (and msgs - (mh-valid-seq-p seq) - (not (mh-folder-name-p seq))) - (save-excursion - (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" - "-sequence" (symbol-name seq) - (mh-coalesce-msg-list msgs))))) - -(defun mh-seq-containing-msg (msg &optional include-internal-flag) - "Return a list of the sequences containing MSG. -If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." - (let ((l mh-seq-list) - (seqs ())) - (while l - (and (memq msg (mh-seq-msgs (car l))) - (or include-internal-flag - (not (mh-internal-seq (mh-seq-name (car l))))) - (setq seqs (cons (mh-seq-name (car l)) seqs))) - (setq l (cdr l))) - seqs)) - - - -;;; Build mh-folder-mode keymap: - -(suppress-keymap mh-folder-mode-map) - -;; Use defalias to make sure the documented primary key bindings -;; appear in menu lists. -(defalias 'mh-alt-show 'mh-show) -(defalias 'mh-alt-refile-msg 'mh-refile-msg) -(defalias 'mh-alt-send 'mh-send) -(defalias 'mh-alt-visit-folder 'mh-visit-folder) - -;; Save the `b' binding for a future `back'. Maybe? -(gnus-define-keys mh-folder-mode-map - " " mh-page-msg - "!" mh-refile-or-write-again - "'" mh-toggle-tick - "," mh-header-display - "." mh-alt-show - ";" mh-toggle-mh-decode-mime-flag - ">" mh-write-msg-to-file - "?" mh-help - "E" mh-extract-rejected-mail - "M" mh-modify - "\177" mh-previous-page - "\C-d" mh-delete-msg-no-motion - "\t" mh-index-next-folder - [backtab] mh-index-previous-folder - "\M-\t" mh-index-previous-folder - "\e<" mh-first-msg - "\e>" mh-last-msg - "\ed" mh-redistribute - "\r" mh-show - "^" mh-alt-refile-msg - "c" mh-copy-msg - "d" mh-delete-msg - "e" mh-edit-again - "f" mh-forward - "g" mh-goto-msg - "i" mh-inc-folder - "k" mh-delete-subject-or-thread - "m" mh-alt-send - "n" mh-next-undeleted-msg - "\M-n" mh-next-unread-msg - "o" mh-refile-msg - "p" mh-previous-undeleted-msg - "\M-p" mh-previous-unread-msg - "q" mh-quit - "r" mh-reply - "s" mh-send - "t" mh-toggle-showing - "u" mh-undo - "v" mh-index-visit-folder - "x" mh-execute-commands - "|" mh-pipe-msg) - -(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) - "?" mh-prefix-help - "'" mh-index-ticked-messages - "S" mh-sort-folder - "c" mh-catchup - "f" mh-alt-visit-folder - "i" mh-index-search - "k" mh-kill-folder - "l" mh-list-folders - "n" mh-index-new-messages - "o" mh-alt-visit-folder - "p" mh-pack-folder - "q" mh-index-sequenced-messages - "r" mh-rescan-folder - "s" mh-search-folder - "u" mh-undo-folder - "v" mh-visit-folder) - -(define-key mh-folder-mode-map "I" mh-inc-spool-map) - -(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map) - "?" mh-prefix-help - "b" mh-junk-blacklist - "w" mh-junk-whitelist) - -(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map) - "?" mh-prefix-help - "C" mh-ps-print-toggle-color - "F" mh-ps-print-toggle-faces - "f" mh-ps-print-msg-file - "l" mh-print-msg - "p" mh-ps-print-msg) - -(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) - "'" mh-narrow-to-tick - "?" mh-prefix-help - "d" mh-delete-msg-from-seq - "k" mh-delete-seq - "l" mh-list-sequences - "n" mh-narrow-to-seq - "p" mh-put-msg-in-seq - "s" mh-msg-is-in-seq - "w" mh-widen) - -(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) - "?" mh-prefix-help - "u" mh-thread-ancestor - "p" mh-thread-previous-sibling - "n" mh-thread-next-sibling - "t" mh-toggle-threads - "d" mh-thread-delete - "o" mh-thread-refile) - -(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) - "'" mh-narrow-to-tick - "?" mh-prefix-help - "c" mh-narrow-to-cc - "f" mh-narrow-to-from - "r" mh-narrow-to-range - "s" mh-narrow-to-subject - "t" mh-narrow-to-to - "w" mh-widen) - -(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) - "?" mh-prefix-help - "s" mh-store-msg ;shar - "u" mh-store-msg) ;uuencode - -(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) - " " mh-page-digest - "?" mh-prefix-help - "\177" mh-page-digest-backwards - "b" mh-burst-digest) - -(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) - "?" mh-prefix-help - "a" mh-mime-save-parts - "e" mh-display-with-external-viewer - "i" mh-folder-inline-mime-part - "o" mh-folder-save-mime-part - "t" mh-toggle-mime-buttons - "v" mh-folder-toggle-mime-part - "\t" mh-next-button - [backtab] mh-prev-button - "\M-\t" mh-prev-button) - -(cond - (mh-xemacs-flag - (define-key mh-folder-mode-map [button2] 'mh-show-mouse)) - (t - (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse))) - -;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt - - - -;;; Help Messages - -;; If you add a new prefix, add appropriate text to the nil key. -;; -;; In general, messages are grouped logically. Taking the main commands for -;; example, the first line is "ways to view messages," the second line is -;; "things you can do with messages", and the third is "composing" messages. -;; -;; When adding a new prefix, ensure that the help message contains "what" the -;; prefix is for. For example, if the word "folder" were not present in the -;; `F' entry, it would not be clear what these commands operated upon. -(defvar mh-help-messages - '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" - "[d]elete, [o]refile, e[x]ecute,\n" - "[s]end, [r]eply,\n" - "[;]toggle MIME decoding.\n" - "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," - "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.") - - (?F "[l]ist; [v]isit folder;\n" - "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n" - "[p]ack; [S]ort; [r]escan; [k]ill") - (?P "[p]rint message to [f]ile; old-style [l]pr printing;\n" - "Toggle printing of [C]olors, [F]aces") - (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n" - "[s]equences, [l]ist,\n" - "[d]elete message from sequence, [k]ill sequence") - (?T "[t]oggle, [d]elete, [o]refile thread") - (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden") - (?X "un[s]har, [u]udecode message") - (?D "[b]urst digest") - (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" - "[TAB] next; [SHIFT-TAB] previous") - (?J "[b]lacklist, [w]hitelist message")) - "Key binding cheat sheet. - -This is an associative array which is used to show the most common commands. -The key is a prefix char. The value is one or more strings which are -concatenated together and displayed in the minibuffer if ? is pressed after -the prefix character. The special key nil is used to display the -non-prefixed commands. - -The substitutions described in `substitute-command-keys' are performed as -well.") - - - -(dolist (mess '("^Cursor not pointing to message$" - "^There is no other window$")) - (add-to-list 'debug-ignored-errors mess)) - -(provide 'mh-e) - -;; Local Variables: -;; indent-tabs-mode: nil -;; sentence-end-double-space: nil -;; End: - -;; arch-tag: cce884de-bd37-4104-9963-e4439d5ed22b -;;; mh-e.el ends here +;;; mh-e.el --- GNU Emacs interface to the MH mail system + +;; Copyright (C) 1985, 1986, 1987, 1988, +;; 1990, 1992, 1993, 1994, 1995, 1997, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Author: Bill Wohler +;; Maintainer: Bill Wohler +;; Version: 7.91+cvs +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; How to use: +;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. +;; C-u M-x mh-rmail to visit any folder. +;; M-x mh-smail to send mail. From within the mail reader, "s" works, too. + +;; Your .emacs might benefit from these bindings: +;; (global-set-key "\C-cr" 'mh-rmail) +;; (global-set-key "\C-xm" 'mh-smail) +;; (global-set-key "\C-x4m" 'mh-smail-other-window) + +;; If Emacs can't find mh-rmail or mh-smail, add the following to ~/.emacs: +;; (require 'mh-autoloads) + +;; If you want to customize MH-E before explicitly loading it, add this: +;; (require 'mh-cus-load) + +;; MH (Message Handler) is a powerful mail reader. + +;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu +;; (send to mh-users-request to be added). See the monthly Frequently Asked +;; Questions posting there for information on getting MH and MH-E: +;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html + +;; N.B. MH must have been compiled with the MHE compiler flag or several +;; features necessary for MH-E will be missing from MH commands, specifically +;; the -build switch to repl and forw. + +;; MH-E is an Emacs interface to the MH mail system. + +;; MH-E is supported in GNU Emacs 21 and 22 as well as XEmacs 21 +;; (except for versions 21.5.9-21.5.16), with MH 6.8.4 on, nmh 1.0.4 +;; on, and GNU mailutils 0.4 on. + +;; Mailing Lists: +;; mh-e-users@lists.sourceforge.net +;; mh-e-announce@lists.sourceforge.net +;; mh-e-devel@lists.sourceforge.net + +;; Subscribe by sending a "subscribe" message to +;; -request@lists.sourceforge.net, or by using the web interface at +;; https://sourceforge.net/mail/?group_id=13357 + +;; Bug Reports: +;; https://sourceforge.net/tracker/?group_id=13357&atid=113357 +;; Include the output of M-x mh-version in the bug report unless +;; you're 110% sure we won't ask for it. + +;; Feature Requests: +;; https://sourceforge.net/tracker/?group_id=13357&atid=363357 + +;; Support: +;; https://sourceforge.net/tracker/?group_id=13357&atid=213357 + +;;; Change Log: + +;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. +;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. +;; Rewritten for GNU Emacs, James Larus, 1985. +;; Modified by Stephen Gildea, 1988. +;; Maintenance picked up by Bill Wohler and the +;; SourceForge Crew , 2001. + +;;; Code: + +;; Provide functions to the rest of MH-E. However, mh-e.el must not +;; use any definitions in files that require mh-e from mh-loaddefs, +;; for if it does it will introduce a require loop. +(require 'mh-loaddefs) + +(mh-require-cl) + +(eval-and-compile + (defvar mh-xemacs-flag (featurep 'xemacs) + "Non-nil means the current Emacs is XEmacs.") + (defvar mh-compiling-flag nil + "Non-nil means we're compiling.")) + +(eval-when (compile) + (setq mh-compiling-flag t)) + +(mh-do-in-xemacs + (require 'mh-xemacs)) + +(require 'mh-buffers) +(require 'mh-compat) + + + +;;; Global Variables + +;; 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 "7.91+cvs" "Version number of MH-E.") + +;; Variants + +(defvar mh-sys-path + '("/usr/local/nmh/bin" ; nmh default + "/usr/local/bin/mh/" + "/usr/local/mh/" + "/usr/bin/mh/" ; Ultrix 4.2, Linux + "/usr/new/mh/" ; Ultrix < 4.2 + "/usr/contrib/mh/bin/" ; BSDI + "/usr/pkg/bin/" ; NetBSD + "/usr/local/bin/" + "/usr/local/bin/mu-mh/" ; GNU mailutils - default + "/usr/bin/mu-mh/") ; GNU mailutils - packaged + "List of directories to search for variants of the MH variant. +The list `exec-path' is searched in addition to this list. +There's no need for users to modify this list. Instead add extra +directories to the customizable variable `mh-path'.") + +(defvar mh-variants nil + "List describing known MH variants. +Do not access this variable directly as it may not have yet been initialized. +Use the function `mh-variants' instead.") + +(defvar mh-variant-in-use nil + "The MH variant currently in use; a string with variant and version number. +This differs from `mh-variant' when the latter is set to +\"autodetect\".") + +(defvar mh-progs nil + "Directory containing MH commands, such as inc, repl, and rmm.") + +;;;###autoload +(put 'mh-progs 'risky-local-variable t) + +(defvar mh-lib nil + "Directory containing the MH library. +This directory contains, among other things, the components file.") + +;;;###autoload +(put 'mh-lib 'risky-local-variable t) + +(defvar mh-lib-progs nil + "Directory containing MH helper programs. +This directory contains, among other things, the mhl program.") + +;;;###autoload +(put 'mh-lib-progs 'risky-local-variable t) + +;; Profile Components + +(defvar mh-draft-folder nil + "Cached value of the \"Draft-Folder:\" MH profile component. +Name of folder containing draft messages. +Nil means do not use a draft folder.") + +(defvar mh-inbox nil + "Cached value of the \"Inbox:\" MH profile component. +Set to \"+inbox\" if no such component. +Name of the Inbox folder.") + +(defvar mh-user-path nil + "Cached value of the \"Path:\" MH profile component. +User's mail folder directory.") + +;; Maps declared here so that they can be used in docstrings. + +(defvar mh-folder-mode-map (make-keymap) + "Keymap for MH-Folder mode.") + +(defvar mh-folder-seq-tool-bar-map nil + "Keymap for MH-Folder tool bar.") + +(defvar mh-folder-tool-bar-map nil + "Keymap for MH-Folder tool bar.") + +(defvar mh-inc-spool-map (make-sparse-keymap) + "Keymap for MH-E's mh-inc-spool commands.") + +(defvar mh-letter-mode-map (copy-keymap text-mode-map) + "Keymap for MH-Letter mode.") + +(defvar mh-letter-tool-bar-map nil + "Keymap for MH-Letter tool bar.") + +(defvar mh-search-mode-map (make-sparse-keymap) + "Keymap for MH-Search mode.") + +(defvar mh-show-mode-map (make-sparse-keymap) + "Keymap MH-Show mode.") + +(defvar mh-show-seq-tool-bar-map nil + "Keymap for MH-Show tool bar.") + +(defvar mh-show-tool-bar-map nil + "Keymap for MH-Show tool bar.") + +;; MH-Folder Locals (alphabetical) + +(defvar mh-arrow-marker nil + "Marker for arrow display in fringe.") + +(defvar mh-colors-available-flag nil + "Non-nil means colors are available.") + +(defvar mh-current-folder nil + "Name of current folder, a string.") + +(defvar mh-delete-list nil + "List of message numbers to delete. +This variable can be used by +`mh-before-commands-processed-hook'.") + +(defvar mh-folder-view-stack nil + "Stack of previous folder views.") + +(defvar mh-index-data nil + "Info about index search results.") + +(defvar mh-index-previous-search nil) + +(defvar mh-index-msg-checksum-map nil) + +(defvar mh-index-checksum-origin-map nil) + +(defvar mh-index-sequence-search-flag nil) + +(defvar mh-mode-line-annotation nil + "Message range displayed in buffer.") + +(defvar mh-next-direction 'forward + "Direction to move to next message.") + +(defvar mh-previous-window-config nil + "Window configuration before MH-E command.") + +(defvar mh-refile-list nil + "List of folder names in `mh-seq-list'. +This variable can be used by +`mh-before-commands-processed-hook'.") + +(defvar mh-seen-list nil + "List of displayed messages to be removed from the \"Unseen\" sequence.") + +(defvar mh-seq-list nil + "Alist of this folder's sequences. +Elements have the form (SEQUENCE . MESSAGES).") + +(defvar mh-sequence-notation-history nil + "Remember original notation that is overwritten by `mh-note-seq'.") + +(defvar mh-show-buffer nil + "Buffer that displays message for this folder.") + +(defvar mh-showing-mode nil + "If non-nil, show the message in a separate window.") + +(defvar mh-view-ops nil + "Stack of operations that change the folder view. +These operations include narrowing or threading.") + +;; MH-Show Locals (alphabetical) + +(defvar mh-globals-hash (make-hash-table) + "Keeps track of MIME data on a per buffer basis.") + +(defvar mh-show-folder-buffer nil + "Keeps track of folder whose message is being displayed.") + +;; MH-Letter Locals + +(defvar mh-folders-changed nil + "Lists which folders were affected by deletes and refiles. +This list will always include the current folder +`mh-current-folder'. This variable can be used by +`mh-after-commands-processed-hook'.") + +(defvar mh-mail-header-separator "--------" + "*Line used by MH to separate headers from text in messages being composed. + +This variable should not be used directly in programs. Programs +should use `mail-header-separator' instead. +`mail-header-separator' is initialized to +`mh-mail-header-separator' in `mh-letter-mode'; in other +contexts, you may have to perform this initialization yourself. + +Do not make this a regular expression as it may be the argument +to `insert' and it is passed through `regexp-quote' before being +used by functions like `re-search-forward'.") + +(defvar mh-sent-from-folder nil + "Folder of msg assoc with this letter.") + +(defvar mh-sent-from-msg nil + "Number of msg assoc with this letter.") + +;; Sequences + +(defvar mh-unseen-seq nil + "Cached value of the \"Unseen-Sequence:\" MH profile component. +Name of the Unseen sequence.") + +(defvar mh-previous-seq nil + "Cached value of the \"Previous-Sequence:\" MH profile component. +Name of the Previous sequence.") + +;; Etc. (alphabetical) + +(defvar mh-flists-present-flag nil + "Non-nil means that we have \"flists\".") + +(defvar mh-index-data-file ".mhe_index" + "MH-E specific file where index seach info is stored.") + +(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):") + +(defvar mh-page-to-next-msg-flag nil + "Non-nil means next SPC or whatever goes to next undeleted message.") + +(defvar mh-pgp-support-flag (not (not (locate-library "mml2015"))) + "Non-nil means PGP support is available.") + +(defvar mh-signature-separator "-- \n" + "Text of a signature separator. + +A signature separator is used to separate the body of a message +from the signature. This can be used by user agents such as MH-E +to render the signature differently or to suppress the inclusion +of the signature in a reply. Use `mh-signature-separator-regexp' +when searching for a separator.") + +(defvar mh-signature-separator-regexp "^-- $" + "This regular expression matches the signature separator. +See `mh-signature-separator'.") + +(defvar mh-thread-scan-line-map nil + "Map of message index to various parts of the scan line.") +(make-variable-buffer-local 'mh-thread-scan-line-map) + +(defvar mh-thread-scan-line-map-stack nil + "Old map of message index to various parts of the scan line. +This is the original map that is stored when the folder is +narrowed.") +(make-variable-buffer-local 'mh-thread-scan-line-map-stack) + +(defvar mh-x-mailer-string nil + "*String containing the contents of the X-Mailer header field. +If nil, this variable is initialized to show the version of MH-E, +Emacs, and MH the first time a message is composed.") + + + +;;; MH-E Entry Points + +(eval-when-compile (require 'gnus)) + +(defmacro mh-macro-expansion-time-gnus-version () + "Return Gnus version available at macro expansion time. +The macro evaluates the Gnus version at macro expansion time. If +MH-E was compiled then macro expansion happens at compile time." +gnus-version) + +(defun mh-run-time-gnus-version () + "Return Gnus version available at run time." + (require 'gnus) + gnus-version) + +;;;###autoload +(defun mh-version () + "Display version information about MH-E and the MH mail handling system." + (interactive) + (set-buffer (get-buffer-create mh-info-buffer)) + (erase-buffer) + ;; MH-E version. + (insert "MH-E " mh-version "\n\n") + ;; MH-E compilation details. + (insert "MH-E compilation details:\n") + (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version))) + (gnus-compiled-version (if compiled-mhe + (mh-macro-expansion-time-gnus-version) + "N/A"))) + (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n" + " Gnus (compile-time):\t" gnus-compiled-version "\n" + " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n")) + ;; Emacs version. + (insert (emacs-version) "\n\n") + ;; MH version. + (if mh-variant-in-use + (insert mh-variant-in-use "\n" + " mh-progs:\t" mh-progs "\n" + " mh-lib:\t" mh-lib "\n" + " mh-lib-progs:\t" mh-lib-progs "\n\n") + (insert "No MH variant detected\n")) + ;; Linux version. + (condition-case () + (call-process "uname" nil t nil "-a") + (file-error)) + (goto-char (point-min)) + (display-buffer mh-info-buffer)) + + + +;;; Support Routines + +(defun mh-list-to-string (l) + "Flatten the list L and make every element of the new list into a string." + (nreverse (mh-list-to-string-1 l))) + +(defun mh-list-to-string-1 (l) + "Flatten the list L and make every element of the new list into a string." + (let ((new-list nil)) + (while l + (cond ((null (car l))) + ((symbolp (car l)) + (setq new-list (cons (symbol-name (car l)) new-list))) + ((numberp (car l)) + (setq new-list (cons (int-to-string (car l)) new-list))) + ((equal (car l) "")) + ((stringp (car l)) (setq new-list (cons (car l) new-list))) + ((listp (car l)) + (setq new-list (nconc (mh-list-to-string-1 (car l)) + new-list))) + (t (error "Bad element in `mh-list-to-string': %s" (car l)))) + (setq l (cdr l))) + new-list)) + + + +;;; MH-E Process Support + +(defvar mh-index-max-cmdline-args 500 + "Maximum number of command line args.") + +(defun mh-xargs (cmd &rest args) + "Partial imitation of xargs. +The current buffer contains a list of strings, one on each line. +The function will execute CMD with ARGS and pass the first +`mh-index-max-cmdline-args' strings to it. This is repeated till +all the strings have been used." + (goto-char (point-min)) + (let ((current-buffer (current-buffer))) + (with-temp-buffer + (let ((out (current-buffer))) + (set-buffer current-buffer) + (while (not (eobp)) + (let ((arg-list (reverse args)) + (count 0)) + (while (and (not (eobp)) (< count mh-index-max-cmdline-args)) + (push (buffer-substring-no-properties (point) + (mh-line-end-position)) + arg-list) + (incf count) + (forward-line)) + (apply #'call-process cmd nil (list out nil) nil + (nreverse arg-list)))) + (erase-buffer) + (insert-buffer-substring out))))) + +;; XXX This should be applied anywhere MH-E calls out to /bin/sh. +(defun mh-quote-for-shell (string) + "Quote STRING for /bin/sh. +Adds double-quotes around entire string and quotes the characters +\\, `, and $ with a backslash." + (concat "\"" + (loop for x across string + concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) + "\"")) + +(defun mh-exec-cmd (command &rest args) + "Execute mh-command COMMAND with ARGS. +The side effects are what is desired. Any output is assumed to be +an error and is shown to the user. The output is not read or +parsed by MH-E." + (save-excursion + (set-buffer (get-buffer-create mh-log-buffer)) + (let* ((initial-size (mh-truncate-log-buffer)) + (start (point)) + (args (mh-list-to-string args))) + (apply 'call-process (expand-file-name command mh-progs) nil t nil args) + (when (> (buffer-size) initial-size) + (save-excursion + (goto-char start) + (insert "Errors when executing: " command) + (loop for arg in args do (insert " " arg)) + (insert "\n")) + (save-window-excursion + (switch-to-buffer-other-window mh-log-buffer) + (sit-for 5)))))) + +(defun mh-exec-cmd-error (env command &rest args) + "In environment ENV, execute mh-command COMMAND with ARGS. +ENV is nil or a string of space-separated \"var=value\" elements. +Signals an error if process does not complete successfully." + (save-excursion + (set-buffer (get-buffer-create mh-temp-buffer)) + (erase-buffer) + (let ((process-environment process-environment)) + ;; XXX: We should purge the list that split-string returns of empty + ;; strings. This can happen in XEmacs if leading or trailing spaces + ;; are present. + (dolist (elem (if (stringp env) (split-string env " ") ())) + (push elem process-environment)) + (mh-handle-process-error + command (apply #'call-process (expand-file-name command mh-progs) + nil t nil (mh-list-to-string args)))))) + +(defun mh-exec-cmd-daemon (command filter &rest args) + "Execute MH command COMMAND in the background. + +If FILTER is non-nil then it is used to process the output +otherwise the default filter `mh-process-daemon' is used. See +`set-process-filter' for more details of FILTER. + +ARGS are passed to COMMAND as command line arguments." + (save-excursion + (set-buffer (get-buffer-create mh-log-buffer)) + (mh-truncate-log-buffer)) + (let* ((process-connection-type nil) + (process (apply 'start-process + command nil + (expand-file-name command mh-progs) + (mh-list-to-string args)))) + (set-process-filter process (or filter 'mh-process-daemon)) + process)) + +(defun mh-exec-cmd-env-daemon (env command filter &rest args) + "In ennvironment ENV, execute mh-command COMMAND in the background. + +ENV is nil or a string of space-separated \"var=value\" elements. +Signals an error if process does not complete successfully. + +If FILTER is non-nil then it is used to process the output +otherwise the default filter `mh-process-daemon' is used. See +`set-process-filter' for more details of FILTER. + +ARGS are passed to COMMAND as command line arguments." + (let ((process-environment process-environment)) + (dolist (elem (if (stringp env) (split-string env " ") ())) + (push elem process-environment)) + (apply #'mh-exec-cmd-daemon command filter args))) + +(defun mh-process-daemon (process output) + "PROCESS daemon that puts OUTPUT into a temporary buffer. +Any output from the process is displayed in an asynchronous +pop-up window." + (with-current-buffer (get-buffer-create mh-log-buffer) + (insert-before-markers output) + (display-buffer mh-log-buffer))) + +(defun mh-exec-cmd-quiet (raise-error command &rest args) + "Signal RAISE-ERROR if COMMAND with ARGS fails. +Execute MH command COMMAND with ARGS. ARGS is a list of strings. +Return at start of mh-temp buffer, where output can be parsed and +used. +Returns value of `call-process', which is 0 for success, unless +RAISE-ERROR is non-nil, in which case an error is signaled if +`call-process' returns non-0." + (set-buffer (get-buffer-create mh-temp-buffer)) + (erase-buffer) + (let ((value + (apply 'call-process + (expand-file-name command mh-progs) nil t nil + args))) + (goto-char (point-min)) + (if raise-error + (mh-handle-process-error command value) + value))) + +(defun mh-exec-cmd-output (command display &rest args) + "Execute MH command COMMAND with DISPLAY flag and ARGS. +Put the output into buffer after point. +Set mark after inserted text. +Output is expected to be shown to user, not parsed by MH-E." + (push-mark (point) t) + (apply 'call-process + (expand-file-name command mh-progs) nil t display + (mh-list-to-string args)) + + ;; The following is used instead of 'exchange-point-and-mark because the + ;; latter activates the current region (between point and mark), which + ;; turns on highlighting. So prior to this bug fix, doing "inc" would + ;; highlight a region containing the new messages, which is undesirable. + ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4. + (mh-exchange-point-and-mark-preserving-active-mark)) + +;; Shush compiler. +(eval-when-compile (mh-do-in-xemacs (defvar mark-active))) + +(defun mh-exchange-point-and-mark-preserving-active-mark () + "Put the mark where point is now, and point where the mark is now. +This command works even when the mark is not active, and +preserves whether the mark is active or not." + (interactive nil) + (let ((is-active (and (boundp 'mark-active) mark-active))) + (let ((omark (mark t))) + (if (null omark) + (error "No mark set in this buffer")) + (set-mark (point)) + (goto-char omark) + (if (boundp 'mark-active) + (setq mark-active is-active)) + nil))) + +(defun mh-exec-lib-cmd-output (command &rest args) + "Execute MH library command COMMAND with ARGS. +Put the output into buffer after point. +Set mark after inserted text." + (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args)) + +(defun mh-handle-process-error (command status) + "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS." + (if (equal status 0) + status + (goto-char (point-min)) + (insert (if (integerp status) + (format "%s: exit code %d\n" command status) + (format "%s: %s\n" command status))) + (save-excursion + (let ((error-message (buffer-substring (point-min) (point-max)))) + (set-buffer (get-buffer-create mh-log-buffer)) + (mh-truncate-log-buffer) + (insert error-message))) + (error "%s failed, check buffer %s for error message" + command mh-log-buffer))) + + + +;;; Variant Support + +(defcustom mh-path nil + "*Additional list of directories to search for MH. +See `mh-variant'." + :group 'mh-e + :type '(repeat (directory))) + +(defun mh-variants () + "Return a list of installed variants of MH on the system. +This function looks for MH in `mh-sys-path', `mh-path' and +`exec-path'. The format of the list of variants that is returned +is described by the variable `mh-variants'." + (if mh-variants + mh-variants + (let ((list-unique)) + ;; Make a unique list of directories, keeping the given order. + ;; We don't want the same MH variant to be listed multiple times. + (loop for dir in (append mh-path mh-sys-path exec-path) do + (setq dir (file-chase-links (directory-file-name dir))) + (add-to-list 'list-unique dir)) + (loop for dir in (nreverse list-unique) do + (when (and dir (file-directory-p dir) (file-readable-p dir)) + (let ((variant (mh-variant-info dir))) + (if variant + (add-to-list 'mh-variants variant))))) + mh-variants))) + +(defun mh-variant-info (dir) + "Return MH variant found in DIR, or nil if none present." + (save-excursion + (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) + (set-buffer tmp-buffer) + (cond + ((mh-variant-mh-info dir)) + ((mh-variant-nmh-info dir)) + ((mh-variant-mu-mh-info dir)))))) + +(defun mh-variant-mh-info (dir) + "Return info for MH variant in DIR assuming a temporary buffer is setup." + ;; MH does not have the -version option. + ;; Its version number is included in the output of "-help" as: + ;; + ;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999 + ;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE] + ;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK] + ;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME] + ;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS] + ;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO] + ;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF] + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (mh-file-command-p mhparam) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-help") + (goto-char (point-min)) + (when (search-forward-regexp "version: MH \\(\\S +\\)" nil t) + (let ((version (format "MH %s" (match-string 1)))) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "libdir") + (goto-char (point-min)) + (when (search-forward-regexp "^.*$" nil t) + (let ((libdir (match-string 0))) + `(,version + (variant mh) + (mh-lib-progs ,libdir) + (mh-lib ,libdir) + (mh-progs ,dir) + (flists nil))))))))) + +(defun mh-variant-mu-mh-info (dir) + "Return info for GNU mailutils variant in DIR. +This assumes that a temporary buffer is setup." + ;; 'mhparam -version' output: + ;; mhparam (GNU mailutils 0.3.2) + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (mh-file-command-p mhparam) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-version") + (goto-char (point-min)) + (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))" + nil t) + (let ((version (match-string 1)) + (mh-progs dir)) + `(,version + (variant mu-mh) + (mh-lib-progs ,(mh-profile-component "libdir")) + (mh-lib ,(mh-profile-component "etcdir")) + (mh-progs ,dir) + (flists ,(file-exists-p + (expand-file-name "flists" dir))))))))) + +(defun mh-variant-nmh-info (dir) + "Return info for nmh variant in DIR assuming a temporary buffer is setup." + ;; `mhparam -version' outputs: + ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003] + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (mh-file-command-p mhparam) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-version") + (goto-char (point-min)) + (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t) + (let ((version (format "nmh %s" (match-string 1))) + (mh-progs dir)) + `(,version + (variant nmh) + (mh-lib-progs ,(mh-profile-component "libdir")) + (mh-lib ,(mh-profile-component "etcdir")) + (mh-progs ,dir) + (flists ,(file-exists-p + (expand-file-name "flists" dir))))))))) + +(defun mh-file-command-p (file) + "Return t if file FILE is the name of a executable regular file." + (and (file-regular-p file) (file-executable-p file))) + +(defun mh-variant-set-variant (variant) + "Setup the system variables for the MH variant named VARIANT. +If VARIANT is a string, use that key in the alist returned by the +function `mh-variants'. +If VARIANT is a symbol, select the first entry that matches that +variant." + (cond + ((stringp variant) ;e.g. "nmh 1.1-RC1" + (when (assoc variant (mh-variants)) + (let* ((alist (cdr (assoc variant (mh-variants)))) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant variant) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use variant)))) + ((symbolp variant) ;e.g. 'nmh (pick the first match) + (loop for variant-list in (mh-variants) + when (eq variant (cadr (assoc 'variant (cdr variant-list)))) + return (let* ((version (car variant-list)) + (alist (cdr variant-list)) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant flavor) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use version) + t))))) + +(defun mh-variant-p (&rest variants) + "Return t if variant is any of VARIANTS. +Currently known variants are 'MH, 'nmh, and 'mu-mh." + (let ((variant-in-use + (cadr (assoc 'variant (assoc mh-variant-in-use (mh-variants)))))) + (not (null (member variant-in-use variants))))) + +(defun mh-profile-component (component) + "Return COMPONENT value from mhparam, or nil if unset." + (save-excursion + (mh-exec-cmd-quiet nil "mhparam" "-components" component) + (mh-profile-component-value component))) + +(defun mh-profile-component-value (component) + "Find and return the value of COMPONENT in the current buffer. +Returns nil if the component is not in the buffer." + (let ((case-fold-search t)) + (goto-char (point-min)) + (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) + ((looking-at "[\t ]*$") nil) + (t + (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) + (let ((start (match-beginning 1))) + (end-of-line) + (buffer-substring start (point))))))) + +(defun mh-variant-set (variant) + "Set the MH variant to VARIANT. +Sets `mh-progs', `mh-lib', `mh-lib-progs' and +`mh-flists-present-flag'. +If the VARIANT is \"autodetect\", then first try nmh, then MH and +finally GNU mailutils." + (interactive + (list (completing-read + "MH variant: " + (mapcar (lambda (x) (list (car x))) (mh-variants)) + nil t))) + (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants)))) + (cond + ((eq variant 'none)) + ((eq variant 'autodetect) + (cond + ((mh-variant-set-variant 'nmh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mu-mh) + (message "%s installed as MH variant" mh-variant-in-use)) + (t + (message "No MH variant found on the system")))) + ((member variant valid-list) + (when (not (mh-variant-set-variant variant)) + (message "Warning: %s variant not found. Autodetecting..." variant) + (mh-variant-set 'autodetect))) + (t + (message "Unknown variant; use %s" + (mapconcat '(lambda (x) (format "%s" (car x))) + (mh-variants) " or ")))))) + +(defcustom mh-variant 'autodetect + "*Specifies the variant used by MH-E. + +The default setting of this option is \"Auto-detect\" which means +that MH-E will automatically choose the first of nmh, MH, or GNU +mailutils that it finds in the directories listed in +`mh-path' (which you can customize), `mh-sys-path', and +`exec-path'. If, for example, you have both nmh and mailutils +installed and `mh-variant-in-use' was initialized to nmh but you +want to use mailutils, then you can set this option to +\"mailutils\". + +When this variable is changed, MH-E resets `mh-progs', `mh-lib', +`mh-lib-progs', `mh-flists-present-flag', and `mh-variant-in-use' +accordingly." + :type `(radio + (const :tag "Auto-detect" autodetect) + ,@(mapcar (lambda (x) `(const ,(car x))) (mh-variants))) + :set (lambda (symbol value) + (set-default symbol value) ;Done in mh-variant-set-variant! + (mh-variant-set value)) + :group 'mh-e) + + + +;;; MH-E Customization + +;; All of the defgroups, defcustoms, and deffaces in MH-E are found +;; here. This makes it possible to customize modules that aren't +;; loaded yet. It also makes it easier to organize the customization +;; groups. + +;; This section contains the following sub-sections: + +;; 1. MH-E Customization Groups + +;; These are the customization group definitions. Every group has a +;; associated manual node. The ordering is alphabetical, except for +;; the groups mh-faces and mh-hooks which are last . + +;; 2. MH-E Customization + +;; These are the actual customization variables. There is a +;; sub-section for each group in the MH-E Customization Groups +;; section, in the same order, separated by page breaks. Within +;; each section, variables are sorted alphabetically. + +;; 3. Hooks + +;; All hooks must be placed in the mh-hook group; in addition, add +;; the group associated with the manual node in which the hook is +;; described. Since the mh-hook group appears near the end of this +;; section, the hooks will appear at the end of these other groups. + +;; 4. Faces + +;; All faces must be placed in the mh-faces group; in addition, add +;; the group associated with the manual node in which the face is +;; described. Since the mh-faces group appears near the end of this +;; section, the faces will appear at the end of these other groups. + +(defun mh-customize (&optional delete-other-windows-flag) + "Customize MH-E variables. +If optional argument DELETE-OTHER-WINDOWS-FLAG is non-nil, other +windows in the frame are removed." + (interactive "P") + (customize-group 'mh-e) + (when delete-other-windows-flag + (delete-other-windows))) + + + +;;; MH-E Customization Groups + +(defgroup mh-e nil + "Emacs interface to the MH mail system. +MH is the Rand Mail Handler. Other implementations include nmh +and GNU mailutils." + :link '(custom-manual "(mh-e)Top") + :group 'mail) + +(defgroup mh-alias nil + "Aliases." + :link '(custom-manual "(mh-e)Aliases") + :prefix "mh-alias-" + :group 'mh-e) + +(defgroup mh-folder nil + "Organizing your mail with folders." + :prefix "mh-" + :link '(custom-manual "(mh-e)Folders") + :group 'mh-e) + +(defgroup mh-folder-selection nil + "Folder selection." + :prefix "mh-" + :link '(custom-manual "(mh-e)Folder Selection") + :group 'mh-e) + +(defgroup mh-identity nil + "Identities." + :link '(custom-manual "(mh-e)Identities") + :prefix "mh-identity-" + :group 'mh-e) + +(defgroup mh-inc nil + "Incorporating your mail." + :prefix "mh-inc-" + :link '(custom-manual "(mh-e)Incorporating Mail") + :group 'mh-e) + +(defgroup mh-junk nil + "Dealing with junk mail." + :link '(custom-manual "(mh-e)Junk") + :prefix "mh-junk-" + :group 'mh-e) + +(defgroup mh-letter nil + "Editing a draft." + :prefix "mh-" + :link '(custom-manual "(mh-e)Editing Drafts") + :group 'mh-e) + +(defgroup mh-ranges nil + "Ranges." + :prefix "mh-" + :link '(custom-manual "(mh-e)Ranges") + :group 'mh-e) + +(defgroup mh-scan-line-formats nil + "Scan line formats." + :link '(custom-manual "(mh-e)Scan Line Formats") + :prefix "mh-" + :group 'mh-e) + +(defgroup mh-search nil + "Searching." + :link '(custom-manual "(mh-e)Searching") + :prefix "mh-search-" + :group 'mh-e) + +(defgroup mh-sending-mail nil + "Sending mail." + :prefix "mh-" + :link '(custom-manual "(mh-e)Sending Mail") + :group 'mh-e) + +(defgroup mh-sequences nil + "Sequences." + :prefix "mh-" + :link '(custom-manual "(mh-e)Sequences") + :group 'mh-e) + +(defgroup mh-show nil + "Reading your mail." + :prefix "mh-" + :link '(custom-manual "(mh-e)Reading Mail") + :group 'mh-e) + +(defgroup mh-speedbar nil + "The speedbar." + :prefix "mh-speed-" + :link '(custom-manual "(mh-e)Speedbar") + :group 'mh-e) + +(defgroup mh-thread nil + "Threading." + :prefix "mh-thread-" + :link '(custom-manual "(mh-e)Threading") + :group 'mh-e) + +(defgroup mh-tool-bar nil + "The tool bar" + :link '(custom-manual "(mh-e)Tool Bar") + :prefix "mh-" + :group 'mh-e) + +(defgroup mh-hooks nil + "MH-E hooks." + :link '(custom-manual "(mh-e)Top") + :prefix "mh-" + :group 'mh-e) + +(defgroup mh-faces nil + "Faces used in MH-E." + :link '(custom-manual "(mh-e)Top") + :prefix "mh-" + :group 'faces + :group 'mh-e) + + + +;;; Emacs Interface to the MH Mail System (:group mh-e) + +;; See Variant Support, above. + +;;; Aliases (:group 'mh-alias) + +(defcustom mh-alias-completion-ignore-case-flag t + "*Non-nil means don't consider case significant in MH alias completion. + +As MH ignores case in the aliases, so too does MH-E. However, you +may turn off this option to make case significant which can be +used to segregate completion of your aliases. You might use +lowercase for mailing lists and uppercase for people." + :type 'boolean + :group 'mh-alias) + +(defcustom mh-alias-expand-aliases-flag nil + "*Non-nil means to expand aliases entered in the minibuffer. + +In other words, aliases entered in the minibuffer will be +expanded to the full address in the message draft. By default, +this expansion is not performed." + :type 'boolean + :group 'mh-alias) + +(defcustom mh-alias-flash-on-comma t + "*Specify whether to flash address or warn on translation. + +This option controls the behavior when a [comma] is pressed while +entering aliases or addresses. The default setting flashes the +address associated with an address in the minibuffer briefly, but +does not display a warning if the alias is not found." + :type '(choice (const :tag "Flash but Don't Warn If No Alias" t) + (const :tag "Flash and Warn If No Alias" 1) + (const :tag "Don't Flash Nor Warn If No Alias" nil)) + :group 'mh-alias) + +(defcustom mh-alias-insert-file nil + "*Filename used to store a new MH-E alias. + +The default setting of this option is \"Use Aliasfile Profile +Component\". This option can also hold the name of a file or a +list a file names. If this option is set to a list of file names, +or the \"Aliasfile:\" profile component contains more than one file +name, MH-E will prompt for one of them when MH-E adds an alias." + :type '(choice (const :tag "Use Aliasfile Profile Component" nil) + (file :tag "Alias File") + (repeat :tag "List of Alias Files" file)) + :group 'mh-alias) + +(defcustom mh-alias-insertion-location 'sorted + "Specifies where new aliases are entered in alias files. + +This option is set to \"Alphabetical\" by default. If you organize +your alias file in other ways, then adding aliases to the \"Top\" +or \"Bottom\" of your alias file might be more appropriate." + :type '(choice (const :tag "Alphabetical" sorted) + (const :tag "Top" top) + (const :tag "Bottom" bottom)) + :group 'mh-alias) + +(defcustom mh-alias-local-users t + "*If on, local users are added to alias completion. + +Aliases are created from \"/etc/passwd\" entries with a user ID +larger than a magical number, typically 200. This can be a handy +tool on a machine where you and co-workers exchange messages. +These aliases have the form \"local.first.last\" if a real name is +present in the password file. Otherwise, the alias will have the +form \"local.login\". + +If you're on a system with thousands of users you don't know, and +the loading of local aliases slows MH-E down noticeably, then +turn this option off. + +This option also takes a string which is executed to generate the +password file. For example, use \"ypcat passwd\" to obtain the +NIS password file." + :type '(choice (boolean) (string)) + :group 'mh-alias) + +(defcustom mh-alias-local-users-prefix "local." + "*String prefixed to the real names of users from the password file. +This option can also be set to \"Use Login\". + +For example, consider the following password file entry: + + psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh + +The following settings of this option will produce the associated +aliases: + + \"local.\" local.peter.galbraith + \"\" peter.galbraith + Use Login psg + +This option has no effect if variable `mh-alias-local-users' is +turned off." + :type '(choice (const :tag "Use Login" nil) + (string)) + :group 'mh-alias) + +(defcustom mh-alias-passwd-gecos-comma-separator-flag t + "*Non-nil means the gecos field in the password file uses a comma separator. + +In the example in `mh-alias-local-users-prefix', commas are used +to separate different values within the so-called gecos field. +This is a fairly common usage. However, in the rare case that the +gecos field in your password file is not separated by commas and +whose contents may contain commas, you can turn this option off." + :type 'boolean + :group 'mh-alias) + + + +;;; Organizing Your Mail with Folders (:group 'mh-folder) + +(defcustom mh-new-messages-folders t + "Folders searched for the \"unseen\" sequence. + +Set this option to \"Inbox\" to search the \"+inbox\" folder or +\"All\" to search all of the top level folders. Otherwise, list +the folders that should be searched with the \"Choose Folders\" +menu item. + +See also `mh-recursive-folders-flag'." + :type '(choice (const :tag "Inbox" t) + (const :tag "All" nil) + (repeat :tag "Choose Folders" (string :tag "Folder"))) + :group 'mh-folder) + +(defcustom mh-ticked-messages-folders t + "Folders searched for `mh-tick-seq'. + +Set this option to \"Inbox\" to search the \"+inbox\" folder or +\"All\" to search all of the top level folders. Otherwise, list +the folders that should be searched with the \"Choose Folders\" +menu item. + +See also `mh-recursive-folders-flag'." + :type '(choice (const :tag "Inbox" t) + (const :tag "All" nil) + (repeat :tag "Choose Folders" (string :tag "Folder"))) + :group 'mh-folder) + +(defcustom mh-large-folder 200 + "The number of messages that indicates a large folder. + +If a folder is deemed to be large, that is the number of messages +in it exceed this value, then confirmation is needed when it is +visited. Even when `mh-show-threads-flag' is non-nil, the folder +is not automatically threaded, if it is large. If set to nil all +folders are treated as if they are small." + :type '(choice (const :tag "No Limit") integer) + :group 'mh-folder) + +(defcustom mh-recenter-summary-flag nil + "*Non-nil means to recenter the summary window. + +If this option is turned on, recenter the summary window when the +show window is toggled off." + :type 'boolean + :group 'mh-folder) + +(defcustom mh-recursive-folders-flag nil + "*Non-nil means that commands which operate on folders do so recursively." + :type 'boolean + :group 'mh-folder) + +(defcustom mh-sortm-args nil + "*Additional arguments for \"sortm\"\\. + +This option is consulted when a prefix argument is used with +\\[mh-sort-folder]. Normally default arguments to \"sortm\" are +specified in the MH profile. This option may be used to provide +an alternate view. For example, \"'(\"-nolimit\" \"-textfield\" +\"subject\")\" is a useful setting." + :type 'string + :group 'mh-folder) + + + +;;; Folder Selection (:group 'mh-folder-selection) + +(defcustom mh-default-folder-for-message-function nil + "Function to select a default folder for refiling or \"Fcc:\". + +The current buffer is set to the message being refiled with point +at the start of the message. This function should return the +default folder as a string with a leading \"+\" sign. It can also +return nil so that the last folder name is used as the default, +or an empty string to suppress the default entirely." + :type 'function + :group 'mh-folder-selection) + +(defcustom mh-default-folder-list nil + "*List of addresses and folders. + +The folder name associated with the first address found in this +list is used as the default for `mh-refile-msg' and similar +functions. Each element in this list contains a \"Check Recipient\" +item. If this item is turned on, then the address is checked +against the recipient instead of the sender. This is useful for +mailing lists. + +See `mh-prompt-for-refile-folder' and `mh-folder-from-address' +for more information." + :type '(repeat (list (regexp :tag "Address") + (string :tag "Folder") + (boolean :tag "Check Recipient"))) + :group 'mh-folder-selection) + +(defcustom mh-default-folder-must-exist-flag t + "*Non-nil means guessed folder name must exist to be used. + +If the derived folder does not exist, and this option is on, then +the last folder name used is suggested. This is useful if you get +mail from various people for whom you have an alias, but file +them all in the same project folder. + +See `mh-prompt-for-refile-folder' and `mh-folder-from-address' +for more information." + :type 'boolean + :group 'mh-folder-selection) + +(defcustom mh-default-folder-prefix "" + "*Prefix used for folder names generated from aliases. +The prefix is used to prevent clutter in your mail directory. + +See `mh-prompt-for-refile-folder' and `mh-folder-from-address' +for more information." + :type 'string + :group 'mh-folder-selection) + + + +;;; Identities (:group 'mh-identity) + +(eval-and-compile + (unless (fboundp 'mh-identity-make-menu-no-autoload) + (defun mh-identity-make-menu-no-autoload () + "Temporary definition. +Real definition will take effect when mh-identity is loaded." + nil))) + +(defcustom mh-identity-list nil + "*List of identities. + +To customize this option, click on the \"INS\" button and enter a label +such as \"Home\" or \"Work\". Then click on the \"INS\" button with the +label \"Add at least one item below\". Then choose one of the items in +the \"Value Menu\". + +You can specify an alternate \"From:\" header field using the \"From +Field\" menu item. You must include a valid email address. A standard +format is \"First Last \". If you use an initial +with a period, then you must quote your name as in '\"First I. Last\" +'. People usually list the name of the company +where they work using the \"Organization Field\" menu item. Set any +arbitrary header field and value in the \"Other Field\" menu item. +Unless the header field is a standard one, precede the name of your +field's label with \"X-\", as in \"X-Fruit-of-the-Day:\". The value of +\"Attribution Verb\" overrides the setting of +`mh-extract-from-attribution-verb'. Set your signature with the +\"Signature\" menu item. You can specify the contents of +`mh-signature-file-name', a file, or a function. Specify a different +key to sign or encrypt messages with the \"GPG Key ID\" menu item. + +You can select the identities you have added via the menu called +\"Identity\" in the MH-Letter buffer. You can also use +\\[mh-insert-identity]. To clear the fields and signature added by the +identity, select the \"None\" identity. + +The \"Identity\" menu contains two other items to save you from having +to set the identity on every message. The menu item \"Set Default for +Session\" can be used to set the default identity to the current +identity until you exit Emacs. The menu item \"Save as Default\" sets +the option `mh-identity-default' to the current identity setting. You +can also customize the `mh-identity-default' option in the usual +fashion." + :type '(repeat (list :tag "" + (string :tag "Label") + (repeat :tag "Add at least one item below" + (choice + (cons :tag "From Field" + (const "From") + (string :tag "Value")) + (cons :tag "Organization Field" + (const "Organization") + (string :tag "Value")) + (cons :tag "Other Field" + (string :tag "Field") + (string :tag "Value")) + (cons :tag "Attribution Verb" + (const ":attribution-verb") + (string :tag "Value")) + (cons :tag "Signature" + (const :tag "Signature" + ":signature") + (choice + (const :tag "mh-signature-file-name" + nil) + (file) + (function))) + (cons :tag "GPG Key ID" + (const :tag "GPG Key ID" + ":pgg-default-user-id") + (string :tag "Value")))))) + :set (lambda (symbol value) + (set-default symbol value) + (mh-identity-make-menu-no-autoload)) + :group 'mh-identity) + +(defcustom mh-auto-fields-list nil + "List of recipients for which header lines are automatically inserted. + +This option can be used to set the identity depending on the +recipient. To customize this option, click on the \"INS\" button and +enter a regular expression for the recipient's address. Click on the +\"INS\" button with the \"Add at least one item below\" label. Then choose +one of the items in the \"Value Menu\". + +The \"Identity\" menu item is used to select an identity from those +configured in `mh-identity-list'. All of the information for that +identity will be added if the recipient matches. The \"Fcc Field\" menu +item is used to select a folder that is used in the \"Fcc:\" header. +When you send the message, MH will put a copy of your message in this +folder. The \"Mail-Followup-To Field\" menu item is used to insert an +\"Mail-Followup-To:\" header field with the recipients you provide. If +the recipient's mail user agent supports this header field (as nmh +does), then their replies will go to the addresses listed. This is +useful if their replies go both to the list and to you and you don't +have a mechanism to suppress duplicates. If you reply to someone not +on the list, you must either remove the \"Mail-Followup-To:\" field, or +ensure the recipient is also listed there so that he receives replies +to your reply. Other header fields may be added using the \"Other +Field\" menu item. + +These fields can only be added after the recipient is known. Once the +header contains one or more recipients, run the +\\[mh-insert-auto-fields] command or choose the \"Identity -> Insert +Auto Fields\" menu item to insert these fields manually. However, you +can just send the message and the fields will be added automatically. +You are given a chance to see these fields and to confirm them before +the message is actually sent. You can do away with this confirmation +by turning off the option `mh-auto-fields-prompt-flag'. + +You should avoid using the same header field in `mh-auto-fields-list' +and `mh-identity-list' definitions that may apply to the same message +as the result is undefined." + :type `(repeat + (list :tag "" + (string :tag "Recipient") + (repeat :tag "Add at least one item below" + (choice + (cons :tag "Identity" + (const ":identity") + ,(append + '(radio) + (mapcar + (function (lambda (arg) `(const ,arg))) + (mapcar 'car mh-identity-list)))) + (cons :tag "Fcc Field" + (const "fcc") + (string :tag "Value")) + (cons :tag "Mail-Followup-To Field" + (const "Mail-Followup-To") + (string :tag "Value")) + (cons :tag "Other Field" + (string :tag "Field") + (string :tag "Value")))))) + :group 'mh-identity) + +(defcustom mh-auto-fields-prompt-flag t + "*Non-nil means to prompt before sending if fields inserted. +See `mh-auto-fields-list'." + :type 'boolean + :group 'mh-identity) + +(defcustom mh-identity-default nil + "Default identity to use when `mh-letter-mode' is called. +See `mh-identity-list'." + :type (append + '(radio) + (cons '(const :tag "None" nil) + (mapcar (function (lambda (arg) `(const ,arg))) + (mapcar 'car mh-identity-list)))) + :group 'mh-identity) + +(defcustom mh-identity-handlers + '(("From" . mh-identity-handler-top) + (":default" . mh-identity-handler-bottom) + (":attribution-verb" . mh-identity-handler-attribution-verb) + (":signature" . mh-identity-handler-signature) + (":pgg-default-user-id" . mh-identity-handler-gpg-identity)) + "Handler functions for fields in `mh-identity-list'. + +This option is used to change the way that fields, signatures, +and attributions in `mh-identity-list' are added. To customize +`mh-identity-handlers', replace the name of an existing handler +function associated with the field you want to change with the +name of a function you have written. You can also click on an +\"INS\" button and insert a field of your choice and the name of +the function you have written to handle it. + +The \"Field\" field can be any field that you've used in your +`mh-identity-list'. The special fields \":attribution-verb\", +\":signature\", or \":pgg-default-user-id\" are used for the +`mh-identity-list' choices \"Attribution Verb\", \"Signature\", and +\"GPG Key ID\" respectively. + +The handler associated with the \":default\" field is used when no +other field matches. + +The handler functions are passed two or three arguments: the +FIELD itself (for example, \"From\"), or one of the special +fields (for example, \":signature\"), and the ACTION 'remove or +'add. If the action is 'add, an additional argument +containing the VALUE for the field is given." + :type '(repeat (cons (string :tag "Field") function)) + :group 'mh-identity) + + + +;;; Incorporating Your Mail (:group 'mh-inc) + +(defcustom mh-inc-prog "inc" + "*Program to incorporate new mail into a folder. + +This program generates a one-line summary for each of the new +messages. Unless it is an absolute pathname, the file is assumed +to be in the `mh-progs' directory. You may also link a file to +\"inc\" that uses a different format. You'll then need to modify +several scan line format variables appropriately." + :type 'string + :group 'mh-inc) + +(eval-and-compile + (unless (fboundp 'mh-inc-spool-make-no-autoload) + (defun mh-inc-spool-make-no-autoload () + "Temporary definition. +Real definition will take effect when mh-inc is loaded." + nil))) + +(defcustom mh-inc-spool-list nil + "*Alternate spool files. + +You can use the `mh-inc-spool-list' variable to direct MH-E to +retrieve mail from arbitrary spool files other than your system +mailbox, file it in folders other than your \"+inbox\", and assign +key bindings to incorporate this mail. + +Suppose you are subscribed to the \"mh-e-devel\" mailing list and +you use \"procmail\" to filter this mail into \"~/mail/mh-e\" with +the following recipe in \".procmailrc\": + + MAILDIR=$HOME/mail + :0: + * ^From mh-e-devel-admin@stop.mail-abuse.org + mh-e + +In order to incorporate \"~/mail/mh-e\" into \"+mh-e\" with an +\"I m\" (mh-inc-spool-mh-e) command, customize this option, and click +on the \"INS\" button. Enter a \"Spool File\" of \"~/mail/mh-e\", a +\"Folder\" of \"mh-e\", and a \"Key Binding\" of \"m\". + +You can use \"xbuffy\" to automate the incorporation of this mail +using the Emacs 22 command \"emacsclient\" as follows: + + box ~/mail/mh-e + title mh-e + origMode + polltime 10 + headertime 0 + command emacsclient --eval '(mh-inc-spool-mh-e)' + +In XEmacs, the command \"gnuclient\" is used in a similar +fashion." + :type '(repeat (list (file :tag "Spool File") + (string :tag "Folder") + (character :tag "Key Binding"))) + :set (lambda (symbol value) + (set-default symbol value) + (mh-inc-spool-make-no-autoload)) + :group 'mh-inc) + + + +;;; Dealing with Junk Mail (:group 'mh-junk) + +(defvar mh-junk-choice nil + "Chosen spam fighting program.") + +;; Available spam filter interfaces +(defvar mh-junk-function-alist + '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist) + (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist) + (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist)) + "Available choices of spam programs to use. + +This is an alist. For each element there are functions that +blacklist a message as spam and whitelist a message incorrectly +classified as spam.") + +(defun mh-junk-choose (symbol value) + "Choose spam program to use. + +The function is always called with SYMBOL bound to +`mh-junk-program' and VALUE bound to the new value of +`mh-junk-program'. The function sets the variable +`mh-junk-choice' in addition to `mh-junk-program'." + (set symbol value) ;XXX shouldn't this be set-default? + (setq mh-junk-choice + (or value + (loop for element in mh-junk-function-alist + until (executable-find (symbol-name (car element))) + finally return (car element))))) + +(defcustom mh-junk-background nil + "If on, spam programs are run in background. + +By default, the programs are run in the foreground, but this can +be slow when junking large numbers of messages. If you have +enough memory or don't junk that many messages at the same time, +you might try turning on this option." + :type '(choice (const :tag "Off" nil) + (const :tag "On" 0)) + :group 'mh-junk) + +(defcustom mh-junk-disposition nil + "Disposition of junk mail." + :type '(choice (const :tag "Delete Spam" nil) + (string :tag "Spam Folder")) + :group 'mh-junk) + +(defcustom mh-junk-program nil + "Spam program that MH-E should use. + +The default setting of this option is \"Auto-detect\" which means +that MH-E will automatically choose one of SpamAssassin, +bogofilter, or SpamProbe in that order. If, for example, you have +both SpamAssassin and bogofilter installed and you want to use +bogofilter, then you can set this option to \"Bogofilter\"." + :type '(choice (const :tag "Auto-detect" nil) + (const :tag "SpamAssassin" spamassassin) + (const :tag "Bogofilter" bogofilter) + (const :tag "SpamProbe" spamprobe)) + :set 'mh-junk-choose + :group 'mh-junk) + + + +;;; Editing a Draft (:group 'mh-letter) + +(defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh) + "Type of tags used when composing MIME messages. + +In addition to MH-style directives, MH-E also supports MML (MIME +Meta Language) tags. (see Info node `(emacs-mime)Composing'). +This option can be used to choose between them. By default, this +option is set to \"MML\" if it is supported since it provides a +lot more functionality. This option can also be set to \"MH\" if +MH-style directives are preferred." + :type '(choice (const :tag "MML" mml) + (const :tag "MH" mh)) + :group 'mh-letter) + +(defcustom mh-compose-skipped-header-fields + '("From" "Organization" "References" "In-Reply-To" + "X-Face" "Face" "X-Image-URL" "X-Mailer") + "List of header fields to skip over when navigating in draft." + :type '(repeat (string :tag "Field")) + :group 'mh-letter) + +(defcustom mh-compose-space-does-completion-flag nil + "*Non-nil means \\\\[mh-letter-complete-or-space] does completion in message header." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-delete-yanked-msg-window-flag nil + "*Non-nil means delete any window displaying the message. + +This deletes the window containing the original message after +yanking it with \\\\[mh-yank-cur-msg] to make +more room on your screen for your reply." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-extract-from-attribution-verb "wrote:" + "*Verb to use for attribution when a message is yanked by \\\\[mh-yank-cur-msg]. + +The attribution consists of the sender's name and email address +followed by the content of this option. This option can be set to +\"wrote:\", \"a écrit:\", and \"schrieb:\". You can also use the +\"Custom String\" menu item to enter your own verb." + :type '(choice (const "wrote:") + (const "a écrit:") + (const "schrieb:") + (string :tag "Custom String")) + :group 'mh-letter) + +(defcustom mh-ins-buf-prefix "> " + "*String to put before each line of a yanked or inserted message. + +The prefix \"> \" is the default setting of this option. I +suggest that you not modify this option since it is used by many +mailers and news readers: messages are far easier to read if +several included messages have all been indented by the same +string. + +This prefix is not inserted if you use one of the supercite +flavors of `mh-yank-behavior' or you have added a +`mail-citation-hook'." + :type 'string + :group 'mh-letter) + +(defcustom mh-letter-complete-function 'ispell-complete-word + "*Function to call when completing outside of address or folder fields. + +In the body of the message, +\\\\[mh-letter-complete] runs this function, +which is set to \"ispell-complete-word\" by default." + :type '(choice function (const nil)) + :group 'mh-letter) + +(defcustom mh-letter-fill-column 72 + "*Fill column to use in MH Letter mode. + +By default, this option is 72 to allow others to quote your +message without line wrapping." + :type 'integer + :group 'mh-letter) + +(defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") + "Default method to use in security tags. + +This option is used to select between a variety of mail security +mechanisms. The default is \"PGP (MIME)\" if it is supported\; +otherwise, the default is \"None\". Other mechanisms include +vanilla \"PGP\" and \"S/MIME\". + +The `pgg' customization group may have some settings which may +interest you (see Info node `(pgg)'). + +In particular, I turn on the option `pgg-encrypt-for-me' so that +all messages I encrypt are encrypted with my public key as well. +If you keep a copy of all of your outgoing mail with a \"Fcc:\" +header field, this setting is vital so that you can read the mail +you write!" + :type '(choice (const :tag "PGP (MIME)" "pgpmime") + (const :tag "PGP" "pgp") + (const :tag "S/MIME" "smime") + (const :tag "None" "none")) + :group 'mh-letter) + +(defcustom mh-signature-file-name "~/.signature" + "*Source of user's signature. + +By default, the text of your signature is taken from the file +\"~/.signature\". You can read from other sources by changing this +option. This file may contain a vCard in which case an attachment is +added with the vCard. + +This option may also be a symbol, in which case that function is +called. You may not want a signature separator to be added for you; +instead you may want to insert one yourself. Options that you may find +useful to do this include `mh-signature-separator' (when inserting a +signature separator) and `mh-signature-separator-regexp' (for finding +said separator). The function `mh-signature-separator-p', which +reports t if the buffer contains a separator, may be useful as well. + +The signature is inserted into your message with the command +\\\\[mh-insert-signature] or with the option +`mh-identity-list'." + :type 'file + :group 'mh-letter) + +(defcustom mh-signature-separator-flag t + "*Non-nil means a signature separator should be inserted. + +It is not recommended that you change this option since various +mail user agents, including MH-E, use the separator to present +the signature differently, and to suppress the signature when +replying or yanking a letter into a draft." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-x-face-file "~/.face" + "*File containing face header field to insert in outgoing mail. + +If the file starts with either of the strings \"X-Face:\", \"Face:\" +or \"X-Image-URL:\" then the contents are added to the message header +verbatim. Otherwise it is assumed that the file contains the value of +the \"X-Face:\" header field. + +The \"X-Face:\" header field, which is a low-resolution, black and +white image, can be generated using the \"compface\" command (see URL +`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z'). The +\"Online X-Face Converter\" is a useful resource for quick conversion +of images into \"X-Face:\" header fields (see URL +`http://www.dairiki.org/xface/'). + +Use the \"make-face\" script to convert a JPEG image to the higher +resolution, color, \"Face:\" header field (see URL +`http://quimby.gnus.org/circus/face/make-face'). + +The URL of any image can be used for the \"X-Image-URL:\" field and no +processing of the image is required. + +To prevent the setting of any of these header fields, either set +`mh-x-face-file' to nil, or simply ensure that the file defined by +this option doesn't exist." + :type 'file + :group 'mh-letter) + +(defcustom mh-yank-behavior 'attribution + "*Controls which part of a message is yanked by \\\\[mh-yank-cur-msg]. + +To include the entire message, including the entire header, use +\"Body and Header\". Use \"Body\" to yank just the body without +the header. To yank only the portion of the message following the +point, set this option to \"Below Point\". + +Choose \"Invoke supercite\" to pass the entire message and header +through supercite. + +If the \"Body With Attribution\" setting is used, then the +message minus the header is yanked and a simple attribution line +is added at the top using the value of the option +`mh-extract-from-attribution-verb'. This is the default. + +If the \"Invoke supercite\" or \"Body With Attribution\" settings +are used, the \"-noformat\" argument is passed to the \"repl\" +program to override a \"-filter\" or \"-format\" argument. These +settings also have \"Automatically\" variants that perform the +action automatically when you reply so that you don't need to use +\\[mh-yank-cur-msg] at all. Note that this automatic action is +only performed if the show buffer matches the message being +replied to. People who use the automatic variants tend to turn on +the option `mh-delete-yanked-msg-window-flag' as well so that the +show window is never displayed. + +If the show buffer has a region, the option `mh-yank-behavior' is +ignored unless its value is one of Attribution variants in which +case the attribution is added to the yanked region. + +If this option is set to one of the supercite flavors, the hook +`mail-citation-hook' is ignored and `mh-ins-buf-prefix' is not +inserted." + :type '(choice (const :tag "Body and Header" t) + (const :tag "Body" body) + (const :tag "Below Point" nil) + (const :tag "Invoke supercite" supercite) + (const :tag "Invoke supercite, Automatically" autosupercite) + (const :tag "Body With Attribution" attribution) + (const :tag "Body With Attribution, Automatically" + autoattrib)) + :group 'mh-letter) + + + +;;; Ranges (:group 'mh-ranges) + +(defcustom mh-interpret-number-as-range-flag t + "*Non-nil means interpret a number as a range. + +Since one of the most frequent ranges used is \"last:N\", MH-E +will interpret input such as \"200\" as \"last:200\" if this +option is on (which is the default). If you need to scan just the +message 200, then use the range \"200:200\"." + :type 'boolean + :group 'mh-ranges) + + + +;;; Scan Line Formats (:group 'mh-scan-line-formats) + +(eval-and-compile + (unless (fboundp 'mh-adaptive-cmd-note-flag-check) + (defun mh-adaptive-cmd-note-flag-check (symbol value) + "Temporary definition. +Real definition, below, uses variables that aren't defined yet." + (set-default symbol value)))) + +(defcustom mh-adaptive-cmd-note-flag t + "*Non-nil means that the message number width is determined dynamically. + +If you've created your own format to handle long message numbers, +you'll be pleased to know you no longer need it since MH-E adapts its +internal format based upon the largest message number if this option +is on (the default). This option may only be turned on when +`mh-scan-format-file' is set to \"Use MH-E scan Format\". + +If you prefer fixed-width message numbers, turn off this option and +call `mh-set-cmd-note' with the width specified by your format file +\(see `mh-scan-format-file'). For example, the default width is 4, so +you would use \"(mh-set-cmd-note 4)\"." + :type 'boolean + :group 'mh-scan-line-formats + :set 'mh-adaptive-cmd-note-flag-check) + +(defun mh-scan-format-file-check (symbol value) + "Check if desired setting is legal. +Throw an error if user tries to set `mh-scan-format-file' to +anything but t when `mh-adaptive-cmd-note-flag' is on. Otherwise, +set SYMBOL to VALUE." + (if (and (not (eq value t)) + mh-adaptive-cmd-note-flag) + (error "%s %s" "You must turn off `mh-adaptive-cmd-note-flag'" + "unless you use \"Use MH-E scan Format\"") + (set-default symbol value))) + +(defcustom mh-scan-format-file t + "Specifies the format file to pass to the scan program. + +The default setting for this option is \"Use MH-E scan Format\". This +means that the format string will be taken from the either +`mh-scan-format-mh' or `mh-scan-format-nmh' depending on whether MH or +nmh (or GNU mailutils) is in use. This setting also enables you to +turn on the `mh-adaptive-cmd-note-flag' option. + +You can also set this option to \"Use Default scan Format\" to get the +same output as you would get if you ran \"scan\" from the shell. If +you have a format file that you want MH-E to use but not MH, you can +set this option to \"Specify a scan Format File\" and enter the name +of your format file. + +If you change the format of the scan lines you'll need to tell MH-E +how to parse the new format. As you will see, quite a lot of variables +are involved to do that. Use \"\\[apropos] RET mh-scan.*regexp\" to +obtain a list of these variables. You will also have to call +`mh-set-cmd-note' if your notations are not in column 4 (columns in +Emacs start with 0)." + :type '(choice (const :tag "Use MH-E scan Format" t) + (const :tag "Use Default scan Format" nil) + (file :tag "Specify a scan Format File")) + :group 'mh-scan-line-formats + :set 'mh-scan-format-file-check) + +(defun mh-adaptive-cmd-note-flag-check (symbol value) + "Check if desired setting is legal. +Throw an error if user tries to turn on +`mh-adaptive-cmd-note-flag' when `mh-scan-format-file' isn't t. +Otherwise, set SYMBOL to VALUE." + (if (and value + (not (eq mh-scan-format-file t))) + (error "%s %s" "Can't turn on unless `mh-scan-format-file'" + "is set to \"Use MH-E scan Format\"") + (set-default symbol value))) + +(defcustom mh-scan-prog "scan" + "*Program used to scan messages. + +The name of the program that generates a listing of one line per +message is held in this option. Unless this variable contains an +absolute pathname, it is assumed to be in the `mh-progs' +directory. You may link another program to `scan' (see +\"mh-profile(5)\") to produce a different type of listing." + :type 'string + :group 'mh-scan-line-formats) +(make-variable-buffer-local 'mh-scan-prog) + + + +;;; Searching (:group 'mh-search) + +(defcustom mh-search-program nil + "Search program that MH-E shall use. + +The default setting of this option is \"Auto-detect\" which means +that MH-E will automatically choose one of swish++, swish-e, +mairix, namazu, pick and grep in that order. If, for example, you +have both swish++ and mairix installed and you want to use +mairix, then you can set this option to \"mairix\". + +More information about setting up an indexing program to use with +MH-E can be found in the documentation of `mh-search'." + :type '(choice (const :tag "Auto-detect" nil) + (const :tag "swish++" swish++) + (const :tag "swish-e" swish) + (const :tag "mairix" mairix) + (const :tag "namazu" namazu) + (const :tag "pick" pick) + (const :tag "grep" grep)) + :group 'mh-search) + + + +;;; Sending Mail (:group 'mh-sending-mail) + +(defcustom mh-compose-forward-as-mime-flag t + "*Non-nil means that messages are forwarded as attachments. + +By default, this option is on which means that the forwarded +messages are included as attachments. If you would prefer to +forward your messages verbatim (as text, inline), then turn off +this option. Forwarding messages verbatim works well for short, +textual messages, but your recipient won't be able to view any +non-textual attachments that were in the forwarded message. Be +aware that if you have \"forw: -mime\" in your MH profile, then +forwarded messages will always be included as attachments +regardless of the settings of this option." + :type 'boolean + :group 'mh-sending-mail) + +(defcustom mh-compose-letter-function nil + "Invoked when starting a new draft. + +However, it is the last function called before you edit your +message. The consequence of this is that you can write a function +to write and send the message for you. This function is passed +three arguments: the contents of the TO, SUBJECT, and CC header +fields." + :type '(choice (const nil) function) + :group 'mh-sending-mail) + +(defcustom mh-compose-prompt-flag nil + "*Non-nil means prompt for header fields when composing a new draft." + :type 'boolean + :group 'mh-sending-mail) + +(defcustom mh-forward-subject-format "%s: %s" + "*Format string for forwarded message subject. + +This option is a string which includes two escapes (\"%s\"). The +first \"%s\" is replaced with the sender of the original message, +and the second one is replaced with the original \"Subject:\"." + :type 'string + :group 'mh-sending-mail) + +(defcustom mh-insert-x-mailer-flag t + "*Non-nil means append an \"X-Mailer:\" header field to the header. + +This header field includes the version of MH-E and Emacs that you +are using. If you don't want to participate in our marketing, you +can turn this option off." + :type 'boolean + :group 'mh-sending-mail) + +(defcustom mh-redist-full-contents-flag nil + "*Non-nil means the \"dist\" command needs entire letter for redistribution. + +This option must be turned on if \"dist\" requires the whole +letter for redistribution, which is the case if \"send\" is +compiled with the BERK option (which many people abhor). If you +find that MH will not allow you to redistribute a message that +has been redistributed before, turn off this option." + :type 'boolean + :group 'mh-sending-mail) + +(defcustom mh-reply-default-reply-to nil + "*Sets the person or persons to whom a reply will be sent. + +This option is set to \"Prompt\" by default so that you are +prompted for the recipient of a reply. If you find that most of +the time that you specify \"cc\" when you reply to a message, set +this option to \"cc\". Other choices include \"from\", \"to\", or +\"all\". You can always edit the recipients in the draft." + :type '(choice (const :tag "Prompt" nil) + (const "from") + (const "to") + (const "cc") + (const "all")) + :group 'mh-sending-mail) + +(defcustom mh-reply-show-message-flag t + "*Non-nil means the MH-Show buffer is displayed when replying. + +If you include the message automatically, you can hide the +MH-Show buffer by turning off this option. + +See also `mh-reply'." + :type 'boolean + :group 'mh-sending-mail) + + + +;;; Sequences (:group 'mh-sequences) + +;; If `mh-unpropagated-sequences' becomes a defcustom, add the following to +;; the docstring: "Additional sequences that should not to be preserved can be +;; specified by setting `mh-unpropagated-sequences' appropriately." XXX + +(defcustom mh-refile-preserves-sequences-flag t + "*Non-nil means that sequences are preserved when messages are refiled. + +If a message is in any sequence (except \"Previous-Sequence:\" +and \"cur\") when it is refiled, 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) + +(defcustom mh-tick-seq 'tick + "The name of the MH sequence for ticked messages. + +You can customize this option if you already use the \"tick\" +sequence for your own use. You can also disable all of the +ticking functions by choosing the \"Disable Ticking\" item but +there isn't much advantage to that." + :type '(choice (const :tag "Disable Ticking" nil) + symbol) + :group 'mh-sequences) + +(defcustom mh-update-sequences-after-mh-show-flag t + "*Non-nil means flush MH sequences to disk after message is shown\\. + +Three sequences are maintained internally by MH-E and pushed out +to MH when a message is shown. They include the sequence +specified by your \"Unseen-Sequence:\" profile entry, \"cur\", +and the sequence listed by the option `mh-tick-seq' which is +\"tick\" by default. If you do not like this behavior, turn off +this option. You can then update the state manually with the +\\[mh-execute-commands], \\[mh-quit], or \\[mh-update-sequences] +commands." + :type 'boolean + :group 'mh-sequences) + + + +;;; Reading Your Mail (:group 'mh-show) + +(defcustom mh-bury-show-buffer-flag t + "*Non-nil means show buffer is buried. + +One advantage of not burying the show buffer is that one can +delete the show buffer more easily in an electric buffer list +because of its proximity to its associated MH-Folder buffer. Try +running \\[electric-buffer-list] to see what I mean." + :type 'boolean + :group 'mh-show) + +(defcustom mh-clean-message-header-flag t + "*Non-nil means remove extraneous header fields. + +See also `mh-invisible-header-fields-default' and +`mh-invisible-header-fields'." + :type 'boolean + :group 'mh-show) + +(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) + "*Non-nil means attachments are handled\\. + +MH-E can handle attachments as well if the Gnus `mm-decode' +library is present. If so, this option will be on. Otherwise, +you'll see the MIME body parts rather than text or attachments. +There isn't much point in turning off this option; however, you +can inspect it if it appears that the body parts are not being +interpreted correctly or toggle it with the command +\\[mh-toggle-mh-decode-mime-flag] to view the raw message. + +This option also controls the display of quoted-printable +messages and other graphical widgets. See the options +`mh-graphical-smileys-flag' and `mh-graphical-emphasis-flag'." + :type 'boolean + :group 'mh-show) + +(defcustom mh-display-buttons-for-alternatives-flag nil + "*Non-nil means display buttons for all alternative attachments. + +Sometimes, a mail program will produce multiple alternatives of +the attachment in increasing degree of faithfulness to the +original content. By default, only the preferred alternative is +displayed. If this option is on, then the preferred part is shown +inline and buttons are shown for each of the other alternatives." + :type 'boolean + :group 'mh-show) + +(defcustom mh-display-buttons-for-inline-parts-flag nil + "*Non-nil means display buttons for all inline attachments\\. + +The sender can request that attachments should be viewed inline so +that they do not really appear like an attachment at all to the +reader. Most of the time, this is desirable, so by default MH-E +suppresses the buttons for inline attachments. On the other hand, you +may receive code or HTML which the sender has added to his message as +inline attachments so that you can read them in MH-E. In this case, it +is useful to see the buttons so that you know you don't have to cut +and paste the code into a file; you can simply save the attachment. + +If you want to make the buttons visible for inline attachments, you +can use the command \\[mh-toggle-mime-buttons] to toggle the +visibility of these buttons. You can turn on these buttons permanently +by turning on this option. + +MH-E cannot display all attachments inline however. It can display +text (including HTML) and images." + :type 'boolean + :group 'mh-show) + +(defcustom mh-do-not-confirm-flag nil + "*Non-nil means non-reversible commands do not prompt for confirmation. + +Commands such as `mh-pack-folder' prompt to confirm whether to +process outstanding moves and deletes or not before continuing. +Turning on this option means that these actions will be +performed--which is usually desired but cannot be +retracted--without question." + :type 'boolean + :group 'mh-show) + +(defcustom mh-fetch-x-image-url nil + "*Control fetching of \"X-Image-URL:\" header field image. + +Ths option controls the fetching of the \"X-Image-URL:\" header +field image with the following values: + +Ask Before Fetching + You are prompted before the image is fetched. MH-E will + remember your reply and will either use the already fetched + image the next time the same URL is encountered or silently + skip it if you didn't fetch it the first time. This is a + good setting. + +Never Fetch + Images are never fetched and only displayed if they are + already present in the cache. This is the default. + +There isn't a value of \"Always Fetch\" for privacy and DOS (denial of +service) reasons. For example, fetching a URL can tip off a spammer +that you've read his email (which is why you shouldn't blindly answer +yes if you've set this option to \"Ask Before Fetching\"). Someone may +also flood your network and fill your disk drive by sending a torrent +of messages, each specifying a unique URL to a very large file. + +The cache of images is found in the directory \".mhe-x-image-cache\" +within your MH directory. You can add your own face to the \"From:\" +field too. See Info node `(mh-e)Picture'. + +This setting only has effect if the option `mh-show-use-xface-flag' is +turned on." + + :type '(choice (const :tag "Ask Before Fetching" ask) + (const :tag "Never Fetch" nil)) + :group 'mh-show) + +(defcustom mh-graphical-smileys-flag t + "*Non-nil means graphical smileys are displayed. + +It is a long standing custom to inject body language using a +cornucopia of punctuation, also known as the \"smileys\". MH-E +can render these as graphical widgets if this option is turned +on, which it is by default. Smileys include patterns such as :-) +and ;-). + +This option is disabled if the option `mh-decode-mime-flag' is +turned off." + :type 'boolean + :group 'mh-show) + +(defcustom mh-graphical-emphasis-flag t + "*Non-nil means graphical emphasis is displayed. + +A few typesetting features are indicated in ASCII text with +certain characters. If your terminal supports it, MH-E can render +these typesetting directives naturally if this option is turned +on, which it is by default. For example, _underline_ will be +underlined, *bold* will appear in bold, /italics/ will appear in +italics, and so on. See the option `gnus-emphasis-alist' for the +whole list. + +This option is disabled if the option `mh-decode-mime-flag' is +turned off." + :type 'boolean + :group 'mh-show) + +(defcustom mh-highlight-citation-style 'gnus + "Style for highlighting citations. + +If the sender of the message has cited other messages in his +message, then MH-E will highlight these citations to emphasize +the sender's actual response. This option can be customized to +change the highlighting style. The \"Multicolor\" method uses a +different color for each indentation while the \"Monochrome\" +method highlights all citations in red. To disable highlighting +of citations entirely, choose \"None\"." + :type '(choice (const :tag "Multicolor" gnus) + (const :tag "Monochrome" font-lock) + (const :tag "None" nil)) + :group 'mh-show) + +;; Keep fields alphabetized. Mention source, if known. +(defvar mh-invisible-header-fields-internal + '("Approved:" + "Autoforwarded:" + "Bestservhost:" + "Cancel-Lock:" ; NNTP posts + "Content-" ; RFC 2045 + "Delivered-To:" ; Egroups/yahoogroups mailing list manager + "Delivery-Date:" ; MH + "Delivery:" + "DomainKey-Signature:" ;http://antispam.yahoo.com/domainkeys + "Encoding:" + "Envelope-to:" + "Errors-To:" + "Face:" ; Gnus Face header + "Forwarded:" ; MH + "From " ; sendmail + "Importance:" ; MS Outlook + "In-Reply-To:" ; MH + "Lines:" + "List-" ; Mailman mailing list manager + "List-" ; Unknown mailing list managers + "List-Subscribe:" ; Unknown mailing list managers + "List-Unsubscribe:" ; Unknown mailing list managers + "Mail-from:" ; MH + "Mailing-List:" ; Egroups/yahoogroups mailing list manager + "Message-Id:" ; RFC 822 + "Mime-Version" ; RFC 2045 + "NNTP-" ; News + "Old-Return-Path:" + "Original-Encoded-Information-Types:" ; X400 + "Original-Lines:" ; mail to news + "Original-NNTP-" ; mail to news + "Original-Newsgroups:" ; mail to news + "Original-Path:" ; mail to news + "Original-Received:" ; mail to news + "Original-To:" ; mail to news + "Original-X-" ; mail to news + "Originator:" + "P1-Content-Type:" ; X400 + "P1-Message-Id:" ; X400 + "P1-Recipient:" ; X400 + "Path:" + "Precedence:" + "Prev-Resent" ; MH + "Priority:" + "Received:" ; RFC 822 + "Received-SPF:" ; Gmail + "References:" + "Remailed-" ; MH + "Replied:" ; MH + "Resent" ; MH + "Return-Path:" ; RFC 822 + "Sensitivity:" ; MS Outlook + "Status:" ; sendmail + "Thread-" + "Ua-Content-Id:" ; X400 +;; "User-Agent:" ; Similar to X-Mailer, so display it. + "Via:" ; MH + "X-Abuse-Info:" + "X-Abuse-and-DMCA-" + "X-Accept-Language:" + "X-Accept-Language:" ; Netscape/Mozilla + "X-Ack:" + "X-Administrivia-To:" + "X-AntiAbuse:" ; cPanel + "X-Apparently-From:" ; MS Outlook + "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager + "X-Authentication-Warning:" ; sendmail + "X-Beenthere:" ; Mailman mailing list manager + "X-Bogosity:" ; bogofilter + "X-BrightmailFiltered:" ; Brightmail + "X-Brightmail-Tracker:" ; Brightmail + "X-Bugzilla-*" ; Bugzilla + "X-Complaints-To:" + "X-ContentStamp:" ; NetZero + "X-Cron-Env:" + "X-DMCA" + "X-Delivered" + "X-ELNK-Trace:" ; Earthlink mailer + "X-Envelope-Date:" ; GNU mailutils + "X-Envelope-From:" + "X-Envelope-Sender:" + "X-Envelope-To:" + "X-Evolution:" ; Evolution mail client + "X-Face:" + "X-Folder:" ; Spam + "X-From-Line" + "X-Gmail-" ; Gmail + "X-Gnus-Mail-Source:" ; gnus + "X-Greylist:" ; milter-greylist-1.2.1 + "X-Habeas-SWE-1:" ; Spam + "X-Habeas-SWE-2:" ; Spam + "X-Habeas-SWE-3:" ; Spam + "X-Habeas-SWE-4:" ; Spam + "X-Habeas-SWE-5:" ; Spam + "X-Habeas-SWE-6:" ; Spam + "X-Habeas-SWE-7:" ; Spam + "X-Habeas-SWE-8:" ; Spam + "X-Habeas-SWE-9:" ; Spam + "X-Hashcash:" ; hashcash + "X-Info:" ; NTMail + "X-Juno-" ; Juno + "X-List-Host:" ; Unknown mailing list managers + "X-List-Subscribe:" ; Unknown mailing list managers + "X-List-Unsubscribe:" ; Unknown mailing list managers + "X-Listprocessor-" ; ListProc(tm) by CREN + "X-Listserver:" ; Unknown mailing list managers + "X-Loop:" ; Unknown mailing list managers + "X-Lumos-SenderID:" ; Roving ConstantContact + "X-MAIL-INFO:" ; NetZero + "X-MHE-Checksum" ; Checksum added during index search + "X-MIME-Autoconverted:" ; sendmail + "X-MIMETrack:" + "X-MS-" ; MS Outlook + "X-MailScanner" ; ListProc(tm) by CREN + "X-Mailing-List:" ; Unknown mailing list managers + "X-Mailman-Version:" ; Mailman mailing list manager + "X-Majordomo:" ; Majordomo mailing list manager + "X-Message-Id" + "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX + "X-MimeOLE:" ; MS Outlook + "X-Mms-" ; T-Mobile pictures + "X-Mozilla-Status:" ; Netscape/Mozilla + "X-Msmail-" ; MS Outlook + "X-NAI-Spam-" ; Network Associates Inc. SpamKiller + "X-News:" ; News + "X-No-Archive:" + "X-Notes-Item:" ; Lotus Notes Domino structured header + "X-OperatingSystem:" + ;;"X-Operator:" ; Similar to X-Mailer, so display it + "X-Orcl-Content-Type:" + "X-Original-Complaints-To:" + "X-Original-Date:" ; SourceForge mailing list manager + "X-Original-To:" + "X-Original-Trace:" + "X-OriginalArrivalTime:" ; Hotmail + "X-Originating-IP:" ; Hotmail + "X-Postfilter:" + "X-Priority:" ; MS Outlook + "X-Qotd-" ; User added + "X-RM" + "X-Received-Date:" + "X-Received:" + "X-Request-" + "X-Return-Path-Hint:" ; Roving ConstantContact + "X-Roving-*" ; Roving ConstantContact + "X-SBClass:" ; Spam + "X-SBNote:" ; Spam + "X-SBPass:" ; Spam + "X-SBRule:" ; Spam + "X-SMTP-" + "X-Scanned-By" + "X-Sender:" + "X-Server-Date:" + "X-Server-Uuid:" + "X-Sieve:" ; Sieve filtering + "X-Source" + "X-Spam-" ; Spamassassin + "X-SpamBouncer:" ; Spam + "X-Status" + "X-Submissions-To:" + "X-Telecom-Digest" + "X-Trace:" + "X-UID" + "X-UIDL:" + "X-UNTD-" ; NetZero + "X-USANET-" ; usa.net + "X-UserInfo1:" + "X-VSMLoop:" ; NTMail + "X-Virus-Scanned" ; amavisd-new + "X-Vms-To:" + "X-WebTV-Signature:" + "X-Wss-Id:" ; Worldtalk gateways + "X-Yahoo" + "X-eGroups-" ; Egroups/yahoogroups mailing list manager + "X-pgp:" + "X-submission-address:" + "X400-" ; X400 + "Xref:") + "List of default header fields that are not to be shown. + +Do not alter this variable directly. Instead, add entries from +here that you would like to be displayed in +`mh-invisible-header-fields-default' and add entries to hide in +`mh-invisible-header-fields'.") + +(eval-and-compile + (unless (fboundp 'mh-invisible-headers) + (defun mh-invisible-headers () + "Temporary definition. +Real definition, below, uses variables that aren't defined yet." + nil))) + +(defvar mh-delay-invisible-header-generation-flag t + "Non-nil means to delay the generation of invisible header fields. +Because the function `mh-invisible-headers' uses both +`mh-invisible-header-fields' and `mh-invisible-header-fields', it +cannot be run until both variables have been initialized.") + +(defcustom mh-invisible-header-fields nil + "*Additional header fields to hide. + +Header fields that you would like to hide that aren't listed in +`mh-invisible-header-fields-default' can be added to this option +with a couple of caveats. Regular expressions are not allowed. +Unique fields should have a \":\" suffix; otherwise, the element +can be used to render invisible an entire class of fields that +start with the same prefix. If you think a header field should be +generally ignored, report a bug (see URL +`https://sourceforge.net/tracker/?group_id=13357&atid=113357'). + +See also `mh-clean-message-header-flag'." + + :type '(repeat (string :tag "Header field")) + :set (lambda (symbol value) + (set-default symbol value) + (mh-invisible-headers)) + :group 'mh-show) + +(defcustom mh-invisible-header-fields-default nil + "*List of hidden header fields. + +The header fields listed in this option are hidden, although you +can check off any field that you would like to see. + +Header fields that you would like to hide that aren't listed can +be added to the option `mh-invisible-header-fields'. + +See also `mh-clean-message-header-flag'." + :type `(set ,@(mapcar (lambda (x) `(const ,x)) + mh-invisible-header-fields-internal)) + :set (lambda (symbol value) + (set-default symbol value) + (mh-invisible-headers)) + :group 'mh-show) + +(defvar mh-invisible-header-fields-compiled nil + "*Regexp matching lines in a message header that are not to be shown. +Do not alter this variable directly. Instead, customize +`mh-invisible-header-fields-default' checking for fields normally +hidden that you wish to display, and add extra entries to hide in +`mh-invisible-header-fields'.") + +(defun mh-invisible-headers () + "Make or remake the variable `mh-invisible-header-fields-compiled'. +Done using `mh-invisible-header-fields-internal' as input, from +which entries from `mh-invisible-header-fields-default' are +removed and entries from `mh-invisible-header-fields' are added." + (let ((fields mh-invisible-header-fields-internal)) + (when mh-invisible-header-fields-default + ;; Remove entries from `mh-invisible-header-fields-default' + (setq fields + (loop for x in fields + unless (member x mh-invisible-header-fields-default) + collect x))) + (when (and (boundp 'mh-invisible-header-fields) + mh-invisible-header-fields) + (dolist (x mh-invisible-header-fields) + (unless (member x fields) (setq fields (cons x fields))))) + (if fields + (setq mh-invisible-header-fields-compiled + (concat + "^" + ;; workaround for insufficient default + (let ((max-specpdl-size 1000)) + (regexp-opt fields t)))) + (setq mh-invisible-header-fields-compiled nil)))) + +;; Compile invisible header fields. +(mh-invisible-headers) + +(defcustom mh-lpr-command-format "lpr -J '%s'" + "*Command used to print\\. + +This option contains the Unix command line which performs the +actual printing for the \\[mh-print-msg] command. The string can +contain one escape, \"%s\", which is replaced by the name of the +folder and the message number and is useful for print job names. +I use \"mpage -h'%s' -b Letter -H1of -mlrtb -P\" which produces a +nice header and adds a bit of margin so the text fits within my +printer's margins. + +This options is not used by the commands \\[mh-ps-print-msg] or +\\[mh-ps-print-msg-file]." + :type 'string + :group 'mh-show) + +(defcustom mh-max-inline-image-height nil + "*Maximum inline image height if \"Content-Disposition:\" is not present. + +Some older mail programs do not insert this needed plumbing to +tell MH-E whether to display the attachments inline or not. If +this is the case, MH-E will display these images inline if they +are smaller than the window. However, you might want to allow +larger images to be displayed inline. To do this, you can change +the options `mh-max-inline-image-width' and +`mh-max-inline-image-height' from their default value of zero to +a large number. The size of your screen is a good choice for +these numbers." + :type '(choice (const nil) integer) + :group 'mh-show) + +(defcustom mh-max-inline-image-width nil + "*Maximum inline image width if \"Content-Disposition:\" is not present. + +Some older mail programs do not insert this needed plumbing to +tell MH-E whether to display the attachments inline or not. If +this is the case, MH-E will display these images inline if they +are smaller than the window. However, you might want to allow +larger images to be displayed inline. To do this, you can change +the options `mh-max-inline-image-width' and +`mh-max-inline-image-height' from their default value of zero to +a large number. The size of your screen is a good choice for +these numbers." + :type '(choice (const nil) integer) + :group 'mh-show) + +(defcustom mh-mhl-format-file nil + "*Specifies the format file to pass to the \"mhl\" program. + +Normally MH-E takes care of displaying messages itself (rather than +calling an MH program to do the work). If you'd rather have \"mhl\" +display the message (within MH-E), change this option from its default +value of \"Use Default mhl Format (Printing Only)\". + +You can set this option to \"Use Default mhl Format\" to get the same +output as you would get if you ran \"mhl\" from the shell. + +If you have a format file that you want MH-E to use, you can set this +option to \"Specify an mhl Format File\" and enter the name of your +format file. Your format file should specify a non-zero value for +\"overflowoffset\" to allow MH-E to parse the header. Note that +\"mhl\" is always used for printing and forwarding; in this case, the +value of this option is consulted if you have specified a format +file." + :type '(choice (const :tag "Use Default mhl Format (Printing Only)" nil) + (const :tag "Use Default mhl Format" t) + (file :tag "Specify an mhl Format File")) + :group 'mh-show) + +(defcustom mh-mime-save-parts-default-directory t + "Default directory to use for \\\\[mh-mime-save-parts]. + +The default value for this option is \"Prompt Always\" so that +you are always prompted for the directory in which to save the +attachments. However, if you usually use the same directory +within a session, then you can set this option to \"Prompt the +First Time\" to avoid the prompt each time. you can make this +directory permanent by choosing \"Directory\" and entering the +directory's name." + :type '(choice (const :tag "Prompt the First Time" nil) + (const :tag "Prompt Always" t) + directory) + :group 'mh-show) + +(defcustom mh-print-background-flag nil + "*Non-nil means messages should be printed in the background\\. + +Normally messages are printed in the foreground. If this is slow on +your system, you may elect to turn off this option to print in the +background. + +WARNING: If you do this, do not delete the message until it is printed +or else the output may be truncated. + +This option is not used by the commands \\[mh-ps-print-msg] or +\\[mh-ps-print-msg-file]." + :type 'boolean + :group 'mh-show) + +(defcustom mh-show-maximum-size 0 + "*Maximum size of message (in bytes) to display automatically. + +This option provides an opportunity to skip over large messages +which may be slow to load. The default value of 0 means that all +message are shown regardless of size." + :type 'integer + :group 'mh-show) + +(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p) + goto-address-highlight-p) + "*Non-nil means highlight URLs and email addresses\\. + +To send a message using the highlighted email address or to view +the web page for the highlighted URL, use the middle mouse button +or \\[goto-address-at-point]. + +See Info node `(mh-e)Sending Mail' to see how to configure Emacs +to send the message using MH-E. + +The default value of this option comes from the value of +`goto-address-highlight-p'." + :type 'boolean + :group 'mh-show) + +(defcustom mh-show-use-xface-flag (>= emacs-major-version 21) + "*Non-nil means display face images in MH-show buffers. + +MH-E can display the content of \"Face:\", \"X-Face:\", and +\"X-Image-URL:\" header fields. If any of these fields occur in the +header of your message, the sender's face will appear in the \"From:\" +header field. If more than one of these fields appear, then the first +field found in the order \"Face:\", \"X-Face:\", and \"X-Image-URL:\" +will be used. + +The option `mh-show-use-xface-flag' is used to turn this feature on +and off. This feature will be turned on by default if your system +supports it. + +The first header field used, if present, is the Gnus-specific +\"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and +XEmacs. For more information, see URL +`http://quimby.gnus.org/circus/face/'. Next is the traditional +\"X-Face:\" header field. The display of this field requires the +\"uncompface\" program (see URL +`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent +versions of XEmacs have internal support for \"X-Face:\" images. If +your version of XEmacs does not, then you'll need both \"uncompface\" +and the x-face package (see URL `ftp://ftp.jpl.org/pub/elisp/'). + +Finally, MH-E will display images referenced by the \"X-Image-URL:\" +header field if neither the \"Face:\" nor the \"X-Face:\" fields are +present. The display of the images requires \"wget\" (see URL +`http://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\" +to fetch the image and the \"convert\" program from the ImageMagick +suite (see URL `http://www.imagemagick.org/'). Of the three header +fields this is the most efficient in terms of network usage since the +image doesn't need to be transmitted with every single mail. + +The option `mh-fetch-x-image-url' controls the fetching of the +\"X-Image-URL:\" header field image." + :type 'boolean + :group 'mh-show) + +(defcustom mh-store-default-directory nil + "*Default directory for \\\\[mh-store-msg]. + +If you would like to change the initial default directory, +customize this option, change the value from \"Current\" to +\"Directory\", and then enter the name of the directory for storing +the content of these messages." + :type '(choice (const :tag "Current" nil) + directory) + :group 'mh-show) + +(defcustom mh-summary-height nil + "*Number of lines in MH-Folder buffer (including the mode line). + +The default value of this option is \"Automatic\" which means +that the MH-Folder buffer will maintain the same proportional +size if the frame is resized. If you'd prefer a fixed height, +then choose the \"Fixed Size\" option and enter the number of +lines you'd like to see." + :type '(choice (const :tag "Automatic" nil) + (integer :tag "Fixed Size")) + :group 'mh-show) + + + +;;; The Speedbar (:group 'mh-speedbar) + +(defcustom mh-speed-update-interval 60 + "Time between speedbar updates in seconds. +Set to 0 to disable automatic update." + :type 'integer + :group 'mh-speedbar) + + + +;;; Threading (:group 'mh-thread) + +(defcustom mh-show-threads-flag nil + "*Non-nil means new folders start in threaded mode. + +Threading large number of messages can be time consuming so this +option is turned off by default. If you turn this option on, then +threading will be done only if the number of messages being +threaded is less than `mh-large-folder'." + :type 'boolean + :group 'mh-thread) + + + +;;; The Tool Bar (:group 'mh-tool-bar) + +;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined +;; dynamically in mh-tool-bar.el. + +(defcustom mh-tool-bar-search-function 'mh-search + "*Function called by the tool bar search button. + +By default, this is set to `mh-search'. You can also choose +\"Other Function\" from the \"Value Menu\" and enter a function +of your own choosing." + :type '(choice (const mh-search) + (function :tag "Other Function")) + :group 'mh-tool-bar) + +;; XEmacs has a couple of extra customizations... +(mh-do-in-xemacs + (defcustom mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag + "*If non-nil, use tool bar. + +This option controls whether to show the MH-E icons at all. By +default, this option is turned on if the window system supports +tool bars. If your system doesn't support tool bars, then you +won't be able to turn on this option." + :type 'boolean + :group 'mh-tool-bar + :set (lambda (symbol value) + (if (and (eq value t) + (not mh-xemacs-has-tool-bar-flag)) + (error "Tool bar not supported")) + (set-default symbol value))) + + (defcustom mh-xemacs-tool-bar-position nil + "*Tool bar location. + +This option controls the placement of the tool bar along the four +edges of the frame. You can choose from one of \"Same As Default +Tool Bar\", \"Top\", \"Bottom\", \"Left\", or \"Right\". If this +variable is set to anything other than \"Same As Default Tool +Bar\" and the default tool bar is in a different location, then +two tool bars will be displayed: the MH-E tool bar and the +default tool bar." + :type '(radio (const :tag "Same As Default Tool Bar" :value nil) + (const :tag "Top" :value top) + (const :tag "Bottom" :value bottom) + (const :tag "Left" :value left) + (const :tag "Right" :value right)) + :group 'mh-tool-bar)) + + + +;;; Hooks (:group 'mh-hooks + group where hook described) + +(defcustom mh-after-commands-processed-hook nil + "Hook run by \\\\[mh-execute-commands] after performing outstanding refile and delete requests. + +Variables that are useful in this hook include +`mh-folders-changed', which lists which folders were affected by +deletes and refiles. This list will always include the current +folder, which is also available in `mh-current-folder'." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-alias-reloaded-hook nil + "Hook run by `mh-alias-reload' after loading aliases." + :type 'hook + :group 'mh-hooks + :group 'mh-alias) + +(defcustom mh-before-commands-processed-hook nil + "Hook run by \\\\[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'." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-before-quit-hook nil + "Hook run by \\\\[mh-quit] before quitting MH-E. + +This hook is called before the quit occurs, so you might use it +to perform any MH-E operations; you could perform some query and +abort the quit or call `mh-execute-commands', for example. + +See also `mh-quit-hook'." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-before-send-letter-hook nil + "Hook run at the beginning of the \\\\[mh-send-letter] command. + +For example, if you want to check your spelling in your message +before sending, add the `ispell-message' function." + :type 'hook + :options '(ispell-message) + :group 'mh-hooks + :group 'mh-letter) + +(defcustom mh-delete-msg-hook nil + "Hook run by \\\\[mh-delete-msg] after marking each message for deletion. + +For example, a past maintainer of MH-E used this once when he +kept statistics on his mail usage." + :type 'hook + :group 'mh-hooks + :group 'mh-show) + +(defcustom mh-find-path-hook nil + "Hook run by `mh-find-path' after reading the user's MH profile. + +This hook can be used the change the value of the variables that +`mh-find-path' sets if you need to run with different values +between MH and MH-E." + :type 'hook + :group 'mh-hooks + :group 'mh-e) + +(defcustom mh-folder-mode-hook nil + "Hook run by `mh-folder-mode' when visiting a new folder." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-forward-hook nil + "Hook run by `mh-forward' on a forwarded letter." + :type 'hook + :group 'mh-hooks + :group 'mh-sending-mail) + +(defcustom mh-inc-folder-hook nil + "Hook run by \\\\[mh-inc-folder] after incorporating mail into a folder." + :type 'hook + :group 'mh-hooks + :group 'mh-inc) + +(defcustom mh-insert-signature-hook nil + "Hook run by \\\\[mh-insert-signature] after signature has been inserted. + +Hook functions may access the actual name of the file or the +function used to insert the signature with +`mh-signature-file-name'." + :type 'hook + :group 'mh-hooks + :group 'mh-letter) + +(defcustom mh-kill-folder-suppress-prompt-hooks '(mh-search-p) + "Abnormal hook run at the beginning of \\\\[mh-kill-folder]. + +The hook functions are called with no arguments and should return +a non-nil value to suppress the normal prompt when you remove a +folder. This is useful for folders that are easily regenerated. + +The default value of `mh-search-p' suppresses the prompt on +folders generated by searching. + +WARNING: Use this hook with care. If there is a bug in your hook +which returns t on \"+inbox\" and you hit \\[mh-kill-folder] by +accident in the \"+inbox\" folder, you will not be happy." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-letter-mode-hook nil + "Hook run by `mh-letter-mode' on a new letter. + +This hook allows you to do some processing before editing a +letter. For example, you may wish to modify the header after +\"repl\" has done its work, or you may have a complicated +\"components\" file and need to tell MH-E where the cursor should +go." + :type 'hook + :group 'mh-hooks + :group 'mh-sending-mail) + +(defcustom mh-mh-to-mime-hook nil + "Hook run on the formatted letter by \\\\[mh-mh-to-mime]." + :type 'hook + :group 'mh-hooks + :group 'mh-letter) + +(defcustom mh-search-mode-hook nil + "Hook run upon entry to `mh-search-mode'\\. + +If you find that you do the same thing over and over when editing +the search template, you may wish to bind some shortcuts to keys. +This can be done with this hook which is called when +\\[mh-search] is run on a new pattern." + :type 'hook + :group 'mh-hooks + :group 'mh-search) + +(defcustom mh-quit-hook nil + "Hook run by \\\\[mh-quit] after quitting MH-E. + +This hook is not run in an MH-E context, so you might use it to +modify the window setup. + +See also `mh-before-quit-hook'." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-refile-msg-hook nil + "Hook run by \\\\[mh-refile-msg] after marking each message for refiling." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + +(defcustom mh-show-hook nil + "Hook run after \\\\[mh-show] shows a message. + +It is the last thing called after messages are displayed. It's +used to affect the behavior of MH-E in general or when +`mh-show-mode-hook' is too early. See `mh-show-mode-hook'." + :type 'hook + :group 'mh-hooks + :group 'mh-show) + +(defcustom mh-show-mode-hook nil + "Hook run upon entry to `mh-show-mode'. + +This hook is called early on in the process of the message +display. It is usually used to perform some action on the +message's content. See `mh-show-hook'." + :type 'hook + :group 'mh-hooks + :group 'mh-show) + +(defcustom mh-unseen-updated-hook nil + "Hook run after the unseen sequence has been updated. + +The variable `mh-seen-list' can be used by this hook to obtain +the list of messages which were removed from the unseen +sequence." + :type 'hook + :group 'mh-hooks + :group 'mh-sequences) + + + +;;; Faces (:group 'mh-faces + group where faces described) + +(if (boundp 'facemenu-unlisted-faces) + (add-to-list 'facemenu-unlisted-faces "^mh-")) + +;; Temporary function and data structure used for defining faces. +;; These will be unbound after the faces are defined. +(defvar mh-min-colors-defined-flag (and (not mh-xemacs-flag) + (>= emacs-major-version 22)) + "Non-nil means defface supports min-colors display requirement.") + +(defun mh-defface-compat (spec) + "Convert SPEC for defface if necessary to run on older platforms. +Modifies SPEC in place and returns it. See `defface' for the spec definition. + +When `mh-min-colors-defined-flag' is nil, this function finds +display entries with \"min-colors\" requirements and either +removes the \"min-colors\" requirement or strips the display +entirely if the display does not support the number of specified +colors." + (if mh-min-colors-defined-flag + spec + (let ((cells (mh-display-color-cells)) + new-spec) + ;; Remove entries with min-colors, or delete them if we have fewer colors + ;; than they specify. + (loop for entry in (reverse spec) do + (let ((requirement (if (eq (car entry) t) + nil + (assoc 'min-colors (car entry))))) + (if requirement + (when (>= cells (nth 1 requirement)) + (setq new-spec (cons (cons (delq requirement (car entry)) + (cdr entry)) + new-spec))) + (setq new-spec (cons entry new-spec))))) + new-spec))) + +(defvar mh-inherit-face-flag (assq :inherit custom-face-attributes) + "Non-nil means that the `defface' :inherit keyword is available. +The :inherit keyword is available on all supported versions of +GNU Emacs and XEmacs from at least 21.5.23 on.") + +(defvar mh-face-data + '((mh-folder-followup + ((((class color) (background light)) + (:foreground "blue3")) + (((class color) (background dark)) + (:foreground "LightGoldenRod")) + (t + (:bold t)))) + (mh-folder-msg-number + ((((class color) (min-colors 64) (background light)) + (:foreground "snow4")) + (((class color) (min-colors 64) (background dark)) + (:foreground "snow3")) + (((class color) (background light)) + (:foreground "purple")) + (((class color) (background dark)) + (:foreground "cyan")))) + (mh-folder-refiled + ((((class color) (min-colors 64) (background light)) + (:foreground "DarkGoldenrod")) + (((class color) (min-colors 64) (background dark)) + (:foreground "LightGoldenrod")) + (((class color)) + (:foreground "yellow" :weight light)) + (((class grayscale) (background light)) + (:foreground "Gray90" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t :italic t)) + (t + (:bold t :italic t)))) + (mh-folder-subject + ((((class color) (background light)) + (:foreground "blue4")) + (((class color) (background dark)) + (:foreground "yellow")) + (t + (:bold t)))) + (mh-folder-tick + ((((class color) (background light)) + (:background "#dddf7e")) + (((class color) (background dark)) + (:background "#dddf7e")) + (t + (:underline t)))) + (mh-folder-to + ((((class color) (min-colors 64) (background light)) + (:foreground "RosyBrown")) + (((class color) (min-colors 64) (background dark)) + (:foreground "LightSalmon")) + (((class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "DimGray" :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :italic t)) + (t + (:italic t)))) + (mh-letter-header-field + ((((class color) (background light)) + (:background "gray90")) + (((class color) (background dark)) + (:background "gray10")) + (t + (:bold t)))) + (mh-search-folder + ((((class color) (background light)) + (:foreground "dark green" :bold t)) + (((class color) (background dark)) + (:foreground "indian red" :bold t)) + (t + (:bold t)))) + (mh-show-cc + ((((class color) (min-colors 64) (background light)) + (:foreground "DarkGoldenrod")) + (((class color) (min-colors 64) (background dark)) + (:foreground "LightGoldenrod")) + (((class color)) + (:foreground "yellow" :weight light)) + (((class grayscale) (background light)) + (:foreground "Gray90" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t :italic t)) + (t + (:bold t :italic t)))) + (mh-show-date + ((((class color) (min-colors 64) (background light)) + (:foreground "ForestGreen")) + (((class color) (min-colors 64) (background dark)) + (:foreground "PaleGreen")) + (((class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "Gray90" :bold t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t)) + (t + (:bold t :underline t)))) + (mh-show-from + ((((class color) (background light)) + (:foreground "red3")) + (((class color) (background dark)) + (:foreground "cyan")) + (t + (:bold t)))) + (mh-show-header + ((((class color) (min-colors 64) (background light)) + (:foreground "RosyBrown")) + (((class color) (min-colors 64) (background dark)) + (:foreground "LightSalmon")) + (((class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "DimGray" :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :italic t)) + (t + (:italic t)))) + (mh-show-pgg-bad ((t (:bold t :foreground "DeepPink1")))) + (mh-show-pgg-good ((t (:bold t :foreground "LimeGreen")))) + (mh-show-pgg-unknown ((t (:bold t :foreground "DarkGoldenrod2")))) + (mh-show-signature ((t (:italic t)))) + (mh-show-to + ((((class color) (background light)) + (:foreground "SaddleBrown")) + (((class color) (background dark)) + (:foreground "burlywood")) + (((class grayscale) (background light)) + (:foreground "DimGray" :underline t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :underline t)) + (t (:underline t)))) + (mh-speedbar-folder + ((((class color) (background light)) + (:foreground "blue4")) + (((class color) (background dark)) + (:foreground "light blue")))) + (mh-speedbar-selected-folder + ((((class color) (background light)) + (:foreground "red1" :underline t)) + (((class color) (background dark)) + (:foreground "red1" :underline t)) + (t + (:underline t)))))) + +(defun mh-face-data (face &optional inherit) + "Return spec for FACE. +If INHERIT is non-nil and `defface' supports the :inherit +keyword, return INHERIT literally; otherwise, return spec for FACE. + +This isn't a perfect implementation. In the case that +the :inherit keyword is not supported, any additional attributes +in the inherit parameter are not added to the returned spec." + (if (and inherit mh-inherit-face-flag) + inherit + (mh-defface-compat (cadr (assoc face mh-face-data))))) + +(defface mh-folder-address + (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) + "Recipient face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-body + (mh-face-data 'mh-folder-msg-number + '((((class color)) + (:inherit mh-folder-msg-number)) + (t + (:inherit mh-folder-msg-number :italic t)))) + "Body text face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-cur-msg-number + (mh-face-data 'mh-folder-msg-number + '((t (:inherit mh-folder-msg-number :bold t)))) + "Current message number face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-date + (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) + "Date face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-deleted + (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) + "Deleted message face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-followup (mh-face-data 'mh-folder-followup) + "\"Re:\" face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) + "Message number face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-refiled (mh-face-data 'mh-folder-refiled) + "Refiled message face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-hint + (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date)))) + "Fontification hint face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-sender + (mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup)))) + "Sender face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-subject (mh-face-data 'mh-folder-subject) + "Subject face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-tick (mh-face-data 'mh-folder-tick) + "Ticked message face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-to (mh-face-data 'mh-folder-to) + "\"To:\" face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-letter-header-field (mh-face-data 'mh-letter-header-field) + "Editable header field value face in draft buffers." + :group 'mh-faces + :group 'mh-letter) + +(defface mh-search-folder (mh-face-data 'mh-search-folder) + "Folder heading face in MH-Folder buffers created by searches." + :group 'mh-faces + :group 'mh-search) + +(defface mh-show-cc (mh-face-data 'mh-show-cc) + "Face used to highlight \"cc:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-date (mh-face-data 'mh-show-date) + "Face used to highlight \"Date:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-from (mh-face-data 'mh-show-from) + "Face used to highlight \"From:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-header (mh-face-data 'mh-show-header) + "Face used to deemphasize less interesting header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) + "Bad PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) + "Good PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) + "Unknown or untrusted PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-signature (mh-face-data 'mh-show-signature) + "Signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-subject + (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) + "Face used to highlight \"Subject:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-to (mh-face-data 'mh-show-to) + "Face used to highlight \"To:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-xface + (mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight))))) + +"X-Face image face. +The background and foreground are used in the image." + :group 'mh-faces + :group 'mh-show) + +(defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) + "Basic folder face." + :group 'mh-faces + :group 'mh-speedbar) + +(defface mh-speedbar-folder-with-unseen-messages + (mh-face-data 'mh-speedbar-folder + '((t (:inherit mh-speedbar-folder :bold t)))) + "Folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) + +(defface mh-speedbar-selected-folder + (mh-face-data 'mh-speedbar-selected-folder) + "Selected folder face." + :group 'mh-faces + :group 'mh-speedbar) + +(defface mh-speedbar-selected-folder-with-unseen-messages + (mh-face-data 'mh-speedbar-selected-folder + '((t (:inherit mh-speedbar-selected-folder :bold t)))) + "Selected folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) + +;; Get rid of temporary functions and data structures. +(fmakunbound 'mh-defface-compat) +(fmakunbound 'mh-face-data) +(makunbound 'mh-face-data) +(makunbound 'mh-inherit-face-flag) +(makunbound 'mh-min-colors-defined-flag) + +(provide 'mh-e) + +;; Local Variables: +;; indent-tabs-mode: nil +;; sentence-end-double-space: nil +;; End: + +;; arch-tag: cce884de-bd37-4104-9963-e4439d5ed22b +;;; mh-e.el ends here