mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

Upgraded to MH-E version 7.4.80.

Browse source 
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
This commit is contained in:
Bill Wohler 2004-08-15 22:00:06 +00:00
parent 6dad1714db
commit f0d73c14e2
20 changed files with 6154 additions and 3119 deletions
Download patch file Download diff file Expand all files Collapse all files

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2004-08-15 Bill Wohler <wohler@newt.com>
* NEWS, MH-E-NEWS: Upgraded to MH-E version 7.4.80.
2004-08-14 Romain Francoise <romain@orebokech.com>
* NEWS: Mention the thumbs.el package.

368
etc/MH-E-NEWS
View file

@ -6,6 +6,372 @@ Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
notice and this notice are preserved.
* Changes in MH-E 7.4.80
Version 7.4.80 now supports GNU mailutils, S/MIME, picons,
which-func-mode, has an improved interface for hiding header fields,
improves upon the MH variant detection, and contains many bug fixes.
Those of you familiar with the GNU version numbering schemes will
recognize this as an alpha release. This does not reflect on the
quality of this release which is as high as it has always been.
Although we are not ready to release 8.0, we want you to have access
to the work that has been hiding in CVS. At the same time we want to
make it clear that there are incompatible changes with previous
versions.
We are planning to release the long-awaited manual update synchronized
with version 8.0. We are using documentation from the manual in the
docstrings which is hoped to make "C-h f (describe-function)" really
useful and create a seamless experience when switching back and forth
between the manual and the docstrings. This has been done in about
half of the variables and functions in this version.
The writing of the manual has revealed a few inconsistencies in the
software whose fixes have resulted in incompatible changes, and there
may well be more. So, unlike version 7 which was chock full of new
features, version 8's strengths will include complete documentation
and higher quality.
** New Features in MH-E 7.4.80
*** GNU mailutils Support
MH-E now supports GNU mailutils 0.4 and higher versions.
*** S/MIME Support
MH-E now supports S/MIME using Gnus 5.10.6 or higher.
*** Picon Support
In addition to the other methods of displaying an icon for the sender
of a message, MH-E can now display images from a picon directory. The
directory search path is found in the `mh-picon-directory-list'
variable. More documentation is found in the "facedb" sections in the
xfaces man page. [NOTE: need to make mh-picon-directory-list an option
and add xfaces facedb documentation to it.]
*** X-Image-URL Updates
Now support the use of `curl' and `fetch' as alternatives to `wget' to
obtain the image. The display of images are controlled with the
`mh-show-use-xface-flag' option while the `mh-fetch-x-image-url'
option controls how the images are fetched.
WARNING: There are security concerns with this feature. Please read
the documentation for these options carefully before changing the
default.
*** Updates to mh-identity-list
Note that the field names found in `mh-identity-list' that refer to
the fields in `mh-identity-handlers' have changed in an incompatible
way from 7.4.4. In general, the symbolic names now have a ":" prefix
to avoid collisions with header fields. Before starting Emacs, edit
your .emacs and insert ":" before "signature" if you have defined it.
You can change your attribution in replies with the new "Attribution
Verb" field, and you can set your default GPG user ID with the "GPG
key ID" field.
Signatures can now be read from the `mh-signature-file-name' variable,
or come from a function, in addition to a named file. If you write
your own function, variables that you can use include
`mh-signature-separator-regexp', `mh-signature-separator',
and `mh-signature-separator-p'.
The handling of these fields has been moved into a new
`mh-identity-handlers' option, an alist of fields (strings) and
handlers (functions). Strings are lowercase. Use ":signature" for
Signature and ":pgg-default-user-id" for GPG Key ID. The function
associated with the string "default" is used if no other functions are
appropriate. For this reason, don't name a header field "Default".
If you point your signature at a vCard file with a vcf suffix, then it
will be incorporated as a vCard body part (closes SF #802723).
*** Catchup Command
There is a new "F c (mh-catchup)" command that marks all unread
messages in the current folder as read.
*** Change Content-Type Renderer on the Fly in MH-Show Buffer
This has been implemented by adding the key binding "K e
(mh-display-with-external-viewer)". For inline text/html parts,
buttons aren't displayed by default. In that case use "K t
(mh-toggle-mime-buttons)" to display the button before viewing it with
an external browser (closes SF #839318).
*** Use which-func-mode to Display Folder in Index Mode
Turning on `which-func-mode' displays the folder name of the message
under the cursor in index folders (closes SF #855520).
*** Render Signature and vCard in Italics
This has been implemented. Use `mh-show-signature-face' to customize
the face used (closes SF #802722).
*** New Print Map
There is now a keymap for the printing functions whose prefix is "P".
The command "l (mh-print-msg)" has been replaced with "P l". Other new
functions in this keymap include:
P A mh-ps-print-toggle-mime
P C mh-ps-print-toggle-color
P F mh-ps-print-toggle-faces
P M mh-ps-print-toggle-mime
P f mh-ps-print-msg-file
P l mh-print-msg
P p mh-ps-print-msg
P s mh-ps-print-msg-show
*** Draft Buffer Keymap Changes
The keymap in the draft buffer has been modified slightly. The old
anonymous ftp and tar composition commands have been reinstated and
letter signing and encrypting keymaps have been added.
The type of signing or encryption has been generalized so the method
is now an option rather than a part of the function's name. The option
is `mh-mml-method-default' and choices include PGP (MIME), PGP,
S/MIME, or none.
Key 7.4.4 7.4.80
C-c RET C-e mh-mml-secure-message-encrypt-pgpmime
mh-mml-secure-message-encrypt
C-c RET C-s mh-mml-secure-message-sign-pgpmime
-
C-c RET C-g - mh-mhn-compose-anon-ftp
C-c RET C-n - mh-mml-unsecure-message
C-c RET C-s - mh-mml-secure-message-sign
C-c RET C-t - mh-mhn-compose-external-compressed-tar
C-c RET C-s mh-mml-secure-message-sign-pgpmime
mh-mml-secure-message-sign
C-c RET C-x - mh-mhn-compose-external-type
C-c RET e mh-mml-secure-message-encrypt-pgpmime
Prefix Command
C-c RET e e - mh-mml-secure-message-encrypt
C-c RET e s - mh-mml-secure-message-signencrypt
C-c RET g - mh-mhn-compose-anon-ftp
C-c RET n - mh-mml-unsecure-message
C-c RET s mh-mml-secure-message-sign-pgpmime
Prefix Command
C-c RET s e - mh-mml-secure-message-signencrypt
C-c RET s s - mh-mml-secure-message-sign
C-c RET t - mh-mhn-compose-external-compressed-tar
C-c RET x - mh-mhn-compose-external-type
*** Speedbar: Highlight Folders With Unseen
The speedbar now renders the folders with unseen messages in boldface
which makes them easier to identify (closes SF #623369).
*** Quick Key Help
The "? (mh-help)" function now displays the help in its own buffer
called *MH-E Help* (closes SF #493740 and SF #656631).
*** New Startup File mh-e-autoloads.el
If you are installing MH-E yourself, then you can replace any
autoloads you may have with "(require 'mh-e-autoloads.el)". See the
README for details.
*** Glimpse Support Removed
Since glimpse isn't free, we cannot mention it. Glimpse has been
removed from the option `mh-indexer-choices' (closes SF #831276).
*** mh-msg-is-in-seq Update
Can now specify an alternate message number to "S s
(mh-msg-is-in-seq)" with a prefix argument.
** New Variables in MH-E 7.4.80
Variables that have been added to MH-E that have not been discussed
elsewhere are listed here.
*** mail-citation-hook
Hook for modifying a citation just inserted in the mail buffer.
*** mh-alias-reloaded-hook
Invoked by `mh-alias-reload' after reloading aliases.
*** mh-auto-fields-prompt-flag
Non-nil means to prompt before sending if fields in
`mh-auto-fields-list' are inserted.
*** mh-default-folder-for-message-function
Function to select a default folder for refiling or `Fcc'.
*** mh-forward-hook
Invoked on the forwarded letter by "f (mh-forward)".
*** mh-invisible-header-fields-default
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 `mh-invisible-header-fields' option (closes SF
#752045).
The option `mh-visible-header-fields' has been deleted.
*** mh-junk-background
If on, spam programs are run in background. This used to be the
default behavior but this could overwhelm a system if many messages
were black- or whitelisted at once. The spam programs are now run in
the foreground, but this option can be used to put them back in the
background.
*** mh-signature-separator-flag
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.
*** mh-variant
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', `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.
If you've set these variables in your .emacs, it is strongly suggested
that you comment them out. The MH detection code has been completely
rewritten and it is very likely that you no longer to set them and
their setting may confuse other MH-E settings.
** Variables Deleted in MH-E
Variables that have been removed from MH-E that have not been
discussed elsewhere are listed here.
*** mh-alias-system-aliases
System definitions should not be a user option.
*** mh-junk-mail-folder
Since this variable can accept values other than folder names, it was
renamed to `mh-junk-disposition' to more accurately reflect the content.
** Bug Fixes in MH-E 7.4.80
Many bugs were fixed in this version that aren't listed below.
*** mh-extract-rejected-mail Can't Do MIME (and Other Formats)
Now handles qmail and exim bounces (addresses SF #404965).
*** mh-rmail Hangs in XEmacs
We've determined that MH-E is incompatible with some versions of
XEmacs (21.5.9-21.5.16). More recent versions work fine. If you think
our list is too broad, please let us know which version of XEmacs you
are using (closes SF #644321).
*** Inconsistent Prompts
Prompt formats are now consistent throughout the application (closes
SF #730470).
*** Empty Shell Comments Confuse mh-mhn-directive-present-p
If you had a string that matched the regexp "^# $" in your draft, it
would cause an error. This has been fixed (closes SF #762458).
*** Quote Hashes When mhbuild Directives Used
A related bug, if you had empty shell comments but inserted your own
directives, you'd get another error from mhbuild. This has been fixed
by quoting the hash ("^# $") like this "##" before submitting to
mhbuild (closes SF #762464).
*** Inconsistent Usage in Scan Formatting Variables
The variables:
mh-note-cur
mh-note-deleted
mh-note-dist
mh-note-forw
mh-note-refiled
mh-note-repl
mh-note-seq
used to contain strings. Although only the first character was read,
the entire string would be inserted which may have caused problems.
These variables have been converted to character constants so that
only a single character can be inserted into the scan line (closes SF
#770772).
*** Bad Handling of Aliases That Conflict With Local User Names
If a user name existed both locally and in the aliases file, the local
user would be flashed, but the alias would be used when sending. This
has been fixed so that the user name that is flashed is the same as
the name that is sent (closes SF #772595).
*** Args out of range
In rare and non-reproducible circumstances, compilation sometimes
threw an "Args out of range" error. Nonetheless, this has been fixed
(closes SF #806577).
*** mh-forward hard-codes '-mime' Switch on nmh
Added new option `mh-compose-forward-as-mime-flag' that controls whether
messages are forwarded as MIME attachments (closes SF #827203).
*** Not Re-prompted to Sign After Pass Phrase Typo
If there were errors when sending a signed message (like getting the
pass phrase wrong), the MML markup remained in the draft buffer. The
draft buffer is now restored if there is an error (closes SF #839303).
*** Font-lock Gets Confused in MH-Letter Buffer
If a user manually moved the cursor to the end of the header field
separator line (by mouse click or keyboard navigation) and hit Enter
to start typing their message, any line in the body with a colon would
be fontified with a gray background. This has been fixed (closes SF
#855479).
*** mh-refile-msg Fails to Suggest Folder for Empty Message
If you received a message with an empty body from someone who is
listed in your aliases file, "o (mh-refile-msg)" failed to suggest the
correct folder. This has been fixed (closes SF #917096).
*** Error Visiting Folder With no Unseen Messages
If you visited a folder without unseen messages and the option "flist:
-noshowzero" is present in your ~/.mh_profile, you'd get an error. This
has been fixed (closes SF #933954).
* Changes in MH-E 7.4.4
Version 7.4.4 addresses programmatic issues from the FSF and prepares
@ -18,7 +384,7 @@ code moved here from desktop.el.
* Changes in MH-E 7.4.3
Version 7.4.3 fixes the problem where mh-identity-list was not getting
Version 7.4.3 fixes the problem where `mh-identity-list' was not getting
set from .emacs.
* Changes in MH-E 7.4.2

2
etc/NEWS
View file

@ -658,7 +658,7 @@ You can now put the init files .emacs and .emacs_SHELL under
** MH-E changes.
Upgraded to MH-E version 7.4.4. There have been major changes since
Upgraded to MH-E version 7.4.80. There have been major changes since
version 5.0.2; see MH-E-NEWS for details.
+++

2008
lisp/mh-e/ChangeLog
View file

File diff suppressed because it is too large Load diff

207
lisp/mh-e/mh-alias.el
View file

@ -27,75 +27,12 @@
;;; Commentary:
;; [To be deleted when documented in MH-E manual.]
;;
;; This module provides mail alias completion when entering addresses.
;;
;; Use the TAB key to complete aliases (and optionally local usernames) when
;; initially composing a message in the To: and Cc: minibuffer prompts. You
;; may enter multiple addressees separated with a comma (but do *not* add any
;; space after the comma).
;;
;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
;; complete aliases. This is useful when you want to add an addressee as an
;; afterthought when creating a message, or when adding an additional
;; addressee to a reply.
;;
;; By default, completion is case-insensitive. This can be changed by
;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
;; useful, for example, to differentiate between people aliases in lowercase
;; such as:
;;
;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
;;
;; and lists in uppercase such as:
;;
;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
;;
;; Note that this variable affects minibuffer completion only. If you have an
;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
;; be expanded in the letter buffer because MH is case-insensitive.
;;
;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
;; the minibuffer, the expansion for the previous mail alias appears briefly.
;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
;;
;; The addresses and aliases entered in the minibuffer are added to the
;; message draft. To expand the aliases before they are added to the draft,
;; customize the variable `mh-alias-expand-aliases-flag'.
;;
;; Completion is also performed on usernames extracted from the /etc/passwd
;; file. This can be a handy tool on a machine where you and co-workers
;; exchange messages, but should probably be disabled on a system with
;; thousands of users you don't know. This is done by customizing the
;; variable `mh-alias-local-users'. This variable also takes a string which
;; is executed to generate the password file. For example, you'd use "ypcat
;; passwd" for NIS.
;;
;; Aliases are loaded the first time you send mail and get the "To:" prompt
;; and whenever a source of aliases changes. Sources of system aliases are
;; defined in the customization variable `mh-alias-system-aliases' and
;; include:
;;
;; /etc/nmh/MailAliases
;; /usr/lib/mh/MailAliases
;; /etc/passwd
;;
;; Sources of personal aliases are read from the files listed in your MH
;; profile component Aliasfile. Multiple files are separated by white space
;; and are relative to your mail directory.
;;
;; Alias Insertions
;; ~~~~~~~~~~~~~~~~
;; There are commands to insert new aliases into your alias file(s) (defined
;; by the `Aliasfile' component in the .mh_profile file or by the variable
;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
;; an alias from the From line of the current message.
;;; Change Log:
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(load "cmr" t t) ; Non-fatal dependency for
; completing-read-multiple.
@ -116,15 +53,23 @@
(defvar mh-alias-tstamp nil
"Time aliases were last loaded.")
(defvar mh-alias-read-address-map nil)
(if mh-alias-read-address-map
()
(unless mh-alias-read-address-map
(setq mh-alias-read-address-map
(copy-keymap minibuffer-local-completion-map))
(if mh-alias-flash-on-comma
(define-key mh-alias-read-address-map
"," 'mh-alias-minibuffer-confirm-address))
(define-key mh-alias-read-address-map
"," 'mh-alias-minibuffer-confirm-address)
(define-key mh-alias-read-address-map " " 'self-insert-command))
(defvar mh-alias-system-aliases
'("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
"/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
"/etc/passwd")
"*A list of system files which are a source of aliases.
If these files are modified, they are automatically reread. This list need
include only system aliases and the passwd file, since personal alias files
listed in your `Aliasfile:' MH profile component are automatically included.
You can update the alias list manually using \\[mh-alias-reload].")
;;; Alias Loading
@ -138,7 +83,7 @@ This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
(defun mh-alias-tstamp (arg)
"Check whether alias files have been modified.
Return t if any file listed in the MH profile component Aliasfile has been
Return t if any file listed in the Aliasfile MH profile component has been
modified since the timestamp.
If ARG is non-nil, set timestamp with the current time."
(if arg
@ -157,7 +102,7 @@ If ARG is non-nil, set timestamp with the current time."
(defun mh-alias-filenames (arg)
"Return list of filenames that contain aliases.
The filenames come from the MH profile component Aliasfile and are expanded.
The filenames come from the Aliasfile profile component and are expanded.
If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(or mh-progs (mh-find-path))
(save-excursion
@ -201,7 +146,8 @@ non-nil."
res))
(defun mh-alias-local-users ()
"Return an alist of local users from /etc/passwd."
"Return an alist of local users from /etc/passwd.
Exclude all aliases already in `mh-alias-alist' from `ali'"
(let (passwd-alist)
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
@ -222,23 +168,33 @@ non-nil."
(gecos-name (match-string 3))
(realname (mh-alias-gecos-name
gecos-name username
mh-alias-passwd-gecos-comma-separator-flag)))
(setq passwd-alist
(cons
(list (if mh-alias-local-users-prefix
(concat mh-alias-local-users-prefix
(mh-alias-suggest-alias realname t))
username)
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">")))
passwd-alist))))))
mh-alias-passwd-gecos-comma-separator-flag))
(alias-name (if mh-alias-local-users-prefix
(concat mh-alias-local-users-prefix
(mh-alias-suggest-alias realname t))
username))
(alias-translation
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">"))))
(when (not (mh-assoc-ignore-case alias-name mh-alias-alist))
(setq passwd-alist (cons (list alias-name alias-translation)
passwd-alist)))))))
(forward-line 1)))
passwd-alist))
;;;###mh-autoload
(defun mh-alias-reload ()
"Load MH aliases into `mh-alias-alist'."
"Reload MH aliases.
Since aliases are updated frequently, MH-E will reload aliases automatically
whenever an alias lookup occurs if an alias source (a file listed in your
`Aliasfile:' profile component and your password file if variable
`mh-alias-local-users' is non-nil) has changed. However, you can reload your
aliases manually by calling this command directly.
The value of `mh-alias-reloaded-hook' is a list of functions to be called,
with no arguments, after the aliases have been loaded."
(interactive)
(save-excursion
(message "Loading MH aliases...")
@ -269,13 +225,14 @@ non-nil."
(if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
(setq mh-alias-alist (append mh-alias-alist (list user))))
(setq local-users (cdr local-users)))))
(run-hooks 'mh-alias-reloaded-hook)
(message "Loading MH aliases...done"))
;;;###mh-autoload
(defun mh-alias-reload-maybe ()
"Load new MH aliases."
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
(mh-alias-tstamp nil)) ; Out of date, so recreate it.
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
(mh-alias-tstamp nil)) ; Out of date?
(mh-alias-reload)))
@ -461,21 +418,21 @@ is converted to lower case."
found)))
(defun mh-alias-insert-file (&optional alias)
"Return the alias file to write a new entry for ALIAS in.
Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
value.
If ALIAS is specified and it already exists, try to return the file that
contains it."
"Return filename which should be used to add ALIAS.
The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise
the value of the `Aliasfile:' profile component is used.
If the alias already exists, try to return the name of the file that contains
it."
(cond
((and mh-alias-insert-file (listp mh-alias-insert-file))
(if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
(car mh-alias-insert-file)
(if (or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
(completing-read "Alias file [press Tab]: "
(completing-read "Alias file: "
(mapcar 'list mh-alias-insert-file) nil t)
(or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
(completing-read "Alias file [press Tab]: "
(completing-read "Alias file: "
(mapcar 'list mh-alias-insert-file) nil t)))))
((and mh-alias-insert-file (stringp mh-alias-insert-file))
mh-alias-insert-file)
@ -490,16 +447,15 @@ contains it."
(cond
((not autolist)
(error "No writable alias file.
Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
Set `mh-alias-insert-file' or the Aliasfile profile component"))
((not (elt autolist 1)) ; Only one entry, use it
(car autolist))
((or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
(completing-read "Alias file [press Tab]: "
(mapcar 'list autolist) nil t))
(completing-read "Alias file: " (mapcar 'list autolist) nil t))
(t
(or (mh-alias-which-file-has-alias alias autolist)
(completing-read "Alias file [press Tab]: "
(completing-read "Alias file: "
(mapcar 'list autolist) nil t))))))))
;;;###mh-autoload
@ -520,10 +476,8 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
(split-string aliases ", +")))))))
;;;###mh-autoload
(defun mh-alias-from-has-no-alias-p ()
"Return t is From has no current alias set.
In the exceptional situation where there isn't a From header in the message the
function returns nil."
(defun mh-alias-for-from-p ()
"Return t if sender's address has a corresponding alias."
(mh-alias-reload-maybe)
(save-excursion
(if (not (mh-folder-line-matches-show-buffer-p))
@ -532,13 +486,16 @@ function returns nil."
(set-buffer mh-show-buffer))
(let ((from-header (mh-extract-from-header-value)))
(and from-header
(not (mh-alias-address-to-alias from-header)))))))
(mh-alias-address-to-alias from-header))))))
(defun mh-alias-add-alias-to-file (alias address &optional file)
"Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
Prompt for alias file if not provided and there is more than one candidate.
If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
after it."
If the alias exists already, you will have the choice of inserting the new
alias before or after the old alias. In the former case, this alias will be
used when sending mail to this alias. In the latter case, the alias serves as
an additional folder name hint when filing messages."
(if (not file)
(setq file (mh-alias-insert-file alias)))
(save-excursion
@ -552,14 +509,15 @@ after it."
((re-search-forward
(concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
(let ((answer (read-string
(format "Exists for %s; [i]nsert, [a]ppend: "
(format (concat "Alias %s exists; insert new address "
"[b]efore or [a]fter: ")
(match-string 1))))
(case-fold-search t))
(cond ((string-match "^i" answer))
(cond ((string-match "^b" answer))
((string-match "^a" answer)
(forward-line 1))
(t
(error "Quitting")))))
(error "Unrecognized response")))))
;; No, so sort-in at the right place
;; search for "^alias", then "^alia", etc.
((eq mh-alias-insertion-location 'sorted)
@ -587,8 +545,11 @@ after it."
;;;###mh-autoload
(defun mh-alias-add-alias (alias address)
"*Add ALIAS for ADDRESS in personal alias file.
Prompts for confirmation if the address already has an alias.
If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
This function prompts you for an alias and address. If the alias exists
already, you will have the choice of inserting the new alias before or after
the old alias. In the former case, this alias will be used when sending mail
to this alias. In the latter case, the alias serves as an additional folder
name hint when filing messages."
(interactive "P\nP")
(mh-alias-reload-maybe)
(setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
@ -614,9 +575,7 @@ If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
;;;###mh-autoload
(defun mh-alias-grab-from-field ()
"*Add ALIAS for ADDRESS in personal alias file.
Prompts for confirmation if the alias is already in use or if the address
already has an alias."
"*Add alias for the sender of the current message."
(interactive)
(mh-alias-reload-maybe)
(save-excursion
@ -636,24 +595,26 @@ already has an alias."
;;;###mh-autoload
(defun mh-alias-add-address-under-point ()
"Insert an alias for email address under point."
"Insert an alias for address under point."
(interactive)
(let ((address (mh-goto-address-find-address-at-point)))
(if address
(mh-alias-add-alias nil address)
(message "No email address found under point."))))
(message "No email address found under point"))))
;;;###mh-autoload
(defun mh-alias-apropos (regexp)
"Show all aliases that match REGEXP either in name or content."
"Show all aliases or addresses that match REGEXP."
(interactive "sAlias regexp: ")
(if mh-alias-local-users
(mh-alias-reload-maybe))
(let ((matches "")(group-matches "")(passwd-matches))
(let ((matches "")
(group-matches "")
(passwd-matches))
(save-excursion
(message "Reading MH aliases...")
(mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
(message "Reading MH aliases...done. Parsing...")
(message "Parsing MH aliases...")
(while (re-search-forward regexp nil t)
(beginning-of-line)
(cond
@ -673,10 +634,9 @@ already has an alias."
(concat matches
(buffer-substring (point)(progn (end-of-line)(point)))
"\n")))))
(message "Reading MH aliases...done. Parsing...done.")
(message "Parsing MH aliases...done")
(when mh-alias-local-users
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...")
(message "Making passwd aliases...")
(setq passwd-matches
(mapconcat
'(lambda (elem)
@ -684,13 +644,12 @@ already has an alias."
(string-match regexp (cadr elem)))
(format "%s: %s\n" (car elem) (cadr elem))))
mh-alias-passwd-alist ""))
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...done.")))
(message "Making passwd aliases...done")))
(if (and (string-equal "" matches)
(string-equal "" group-matches)
(string-equal "" passwd-matches))
(message "No matches")
(with-output-to-temp-buffer "*Help*"
(with-output-to-temp-buffer mh-aliases-buffer
(if (not (string-equal "" matches))
(princ matches))
(when (not (string-equal group-matches ""))

450
lisp/mh-e/mh-comp.el
View file

@ -33,11 +33,12 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
(require 'mh-utils)
(mh-require-cl)
(require 'mh-gnus)
(eval-when (compile load eval)
(ignore-errors (require 'mailabbrev)))
@ -48,6 +49,7 @@
(defvar sendmail-coding-system)
(defvar mh-identity-list)
(defvar mh-identity-default)
(defvar mh-mml-mode-default)
(defvar mh-identity-menu)
;;; Autoloads
@ -58,7 +60,7 @@
(autoload 'sc-cite-original "sc"
"Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
function according to the agreed upon standard. See `\\[sc-describe]'
function according to the agreed upon standard. See `sc-describe'
for more details. `sc-cite-original' does not do any yanking of the
original message but it does require a few things:
@ -95,14 +97,16 @@ If MH will not allow you to redist a previously redist'd msg, set to nil.")
This allows transaction log to be visible if -watch, -verbose or -snoop are
used.")
(defvar mh-note-repl "-"
"String whose first character is used to notate replied to messages.")
;;; Scan Line Formats
(defvar mh-note-forw "F"
"String whose first character is used to notate forwarded messages.")
(defvar mh-note-repl ?-
"Messages that have been replied to are marked by this character.")
(defvar mh-note-dist "R"
"String whose first character is used to notate redistributed messages.")
(defvar mh-note-forw ?F
"Messages that have been forwarded are marked by this character.")
(defvar mh-note-dist ?R
"Messages that have been redistributed are marked by this character.")
(defvar mh-yank-hooks nil
"Obsolete hook for modifying a citation just inserted in the mail buffer.
@ -113,23 +117,6 @@ text as modified.
This is a normal hook, misnamed for historical reasons.
It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
(defvar mail-citation-hook nil
"*Hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between point and mark.
And each hook function should leave point and mark around the citation
text as modified.
If this hook is entirely empty (nil), the text of the message is inserted
with `mh-ins-buf-prefix' prefixed to each line.
See also the variable `mh-yank-from-start-of-msg', which controls how
much of the message passed to the hook.
This hook was historically provided to set up supercite. You may now leave
this nil and set up supercite by setting the variable
`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
to 'autosupercite.")
(defvar mh-comp-formfile "components"
"Name of file to be used as a skeleton for composing messages.
Default is \"components\". If not an absolute file name, the file
@ -145,7 +132,8 @@ system MH lib directory.")
(defvar mh-repl-group-formfile "replgroupcomps"
"Name of file to be used as a skeleton for replying to messages.
This file is used to form replies to the sender and all recipients of a
message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
message. Only used if `(mh-variant-p 'nmh)' is non-nil.
Default is \"replgroupcomps\".
If not an absolute file name, the file is searched for first in the user's MH
directory, then in the system MH lib directory.")
@ -153,6 +141,8 @@ directory, then in the system MH lib directory.")
(format "^%s$"
(regexp-opt
'("Content-Type: message/rfc822" ;MIME MDN
"------ This is a copy of the message, including all the headers. ------";from exim
"--- Below this line is a copy of the message."; from qmail
" ----- Unsent message follows -----" ;from sendmail V5
" --------Unsent Message below:" ; from sendmail at BU
" ----- Original message follows -----" ;from sendmail V8
@ -201,16 +191,16 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
"Field name for message annotation.")
(defvar mh-insert-auto-fields-done-local nil
"Buffer-local variable set when `mh-insert-auto-fields' successfully called.")
"Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
;;;###autoload
(defun mh-smail ()
"Compose and send mail with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
See documentation of `\\[mh-send]' for more details on composing mail."
See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send))
@ -220,11 +210,11 @@ See documentation of `\\[mh-send]' for more details on composing mail."
;;;###autoload
(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
"Set up a mail composition draft with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system. This function does not prompt the user
for any header fields, and thus is suitable for use by programs
that want to create a mail buffer.
Users should use `\\[mh-smail]' to compose mail.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system. This function does not prompt the user for any header fields, and thus
is suitable for use by programs that want to create a mail buffer. Users
should use `mh-smail' to compose mail.
Optional arguments for setting certain fields include TO, SUBJECT, and
OTHER-HEADERS. Additional arguments are IGNORED."
(mh-find-path)
@ -260,7 +250,8 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
"Clean up a draft or a message MSG previously sent and make it resendable.
Default is the current message.
The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
See also documentation for `\\[mh-send]' function."
See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let* ((from-folder mh-current-folder)
(config (current-window-configuration))
@ -292,7 +283,8 @@ See also documentation for `\\[mh-send]' function."
"Extract message MSG returned by the mail system and make it resendable.
Default is the current message. The variable `mh-new-draft-cleaned-headers'
gives the headers to clean out of the original message.
See also documentation for `\\[mh-send]' function."
See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let ((from-folder mh-current-folder)
(config (current-window-configuration))
@ -303,7 +295,7 @@ See also documentation for `\\[mh-send]' function."
(delete-region (point-min) (point))
(mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
(t
(message "Does not appear to be a rejected letter.")))
(message "Does not appear to be a rejected letter")))
(mh-insert-header-separator)
(goto-char (point-min))
(save-buffer)
@ -323,7 +315,7 @@ Default is the displayed message.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function."
See also `mh-send'."
(interactive (list (mh-interactive-read-address "To: ")
(mh-interactive-read-address "Cc: ")
(mh-interactive-range "Forward")))
@ -335,7 +327,10 @@ See also documentation for `\\[mh-send]' function."
(draft-name (expand-file-name "draft" mh-user-path))
(draft (cond ((or (not (file-exists-p draft-name))
(y-or-n-p "The file 'draft' exists. Discard it? "))
(mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
(mh-exec-cmd "forw" "-build"
(if (and (mh-variant-p 'nmh)
mh-compose-forward-as-mime-flag)
"-mime")
mh-current-folder
(mh-coalesce-msg-list msgs))
(prog1
@ -388,7 +383,8 @@ See also documentation for `\\[mh-send]' function."
mh-note-forw "Forwarded:"
config)
(mh-letter-mode-message)
(mh-letter-adjust-point)))))
(mh-letter-adjust-point)
(run-hooks 'mh-forward-hook)))))
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
@ -406,10 +402,10 @@ Original message has headers FROM and SUBJECT."
;;;###autoload
(defun mh-smail-other-window ()
"Compose and send mail in other window with the MH mail system.
This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
See documentation of `\\[mh-send]' for more details on composing mail."
See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send-other-window))
@ -496,13 +492,15 @@ to reply to:
If optional prefix argument INCLUDEP provided, then include the message
in the reply using filter `mhl.reply' in your MH directory.
If the file named by `mh-repl-formfile' exists, it is used as a skeleton
for the reply. See also documentation for `\\[mh-send]' function."
for the reply.
See also `mh-send'."
(interactive (list
(mh-get-msg-num t)
(let ((minibuffer-help-form
"from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
(or mh-reply-default-reply-to
(completing-read "Reply to whom? (from, to, all) [from]: "
(completing-read "Reply to whom: [from] "
'(("from") ("to") ("cc") ("all"))
nil
t)))
@ -511,7 +509,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
(show-buffer mh-show-buffer)
(config (current-window-configuration))
(group-reply (or (equal reply-to "cc") (equal reply-to "all")))
(form-file (cond ((and mh-nmh-flag group-reply
(form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
(stringp mh-repl-group-formfile))
mh-repl-group-formfile)
((stringp mh-repl-formfile) mh-repl-formfile)
@ -525,7 +523,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
'("-nocc" "all"))
((equal reply-to "to")
'("-cc" "to"))
(group-reply (if mh-nmh-flag
(group-reply (if (mh-variant-p 'nmh 'mu-mh)
'("-group" "-nocc" "me")
'("-cc" "all" "-nocc" "me"))))
(cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
@ -562,7 +560,6 @@ for the reply. See also documentation for `\\[mh-send]' function."
;;;###mh-autoload
(defun mh-send (to cc subject)
"Compose and send a letter.
Do not call this function from outside MH-E; use \\[mh-smail] instead.
The file named by `mh-comp-formfile' will be used as the form.
@ -581,7 +578,6 @@ passed three arguments: TO, CC, and SUBJECT."
;;;###mh-autoload
(defun mh-send-other-window (to cc subject)
"Compose and send a letter in another window.
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
instead.
@ -711,6 +707,8 @@ Do not insert any pairs whose value is the empty string."
(while name-values
(let ((field-name (car name-values))
(value (car (cdr name-values))))
(if (not (string-match "^.*:$" field-name))
(setq field-name (concat field-name ":")))
(cond ((equal value "")
nil)
((mh-position-on-field field-name)
@ -730,6 +728,7 @@ The optional second arg is for pre-version 4 compatibility and is IGNORED."
((mh-goto-header-end 0)
nil)))
;;;###mh-autoload
(defun mh-get-header-field (field)
"Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
@ -777,35 +776,53 @@ Returns t if found, nil if not."
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(eval-when-compile (defvar mh-letter-menu nil))
(cond
((fboundp 'easy-menu-define)
(easy-menu-define
mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
'("Letter"
["Send This Draft" mh-send-letter t]
["Split Current Line" mh-open-line t]
["Check Recipient" mh-check-whom t]
["Yank Current Message" mh-yank-cur-msg t]
["Insert a Message..." mh-insert-letter t]
["Insert Signature" mh-insert-signature t]
["GPG Sign message"
mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
["GPG Encrypt message"
mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
["Compose Insertion (MIME)..." mh-compose-insertion t]
;; ["Compose Compressed tar (MIME)..."
;;mh-mhn-compose-external-compressed-tar t]
;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
["Compose Forward (MIME)..." mh-compose-forward t]
;; The next two will have to be merged. But I also need to make sure the
;; user can't mix directives of both types.
["Pull in All Compositions (mhn)"
mh-edit-mhn (mh-mhn-directive-present-p)]
["Pull in All Compositions (gnus)"
mh-mml-to-mime (mh-mml-directive-present-p)]
["Revert to Non-MIME Edit (mhn)"
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
["Kill This Draft" mh-fully-kill-draft t]))))
(easy-menu-define
mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
'("Letter"
["Send This Draft" mh-send-letter t]
["Split Current Line" mh-open-line t]
["Check Recipient" mh-check-whom t]
["Yank Current Message" mh-yank-cur-msg t]
["Insert a Message..." mh-insert-letter t]
["Insert Signature" mh-insert-signature t]
("Encrypt/Sign Message"
["Sign Message"
mh-mml-secure-message-sign mh-gnus-pgp-support-flag]
["Encrypt Message"
mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag]
["Sign+Encrypt Message"
mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag]
["Disable Security"
mh-mml-unsecure-message mh-gnus-pgp-support-flag]
"--"
"Security Method"
["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
:style radio
:selected (equal mh-mml-method-default "pgpmime")]
["PGP" (setq mh-mml-method-default "pgp")
:style radio
:selected (equal mh-mml-method-default "pgp")]
["S/MIME" (setq mh-mml-method-default "smime")
:style radio
:selected (equal mh-mml-method-default "smime")]
"--"
["Save Method as Default"
(customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
)
["Compose Insertion (MIME)..." mh-compose-insertion t]
["Compose Compressed tar (MIME)..."
mh-mhn-compose-external-compressed-tar t]
["Compose Get File (MIME)..." mh-mhn-compose-anon-ftp t]
["Compose Forward (MIME)..." mh-compose-forward t]
;; The next two will have to be merged. But I also need to make sure the
;; user can't mix directives of both types.
["Pull in All Compositions (mhn)"
mh-edit-mhn (mh-mhn-directive-present-p)]
["Pull in All Compositions (gnus)"
mh-mml-to-mime (mh-mml-directive-present-p)]
["Revert to Non-MIME Edit (mhn)"
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
["Kill This Draft" mh-fully-kill-draft t]))
;;; Help Messages
;;; Group messages logically, more or less.
@ -817,12 +834,15 @@ Returns t if found, nil if not."
"\t\tInsert:\n"
"Check recipients: \\[mh-check-whom]"
"\t\t Current message: \\[mh-yank-cur-msg]\n"
"Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
"\t\t Attachment: \\[mh-compose-insertion]\n"
"Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
"\t\t Message to forward: \\[mh-compose-forward]\n"
"\t\t Attachment: \\[mh-compose-insertion]\n"
"\t\t Message to forward: \\[mh-compose-forward]\n"
" "
"\t\t Signature: \\[mh-insert-signature]"))
"Security:"
"\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
"\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
"\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
" "
"\t\t Signature: \\[mh-insert-signature]"))
"Key binding cheat sheet.
This is an associative array which is used to show the most common commands.
@ -872,13 +892,19 @@ When a message is composed, the hooks `text-mode-hook' and
`mh-letter-mode-hook' are run.
\\{mh-letter-mode-map}"
(or mh-user-path (mh-find-path))
(mh-find-path)
(make-local-variable 'mh-send-args)
(make-local-variable 'mh-annotate-char)
(make-local-variable 'mh-annotate-field)
(make-local-variable 'mh-previous-window-config)
(make-local-variable 'mh-sent-from-folder)
(make-local-variable 'mh-sent-from-msg)
;; Set the local value of mh-mail-header-separator according to what is
;; present in the buffer...
(set (make-local-variable 'mh-mail-header-separator)
(save-excursion
(goto-char (mh-mail-header-end))
(buffer-substring-no-properties (point) (line-end-position))))
(make-local-variable 'mail-header-separator)
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
(make-local-variable 'mh-help-messages)
@ -886,12 +912,6 @@ When a message is composed, the hooks `text-mode-hook' and
(setq buffer-invisibility-spec '((vanish . t) t))
(set (make-local-variable 'line-move-ignore-invisible) t)
;; Set mh-mail-header-end-marker to remember end of message header.
(set (make-local-variable 'mh-letter-mail-header-end-marker)
(set-marker (make-marker) (save-excursion
(goto-char (mh-mail-header-end))
(line-beginning-position 2))))
;; From sendmail.el for proper paragraph fill
;; sendmail.el also sets a normal-auto-fill-function (not done here)
(make-local-variable 'paragraph-separate)
@ -965,11 +985,15 @@ When a message is composed, the hooks `text-mode-hook' and
t)))
(defun mh-letter-header-end ()
"Find the end of header from `mh-letter-mail-header-end-marker'."
"Find the end of the message header.
This function is to be used only for font locking. It works by searching for
`mh-mail-header-separator' in the buffer."
(save-excursion
(goto-char (marker-position mh-letter-mail-header-end-marker))
(forward-line -1)
(point)))
(goto-char (point-min))
(cond ((equal mh-mail-header-separator "") (point-min))
((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
(line-beginning-position 0))
(t (point-min)))))
(defun mh-auto-fill-for-letter ()
"Perform auto-fill for message.
@ -1041,16 +1065,69 @@ Prompt for the field name with a completion list of the current folders."
(substring folder 1)
folder)))))
(defun mh-file-is-vcard-p (file)
"Return t if FILE is a .vcf vcard."
(let ((case-fold-search t))
(and (stringp file)
(file-exists-p file)
(or (and (not (mh-have-file-command))
(not (null (string-match "\.vcf$" file))))
(and (mh-have-file-command)
(string-equal "text/x-vcard" (mh-file-mime-type file)))))))
;;;###mh-autoload
(defun mh-insert-signature ()
"Insert the file named by `mh-signature-file-name' at point.
(defun mh-insert-signature (&optional file)
"Insert the signature specified by `mh-signature-file-name' or FILE at point.
A signature separator (`-- ') will be added if the signature block does not
contain one and `mh-signature-separator-flag' is on.
The value of `mh-letter-insert-signature-hook' is a list of functions to be
called, with no arguments, before the signature is actually inserted."
(interactive)
(let ((mh-signature-file-name mh-signature-file-name))
(run-hooks 'mh-letter-insert-signature-hook)
(if mh-signature-file-name
(insert-file-contents mh-signature-file-name)))
called, with no arguments, after the signature is inserted.
The signature can also be inserted with `mh-identity-list'."
(interactive)
(save-excursion
(insert "\n")
(let ((mh-signature-file-name (or file mh-signature-file-name))
(mh-mhn-p (mh-mhn-directive-present-p))
(mh-mml-p (mh-mml-directive-present-p)))
(save-restriction
(narrow-to-region (point) (point))
(cond
((mh-file-is-vcard-p mh-signature-file-name)
(if (equal mh-compose-insertion 'gnus)
(insert "<#part type=\"text/x-vcard\" filename=\""
mh-signature-file-name
"\" disposition=inline description=VCard>\n<#/part>")
(insert "#text/x-vcard; name=\""
(file-name-nondirectory mh-signature-file-name)
"\" [VCard] " (expand-file-name mh-signature-file-name))))
(t
(cond
(mh-mhn-p
(insert "#\n" "Content-Description: Signature\n"))
(mh-mml-p
(mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
'description "Signature")))
(cond ((null mh-signature-file-name))
((and (stringp mh-signature-file-name)
(file-readable-p mh-signature-file-name))
(insert-file-contents mh-signature-file-name))
((functionp mh-signature-file-name)
(funcall mh-signature-file-name)))))
(save-restriction
(widen)
(run-hooks 'mh-letter-insert-signature-hook))
(goto-char (point-min))
(when (and (not (mh-file-is-vcard-p mh-signature-file-name))
mh-signature-separator-flag
(> (point-max) (point-min))
(not (mh-signature-separator-p)))
(cond (mh-mhn-p
(forward-line 2))
(mh-mml-p
(forward-line 1)))
(insert mh-signature-separator))
(if (not (> (point-max) (point-min)))
(message "No signature found")))))
(force-mode-line-update))
;;;###mh-autoload
@ -1100,33 +1177,18 @@ MH the first time a message is composed.")
(defun mh-insert-x-mailer ()
"Append an X-Mailer field to the header.
The versions of MH-E, Emacs, and MH are shown."
;; Lazily initialize mh-x-mailer-string.
(when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
(save-window-excursion
;; User would be confused if version info buffer disappeared magically,
;; so don't delete buffer if it already existed.
(let ((info-buffer-exists-p (get-buffer mh-info-buffer)))
(mh-version)
(set-buffer mh-info-buffer)
(if mh-nmh-flag
(search-forward-regexp "^nmh-\\(\\S +\\)")
(search-forward-regexp "^MH \\(\\S +\\)" nil t))
(let ((x-mailer-mh (buffer-substring (match-beginning 1)
(match-end 1))))
(setq mh-x-mailer-string
(format "MH-E %s; %s %s; %sEmacs %s"
mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
(if mh-xemacs-flag "X" "GNU ")
(cond ((not mh-xemacs-flag) emacs-version)
((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
emacs-version)
(match-string 0 emacs-version))
(t (format "%s.%s"
emacs-major-version
emacs-minor-version))))))
(if (not info-buffer-exists-p)
(kill-buffer mh-info-buffer)))))
(setq mh-x-mailer-string
(format "MH-E %s; %s; %sEmacs %s"
mh-version mh-variant-in-use
(if mh-xemacs-flag "X" "GNU ")
(cond ((not mh-xemacs-flag) emacs-version)
((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
emacs-version)
(match-string 0 emacs-version))
(t (format "%s.%s" emacs-major-version
emacs-minor-version))))))
;; Insert X-Mailer, but only if it doesn't already exist.
(save-excursion
(when (and mh-insert-x-mailer-flag
@ -1155,25 +1217,31 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually."
An `identity' entry is skipped if one was already entered manually.
Return t if fields added; otherwise return nil."
(interactive)
(when (or (not non-interactive) (not mh-insert-auto-fields-done-local))
(when (or (not non-interactive)
(not mh-insert-auto-fields-done-local))
(save-excursion
(when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list))
(when (and (or (mh-goto-header-field "To:")
(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list)
(fields-inserted nil))
(while list
(let ((regexp (nth 0 (car list)))
(entries (nth 1 (car list))))
(when (mh-regexp-in-field-p regexp "To:" "cc:")
(setq mh-insert-auto-fields-done-local t)
(setq fields-inserted t)
(if (not non-interactive)
(message "Matched for regexp %s" regexp))
(message "Fields for %s added" regexp))
(let ((entry-list entries))
(while entry-list
(let ((field (caar entry-list))
(value (cdar entry-list)))
(cond
((equal "identity" field)
((equal ":identity" field)
(when (and (not mh-identity-local)
(assoc value mh-identity-list))
(mh-insert-identity value)))
@ -1181,7 +1249,8 @@ An `identity' entry is skipped if one was already entered manually."
(mh-modify-header-field field value
(equal field "From")))))
(setq entry-list (cdr entry-list))))))
(setq list (cdr list))))))))
(setq list (cdr list)))
fields-inserted)))))
(defun mh-modify-header-field (field value &optional overwrite-flag)
"To header FIELD add VALUE.
@ -1201,8 +1270,6 @@ If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
(mh-goto-header-end 0)
(insert field ": " value "\n"))))
(defvar mh-letter-mail-header-end-marker nil)
(defun mh-compose-and-send-mail (draft send-args
sent-from-folder sent-from-msg
to subject cc
@ -1221,22 +1288,19 @@ for `mh-annotate-msg'.
CONFIG is the window configuration to restore after sending the letter."
(pop-to-buffer draft)
(mh-letter-mode)
(mh-insert-auto-fields t)
;; mh-identity support
;; Insert identity.
(if (and (boundp 'mh-identity-default)
mh-identity-default
(not mh-identity-local))
(mh-insert-identity mh-identity-default))
(when (and (boundp 'mh-identity-list)
mh-identity-list)
(mh-identity-make-menu)
(easy-menu-add mh-identity-menu))
(mh-identity-make-menu)
(easy-menu-add mh-identity-menu)
;; Extra fields
;; Insert extra fields.
(mh-insert-x-mailer)
(mh-insert-x-face)
;; Hide skipped fields
(mh-letter-hide-all-skipped-fields)
(setq mh-sent-from-folder sent-from-folder)
@ -1264,7 +1328,16 @@ CONFIG is the window configuration to restore after sending the letter."
This should be the last function called when composing the draft."
(message "%s" (substitute-command-keys
(concat "Type \\[mh-send-letter] to send message, "
"\\[mh-help] for help."))))
"\\[mh-help] for help"))))
(defun mh-ascii-buffer-p ()
"Check if current buffer is entirely composed of ASCII.
The function doesn't work for XEmacs since `find-charset-region' doesn't exist
there."
(loop for charset in (mh-funcall-if-exists
find-charset-region (point-min) (point-max))
unless (eq charset 'ascii) return nil
finally return t))
;;;###mh-autoload
(defun mh-send-letter (&optional arg)
@ -1273,15 +1346,17 @@ If optional prefix argument ARG is provided, monitor delivery.
The value of `mh-before-send-letter-hook' is a list of functions to be called,
with no arguments, before doing anything.
Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise
run `\\[mh-mml-to-mime]' if mml directives are present.
Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
Insert X-Face field if the file specified by `mh-x-face-file' exists."
run `\\[mh-mml-to-mime]' if mml directives are present."
(interactive "P")
(run-hooks 'mh-before-send-letter-hook)
(mh-insert-auto-fields t)
(if (and (mh-insert-auto-fields t)
mh-auto-fields-prompt-flag
(goto-char (point-min)))
(if (not (y-or-n-p "Auto fields inserted, send? "))
(error "Send aborted")))
(cond ((mh-mhn-directive-present-p)
(mh-edit-mhn))
((mh-mml-directive-present-p)
((or (mh-mml-directive-present-p) (not (mh-ascii-buffer-p)))
(mh-mml-to-mime)))
(save-buffer)
(message "Sending...")
@ -1302,7 +1377,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
'iso-latin-1))))
;; The default BCC encapsulation will make a MIME message unreadable.
;; With nmh use the -mime arg to prevent this.
(if (and mh-nmh-flag
(if (and (mh-variant-p 'nmh)
(mh-goto-header-field "Bcc:")
(mh-goto-header-field "Content-Type:"))
(setq mh-send-args (format "-mime %s" mh-send-args)))
@ -1338,7 +1413,8 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
;;;###mh-autoload
(defun mh-insert-letter (folder message verbatim)
"Insert a message into the current letter.
Removes the header fields according to the variable `mh-invisible-headers'.
Removes the header fields according to the variable
`mh-invisible-header-fields-compiled'.
Prefixes each non-blank line with `mh-ins-buf-prefix', unless
`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
used to format the message.
@ -1355,11 +1431,12 @@ and point after it."
(save-restriction
(narrow-to-region (point) (point))
(let ((start (point-min)))
(if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
(if (and (equal message "") (numberp mh-sent-from-msg))
(setq message (int-to-string mh-sent-from-msg)))
(insert-file-contents
(expand-file-name message (mh-expand-file-name folder)))
(when (not verbatim)
(mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
(mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
(goto-char (point-max)) ;Needed for sc-cite-original
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
@ -1373,15 +1450,13 @@ and point after it."
(skip-chars-forward " ")
(cond
((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
(format "%s %s %s" (match-string 1)(match-string 2)
mh-extract-from-attribution-verb))
(format "%s %s " (match-string 1)(match-string 2)))
((looking-at "\\([^<\n]+<.+>\\)$")
(format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
(format "%s " (match-string 1)))
((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
(format "%s <%s> %s" (match-string 2)(match-string 1)
mh-extract-from-attribution-verb))
(format "%s <%s> " (match-string 2)(match-string 1)))
((looking-at " *\\(.+\\)$")
(format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
(format "%s " (match-string 1)))))))
;;;###mh-autoload
(defun mh-yank-cur-msg ()
@ -1444,9 +1519,11 @@ yanked message will be deleted."
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
(mh-insert-prefix-string mh-ins-buf-prefix)
(if (or (eq 'attribution mh-yank-from-start-of-msg)
(eq 'autoattrib mh-yank-from-start-of-msg))
(insert from-attr "\n\n"))
(when (or (eq 'attribution mh-yank-from-start-of-msg)
(eq 'autoattrib mh-yank-from-start-of-msg))
(insert from-attr)
(mh-identity-insert-attribution-verb nil)
(insert "\n\n"))
;; If the user has selected a region, he has already "edited" the
;; text, so leave the cursor at the end of the yanked text. In
;; either case, leave a mark at the opposite end of the included
@ -1572,7 +1649,7 @@ Any match found replaces the text from BEGIN to END."
(let ((syntax-table (syntax-table)))
(unwind-protect
(save-excursion
(mh-funcall-if-exists mail-abbrev-make-syntax-table)
(mh-mail-abbrev-make-syntax-table)
(set-syntax-table mail-abbrev-syntax-table)
(backward-word n)
(point))
@ -1593,7 +1670,6 @@ Any match found replaces the text from BEGIN to END."
(mh-folder-completion-function folder nil t))))
(mh-complete-word folder choices beg end)))
;; XXX: This should probably be customizable
(defvar mh-letter-complete-function-alist
'((cc . mh-alias-letter-expand-alias)
(bcc . mh-alias-letter-expand-alias)
@ -1607,10 +1683,10 @@ Any match found replaces the text from BEGIN to END."
(defun mh-letter-complete (arg)
"Perform completion on header field or word preceding point.
Alias completion is done within the mail header on selected fields based on
the matches in `mh-letter-complete-function-alist'. Elsewhere the function
designated by `mh-letter-complete-function' is used and given the prefix ARG,
if present."
If the field contains addresses (for example, `To:' or `Cc:') or folders (for
example, `Fcc:') then this function will provide alias completion. Elsewhere,
this function runs `mh-letter-complete-function' instead and passes the prefix
ARG, if present."
(interactive "P")
(let ((func nil))
(cond ((not (mh-in-header-p))
@ -1832,10 +1908,13 @@ Otherwise return the empty string."
;;; Build the letter-mode keymap:
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
(gnus-define-keys mh-letter-mode-map
" " mh-letter-complete-or-space
"," mh-letter-confirm-address
"\C-c?" mh-help
"\C-c\C-\\" mh-fully-kill-draft ;if no C-q
"\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-c" mh-send-letter
"\C-c\C-d" mh-insert-identity
"\C-c\M-d" mh-insert-auto-fields
"\C-c\C-e" mh-edit-mhn
"\C-c\C-f\C-b" mh-to-field
"\C-c\C-f\C-c" mh-to-field
@ -1852,31 +1931,38 @@ Otherwise return the empty string."
"\C-c\C-fs" mh-to-field
"\C-c\C-ft" mh-to-field
"\C-c\C-i" mh-insert-letter
"\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
"\C-c\C-m\C-e" mh-mml-secure-message-encrypt
"\C-c\C-m\C-f" mh-compose-forward
"\C-c\C-m\C-g" mh-mhn-compose-anon-ftp
"\C-c\C-m\C-i" mh-compose-insertion
"\C-c\C-m\C-m" mh-mml-to-mime
"\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
"\C-c\C-m\C-n" mh-mml-unsecure-message
"\C-c\C-m\C-s" mh-mml-secure-message-sign
"\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar
"\C-c\C-m\C-u" mh-revert-mhn-edit
"\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
"\C-c\C-m\C-x" mh-mhn-compose-external-type
"\C-c\C-mee" mh-mml-secure-message-encrypt
"\C-c\C-mes" mh-mml-secure-message-signencrypt
"\C-c\C-mf" mh-compose-forward
"\C-c\C-mg" mh-mhn-compose-anon-ftp
"\C-c\C-mi" mh-compose-insertion
"\C-c\C-mm" mh-mml-to-mime
"\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
"\C-c\C-mn" mh-mml-unsecure-message
"\C-c\C-mse" mh-mml-secure-message-signencrypt
"\C-c\C-mss" mh-mml-secure-message-sign
"\C-c\C-mt" mh-mhn-compose-external-compressed-tar
"\C-c\C-mu" mh-revert-mhn-edit
"\C-c\C-mx" mh-mhn-compose-external-type
"\C-c\C-o" mh-open-line
"\C-c\C-q" mh-fully-kill-draft
"\C-c\C-\\" mh-fully-kill-draft ;if no C-q
"\C-c\C-s" mh-insert-signature
"\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-t" mh-letter-toggle-header-field-display
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
"\C-c\C-t" mh-letter-toggle-header-field-display
" " mh-letter-complete-or-space
"\C-c\M-d" mh-insert-auto-fields
"\M-\t" mh-letter-complete
"\t" mh-letter-next-header-field-or-indent
[backtab] mh-letter-previous-header-field
"," mh-letter-confirm-address)
[backtab] mh-letter-previous-header-field)
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.

2770
lisp/mh-e/mh-customize.el
View file

File diff suppressed because it is too large Load diff

524
lisp/mh-e/mh-e.el
View file

@ -5,7 +5,7 @@
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Version: 7.4.4
;; Version: 7.4.80
;; Keywords: mail
;; This file is part of GNU Emacs.
@ -75,24 +75,19 @@
;; 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. larus@ginger.berkeley.edu
;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
;; Rewritten for GNU Emacs, James Larus, 1985.
;; Modified by Stephen Gildea, 1988.
;; Maintenance picked up by Bill Wohler and the
;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
;;; Code:
(provide 'mh-e)
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(defvar recursive-load-depth-limit)
(eval-when (compile load eval)
(if (and (boundp 'recursive-load-depth-limit)
(integerp recursive-load-depth-limit)
(> 50 recursive-load-depth-limit))
(setq recursive-load-depth-limit 50)))
(require 'mh-utils)
(require 'mh-init)
(require 'mh-inc)
(require 'gnus-util)
(require 'easymenu)
@ -101,35 +96,27 @@
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defconst mh-version "7.4.4" "Version number of MH-E.")
(defconst mh-version "7.4.80" "Version number of MH-E.")
;;; Autoloads
(autoload 'Info-goto-node "info")
(defvar mh-note-deleted "D"
"String whose first character is used to notate deleted messages.")
(defvar mh-note-refiled "^"
"String whose first character is used to notate refiled messages.")
(defvar mh-note-cur "+"
"String whose first character is used to notate the current message.")
(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' above is nil. 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 width of
;; the msg number, use the `mh-set-cmd-note' function.
;; 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 width of the msg number, use the `mh-set-cmd-note'
;; function.
(defvar mh-scan-format-mh
(concat
@ -150,11 +137,10 @@ 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.")
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
@ -176,78 +162,94 @@ 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.")
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
"Deleted messages are marked by this character.
See also `mh-scan-deleted-msg-regexp'.")
(defvar mh-note-refiled ?^
"Refiled messages are marked by this character.
See also `mh-scan-refiled-msg-regexp'.")
(defvar mh-note-cur ?+
"The current message (in MH) is marked by this character.
See also `mh-scan-cur-msg-number-regexp'.")
(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
"Regexp specifying the scan lines that are 'good' messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp specifies the scan lines that are 'good' messages.
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]\".")
(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
"Regexp matching scan lines of deleted messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp matches deleted messages.
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\".
See also `mh-note-deleted'.")
(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
"Regexp matching scan lines of refiled messages.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.")
"This regexp matches refiled messages.
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]+\\\\)\\\\^\".
See also `mh-note-refiled'.")
(defvar mh-scan-valid-regexp "^ *[0-9]"
"Regexp matching scan lines for messages (not error messages).")
"This regexp matches scan lines for messages (not error messages).")
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
"Regexp matching scan line for the current message.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the message number.
Don't disable this regexp as it's needed by non fontifying functions.")
(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
"Regexp matching scan line for the current message.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the whole line.
To enable this feature, remove the string DISABLED from the regexp.")
"This regexp matches the current message.
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]+\\\\+\\\\).*\". Don't
disable this regexp as it's needed by non-fontifying functions.
See also `mh-note-cur'.")
(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
"Regexp matching a valid date in scan lines.
The default `mh-folder-font-lock-keywords' expects this expression to contain
only one parenthesized expression which matches the date field
\(see `mh-scan-format-regexp').")
"This regexp matches a valid date.
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]\\\\)\"}.
See also `mh-scan-format-regexp'.")
(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
"Regexp specifying the recipient in scan lines for messages we sent.
The default `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.")
"This regexp 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:\\\\)\\\\(..............\\\\)\".")
(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
"Regexp matching the message body beginning displayed in scan lines.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least one parenthesized expression which matches the body text.")
"This regexp matches the message body fragment displayed in scan lines.
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]+\\\\)?\\\\)\".")
(defvar mh-scan-subject-regexp
;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
"^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
"*Regexp matching the subject string in MH folder mode.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least tree 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 the third is expected to match the subject line itself.")
"This regexp matches the subject.
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 \"^ *[0-9]+........[ ]*...................\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*\\\\([^<\\n]*\\\\)\".")
(defvar mh-scan-format-regexp
(concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
"Regexp matching the output of scan.
The default value is based upon the default values of either
`mh-scan-format-mh' or `mh-scan-format-nmh'.
The default `mh-folder-font-lock-keywords' expects this expression to contain
at least three parenthesized expressions. The first should match the
fontification hint, the second is found in `mh-scan-date-regexp', and the
third should match the user name.")
"This regexp 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, 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
\"*\\\\(..................\\\\)\")\".")
@ -279,10 +281,7 @@ third should match the user name.")
;; scan font-lock name
(list mh-scan-format-regexp
'(1 mh-folder-date-face)
'(3 mh-folder-scan-format-face))
;; Current message line
(list mh-scan-cur-msg-regexp
'(1 mh-folder-cur-msg-face prepend t)))
'(3 mh-folder-scan-format-face)))
"Regexp keywords used to fontify the MH-Folder buffer.")
(defvar mh-scan-cmd-note-width 1
@ -356,46 +355,6 @@ This column will only ever have spaces in it.")
;; Fontifify unseen mesages in bold.
(defvar mh-folder-unseen-seq-name nil
"Name of unseen sequence.
The default for this is provided by the function `mh-folder-unseen-seq-name'
On nmh systems.")
(defun mh-folder-unseen-seq-name ()
"Provide name of unseen sequence from mhparam."
(or mh-progs (mh-find-path))
(save-excursion
(let ((unseen-seq-name "unseen"))
(with-temp-buffer
(unwind-protect
(progn
(call-process (expand-file-name "mhparam" mh-progs)
nil '(t t) nil "-component" "Unseen-Sequence")
(goto-char (point-min))
(if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
(setq unseen-seq-name (match-string 1))))))
unseen-seq-name)))
(defun mh-folder-unseen-seq-list ()
"Return a list of unseen message numbers for current folder."
(if (not mh-folder-unseen-seq-name)
(setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
(cond
((not mh-folder-unseen-seq-name)
nil)
(t
(let ((folder mh-current-folder))
(save-excursion
(with-temp-buffer
(unwind-protect
(progn
(call-process (expand-file-name "mark" mh-progs)
nil '(t t) nil
folder "-seq" mh-folder-unseen-seq-name
"-list")
(goto-char (point-min))
(sort (mh-read-msg-list) '<)))))))))
(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
@ -492,6 +451,8 @@ is done highlighting.")
;Rememeber original notation that
;is overwritten by `mh-note-seq'.
(defvar mh-colors-available-flag nil) ;Are colors available?
;;; Macros and generic functions:
(defun mh-mapc (function list)
@ -503,7 +464,7 @@ is done highlighting.")
(defun mh-scan-format ()
"Return the output format argument for the scan program."
(if (equal mh-scan-format-file t)
(list "-format" (if mh-nmh-flag
(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
@ -519,7 +480,7 @@ is done highlighting.")
(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 front end to the MH mail system."
the Emacs interface to the MH mail system."
(interactive "P")
(mh-find-path)
(if arg
@ -532,7 +493,7 @@ the Emacs front end to the MH mail system."
(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 front end to the MH mail system."
the Emacs interface to the MH mail system."
(interactive "P")
(mh-find-path) ; init mh-inbox
(if arg
@ -616,6 +577,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(setq folder mh-inbox))
(let ((threading-needed-flag nil))
(let ((config (current-window-configuration)))
(delete-other-windows)
(cond ((not (get-buffer folder))
(mh-make-folder folder)
(setq threading-needed-flag mh-show-threads-flag)
@ -659,25 +621,26 @@ last undeleted message then pause for a second after printing message."
(if wait-after-complaining-flag (sit-for 1)))))
(defun mh-folder-from-address ()
"Determine folder name from address in From field.
Takes the address in the From: header field, and returns one of:
"Derive folder name from sender.
a) The folder name associated with the address in the alist
`mh-default-folder-list'. If the `Check Recipient' boolean
is set, then the `mh-default-folder-list' addresses are
checked against the recipient instead of the originator
(making possible to use this feature for mailing lists).
The first match found in `mh-default-folder-list' is used.
The name of the folder is derived as follows:
b) The address' corresponding alias from the user's personal
aliases file prefixed by `mh-default-folder-prefix'.
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.
Returns nil if the address was not found in either place or if the variable
`mh-default-folder-must-exist-flag' is nil and the folder does not exist."
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 t)
(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") "")))
@ -715,25 +678,24 @@ Returns nil if the address was not found in either place or if the variable
"Prompt the user for a folder in which the message should be filed.
The folder is returned as a string.
If `mh-default-folder-for-message-function' is a function then the message
being refiled is yanked into a temporary buffer and the function is called to
intelligently guess where the message is to be refiled.
Otherwise, a default folder name is generated by `mh-folder-from-address'."
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 (mh-msg-filename (mh-get-msg-num t))))
(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)))
"")))
(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)
@ -872,7 +834,9 @@ are skipped."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
(t (mh-goto-msg (car unread-sequence))))))
(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.
@ -1090,7 +1054,7 @@ interactive use."
(if (not (mh-outstanding-commands-p))
(mh-set-folder-modified-p nil)))
;;;###mh-autoload
(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,
@ -1123,7 +1087,6 @@ compiled then macro expansion happens at compile time."
(defun mh-version ()
"Display version information about MH-E and the MH mail handling system."
(interactive)
(mh-find-progs)
(set-buffer (get-buffer-create mh-info-buffer))
(erase-buffer)
;; MH-E version.
@ -1140,19 +1103,12 @@ compiled then macro expansion happens at compile time."
;; Emacs version.
(insert (emacs-version) "\n\n")
;; MH version.
(let ((help-start (point)))
(condition-case err-data
(mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
(file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
(goto-char help-start)
(if mh-nmh-flag
(search-forward "inc -- " nil t)
(search-forward "version: " nil t))
(delete-region help-start (point)))
(goto-char (point-max))
(insert " mh-progs:\t" mh-progs "\n"
" mh-lib:\t" mh-lib "\n"
" mh-lib-progs:\t" mh-lib-progs "\n\n")
(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")
@ -1202,7 +1158,7 @@ used to avoid problems in corner cases involving folders whose names end with a
(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
(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)
@ -1236,6 +1192,7 @@ regardless of the size of the `mh-large-folder' variable."
(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)
@ -1258,12 +1215,11 @@ regardless of the size of the `mh-large-folder' variable."
(mh-toggle-threads))
(mh-index-data
(mh-index-insert-folder-headers)))
(unless mh-showing-mode (delete-other-windows))
(unless (eq current-buffer (current-buffer))
(setq mh-previous-window-config config)))
nil)
;;;###mh-autoload
(defun mh-update-sequences ()
"Update MH's Unseen-Sequence and current folder and message.
Flush MH-E's state out to MH. The message at the cursor becomes current."
@ -1334,7 +1290,7 @@ arguments, after the message has been refiled."
(mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
"-src" mh-current-folder
(symbol-name folder))
(message "Message not copied.")))
(message "Message not copied")))
(t
(mh-set-folder-modified-p t)
(cond ((null (assoc folder mh-refile-list))
@ -1381,7 +1337,9 @@ With optional argument COUNT, COUNT-1 unread messages are skipped."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
(t (mh-goto-msg (car unread-sequence))))))
(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."
@ -1472,12 +1430,12 @@ Make it the current folder."
["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]
["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 t]
["Process Delete/Refile" mh-execute-commands
(or mh-refile-list mh-delete-list)]
["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)]
@ -1501,7 +1459,7 @@ Make it the current folder."
["Incorporate New Mail" mh-inc-folder t]
["Toggle Show/Folder" mh-toggle-showing t]
["Execute Delete/Refile" mh-execute-commands
(or mh-refile-list mh-delete-list)]
(mh-outstanding-commands-p)]
["Rescan Folder" mh-rescan-folder t]
["Thread Folder" mh-toggle-threads
(not (memq 'unthread mh-view-ops))]
@ -1541,6 +1499,12 @@ is used in previous versions and XEmacs."
(defvar tool-bar-map)
(defvar desktop-save-buffer)) ;Emacs 21.4
;; Register mh-folder-mode as supporting which-function-mode...
(load "which-func" t t)
(when (and (boundp 'which-func-modes)
(not (member 'mh-folder-mode which-func-modes)))
(push 'mh-folder-mode which-func-modes))
(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
"Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
@ -1548,16 +1512,49 @@ 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.
A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
applies the action to a message sequence. If `transient-mark-mode',
is non-nil, the action is applied to the region.
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 legal MH
range which can include messages, sequences, and the abbreviations (described
in the mh(1) man page):
<num1>-<num2>
Indicates all messages in the range <num1> to <num2>, inclusive. The range
must be nonempty.
`<num>:N'
`<num>:+N'
`<num>:-N'
Up to N messages beginning with (or ending with) message num. Num may be
any of the pre-defined 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}"
(make-local-variable 'font-lock-defaults)
@ -1565,10 +1562,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(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.
@ -1597,6 +1599,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
'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)
@ -1620,6 +1624,26 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
font-lock-auto-fontify)
(turn-on-font-lock))) ; Force font-lock in XEmacs.
(defun mh-toggle-mime-buttons ()
"Toggle display of buttons for inline MIME parts."
(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."
@ -1631,7 +1655,11 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(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."
"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))
@ -1641,6 +1669,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
refiles aren't carried out.
Return in the folder's buffer."
(when (stringp range)
(setq range (delete "" (split-string range "[ \t\n]"))))
(cond ((null (get-buffer folder))
(mh-make-folder folder))
(t
@ -1693,7 +1723,9 @@ If UPDATE, append the scan lines, otherwise replace."
(goto-char scan-start)
(cond ((looking-at "scan: no messages in")
(keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
((looking-at "scan: bad message list ")
((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
@ -1869,46 +1901,21 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
(""))))))
(mh-logo-display))))
;;; XXX: Remove this function, if no one uses it any more...
(defun mh-unmark-all-headers (remove-all-flags)
"Remove all '+' flags from the folder listing.
With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
Optimized for speed (i.e., no regular expressions).
This function is deprecated. Use `mh-remove-all-notation' instead."
(save-excursion
(let ((case-fold-search nil)
(last-line (1- (point-max)))
char)
(mh-first-msg)
(while (<= (point) last-line)
(forward-char mh-cmd-note)
(setq char (following-char))
(if (or (and remove-all-flags
(or (= char (aref mh-note-deleted 0))
(= char (aref mh-note-refiled 0))))
(= char (aref mh-note-cur 0)))
(progn
(delete-char 1)
(insert " ")))
(if remove-all-flags
(progn
(forward-char 1)
(if (= (following-char) (aref mh-note-seq 0))
(progn
(delete-char 1)
(insert " ")))))
(forward-line)))))
(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 just remove text properties from the
current line, so that font-lock would automatically refontify it."
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
(mh-notate nil nil mh-cmd-note)
(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 (1+ mh-cmd-note))
(let ((stack (gethash msg mh-sequence-notation-history)))
(setf (gethash msg mh-sequence-notation-history)
@ -1930,7 +1937,11 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
(while (and all (cdr stack))
(setq stack (cdr stack)))
(when stack
(mh-notate nil (car stack) (1+ mh-cmd-note)))
(save-excursion
(beginning-of-line)
(forward-char (1+ mh-cmd-note))
(delete-char 1)
(insert (car stack))))
(setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
(defun mh-remove-cur-notation ()
@ -1953,7 +1964,7 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
(mh-remove-sequence-notation msg nil t))
(clrhash mh-sequence-notation-history)))
;;;###mh-autoload
(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
@ -2102,7 +2113,10 @@ with no arguments, after the unseen sequence is updated."
(defun mh-outstanding-commands-p ()
"Return non-nil if there are outstanding deletes or refiles."
(or mh-delete-list mh-refile-list))
(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.
@ -2223,7 +2237,7 @@ numbers, a sequence, a region in a cons cell. If nil all messages are notated."
"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-tick-seq (eq name mh-tick-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)))
@ -2264,6 +2278,15 @@ change."
(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 `mh-unseen-seq' sequence.
Check the document 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."
@ -2291,23 +2314,6 @@ Signals an error if SEQ is an illegal name."
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs)))))
(defun mh-map-over-seqs (function seq-list)
"Apply FUNCTION to each sequence in SEQ-LIST.
The sequence name and the list of messages are passed as arguments."
(while seq-list
(funcall function
(mh-seq-name (car seq-list))
(mh-seq-msgs (car seq-list)))
(setq seq-list (cdr seq-list))))
(defun mh-notate-if-in-one-seq (msg character offset seq)
"Notate MSG.
The CHARACTER is placed at the given OFFSET from the beginning of the listing.
The notation is performed if the MSG is only in SEQ."
(let ((in-seqs (mh-seq-containing-msg msg nil)))
(if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
(mh-notate msg character offset))))
(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."
@ -2362,7 +2368,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"g" mh-goto-msg
"i" mh-inc-folder
"k" mh-delete-subject-or-thread
"l" mh-print-msg
"m" mh-alt-send
"n" mh-next-undeleted-msg
"\M-n" mh-next-unread-msg
@ -2382,6 +2387,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"?" 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
@ -2402,6 +2408,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
"b" mh-junk-blacklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
"?" mh-prefix-help
"A" mh-ps-print-toggle-mime
"C" mh-ps-print-toggle-color
"F" mh-ps-print-toggle-faces
"M" mh-ps-print-toggle-mime
"f" mh-ps-print-msg-file
"l" mh-print-msg
"p" mh-ps-print-msg
"s" mh-ps-print-msg-show)
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
@ -2446,8 +2463,10 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
(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
@ -2484,6 +2503,9 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
(?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 "PS [p]rint message; [l]non-PS print;\n"
"PS Print [s]how window, message to [f]ile;\n"
"Toggle printing of [M]IME parts, [C]olor, [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")

97
lisp/mh-e/mh-funcs.el
View file

@ -1,6 +1,6 @@
;;; mh-funcs.el --- MH-E functions not everyone will use right away
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,6 +34,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
;;; Customization
@ -45,11 +47,13 @@ prefix argument. Normally default arguments to sortm are specified in the
MH profile.
For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
;;; Scan Line Formats
(defvar mh-note-copied "C"
"String whose first character is used to notate copied messages.")
"Copied messages are marked by this character.")
(defvar mh-note-printed "P"
"String whose first character is used to notate printed messages.")
"Messages that have been printed are marked by this character.")
;;; Functions
@ -232,60 +236,6 @@ Otherwise just send the message's body without the headers."
(forward-line 2))
(mh-recenter 0)))
;;;###mh-autoload
(defun mh-print-msg (range)
"Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'."
(interactive (list (mh-interactive-range "Print")))
(message "Printing...")
(let (msgs)
;; Gather message numbers and add them to "printed" sequence.
(mh-iterate-on-range msg range
(mh-add-msgs-to-seq msg 'printed t)
(mh-notate nil mh-note-printed mh-cmd-note)
(push msg msgs))
(setq msgs (nreverse msgs))
;; Print scan listing if we have more than one message.
(if (> (length msgs) 1)
(let* ((msgs-string
(mapconcat 'identity (mh-list-to-string
(mh-coalesce-msg-list msgs)) " "))
(lpr-command
(format mh-lpr-command-format
(cond ((listp range)
(format "Folder: %s, Messages: %s"
mh-current-folder msgs-string))
((symbolp range)
(format "Folder: %s, Sequence: %s"
mh-current-folder range)))))
(scan-command
(format "scan %s | %s" msgs-string lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
(call-process shell-file-name nil nil nil "-c" scan-command))))
;; Print the messages
(dolist (msg msgs)
(let* ((mhl-command (format "%s %s %s"
(expand-file-name "mhl" mh-lib-progs)
(if mhl-formfile
(format " -form %s" mhl-formfile)
"")
(mh-msg-filename msg)))
(lpr-command
(format mh-lpr-command-format
(format "%s/%s" mh-current-folder msg)))
(print-command
(format "%s | %s" mhl-command lpr-command)))
(if mh-print-background-flag
(mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
(call-process shell-file-name nil nil nil "-c" print-command)))))
(message "Printing...done"))
;;;###mh-autoload
(defun mh-sort-folder (&optional extra-args)
"Sort the messages in the current folder by date.
@ -307,9 +257,8 @@ argument EXTRA-ARGS is given."
(mh-index-data (mh-index-insert-folder-headers)))))
;;;###mh-autoload
(defun mh-undo-folder (&rest ignore)
"Undo all pending deletes and refiles in current folder.
Argument IGNORE is deprecated."
(defun mh-undo-folder ()
"Undo all pending deletes and refiles in current folder."
(interactive)
(cond ((or mh-do-not-confirm-flag
(yes-or-no-p "Undo all commands in folder? "))
@ -320,10 +269,7 @@ Argument IGNORE is deprecated."
(with-mh-folder-updating (nil)
(mh-remove-all-notation)))
(t
(message "Commands not undone.")
;; Remove by 2003-06-30 if nothing seems amiss. XXX
;; (sit-for 2)
)))
(message "Commands not undone"))))
;;;###mh-autoload
(defun mh-store-msg (directory)
@ -413,11 +359,15 @@ Default directory is the last directory used, or initially the value of
;;;###mh-autoload
(defun mh-help ()
"Display cheat sheet for the MH-Folder commands in minibuffer."
"Display cheat sheet for the MH-E commands."
(interactive)
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
(with-electric-help
(function
(lambda ()
(insert
(substitute-command-keys
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
mh-help-buffer)))
;;;###mh-autoload
(defun mh-prefix-help ()
@ -430,9 +380,14 @@ Default directory is the last directory used, or initially the value of
;; from the recent keys.
(let* ((keys (recent-keys))
(prefix-char (elt keys (- (length keys) 2))))
(mh-ephem-message
(substitute-command-keys
(mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
(with-electric-help
(function
(lambda ()
(insert
(substitute-command-keys
(mapconcat 'identity
(cdr (assoc prefix-char mh-help-messages)) "")))))
mh-help-buffer)))
(provide 'mh-funcs)

36
lisp/mh-e/mh-gnus.el
View file

@ -1,6 +1,6 @@
;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,6 +34,7 @@
(load "mm-uu" t t) ; Non-fatal dependency
(load "mailcap" t t) ; Non-fatal dependency
(load "smiley" t t) ; Non-fatal dependency
(load "mailabbrev" t t)
(defmacro mh-defun-compat (function arg-list &rest body)
"This is a macro to define functions which are not defined.
@ -74,12 +75,28 @@ BODY."
(put-text-property 0 (length (car handle)) parameter value
(car handle))))
;; Copy of function from mm-view.el
(mh-defun-compat mm-inline-text-vcard (handle)
(let (buffer-read-only)
(mm-insert-inline
handle
(concat "\n-- \n"
(ignore-errors
(if (fboundp 'vcard-pretty-print)
(vcard-pretty-print (mm-get-part handle))
(vcard-format-string
(vcard-parse-string (mm-get-part handle)
'vcard-standard-filter))))))))
;; Function from mm-decode.el used in PGP messages. Just define it with older
;; gnus to avoid compiler warning.
(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl)
nil)
;; Copy of original macro is in mm-decode.el
(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
`(get-text-property 0 ,parameter (car ,handle)))
(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
"Say whether the content of HANDLE is readable."
@ -134,10 +151,23 @@ BODY."
file)))
(mm-save-part-to-file handle file))))
(defun mh-mm-text-html-renderer ()
"Find the renderer gnus is using to display text/html MIME parts."
(or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer)
(and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))
(defun mh-mail-abbrev-make-syntax-table ()
"Call `mail-abbrev-make-syntax-table' if available."
(when (fboundp 'mail-abbrev-make-syntax-table)
(mail-abbrev-make-syntax-table)))
(provide 'mh-gnus)
;;; Local Variables:
;;; no-byte-compile: t
;;; no-update-autoloads: t
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa

296
lisp/mh-e/mh-identity.el
View file

@ -39,47 +39,50 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(eval-when (compile load eval)
(defvar mh-comp-loaded nil)
(unless mh-comp-loaded
(setq mh-comp-loaded t)
(require 'mh-comp))) ;Since we do this on sending
(require 'mh-comp)
(autoload 'mml-insert-tag "mml")
(defvar mh-identity-pgg-default-user-id nil
"Holds the GPG key ID to be used by pgg.el.
This is normally set as part of an Identity in `mh-identity-list'.")
(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
;;;###mh-autoload
(defun mh-identity-make-menu ()
"Build (or rebuild) the Identity menu (e.g. after the list is modified)."
(when (and mh-identity-list (boundp 'mh-letter-mode-map))
(easy-menu-define mh-identity-menu mh-letter-mode-map
"mh-e identity menu"
(append
'("Identity")
;; Dynamically render :type corresponding to `mh-identity-list'
;; e.g.:
;; ["home" (mh-insert-identity "home")
;; :style radio :active (not (equal mh-identity-local "home"))
;; :selected (equal mh-identity-local "home")]
'(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list]
"--")
(mapcar (function
(lambda (arg)
`[,arg (mh-insert-identity ,arg) :style radio
:active (not (equal mh-identity-local ,arg))
:selected (equal mh-identity-local ,arg)]))
(mapcar 'car mh-identity-list))
'("--"
["none" (mh-insert-identity "none") mh-identity-local]
["Set Default for Session"
(setq mh-identity-default mh-identity-local) t]
["Save as Default"
(customize-save-variable
'mh-identity-default mh-identity-local) t]
)))))
"Build the Identity menu.
This should be called any time `mh-identity-list' or `mh-auto-fields-list'
change."
(easy-menu-define mh-identity-menu mh-letter-mode-map
"MH-E identity menu"
(append
'("Identity")
;; Dynamically render :type corresponding to `mh-identity-list'
;; e.g.:
;; ["Home" (mh-insert-identity "Home")
;; :style radio :active (not (equal mh-identity-local "Home"))
;; :selected (equal mh-identity-local "Home")]
'(["Insert Auto Fields"
(mh-insert-auto-fields) mh-auto-fields-list]
"--")
(mapcar (function
(lambda (arg)
`[,arg (mh-insert-identity ,arg) :style radio
:selected (equal mh-identity-local ,arg)]))
(mapcar 'car mh-identity-list))
'(["None"
(mh-insert-identity "None") :style radio
:selected (not mh-identity-local)]
"--"
["Set Default for Session"
(setq mh-identity-default mh-identity-local) t]
["Save as Default"
(customize-save-variable 'mh-identity-default mh-identity-local) t]
["Customize Identities" (customize-variable 'mh-identity-list) t]
))))
;;;###mh-autoload
(defun mh-identity-list-set (symbol value)
@ -97,21 +100,36 @@ customization). This is called after 'customize is used to alter
(defun mh-header-field-delete (field value-only)
"Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
Return t if anything is deleted."
(when (mh-goto-header-field field)
(if (not value-only)
(beginning-of-line)
(forward-char))
(delete-region (point)
(progn (mh-header-field-end)
(if (not value-only) (forward-char 1))
(point)))
t))
(let ((field-colon (if (string-match "^.*:$" field)
field
(concat field ":"))))
(when (mh-goto-header-field field-colon)
(if (not value-only)
(beginning-of-line)
(forward-char))
(delete-region (point)
(progn (mh-header-field-end)
(if (not value-only) (forward-char 1))
(point)))
t)))
(defvar mh-identity-signature-start nil
"Marker for the beginning of a signature inserted by `mh-insert-identity'.")
(defvar mh-identity-signature-end nil
"Marker for the end of a signature inserted by `mh-insert-identity'.")
(defun mh-identity-field-handler (field)
"Return the handler for a FIELD or nil if none set.
The field name is downcased. If the FIELD begins with the character
`:', then it must have a special handler defined in
`mh-identity-handlers', else return an error since it is not a legal
message header."
(or (cdr (assoc (downcase field) mh-identity-handlers))
(and (eq (aref field 0) ?:)
(error (format "Field %s - unknown mh-identity-handler" field)))
(cdr (assoc "default" mh-identity-handlers))
'mh-identity-handler-default))
;;;###mh-autoload
(defun mh-insert-identity (identity)
"Insert proper fields for given IDENTITY.
@ -120,7 +138,7 @@ Edit the `mh-identity-list' variable to define identity."
(list (completing-read
"Identity: "
(if mh-identity-local
(cons '("none")
(cons '("None")
(mapcar 'list (mapcar 'car mh-identity-list)))
(mapcar 'list (mapcar 'car mh-identity-list)))
nil t)))
@ -129,83 +147,135 @@ Edit the `mh-identity-list' variable to define identity."
(when mh-identity-local
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
(while pers-list
(let ((field (concat (caar pers-list) ":")))
(cond
((string-equal "signature:" field)
(when (and (boundp 'mh-identity-signature-start)
(markerp mh-identity-signature-start))
(goto-char mh-identity-signature-start)
(forward-char -1)
(delete-region (point) mh-identity-signature-end)))
((mh-header-field-delete field nil))))
(let* ((field (caar pers-list))
(handler (mh-identity-field-handler field)))
(funcall handler field 'remove))
(setq pers-list (cdr pers-list)))))
;; Then insert the replacement
(when (not (equal "none" identity))
(when (not (equal "None" identity))
(let ((pers-list (cadr (assoc identity mh-identity-list))))
(while pers-list
(let ((field (concat (caar pers-list) ":"))
(value (cdar pers-list)))
(cond
;; No value, remove field
((or (not value)
(string= value ""))
(mh-header-field-delete field nil))
;; Existing field, replace
((mh-header-field-delete field t)
(insert value))
;; Handle "signature" special case. Insert file or call function.
((and (string-equal "signature:" field)
(or (and (stringp value)
(file-readable-p value))
(fboundp value)))
(goto-char (point-max))
(if (not (looking-at "^$"))
(insert "\n"))
(insert "\n")
(save-restriction
(narrow-to-region (point) (point))
(set (make-local-variable 'mh-identity-signature-start)
(make-marker))
(set-marker mh-identity-signature-start (point))
(cond
;; If MIME composition done, insert signature at the end as
;; an inline MIME part.
((mh-mhn-directive-present-p)
(insert "#\n" "Content-Description: Signature\n"))
((mh-mml-directive-present-p)
(mml-insert-tag 'part 'type "text/plain"
'disposition "inline"
'description "Signature")))
(if (stringp value)
(insert-file-contents value)
(funcall value))
(goto-char (point-min))
(when (not (re-search-forward "^--" nil t))
(cond ((mh-mhn-directive-present-p)
(forward-line 2))
((mh-mml-directive-present-p)
(forward-line 1)))
(insert "-- \n"))
(set (make-local-variable 'mh-identity-signature-end)
(make-marker))
(set-marker mh-identity-signature-end (point-max))))
;; Handle "From" field differently, adding it at the beginning.
((string-equal "From:" field)
(goto-char (point-min))
(insert "From: " value "\n"))
;; Skip empty signature (Can't remove what we don't know)
((string-equal "signature:" field))
;; Other field, add at end
(t ;Otherwise, add the end.
(goto-char (point-min))
(mh-goto-header-end 0)
(mh-insert-fields field value))))
(let* ((field (caar pers-list))
(value (cdar pers-list))
(handler (mh-identity-field-handler field)))
(funcall handler field 'add value))
(setq pers-list (cdr pers-list))))))
;; Remember what is in use in this buffer
(if (equal "none" identity)
(if (equal "None" identity)
(setq mh-identity-local nil)
(setq mh-identity-local identity)))
;;;###mh-autoload
(defun mh-identity-handler-gpg-identity (field action &optional value)
"For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
when action 'add is selected."
(cond
((or (equal action 'remove)
(not value)
(string= value ""))
(setq mh-identity-pgg-default-user-id nil))
((equal action 'add)
(setq mh-identity-pgg-default-user-id value))))
;;;###mh-autoload
(defun mh-identity-handler-signature (field action &optional value)
"For FIELD \"signature\", process headers for ACTION 'remove or 'add.
The VALUE is added."
(cond
((equal action 'remove)
(when (and (markerp mh-identity-signature-start)
(markerp mh-identity-signature-end))
(delete-region mh-identity-signature-start
mh-identity-signature-end)))
(t
;; Insert "signature". Nil value means to use `mh-signature-file-name'.
(when (not (mh-signature-separator-p)) ;...unless already present
(goto-char (point-max))
(save-restriction
(narrow-to-region (point) (point))
(if (null value)
(mh-insert-signature)
(mh-insert-signature value))
(set (make-local-variable 'mh-identity-signature-start)
(point-min-marker))
(set-marker-insertion-type mh-identity-signature-start t)
(set (make-local-variable 'mh-identity-signature-end)
(point-max-marker)))))))
(defvar mh-identity-attribution-verb-start nil
"Marker for the beginning of the attribution verb.")
(defvar mh-identity-attribution-verb-end nil
"Marker for the end of the attribution verb.")
;;;###mh-autoload
(defun mh-identity-handler-attribution-verb (field action &optional value)
"For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
The VALUE is added."
(when (and (markerp mh-identity-attribution-verb-start)
(markerp mh-identity-attribution-verb-end))
(delete-region mh-identity-attribution-verb-start
mh-identity-attribution-verb-end)
(goto-char mh-identity-attribution-verb-start)
(cond
((equal action 'remove) ; Replace with default
(mh-identity-insert-attribution-verb nil))
(t ; Insert attribution verb.
(mh-identity-insert-attribution-verb value)))))
;;;###mh-autoload
(defun mh-identity-insert-attribution-verb (value)
"Insert VALUE as attribution verb, setting up delimiting markers.
If VALUE is nil, use `mh-extract-from-attribution-verb'."
(save-restriction
(narrow-to-region (point) (point))
(if (null value)
(insert mh-extract-from-attribution-verb)
(insert value))
(set (make-local-variable 'mh-identity-attribution-verb-start)
(point-min-marker))
(set-marker-insertion-type mh-identity-attribution-verb-start t)
(set (make-local-variable 'mh-identity-attribution-verb-end)
(point-max-marker))))
(defun mh-identity-handler-default (field action top &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
if TOP is non-nil, add the field and it's VALUE at the top of the header, else
add it at the bottom of the header."
(let ((field-colon (if (string-match "^.*:$" field)
field
(concat field ":"))))
(cond
((equal action 'remove)
(mh-header-field-delete field-colon nil))
(t
(cond
;; No value, remove field
((or (not value)
(string= value ""))
(mh-header-field-delete field-colon nil))
;; Existing field, replace
((mh-header-field-delete field-colon t)
(insert value))
;; Other field, add at end or top
(t
(goto-char (point-min))
(if (not top)
(mh-goto-header-end 0))
(insert field-colon " " value "\n")))))))
;;;###mh-autoload
(defun mh-identity-handler-top (field action &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the top of the header."
(mh-identity-handler-default field action t value))
;;;###mh-autoload
(defun mh-identity-handler-bottom (field action &optional value)
"For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the bottom of the header."
(mh-identity-handler-default field action nil value))
(provide 'mh-identity)
;;; Local Variables:

8
lisp/mh-e/mh-inc.el
View file

@ -1,6 +1,6 @@
;;; mh-inc.el --- MH-E `inc' and separate mail spool handling
;;
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,7 +34,8 @@
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(defvar mh-inc-spool-map (make-sparse-keymap)
"Keymap for MH-E's mh-inc-spool commands.")
@ -46,7 +47,8 @@
'(lambda ()
(interactive)
(if mh-inc-spool-map-help
(mh-ephem-message (substring mh-inc-spool-map-help 0 -1))
(let ((mh-help-messages (list (list nil mh-inc-spool-map-help))))
(mh-help))
(mh-ephem-message
"There are no keys defined yet. Customize `mh-inc-spool-list'"))))

225
lisp/mh-e/mh-index.el
View file

@ -31,7 +31,6 @@
;;; swish-e
;;; mairix
;;; namazu
;;; glimpse
;;; grep
;;;
;;; (2) To use this package, you first have to build an index. Please read
@ -43,7 +42,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'mh-mime)
@ -66,8 +65,6 @@
mh-mairix-regexp-builder)
(namazu
mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
(glimpse
mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)
(pick
mh-pick-binary mh-pick-execute-search mh-pick-next-result
mh-pick-regexp-builder)
@ -200,7 +197,8 @@ This function should only be called in the appropriate index folder buffer."
(call-process "rm" nil nil nil
(format "%s%s/%s" mh-user-path
(substring mh-current-folder 1) msg))
(remhash omsg (gethash ofolder mh-index-data))))
(when (gethash ofolder mh-index-data)
(remhash omsg (gethash ofolder mh-index-data)))))
(t
(setf (gethash msg mh-index-msg-checksum-map) checksum)
(when origin-map
@ -301,7 +299,8 @@ list of messages in that sequence."
(pair (gethash checksum mh-index-checksum-origin-map))
(ofolder (car pair))
(omsg (cdr pair)))
(loop for seq in (gethash omsg (gethash ofolder seq-hash))
(loop for seq in (ignore-errors
(gethash omsg (gethash ofolder seq-hash)))
do (if (assoc seq seq-list)
(push msg (cdr (assoc seq seq-list)))
(push (list seq msg) seq-list)))))
@ -374,7 +373,6 @@ index for each program:
- `mh-swish-execute-search'
- `mh-mairix-execute-search'
- `mh-namazu-execute-search'
- `mh-glimpse-execute-search'
If none of these programs are present then we use pick. If desired grep can be
used instead. Details about these methods can be found in:
@ -436,7 +434,7 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
(setq index-folder buffer-name))
(setq index-folder (mh-index-new-folder index-folder)))
(setq index-folder (mh-index-new-folder index-folder search-regexp)))
(let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
(folder-results-map (make-hash-table :test #'equal))
@ -587,13 +585,6 @@ PROC is used to convert the value to actual data."
mh-previous-window-config)
(error "No search terms"))))
(defun mh-replace-string (old new)
"Replace all occurrences of OLD with NEW in the current buffer."
(goto-char (point-min))
(let ((case-fold-search t))
(while (search-forward old nil t)
(replace-match new t t))))
;;;###mh-autoload
(defun mh-index-parse-search-regexp (input-string)
"Construct parse tree for INPUT-STRING.
@ -739,28 +730,48 @@ results."
"Check if MSG exists in FOLDER."
(file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
(defun mh-index-new-folder (name)
"Create and return an MH folder name based on NAME.
If the folder NAME already exists then check if NAME<2> exists. If it doesn't
then it is created and returned. Otherwise try NAME<3>. This is repeated till
we find a new folder name."
(defun mh-index-new-folder (name search-regexp)
"Return a folder name based on NAME for search results of SEARCH-REGEXP.
If folder NAME already exists and was generated for the same SEARCH-REGEXP
then it is reused.
Otherwise if the folder NAME was generated from a different search then check
if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a
new folder name.
If the folder returned doesn't exist then it is created."
(unless (mh-folder-name-p name)
(error "The argument should be a valid MH folder name"))
(let ((chosen-name name))
(block unique-name
(unless (mh-folder-exists-p name)
(return-from unique-name))
(loop for index from 2
do (let ((new-name (format "%s<%s>" name index)))
(unless (mh-folder-exists-p new-name)
(setq chosen-name new-name)
(return-from unique-name)))))
(let ((chosen-name
(loop for i from 1
for candidate = (if (equal i 1) name (format "%s<%s>" name i))
when (or (not (mh-folder-exists-p candidate))
(equal (mh-index-folder-search-regexp candidate)
search-regexp))
return candidate)))
;; Do pending refiles/deletes...
(when (get-buffer chosen-name)
(mh-process-or-undo-commands chosen-name))
;; Recreate folder...
(save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
(mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
(mh-remove-from-sub-folders-cache chosen-name)
(when (boundp 'mh-speed-folder-map)
(mh-speed-add-folder chosen-name))
chosen-name))
(defun mh-index-folder-search-regexp (folder)
"If FOLDER was created by a index search, return the search regexp.
Return nil if FOLDER doesn't exist or the .mhe_index file is garbled."
(ignore-errors
(with-temp-buffer
(insert-file-contents
(format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file))
(goto-char (point-min))
(forward-list 3)
(cadr (read (current-buffer))))))
;;;###mh-autoload
(defun mh-index-insert-folder-headers ()
"Annotate the search results with original folder names."
@ -777,8 +788,27 @@ we find a new folder name."
(insert (if last-folder "\n" "") current-folder "\n")
(setq last-folder current-folder))
(forward-line))
(when cur-msg (mh-goto-msg cur-msg t))
(set-buffer-modified-p old-buffer-modified-flag)))
(when cur-msg
(mh-notate-cur)
(mh-goto-msg cur-msg t))
(set-buffer-modified-p old-buffer-modified-flag))
(mh-index-create-imenu-index))
;;;###mh-autoload
(defun mh-index-create-imenu-index ()
"Create alist of folder names and positions in index folder buffers."
(save-excursion
(setq which-func-mode t)
(let ((alist ()))
(goto-char (point-min))
(while (re-search-forward "^+" nil t)
(save-excursion
(beginning-of-line)
(push (cons (buffer-substring-no-properties
(point) (line-end-position))
(set-marker (make-marker) (point)))
alist)))
(setq imenu--index-alist (nreverse alist)))))
;;;###mh-autoload
(defun mh-index-group-by-folder ()
@ -837,23 +867,6 @@ list of messages originally from that folder."
folder (loop for x being the hash-keys of (gethash folder mh-index-data)
when (mh-msg-exists-p x folder) collect x)))))
;;;###mh-autoload
(defun mh-index-update-unseen (msg)
"Remove counterpart of MSG in source folder from `mh-unseen-seq'.
Also `mh-update-unseen' is called in the original folder, if we have it open."
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
(orig-folder (car folder-msg-pair))
(orig-msg (cdr folder-msg-pair)))
(when (mh-index-match-checksum orig-msg orig-folder checksum)
(when (get-buffer orig-folder)
(save-excursion
(set-buffer orig-folder)
(unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
(mh-update-unseen)))
(mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
"-sequence" (symbol-name mh-unseen-seq) "-del"))))
(defun mh-index-match-checksum (msg folder checksum)
"Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
(with-temp-buffer
@ -973,90 +986,6 @@ update the source folder buffer if present."
;; Glimpse interface
(defvar mh-glimpse-binary (executable-find "glimpse"))
(defvar mh-glimpse-directory ".glimpse")
;;;###mh-autoload
(defun mh-glimpse-execute-search (folder-path search-regexp)
"Execute glimpse and read the results.
In the examples below, replace /home/user/Mail with the path to your MH
directory.
First create the directory /home/user/Mail/.glimpse. Then create the file
/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
*/.*
*/#*
*/,*
*/*~
^/home/user/Mail/.glimpse
^/home/user/Mail/mhe-index
If there are any directories you would like to ignore, append lines like the
following to .glimpse_exclude:
^/home/user/Mail/scripts
You do not want to index the folders that hold the results of your searches
since they tend to be ephemeral and the original messages are indexed anyway.
The configuration file above assumes that the results are found in sub-folders
of `mh-index-folder' which is +mhe-index by default.
Use the following command line to generate the glimpse index. Run this
daily from cron:
glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
(set-buffer (get-buffer-create mh-index-temp-buffer))
(erase-buffer)
(call-process mh-glimpse-binary nil '(t nil) nil
;(format "-%s" fuzz)
"-i" "-y"
"-H" (format "%s%s" mh-user-path mh-glimpse-directory)
"-F" (format "^%s" folder-path)
search-regexp)
(goto-char (point-min)))
(defun mh-glimpse-next-result ()
"Read the next result.
Parse it and return the message folder, message index and the match. If no
other matches left then return nil. If the current record is invalid return
'error."
(prog1
(block nil
(when (eobp)
(return nil))
(let ((eol-pos (line-end-position))
(bol-pos (line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos t)
(return 'error))
(setq folder-start (point))
(unless (search-forward ": " eol-pos t)
(return 'error))
(let ((match (buffer-substring-no-properties (point) eol-pos)))
(forward-char -2)
(setq msg-end (point))
(unless (search-backward "/" folder-start t)
(return 'error))
(list (format "+%s" (buffer-substring-no-properties
folder-start (point)))
(let ((val (ignore-errors (read-from-string
(buffer-substring-no-properties
(1+ (point)) msg-end)))))
(if (and (consp val) (integerp (car val)))
(car val)
(return 'error)))
match))))
(forward-line)))
;; Pick interface
(defvar mh-index-pick-folder)
@ -1319,16 +1248,12 @@ then the folders are searched recursively. All parameters ARGS are ignored."
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
"Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use."
All messages in the sequence you provide from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of folders, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-new-messages-folders)
(mh-read-seq-default "Search" nil)))
(unless sequence (setq sequence mh-unseen-seq))
@ -1367,26 +1292,26 @@ sequence to use."
;;;###mh-autoload
(defun mh-index-new-messages (folders)
"Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
If you use a program such as `procmail' to use `rcvstore' to file your
incoming mail automatically, you can display new, unseen, messages using this
command. All messages in the `unseen' sequence from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-new-messages-folders)))
(mh-index-sequenced-messages folders mh-unseen-seq))
;;;###mh-autoload
(defun mh-index-ticked-messages (folders)
"Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
All messages in `mh-tick-seq' from the folders in
`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
(split-string (read-string "Search folder(s): [all] "))
mh-index-ticked-messages-folders)))
(mh-index-sequenced-messages folders mh-tick-seq))

450
lisp/mh-e/mh-junk.el
View file

@ -1,6 +1,6 @@
;;; mh-junk.el --- Interface to anti-spam measures
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
@ -32,6 +32,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
;; Interactive functions callable from the folder buffer
@ -39,36 +41,33 @@
(defun mh-junk-blacklist (range)
"Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command trains the spam program in use (see the `mh-junk-program' option)
with the content of the range (see `mh-interactive-range') and then handles
the message(s) as specified by the `mh-junk-disposition' option.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
refiled to that folder. If nil, the message is deleted.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended.
The documentation for the following functions describes what setup is needed
for the different spam fighting programs:
For more information about using your particular spam fighting program, see:
- `mh-spamassassin-blacklist'
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'"
- `mh-spamprobe-blacklist'"
(interactive (list (mh-interactive-range "Blacklist")))
(let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
(unless blacklist-func
(error "Customize `mh-junk-program' appropriately"))
(let ((dest (cond ((null mh-junk-mail-folder) nil)
((equal mh-junk-mail-folder "") "+")
((eq (aref mh-junk-mail-folder 0) ?+)
mh-junk-mail-folder)
((eq (aref mh-junk-mail-folder 0) ?@)
(let ((dest (cond ((null mh-junk-disposition) nil)
((equal mh-junk-disposition "") "+")
((eq (aref mh-junk-disposition 0) ?+)
mh-junk-disposition)
((eq (aref mh-junk-disposition 0) ?@)
(concat mh-current-folder "/"
(substring mh-junk-mail-folder 1)))
(t (concat "+" mh-junk-mail-folder)))))
(substring mh-junk-disposition 1)))
(t (concat "+" mh-junk-disposition)))))
(mh-iterate-on-range msg range
(message (format "Blacklisting message %d..." msg))
(funcall (symbol-function blacklist-func) msg)
(message (format "Blacklisting message %d...done" msg))
(if (not (memq msg mh-seen-list))
(setq mh-seen-list (cons msg mh-seen-list)))
(if dest
(mh-refile-a-msg nil (intern dest))
(mh-delete-a-msg nil)))
@ -76,231 +75,124 @@ for the different spam fighting programs:
;;;###mh-autoload
(defun mh-junk-whitelist (range)
"Whitelist RANGE incorrectly classified as spam.
"Whitelist RANGE as ham.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command reclassifies a range of messages (see `mh-interactive-range') as
ham if it were incorrectly classified as spam. It then refiles the message
into the `+inbox' folder.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended."
The `mh-junk-program' option specifies the spam program in use."
(interactive (list (mh-interactive-range "Whitelist")))
(let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
(unless whitelist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
(message (format "Whitelisting message %d..." msg))
(funcall (symbol-function whitelist-func) msg)
(message (format "Whitelisting message %d...done" msg))
(mh-refile-a-msg nil (intern mh-inbox)))
(mh-next-msg)))
;; Bogofilter Interface
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
(defun mh-bogofilter-blacklist (msg)
"Classify MSG as spam.
Tell bogofilter that the message is spam.
Bogofilter is a Bayesian spam filtering program. Get it from your local
distribution or from:
http://bogofilter.sourceforge.net/
You first need to teach bogofilter. This is done by running
bogofilter -n < good-message
on every good message, and
bogofilter -s < spam-message
on every spam message. Most Bayesian filters need 1000 to 5000 of each to
start doing a good job.
To use bogofilter, add the following .procmailrc recipes which you can also
find in the bogofilter man page:
# Bogofilter
:0fw
| bogofilter -u -e -p
:0
* ^X-Bogosity: Yes, tests=bogofilter
$SPAM
Bogofilter continues to feed the messages it classifies back into its
database. Occasionally it misses, and those messages need to be reclassified.
MH-E can do this for you. Use \\[mh-junk-blacklist] to reclassify messges in
your +inbox as spam, and \\[mh-junk-whitelist] to reclassify messages in your
spambox as good messages."
(unless mh-bogofilter-executable
(error "Couldn't find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file 0 nil "-Ns")))
(defun mh-bogofilter-whitelist (msg)
"Reinstate incorrectly filtered MSG.
Train bogofilter to think of the message as non-spam."
(unless mh-bogofilter-executable
(error "Couldn't find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file 0 nil "-Sn")))
;; Spamprobe Interface
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
(defun mh-spamprobe-blacklist (msg)
"Classify MSG as spam.
Tell spamprobe that the message is spam.
Spamprobe is a Bayesian spam filtering program. More info about the program can
be found at:
http://spamprobe.sourceforge.net
Here is a procmail recipe to stores incoming spam mail into the folder +spam
and good mail in /home/user/Mail/mdrop/mbox. This recipe is provided as an
example in the spamprobe man page.
PATH=/bin:/usr/bin:/usr/local/bin
DEFAULT=/home/user/Mail/mdrop/mbox
SPAM=/home/user/Mail/spam/.
# Spamprobe filtering
:0
SCORE=| spamprobe receive
:0 wf
| formail -I \"X-SpamProbe: $SCORE\"
:0 a:
*^X-SpamProbe: SPAM
$SPAM
Occasionally some good mail gets misclassified as spam. You can use
\\[mh-junk-whitelist] to reclassify that as good mail."
(unless mh-spamprobe-executable
(error "Couldn't find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file 0 nil "spam")))
(defun mh-spamprobe-whitelist (msg)
"Reinstate incorrectly filtered MSG.
Train spamprobe to think of the message as non-spam."
(unless mh-spamprobe-executable
(error "Couldn't find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file 0 nil "good")))
;; Spamassassin Interface
(defvar mh-spamassassin-executable (executable-find "spamassassin"))
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
(defun mh-spamassassin-blacklist (msg)
"Blacklist MSG.
This is done by sending the message to Razor and by appending the sender to
~/.spamassassin/user_prefs in a blacklist_from rule. If sa-learn is available,
the message is also recategorized as spam.
"Blacklist MSG with SpamAssassin.
Spamassassin is an excellent spam filter. For more information, see:
http://spamassassin.org/.
SpamAssassin is one of the more popular spam filtering programs. Get it from
your local distribution or from http://spamassassin.org/.
I ran \"spamassassin -t\" on every mail message in my archive and ran an
analysis in Gnumeric to find that the standard deviation of good mail
scored under 5 (coincidentally, the spamassassin default for \"spam\").
To use SpamAssassin, add the following recipes to `.procmailrc':
Furthermore, I observed that there weren't any messages with a score of 8
or more that were interesting, so I added a couple of points to be
conservative and send any message with a score of 10 or more down the
drain. You might want to use a score of 12 or 13 to be really conservative.
I have found that this really decreases the amount of junk to review.
MAILDIR=$HOME/`mhparam Path`
Messages with a score of 5-9 are set aside for later review. The major
weakness of rules-based filters is a plethora of false positives\; I catch one
or two legitimate messages in here a week, so it is worthwhile to check.
# Fight spam with SpamAssassin.
:0fw
| spamc
You might choose to do this analysis yourself to pick a good score for
deleting spam sight unseen, or you might pick a score out of a hat, or you
might choose to be very conservative and not delete any messages at all.
# Anything with a spam level of 10 or more is junked immediately.
:0:
* ^X-Spam-Level: ..........
/dev/null
Based upon this discussion, here is what the associated ~/.procmailrc
entries look like. These rules appear before my list filters so that spam
sent to mailing lists gets pruned too.
:0:
* ^X-Spam-Status: Yes
spam/.
#
# Spam
#
:0fw
| spamc
If you don't use `spamc', use `spamassassin -P -a'.
# Anything with a spam level of 10 or more is junked immediately.
:0:
* ^X-Spam-Level: ..........
/dev/null
Note that one of the recipes above throws away messages with a score greater
than or equal to 10. Here's how you can determine a value that works best for
you.
:0
* ^X-Spam-Status: Yes
$SPAM
First, run `spamassassin -t' on every mail message in your archive and use
Gnumeric to verify that the average plus the standard deviation of good mail
is under 5, the SpamAssassin default for \"spam\".
If you don't use \"spamc\", use \"spamassassin -P -a\".
Using Gnumeric, sort the messages by score and view the messages with the
highest score. Determine the score which encompasses all of your interesting
messages and add a couple of points to be conservative. Add that many dots to
the `X-Spam-Level:' header field above to send messages with that score down
the drain.
A handful of spam does find its way into +inbox. In this case, use
\\[mh-junk-blacklist] to add a \"blacklist_from\" line to
~/spamassassin/user_prefs, delete the message, and send the message to the
Razor, so that others might not see this spam.
In the example above, messages with a score of 5-9 are set aside in the
`+spam' folder for later review. The major weakness of rules-based filters is
a plethora of false positives so it is worthwhile to check.
Over time, you see some patterns in the blacklisted addresses and can
replace several lines with wildcards. For example, it is clear that High
Speed Media is the biggest bunch of jerks on the Net. Here are some of the
entries I have for them, and the list continues to grow.
If SpamAssassin classifies a message incorrectly, or is unsure, you can use
the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist].
blacklist_from *@*-hsm-*.com
blacklist_from *@*182*643*.com
blacklist_from *@*antarhsm*.com
blacklist_from *@*h*speed*
blacklist_from *@*hsm*182*.com
blacklist_from *@*hsm*643*.com
blacklist_from *@*hsmridi2983cslt227.com
blacklist_from *@*list*hsm*.com
blacklist_from *@h*s*media*
blacklist_from *@hsmdrct.com
blacklist_from *@hsmridi2983csltsite.com
The \\[mh-junk-blacklist] command adds a `blacklist_from' entry to
`~/spamassassin/user_prefs', deletes the message, and sends the message to the
Razor, so that others might not see this spam. If the `sa-learn' command is
available, the message is also recategorized as spam.
The function `mh-spamassassin-identify-spammers' is provided that shows the
frequency counts of the host and domain names in your blacklist_from
entries. This can be helpful when editing the blacklist_from entries.
The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
message is also recategorized as ham.
In versions of spamassassin (2.50 and on) that support a Bayesian classifier,
\\[mh-junk-blacklist] uses the sa-learn program to recategorize the message as
spam. Neither MH-E, nor spamassassin, rebuilds the database after adding
words, so you will need to run \"sa-learn --rebuild\" periodically. This can
be done by adding the following to your crontab:
Over time, you'll observe that the same host or domain occurs repeatedly in
the `blacklist_from' entries, so you might think that you could avoid future
spam by blacklisting all mail from a particular domain. The utility function
`mh-spamassassin-identify-spammers' helps you do precisely that. This function
displays a frequency count of the hosts and domains in the `blacklist_from'
entries from the last blank line in `~/.spamassassin/user_prefs' to the end of
the file. This information can be used so that you can replace multiple
`blacklist_from' entries with a single wildcard entry such as:
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
blacklist_from *@*amazingoffersdirect2u.com
In versions of SpamAssassin (2.50 and on) that support a Bayesian classifier,
\\[mh-junk-blacklist] uses the `sa-learn' program to recategorize the message
as spam. Neither MH-E, nor SpamAssassin, rebuilds the database after adding
words, so you will need to run `sa-learn --rebuild' periodically. This can be
done by adding the following to your crontab:
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
(unless mh-spamassassin-executable
(error "Couldn't find the spamassassin executable"))
(error "Unable to find the spamassassin executable"))
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
(save-excursion
(message "Giving this message the Razor...")
(message (format "Reporting message %d..." msg))
(mh-truncate-log-buffer)
(call-process mh-spamassassin-executable msg-file mh-log-buffer nil
"--report" "--remove-from-whitelist")
;;"--report" "--remove-from-whitelist"
"-r" "-R") ; spamassassin V2.20
(when mh-sa-learn-executable
(message "Recategorizing this message as spam...")
(call-process mh-sa-learn-executable msg-file mh-log-buffer nil
"--single" "--spam" "--local" "--no-rebuild"))
(message "Blacklisting address...")
(message (format "Blacklisting message %d..." msg))
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs) nil t nil
(call-process (expand-file-name mh-scan-prog mh-progs) mh-junk-background
t nil
(format "%s" msg) current-folder
"-format" "%<(mymbox{from})%|%(addr{from})%>")
(goto-char (point-min))
@ -308,15 +200,19 @@ be done by adding the following to your crontab:
(progn
(setq sender (match-string 0))
(mh-spamassassin-add-rule "blacklist_from" sender)
(message "Blacklisting address...done"))
(message "Blacklisting address...not done (from my address)")))))
(message (format "Blacklisting message %d...done" msg)))
(message (format "Blacklisting message %d...not done (from my address)" msg))))))
(defun mh-spamassassin-whitelist (msg)
"Whitelist MSG.
Add a whitelist_from rule to the ~/.spamassassin/user_prefs file. If sa-learn
is available, then the message is recategorized as ham."
"Whitelist MSG with SpamAssassin.
The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
message is also recategorized as ham.
See `mh-spamassassin-blacklist' for more information."
(unless mh-spamassassin-executable
(error "Couldn't find the spamassassin executable"))
(error "Unable to find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
(show-buffer (get-buffer mh-show-buffer))
from)
@ -325,7 +221,8 @@ is available, then the message is recategorized as ham."
(erase-buffer)
(message "Removing spamassassin markup from message...")
(call-process mh-spamassassin-executable msg-file mh-temp-buffer nil
"--remove-markup")
;; "--remove-markup"
"-d") ; spamassassin V2.20
(if show-buffer
(kill-buffer show-buffer))
(write-file msg-file)
@ -333,15 +230,17 @@ is available, then the message is recategorized as ham."
(message "Recategorizing this message as ham...")
(call-process mh-sa-learn-executable msg-file mh-temp-buffer nil
"--single" "--ham" "--local --no-rebuild"))
(message "Whitelisting address...")
(setq from (car (ietf-drums-parse-address (mh-get-header-field "From:"))))
(message (format "Whitelisting message %d..." msg))
(setq from
(car (mh-funcall-if-exists
ietf-drums-parse-address (mh-get-header-field "From:"))))
(kill-buffer nil)
(unless (equal from "")
(unless (or (null from) (equal from ""))
(mh-spamassassin-add-rule "whitelist_from" from))
(message "Whitelisting address...done"))))
(message (format "Whitelisting message %d...done" msg)))))
(defun mh-spamassassin-add-rule (rule body)
"Add a new rule to ~/.spamassassin/user_prefs.
"Add a new rule to `~/.spamassassin/user_prefs'.
The name of the rule is RULE and its body is BODY."
(save-window-excursion
(let* ((line (format "%s\t%s\n" rule body))
@ -358,15 +257,15 @@ The name of the rule is RULE and its body is BODY."
(kill-buffer nil)))))
(defun mh-spamassassin-identify-spammers ()
"Identifies spammers who are repeat offenders.
"Identify spammers who are repeat offenders.
For each blacklist_from entry from the last blank line of
~/.spamassassin/user_prefs to the end of the file, a list of host and domain
names along with their frequency counts is displayed. This information can be
used to replace multiple blacklist_from entries with a single wildcard entry
such as:
This function displays a frequency count of the hosts and domains in the
`blacklist_from' entries from the last blank line in
`~/.spamassassin/user_prefs' to the end of the file. This information can be
used so that you can replace multiple `blacklist_from' entries with a single
wildcard entry such as:
blacklist_from *@*amazingoffersdirect2u.com"
blacklist_from *@*amazingoffersdirect2u.com"
(interactive)
(let* ((file (expand-file-name "~/.spamassassin/user_prefs"))
(domains (make-hash-table :test 'equal)))
@ -385,7 +284,7 @@ such as:
;; Add counts for each host and domain part.
(while host
(setq value (gethash (car host) domains))
(puthash (car host) (1+ (if (not value) 0 value)) domains)
(setf (gethash (car host) domains) (1+ (if (not value) 0 value)))
(setq host (cdr host))))))
;; Output
@ -400,6 +299,121 @@ such as:
(reverse-region (point-min) (point-max))
(goto-char (point-min))))
;; Bogofilter Interface
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
(defun mh-bogofilter-blacklist (msg)
"Blacklist MSG with Bogofilter.
Bogofilter is a Bayesian spam filtering program. Get it from your local
distribution or from http://bogofilter.sourceforge.net/.
Bogofilter is taught by running:
bogofilter -n < good-message
on every good message, and
bogofilter -s < spam-message
on every spam message. This is called a full training; three other
training methods are described in the FAQ that is distributed with bogofilter.
Note that most Bayesian filters need 1000 to 5000 of each type of message to
start doing a good job.
To use Bogofilter, add the following recipes to `.procmailrc':
MAILDIR=$HOME/`mhparam Path`
# Fight spam with Bogofilter.
:0fw
| bogofilter -3 -e -p
:0:
* ^X-Bogosity: Yes, tests=bogofilter
spam/.
:0:
* ^X-Bogosity: Unsure, tests=bogofilter
spam/unsure/.
If Bogofilter classifies a message incorrectly, or is unsure, you can use the
MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update
Bogofilter's training.
The \"Bogofilter FAQ\" suggests that you run the following
occasionally to shrink the database:
bogoutil -d wordlist.db | bogoutil -l wordlist.db.new
mv wordlist.db wordlist.db.prv
mv wordlist.db.new wordlist.db
The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file mh-junk-background
nil "-s")))
(defun mh-bogofilter-whitelist (msg)
"Whitelist MSG with Bogofilter.
See `mh-bogofilter-blacklist' for more information."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-bogofilter-executable msg-file mh-junk-background
nil "-n")))
;; Spamprobe Interface
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
(defun mh-spamprobe-blacklist (msg)
"Blacklist MSG with SpamProbe.
SpamProbe is a Bayesian spam filtering program. Get it from your local
distribution or from http://spamprobe.sourceforge.net.
To use SpamProbe, add the following recipes to `.procmailrc':
MAILDIR=$HOME/`mhparam Path`
# Fight spam with SpamProbe.
:0
SCORE=| spamprobe receive
:0 wf
| formail -I \"X-SpamProbe: $SCORE\"
:0:
*^X-SpamProbe: SPAM
spam/.
If SpamProbe classifies a message incorrectly, you can use the MH-E commands
\\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update SpamProbe's
training."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file mh-junk-background
nil "spam")))
(defun mh-spamprobe-whitelist (msg)
"Whitelist MSG with SpamProbe.
See `mh-spamprobe-blacklist' for more information."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(call-process mh-spamprobe-executable msg-file mh-junk-background
nil "good")))
(provide 'mh-junk)
;;; Local Variables:

513
lisp/mh-e/mh-loaddefs.el
View file

@ -11,22 +11,24 @@
;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft
;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields
;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
;;;;;; (16625 53169))
;;;;;; mh-get-header-field mh-send-other-window mh-send mh-reply
;;;;;; mh-redistribute mh-forward mh-extract-rejected-mail mh-edit-again)
;;;;;; "mh-comp" "mh-comp.el" (16665 55172))
;;; Generated autoloads from mh-comp.el
(autoload (quote mh-edit-again) "mh-comp" "\
Clean up a draft or a message MSG previously sent and make it resendable.
Default is the current message.
The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
See also documentation for `\\[mh-send]' function." t nil)
See also `mh-send'." t nil)
(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
Extract message MSG returned by the mail system and make it resendable.
Default is the current message. The variable `mh-new-draft-cleaned-headers'
gives the headers to clean out of the original message.
See also documentation for `\\[mh-send]' function." t nil)
See also `mh-send'." t nil)
(autoload (quote mh-forward) "mh-comp" "\
Forward messages to the recipients TO and CC.
@ -36,7 +38,7 @@ Default is the displayed message.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function." t nil)
See also `mh-send'." t nil)
(autoload (quote mh-redistribute) "mh-comp" "\
Redistribute displayed message to recipients TO and CC.
@ -55,11 +57,12 @@ to reply to:
If optional prefix argument INCLUDEP provided, then include the message
in the reply using filter `mhl.reply' in your MH directory.
If the file named by `mh-repl-formfile' exists, it is used as a skeleton
for the reply. See also documentation for `\\[mh-send]' function." t nil)
for the reply.
See also `mh-send'." t nil)
(autoload (quote mh-send) "mh-comp" "\
Compose and send a letter.
Do not call this function from outside MH-E; use \\[mh-smail] instead.
The file named by `mh-comp-formfile' will be used as the form.
@ -70,7 +73,6 @@ passed three arguments: TO, CC, and SUBJECT." t nil)
(autoload (quote mh-send-other-window) "mh-comp" "\
Compose and send a letter in another window.
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
instead.
@ -80,6 +82,11 @@ details.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT." t nil)
(autoload (quote mh-get-header-field) "mh-comp" "\
Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
current buffer." nil nil)
(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
Fill paragraph at or after point.
Prefix ARG means justify as well. This function enables `fill-paragraph' to
@ -96,9 +103,12 @@ Insert an Fcc: FOLDER field in the current message.
Prompt for the field name with a completion list of the current folders." t nil)
(autoload (quote mh-insert-signature) "mh-comp" "\
Insert the file named by `mh-signature-file-name' at point.
Insert the signature specified by `mh-signature-file-name' or FILE at point.
A signature separator (`-- ') will be added if the signature block does not
contain one and `mh-signature-separator-flag' is on.
The value of `mh-letter-insert-signature-hook' is a list of functions to be
called, with no arguments, before the signature is actually inserted." t nil)
called, with no arguments, after the signature is inserted.
The signature can also be inserted with `mh-identity-list'." t nil)
(autoload (quote mh-check-whom) "mh-comp" "\
Verify recipients of the current letter, showing expansion of any aliases." t nil)
@ -109,7 +119,9 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually." t nil)
An `identity' entry is skipped if one was already entered manually.
Return t if fields added; otherwise return nil." t nil)
(autoload (quote mh-send-letter) "mh-comp" "\
Send the draft letter in the current buffer.
@ -117,13 +129,12 @@ If optional prefix argument ARG is provided, monitor delivery.
The value of `mh-before-send-letter-hook' is a list of functions to be called,
with no arguments, before doing anything.
Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise
run `\\[mh-mml-to-mime]' if mml directives are present.
Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
run `\\[mh-mml-to-mime]' if mml directives are present." t nil)
(autoload (quote mh-insert-letter) "mh-comp" "\
Insert a message into the current letter.
Removes the header fields according to the variable `mh-invisible-headers'.
Removes the header fields according to the variable
`mh-invisible-header-fields-compiled'.
Prefixes each non-blank line with `mh-ins-buf-prefix', unless
`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
used to format the message.
@ -166,44 +177,13 @@ In the message header, go to the next field. Elsewhere call
Cycle to the previous header field.
If we are at the first header field go to the start of the message body." t nil)
;;;***
;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
;;;;;; (16625 53481))
;;; Generated autoloads from mh-customize.el
(autoload (quote mh-customize) "mh-customize" "\
Customize MH-E variables.
With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
are removed." t nil)
;;;***
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
;;;;;; "mh-e" "mh-e.el" (16627 22341))
;;; Generated autoloads from mh-e.el
(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
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." nil nil)
(autoload (quote mh-update-sequences) "mh-e" "\
Update MH's Unseen-Sequence and current folder and message.
Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
(autoload (quote mh-goto-cur-msg) "mh-e" "\
Position the cursor at the current message.
When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
recenter the folder buffer." nil nil)
;;;***
;;;### (autoloads (mh-prefix-help mh-help mh-ephem-message mh-store-buffer
;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-page-digest-backwards
;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
;;;;;; (16625 54011))
;;;;;; (16671 49652))
;;; Generated autoloads from mh-funcs.el
(autoload (quote mh-burst-digest) "mh-funcs" "\
@ -245,15 +225,6 @@ Advance displayed message to next digested message." t nil)
(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
Back up displayed message to previous digested message." t nil)
(autoload (quote mh-print-msg) "mh-funcs" "\
Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
(autoload (quote mh-sort-folder) "mh-funcs" "\
Sort the messages in the current folder by date.
Calls the MH program sortm to do the work.
@ -261,8 +232,7 @@ The arguments in the list `mh-sortm-args' are passed to sortm if the optional
argument EXTRA-ARGS is given." t nil)
(autoload (quote mh-undo-folder) "mh-funcs" "\
Undo all pending deletes and refiles in current folder.
Argument IGNORE is deprecated." t nil)
Undo all pending deletes and refiles in current folder." t nil)
(autoload (quote mh-store-msg) "mh-funcs" "\
Store the file(s) contained in the current message into DIRECTORY.
@ -280,19 +250,24 @@ Default directory is the last directory used, or initially the value of
Display STRING in the minibuffer momentarily." nil nil)
(autoload (quote mh-help) "mh-funcs" "\
Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
Display cheat sheet for the MH-E commands." t nil)
(autoload (quote mh-prefix-help) "mh-funcs" "\
Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
;;;***
;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
;;;;;; "mh-identity" "mh-identity.el" (16625 54171))
;;;### (autoloads (mh-identity-handler-bottom mh-identity-handler-top
;;;;;; mh-identity-insert-attribution-verb mh-identity-handler-attribution-verb
;;;;;; mh-identity-handler-signature mh-identity-handler-gpg-identity
;;;;;; mh-insert-identity mh-identity-list-set mh-identity-make-menu)
;;;;;; "mh-identity" "mh-identity.el" (16665 55172))
;;; Generated autoloads from mh-identity.el
(autoload (quote mh-identity-make-menu) "mh-identity" "\
Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
Build the Identity menu.
This should be called any time `mh-identity-list' or `mh-auto-fields-list'
change." nil nil)
(autoload (quote mh-identity-list-set) "mh-identity" "\
Update the `mh-identity-list' variable, and rebuild the menu.
@ -304,10 +279,35 @@ customization). This is called after 'customize is used to alter
Insert proper fields for given IDENTITY.
Edit the `mh-identity-list' variable to define identity." t nil)
(autoload (quote mh-identity-handler-gpg-identity) "mh-identity" "\
For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
when action 'add is selected." nil nil)
(autoload (quote mh-identity-handler-signature) "mh-identity" "\
For FIELD \"signature\", process headers for ACTION 'remove or 'add.
The VALUE is added." nil nil)
(autoload (quote mh-identity-handler-attribution-verb) "mh-identity" "\
For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
The VALUE is added." nil nil)
(autoload (quote mh-identity-insert-attribution-verb) "mh-identity" "\
Insert VALUE as attribution verb, setting up delimiting markers.
If VALUE is nil, use `mh-extract-from-attribution-verb'." nil nil)
(autoload (quote mh-identity-handler-top) "mh-identity" "\
For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the top of the header." nil nil)
(autoload (quote mh-identity-handler-bottom) "mh-identity" "\
For FIELD, process mh-identity headers for ACTION 'remove or 'add.
If the field wasn't present, the VALUE is added at the bottom of the header." nil nil)
;;;***
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625
;;;;;; 54212))
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16671
;;;;;; 49652))
;;; Generated autoloads from mh-inc.el
(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
@ -319,14 +319,14 @@ This is called after 'customize is used to alter `mh-inc-spool-list'." nil nil)
;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search
;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages
;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence
;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder
;;;;;; mh-index-sequenced-messages mh-index-delete-from-sequence
;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-visit-folder
;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-create-imenu-index
;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder
;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p
;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences
;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el"
;;;;;; (16625 54348))
;;;;;; (16665 55172))
;;; Generated autoloads from mh-index.el
(autoload (quote mh-index-update-maps) "mh-index" "\
@ -367,7 +367,6 @@ index for each program:
- `mh-swish-execute-search'
- `mh-mairix-execute-search'
- `mh-namazu-execute-search'
- `mh-glimpse-execute-search'
If none of these programs are present then we use pick. If desired grep can be
used instead. Details about these methods can be found in:
@ -411,6 +410,9 @@ Jump to the previous folder marker." t nil)
(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
Annotate the search results with original folder names." nil nil)
(autoload (quote mh-index-create-imenu-index) "mh-index" "\
Create alist of folder names and positions in index folder buffers." nil nil)
(autoload (quote mh-index-group-by-folder) "mh-index" "\
Partition the messages based on source folder.
Returns an alist with the the folder names in the car and the cdr being the
@ -422,10 +424,6 @@ Delete the folder headers." nil nil)
(autoload (quote mh-index-visit-folder) "mh-index" "\
Visit original folder from where the message at point was found." t nil)
(autoload (quote mh-index-update-unseen) "mh-index" "\
Remove counterpart of MSG in source folder from `mh-unseen-seq'.
Also `mh-update-unseen' is called in the original folder, if we have it open." nil nil)
(autoload (quote mh-index-execute-commands) "mh-index" "\
Delete/refile the actual messages.
The copies in the searched folder are then deleted/refiled to get the desired
@ -442,62 +440,25 @@ Delete from SEQ the messages in MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if present." nil nil)
(autoload (quote mh-glimpse-execute-search) "mh-index" "\
Execute glimpse and read the results.
In the examples below, replace /home/user/Mail with the path to your MH
directory.
First create the directory /home/user/Mail/.glimpse. Then create the file
/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
*/.*
*/#*
*/,*
*/*~
^/home/user/Mail/.glimpse
^/home/user/Mail/mhe-index
If there are any directories you would like to ignore, append lines like the
following to .glimpse_exclude:
^/home/user/Mail/scripts
You do not want to index the folders that hold the results of your searches
since they tend to be ephemeral and the original messages are indexed anyway.
The configuration file above assumes that the results are found in sub-folders
of `mh-index-folder' which is +mhe-index by default.
Use the following command line to generate the glimpse index. Run this
daily from cron:
glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
(autoload (quote mh-index-sequenced-messages) "mh-index" "\
Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use." t nil)
All messages in the sequence you provide from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of folders, or nothing to search all folders." t nil)
(autoload (quote mh-index-new-messages) "mh-index" "\
Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
If you use a program such as `procmail' to use `rcvstore' to file your
incoming mail automatically, you can display new, unseen, messages using this
command. All messages in the `unseen' sequence from the folders in
`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders." t nil)
(autoload (quote mh-index-ticked-messages) "mh-index" "\
Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
All messages in `mh-tick-seq' from the folders in
`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
space-separated list of FOLDERS, or nothing to search all folders." t nil)
(autoload (quote mh-swish-execute-search) "mh-index" "\
Execute swish-e and read the results.
@ -618,56 +579,71 @@ The side-effects of this function are that the variables `mh-indexer',
set according to the first indexer in `mh-indexer-choices' present on the
system." nil nil)
;;;***
;;;### (autoloads (mh-variants mh-variant-p mh-variant-set) "mh-init"
;;;;;; "mh-init.el" (16671 49652))
;;; Generated autoloads from mh-init.el
(autoload (quote mh-variant-set) "mh-init" "\
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." t nil)
(autoload (quote mh-variant-p) "mh-init" "\
Return t if variant is any of VARIANTS.
Currently known variants are 'mh and 'nmh." nil nil)
(autoload (quote mh-variants) "mh-init" "\
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'." nil nil)
;;;***
;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
;;;;;; "mh-junk.el" (16625 54386))
;;;;;; "mh-junk.el" (16671 49652))
;;; Generated autoloads from mh-junk.el
(autoload (quote mh-junk-blacklist) "mh-junk" "\
Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command trains the spam program in use (see the `mh-junk-program' option)
with the content of the range (see `mh-interactive-range') and then handles
the message(s) as specified by the `mh-junk-disposition' option.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
refiled to that folder. If nil, the message is deleted.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended.
The documentation for the following functions describes what setup is needed
for the different spam fighting programs:
For more information about using your particular spam fighting program, see:
- `mh-spamassassin-blacklist'
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'" t nil)
- `mh-spamprobe-blacklist'" t nil)
(autoload (quote mh-junk-whitelist) "mh-junk" "\
Whitelist RANGE incorrectly classified as spam.
Whitelist RANGE as ham.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
This command reclassifies a range of messages (see `mh-interactive-range') as
ham if it were incorrectly classified as spam. It then refiles the message
into the `+inbox' folder.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
To change the spam program being used, customize `mh-junk-program'. Directly
setting `mh-junk-choice' is not recommended." t nil)
The `mh-junk-program' option specifies the spam program in use." t nil)
;;;***
;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
;;;;;; mh-press-button mh-mime-display mh-decode-message-header
;;;;;; mh-mime-save-parts mh-display-emphasis mh-display-smileys
;;;;;; mh-add-missing-mime-version-header mh-destroy-postponed-handles
;;;;;; mh-mime-cleanup mh-mml-directive-present-p mh-mml-secure-message-encrypt-pgpmime
;;;;;; mh-mml-secure-message-sign-pgpmime mh-mml-attach-file mh-mml-forward-message
;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit
;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523))
;;;### (autoloads (mh-display-with-external-viewer mh-mime-inline-part
;;;;;; mh-mime-save-part mh-push-button mh-press-button mh-mime-display
;;;;;; mh-decode-message-header mh-mime-save-parts mh-display-emphasis
;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
;;;;;; mh-mime-cleanup mh-mml-directive-present-p mh-mml-secure-message-signencrypt
;;;;;; mh-mml-secure-message-encrypt mh-mml-secure-message-sign
;;;;;; mh-mml-unsecure-message mh-mml-attach-file mh-mml-query-cryptographic-method
;;;;;; mh-mml-forward-message mh-mml-to-mime mh-mhn-directive-present-p
;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-type
;;;;;; mh-mhn-compose-external-compressed-tar mh-mhn-compose-anon-ftp
;;;;;; mh-mhn-compose-insertion mh-file-mime-type mh-have-file-command
;;;;;; mh-compose-forward mh-compose-insertion) "mh-mime" "mh-mime.el"
;;;;;; (16665 55171))
;;; Generated autoloads from mh-mime.el
(autoload (quote mh-compose-insertion) "mh-mime" "\
@ -686,6 +662,14 @@ come.
Optional argument MESSAGE is the message to forward.
If any of the optional arguments are absent, they are prompted for." t nil)
(autoload (quote mh-have-file-command) "mh-mime" "\
Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion." nil nil)
(autoload (quote mh-file-mime-type) "mh-mime" "\
Return MIME type of FILENAME from file command.
Returns nil if file command not on system." nil nil)
(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
Add a directive to insert a MIME message part from a file.
This is the typical way to insert non-text parts in a message.
@ -718,6 +702,18 @@ DESCRIPTION, a line of text for the Content-description header.
See also \\[mh-edit-mhn]." t nil)
(autoload (quote mh-mhn-compose-external-type) "mh-mime" "\
Add a directive to include a MIME reference to a remote file.
The file should be available via anonymous ftp. This directive tells MH to
include a reference to a message/external-body part.
Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
file and TYPE which is the MIME Content-Type. Optional arguments include
DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.
See also \\[mh-edit-mhn]." t nil)
(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
Add a forw directive to this message, to forward a message with MIME.
This directive tells MH to include the named messages in this one.
@ -758,7 +754,9 @@ Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
(autoload (quote mh-mhn-directive-present-p) "mh-mime" "\
Check if the current buffer has text which might be a MHN directive." nil nil)
Check if the text between BEGIN and END might be a MHN directive.
The optional argument BEGIN defaults to the beginning of the buffer, while END
defaults to the the end of the buffer." nil nil)
(autoload (quote mh-mml-to-mime) "mh-mime" "\
Compose MIME message from mml directives.
@ -770,6 +768,9 @@ Forward a message as attachment.
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
number." nil nil)
(autoload (quote mh-mml-query-cryptographic-method) "mh-mime" "\
Read the cryptographic method to use." nil nil)
(autoload (quote mh-mml-attach-file) "mh-mime" "\
Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
@ -781,12 +782,18 @@ This is basically `mml-attach-file' from gnus, modified such that a prefix
argument yields an `inline' disposition and Content-Type is determined
automatically." nil nil)
(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
Add directive to encrypt/sign the entire message." t nil)
(autoload (quote mh-mml-unsecure-message) "mh-mime" "\
Remove any secure message directives.
The IGNORE argument is not used." t nil)
(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
Add directive to encrypt and sign the entire message.
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
(autoload (quote mh-mml-secure-message-sign) "mh-mime" "\
Add security directive to sign the entire message using METHOD." t nil)
(autoload (quote mh-mml-secure-message-encrypt) "mh-mime" "\
Add security directive to encrypt the entire message using METHOD." t nil)
(autoload (quote mh-mml-secure-message-signencrypt) "mh-mime" "\
Add security directive to encrypt and sign the entire message using METHOD." t nil)
(autoload (quote mh-mml-directive-present-p) "mh-mime" "\
Check if the current buffer has text which may be an MML directive." nil nil)
@ -840,10 +847,13 @@ Save MIME part at point." t nil)
(autoload (quote mh-mime-inline-part) "mh-mime" "\
Toggle display of the raw MIME part." t nil)
(autoload (quote mh-display-with-external-viewer) "mh-mime" "\
View MIME PART-INDEX externally." t nil)
;;;***
;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571))
;;;### (autoloads (mh-do-search mh-pick-do-search mh-search-folder)
;;;;;; "mh-pick" "mh-pick.el" (16671 49652))
;;; Generated autoloads from mh-pick.el
(autoload (quote mh-search-folder) "mh-pick" "\
@ -853,13 +863,6 @@ Add the messages found to the sequence named `search'.
Argument WINDOW-CONFIG is the current window configuration and is used when
the search folder is dismissed." t nil)
(autoload (quote mh-do-pick-search) "mh-pick" "\
Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in `mh-searching-folder'.
Add the messages found to the sequence named `search'.
This is a deprecated function and `mh-pick-do-search' should be used instead." t nil)
(autoload (quote mh-pick-do-search) "mh-pick" "\
Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in `mh-searching-folder'.
@ -871,6 +874,50 @@ If \\[mh-search-folder] was used to create the search pattern then pick is used
to search the folder. Otherwise if \\[mh-index-search] was used then the
indexing program specified in `mh-index-program' is used." t nil)
;;;***
;;;### (autoloads (mh-print-msg mh-ps-print-toggle-mime mh-ps-print-toggle-color
;;;;;; mh-ps-print-toggle-faces mh-ps-print-msg-show mh-ps-print-msg-file
;;;;;; mh-ps-print-msg) "mh-print" "mh-print.el" (16671 49652))
;;; Generated autoloads from mh-print.el
(autoload (quote mh-ps-print-msg) "mh-print" "\
Print the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-ps-print-msg-file) "mh-print" "\
Print to FILE the messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-ps-print-msg-show) "mh-print" "\
Print current show buffer to FILE." t nil)
(autoload (quote mh-ps-print-toggle-faces) "mh-print" "\
Toggle whether printing is done with faces or not." t nil)
(autoload (quote mh-ps-print-toggle-color) "mh-print" "\
Toggle whether color is used in printing messages." t nil)
(autoload (quote mh-ps-print-toggle-mime) "mh-print" "\
Cycle through available choices on how MIME parts should be printed.
The available settings are:
1. Print only inline MIME parts.
2. Print all MIME parts.
3. Print no MIME parts." t nil)
(autoload (quote mh-print-msg) "mh-print" "\
Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
;;;***
;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile
@ -879,13 +926,12 @@ indexing program specified in `mh-index-program' is used." t nil)
;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc
;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range
;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject
;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list
;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence
;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled
;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625
;;;;;; 54690))
;;;;;; mh-interactive-range mh-range-to-msg-list mh-iterate-on-range
;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur
;;;;;; mh-rename-seq mh-translate-range mh-read-range mh-read-seq-default
;;;;;; mh-notate-deleted-and-refiled mh-widen mh-put-msg-in-seq
;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq)
;;;;;; "mh-seq" "mh-seq.el" (16668 22297))
;;; Generated autoloads from mh-seq.el
(autoload (quote mh-delete-seq) "mh-seq" "\
@ -895,8 +941,9 @@ Delete the SEQUENCE." t nil)
List the sequences defined in the folder being visited." t nil)
(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
Display the sequences that contain MESSAGE.
Default is the displayed message." t nil)
Display the sequences in which the current message appears.
Use a prefix argument to display the sequences in which another MESSAGE
appears." t nil)
(autoload (quote mh-narrow-to-seq) "mh-seq" "\
Restrict display of this folder to just messages in SEQUENCE.
@ -909,10 +956,8 @@ Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-widen) "mh-seq" "\
Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained." t nil)
Restore the previous limit.
If optional prefix argument ALL-FLAG is non-nil, remove all limits." t nil)
(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\
Notate messages marked for deletion or refiling.
@ -965,16 +1010,6 @@ In FOLDER, translate the string EXPR to a list of messages numbers." nil nil)
(autoload (quote mh-rename-seq) "mh-seq" "\
Rename SEQUENCE to have NEW-NAME." t nil)
(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
Invoke the FUNC at each message in the SEQ.
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
passed as arguments to FUNC." nil nil)
(autoload (quote mh-notate-seq) "mh-seq" "\
Mark the scan listing.
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
the line." nil nil)
(autoload (quote mh-notate-cur) "mh-seq" "\
Mark the MH sequence cur.
In addition to notating the current message with `mh-note-cur' the function
@ -1019,37 +1054,44 @@ RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
If DEFAULT non-nil then it is returned.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions." nil nil)
(autoload (quote mh-region-to-msg-list) "mh-seq" "\
Return a list of messages within the region between BEGIN and END." nil nil)
(autoload (quote mh-narrow-to-subject) "mh-seq" "\
Narrow to a sequence containing all following messages with same subject." t nil)
Limit to messages with same subject.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-from) "mh-seq" "\
Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `From:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-cc) "mh-seq" "\
Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `Cc:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-to) "mh-seq" "\
Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
Limit to messages with the same `To:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-narrow-to-range) "mh-seq" "\
Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
interactive use.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-delete-subject) "mh-seq" "\
Mark all following messages with same subject to be deleted.
@ -1103,14 +1145,15 @@ Mark current message and all its children for refiling to FOLDER." t nil)
Toggle tick mark of all messages in RANGE." t nil)
(autoload (quote mh-narrow-to-tick) "mh-seq" "\
Restrict display of this folder to just messages in `mh-tick-seq'.
Limit to messages in `mh-tick-seq'.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
;;;***
;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
;;;;;; "mh-speed" "mh-speed.el" (16625 54721))
;;;;;; "mh-speed" "mh-speed.el" (16665 55171))
;;; Generated autoloads from mh-speed.el
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@ -1143,33 +1186,26 @@ Remove FOLDER from various optimization caches." t nil)
Add FOLDER since it is being created.
The function invalidates the latest ancestor that is present." nil nil)
;;;***
;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
;;;;;; "mh-utils" "mh-utils.el" (16625 54979))
;;; Generated autoloads from mh-utils.el
(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
Find e-mail address around or before point.
Then search backwards to beginning of line for the start of an e-mail
address. If no e-mail address found, return nil." nil nil)
(autoload (quote mh-get-msg-num) "mh-utils" "\
Return the message number of the displayed message.
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
not pointing to a message." nil nil)
;;;***
;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point
;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p
;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-for-from-p
;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias"
;;;;;; "mh-alias.el" (16625 53006))
;;;;;; "mh-alias.el" (16671 49553))
;;; Generated autoloads from mh-alias.el
(autoload (quote mh-alias-reload) "mh-alias" "\
Load MH aliases into `mh-alias-alist'." t nil)
Reload MH aliases.
Since aliases are updated frequently, MH-E will reload aliases automatically
whenever an alias lookup occurs if an alias source (a file listed in your
`Aliasfile:' profile component and your password file if variable
`mh-alias-local-users' is non-nil) has changed. However, you can reload your
aliases manually by calling this command directly.
The value of `mh-alias-reloaded-hook' is a list of functions to be called,
with no arguments, after the aliases have been loaded." t nil)
(autoload (quote mh-alias-reload-maybe) "mh-alias" "\
Load new MH aliases." nil nil)
@ -1186,26 +1222,25 @@ Expand mail alias before point." nil nil)
(autoload (quote mh-alias-address-to-alias) "mh-alias" "\
Return the ADDRESS alias if defined, or nil." nil nil)
(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
Return t is From has no current alias set.
In the exceptional situation where there isn't a From header in the message the
function returns nil." nil nil)
(autoload (quote mh-alias-for-from-p) "mh-alias" "\
Return t if sender's address has a corresponding alias." nil nil)
(autoload (quote mh-alias-add-alias) "mh-alias" "\
*Add ALIAS for ADDRESS in personal alias file.
Prompts for confirmation if the address already has an alias.
If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
This function prompts you for an alias and address. If the alias exists
already, you will have the choice of inserting the new alias before or after
the old alias. In the former case, this alias will be used when sending mail
to this alias. In the latter case, the alias serves as an additional folder
name hint when filing messages." t nil)
(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
*Add ALIAS for ADDRESS in personal alias file.
Prompts for confirmation if the alias is already in use or if the address
already has an alias." t nil)
*Add alias for the sender of the current message." t nil)
(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
Insert an alias for email address under point." t nil)
Insert an alias for address under point." t nil)
(autoload (quote mh-alias-apropos) "mh-alias" "\
Show all aliases that match REGEXP either in name or content." t nil)
Show all aliases or addresses that match REGEXP." t nil)
;;;***

288
lisp/mh-e/mh-mime.el
View file

@ -34,7 +34,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
@ -46,8 +46,7 @@
(autoload 'gnus-eval-format "gnus-spec")
(autoload 'widget-convert-button "wid-edit")
(autoload 'message-options-set-recipient "message")
(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
(autoload 'mml-unsecure-message "mml-sec")
(autoload 'mml-minibuffer-read-file "mml")
(autoload 'mml-minibuffer-read-description "mml")
(autoload 'mml-insert-empty-tag "mml")
@ -82,7 +81,7 @@ If any of the optional arguments are absent, they are prompted for."
(read-string "Forw Content-description: ")
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
(read-string (format "Messages%s: "
(if mh-sent-from-msg
(if (numberp mh-sent-from-msg)
(format " [%d]" mh-sent-from-msg)
"")))))
(if (equal mh-compose-insertion 'gnus)
@ -114,6 +113,7 @@ MH profile.")
;; the variable, so things should work exactly as before.
(defvar mh-have-file-command)
;;;###mh-autoload
(defun mh-have-file-command ()
"Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion."
@ -129,7 +129,8 @@ MH profile.")
(defvar mh-file-mime-type-substitutions
'(("application/msword" "\.xls" "application/ms-excel")
("application/msword" "\.ppt" "application/ms-powerpoint"))
("application/msword" "\.ppt" "application/ms-powerpoint")
("text/plain" "\.vcf" "text/x-vcard"))
"Substitutions to make for Content-Type returned from file command.
The first element is the Content-Type returned by the file command.
The second element is a regexp matching the file name, usually the extension.
@ -151,6 +152,7 @@ Substitutions are made from the `mh-file-mime-type-substitutions' variable."
(setq subst (cdr subst))))
answer))
;;;###mh-autoload
(defun mh-file-mime-type (filename)
"Return MIME type of FILENAME from file command.
Returns nil if file command not on system."
@ -192,12 +194,38 @@ Returns nil if file command not on system."
("message/external-body") ("message/partial") ("message/rfc822")
("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
("text/richtext") ("text/xml")
("text/richtext") ("text/x-vcard") ("text/xml")
("video/mpeg") ("video/quicktime"))
"Legal MIME content types.
See documentation for \\[mh-edit-mhn].")
;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One:
;; Format of Internet Message Bodies.
;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two:
;; Media Types.
;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five:
;; Conformance Criteria and Examples.
;; RFC 2017 - Definition of the URL MIME External-Body Access-Type
;; RFC 1738 - Uniform Resource Locators (URL)
(defvar mh-access-types
'(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol
("file") ; RFC1738 Host-specific file names
("ftp") ; RFC2046 File Transfer Protocol
("gopher") ; RFC1738 The Gopher Protocol
("http") ; RFC1738 Hypertext Transfer Protocol
("local-file") ; RFC2046 Local file access
("mail-server") ; RFC2046 mail-server Electronic mail address
("mailto") ; RFC1738 Electronic mail address
("news") ; RFC1738 Usenet news
("nntp") ; RFC1738 Usenet news using NNTP access
("propspero") ; RFC1738 Prospero Directory Service
("telnet") ; RFC1738 Telnet
("tftp") ; RFC2046 Trivial File Transfer Protocol
("url") ; RFC2017 URL scheme MIME access-type Protocol
("wais")) ; RFC1738 Wide Area Information Servers
"Legal MIME access-type values.")
;;;###mh-autoload
(defun mh-mhn-compose-insertion (filename type description attributes)
"Add a directive to insert a MIME message part from a file.
@ -286,7 +314,7 @@ See also \\[mh-edit-mhn]."
"type=tar; conversions=x-compress"
"mode=image"))
;;;###mh-autoload
(defun mh-mhn-compose-external-type (access-type host filename type
&optional description
attributes extra-params
@ -301,6 +329,18 @@ DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.
See also \\[mh-edit-mhn]."
(interactive (list
(completing-read "Access Type: " mh-access-types)
(read-string "Remote host: ")
(read-string "Remote url-path: ")
(completing-read "Content-Type: "
(if (fboundp 'mailcap-mime-types)
(mapcar 'list (mailcap-mime-types))
mh-mime-content-types))
(if current-prefix-arg (read-string "Content-description: "))
(if current-prefix-arg (read-string "Attributes: "))
(if current-prefix-arg (read-string "Extra Parameters: "))
(if current-prefix-arg (read-string "Comment: "))))
(beginning-of-line)
(insert "#@" type)
(and attributes
@ -314,7 +354,9 @@ See also \\[mh-edit-mhn]."
(insert "access-type=" access-type "; ")
(insert "site=" host)
(insert "; name=" (file-name-nondirectory filename))
(insert "; directory=\"" (file-name-directory filename) "\"")
(let ((directory (file-name-directory filename)))
(and directory
(insert "; directory=\"" directory "\"")))
(and extra-params
(insert "; " extra-params))
(insert "\n"))
@ -332,7 +374,7 @@ See also \\[mh-edit-mhn]."
(read-string "Forw Content-description: ")
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
(read-string (format "Messages%s: "
(if mh-sent-from-msg
(if (numberp mh-sent-from-msg)
(format " [%d]" mh-sent-from-msg)
"")))))
(beginning-of-line)
@ -349,7 +391,7 @@ See also \\[mh-edit-mhn]."
(let ((start (point)))
(insert " " messages)
(subst-char-in-region start (point) ?, ? ))
(if mh-sent-from-msg
(if (numberp mh-sent-from-msg)
(insert " " (int-to-string mh-sent-from-msg))))
(insert "\n"))
@ -380,10 +422,11 @@ arguments, after performing the conversion.
The mhn program is part of MH version 6.8 or later."
(interactive "*P")
(mh-mhn-quote-unescaped-sharp)
(save-buffer)
(message "mhn editing...")
(cond
(mh-nmh-flag
((mh-variant-p 'nmh)
(mh-exec-cmd-error nil
"mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
(t
@ -393,6 +436,19 @@ The mhn program is part of MH version 6.8 or later."
(message "mhn editing...done")
(run-hooks 'mh-edit-mhn-hook))
(defun mh-mhn-quote-unescaped-sharp ()
"Quote `#' characters that haven't been quoted for `mhbuild'.
If the `#' character is present in the first column, but it isn't part of a
MHN directive then `mhbuild' gives an error. This function will quote all such
characters."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^#" nil t)
(beginning-of-line)
(unless (mh-mhn-directive-present-p (point) (line-end-position))
(insert "#"))
(goto-char (line-end-position)))))
;;;###mh-autoload
(defun mh-revert-mhn-edit (noconfirm)
"Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
@ -422,18 +478,24 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
(after-find-file nil)))
;;;###mh-autoload
(defun mh-mhn-directive-present-p ()
"Check if the current buffer has text which might be a MHN directive."
(defun mh-mhn-directive-present-p (&optional begin end)
"Check if the text between BEGIN and END might be a MHN directive.
The optional argument BEGIN defaults to the beginning of the buffer, while END
defaults to the the end of the buffer."
(unless begin (setq begin (point-min)))
(unless end (setq end (point-max)))
(save-excursion
(block 'search-for-mhn-directive
(goto-char (point-min))
(while (re-search-forward "^#" nil t)
(goto-char begin)
(while (re-search-forward "^#" end t)
(let ((s (buffer-substring-no-properties (point) (line-end-position))))
(cond ((equal s ""))
((string-match "^forw[ \t\n]+" s)
(return-from 'search-for-mhn-directive t))
(t (let ((first-token (car (split-string s "[ \t;@]"))))
(when (string-match mh-media-type-regexp first-token)
(when (and first-token
(string-match mh-media-type-regexp
first-token))
(return-from 'search-for-mhn-directive t)))))))
nil)))
@ -450,14 +512,23 @@ function may be called manually before sending the draft as well."
(require 'message)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
(mml-to-mime))
(let ((saved-text (buffer-string))
(buffer (current-buffer))
(modified-flag (buffer-modified-p)))
(condition-case err (mml-to-mime)
(error
(with-current-buffer buffer
(delete-region (point-min) (point-max))
(insert saved-text)
(set-buffer-modified-p modified-flag))
(error (error-message-string err))))))
;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
"Forward a message as attachment.
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
number."
(let ((msg (if (equal message "")
(let ((msg (if (and (equal message "") (numberp mh-sent-from-msg))
mh-sent-from-msg
(car (read-from-string message)))))
(cond ((integerp msg)
@ -473,6 +544,19 @@ number."
description)))
(t (error "The message number, %s is not a integer!" msg)))))
(defvar mh-mml-cryptographic-method-history ())
;;;###mh-autoload
(defun mh-mml-query-cryptographic-method ()
"Read the cryptographic method to use."
(if current-prefix-arg
(let ((def (or (car mh-mml-cryptographic-method-history)
mh-mml-method-default)))
(completing-read (format "Method: [%s] " def)
'(("pgp") ("pgpmime") ("smime"))
nil t nil 'mh-mml-cryptographic-method-history def))
mh-mml-method-default))
;;;###mh-autoload
(defun mh-mml-attach-file (&optional disposition)
"Attach a file to the outgoing MIME message.
@ -499,22 +583,56 @@ automatically."
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
"Add directive to encrypt/sign the entire message."
(interactive)
(defun mh-secure-message (method mode &optional identity)
"Add directive to Encrypt/Sign an entire message.
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
IDENTITY is optionally the default-user-id to use."
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
(mml-secure-message-sign-pgpmime)))
;; Check the arguments
(let ((valid-methods (list "pgpmime" "pgp" "smime"))
(valid-modes (list "sign" "encrypt" "signencrypt" "none")))
(if (not (member method valid-methods))
(error (format "Sorry. METHOD \"%s\" is invalid." method)))
(if (not (member mode valid-modes))
(error (format "Sorry. MODE \"%s\" is invalid" mode)))
(mml-unsecure-message)
(if (not (string= mode "none"))
(save-excursion
(goto-char (point-min))
(mh-goto-header-end 1)
(if mh-identity-pgg-default-user-id
(mml-insert-tag 'secure 'method method 'mode mode
'sender mh-identity-pgg-default-user-id)
(mml-insert-tag 'secure 'method method 'mode mode)))))))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
"Add directive to encrypt and sign the entire message.
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
(defun mh-mml-unsecure-message (&optional ignore)
"Remove any secure message directives.
The IGNORE argument is not used."
(interactive "P")
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
(mml-secure-message-encrypt-pgpmime dontsign)))
(mml-unsecure-message)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign (method)
"Add security directive to sign the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "sign" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt (method)
"Add security directive to encrypt the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-secure-message-signencrypt (method)
"Add security directive to encrypt and sign the entire message using METHOD."
(interactive (list (mh-mml-query-cryptographic-method)))
(mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))
;;;###mh-autoload
(defun mh-mml-directive-present-p ()
@ -667,19 +785,19 @@ actual storing."
(folder (if (eq major-mode 'mh-show-mode)
mh-show-folder-buffer
mh-current-folder))
(command (if mh-nmh-flag "mhstore" "mhn"))
(command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
(directory
(cond
((and (or arg
(equal nil mh-mime-save-parts-default-directory)
(equal t mh-mime-save-parts-default-directory))
(not mh-mime-save-parts-directory))
(read-file-name "Store in what directory? " nil nil t nil))
(read-file-name "Store in directory: " nil nil t nil))
((and (or arg
(equal t mh-mime-save-parts-default-directory))
mh-mime-save-parts-directory)
(read-file-name (format
"Store in what directory? [%s] "
"Store in directory: [%s] "
mh-mime-save-parts-directory)
"" mh-mime-save-parts-directory t ""))
((stringp mh-mime-save-parts-default-directory)
@ -689,7 +807,7 @@ actual storing."
(if (and (equal directory "") mh-mime-save-parts-directory)
(setq directory mh-mime-save-parts-directory))
(if (not (file-directory-p directory))
(message "No directory specified.")
(message "No directory specified")
(if (equal nil mh-mime-save-parts-default-directory)
(setq mh-mime-save-parts-directory directory))
(save-excursion
@ -766,17 +884,18 @@ displayed."
(mh-mime-handles (mh-buffer-data))))
(unless handles (mh-decode-message-body)))
(when (and handles
(or (not (stringp (car handles))) (cdr handles)))
;; Goto start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (goto-char (point-max)))
(cond ((and handles
(or (not (stringp (car handles))) (cdr handles)))
;; Goto start of message body
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (goto-char (point-max)))
;; Delete the body
(delete-region (point) (point-max))
;; Delete the body
(delete-region (point) (point-max))
;; Display the MIME handles
(mh-mime-display-part handles)))
;; Display the MIME handles
(mh-mime-display-part handles))
(t (mh-signature-highlight))))
(error
(message "Please report this error. The error message is:\n %s"
(error-message-string err))
@ -874,7 +993,7 @@ This is only useful if a Content-Disposition header is not present."
(save-restriction
(widen)
(goto-char (point-min))
(not (re-search-forward "^-- $" nil t)))))))
(not (mh-signature-separator-p)))))))
(defun mh-mime-display-single (handle)
"Display a leaf node, HANDLE in the MIME tree."
@ -904,7 +1023,8 @@ This is only useful if a Content-Disposition header is not present."
(insert "\n")
(mh-insert-mime-button handle (mh-mime-part-index handle) nil))
((and displayp (not mh-display-buttons-for-inline-parts-flag))
(or (mm-display-part handle) (mm-display-part handle)))
(or (mm-display-part handle) (mm-display-part handle))
(mh-signature-highlight handle))
((and displayp mh-display-buttons-for-inline-parts-flag)
(insert "\n")
(mh-insert-mime-button handle (mh-mime-part-index handle) nil)
@ -912,6 +1032,28 @@ This is only useful if a Content-Disposition header is not present."
(mh-mm-display-part handle)))
(goto-char (point-max)))))
(defun mh-signature-highlight (&optional handle)
"Highlight message signature in HANDLE.
The optional argument, HANDLE is a MIME handle if the function is being used
to highlight the signature in a MIME part."
(let ((regexp
(cond ((not handle) "^-- $")
((not (and (equal (mm-handle-media-supertype handle) "text")
(equal (mm-handle-media-subtype handle) "html")))
"^-- $")
((eq (mh-mm-text-html-renderer) 'lynx) "^ --$")
(t "^--$"))))
(save-excursion
(goto-char (point-max))
(when (re-search-backward regexp nil t)
(mh-do-in-gnu-emacs
(let ((ov (make-overlay (point) (point-max))))
(overlay-put ov 'face 'mh-show-signature-face)
(overlay-put ov 'evaporate t)))
(mh-do-in-xemacs
(set-extent-property (make-extent (point) (point-max))
'face 'mh-show-signature-face))))))
(mh-do-in-xemacs
(defvar dots)
(defvar type))
@ -954,7 +1096,9 @@ like \"K v\" which operate on individual MIME parts."
:action 'mh-widget-press-button
:button-keymap mh-mime-button-map
:help-echo
"Mouse-2 click or press RET (in show buffer) to toggle display")))
"Mouse-2 click or press RET (in show buffer) to toggle display")
(dolist (ov (mh-funcall-if-exists overlays-in begin end))
(mh-funcall-if-exists overlay-put ov 'evaporate t))))
;; There is a bug in Gnus inline image display due to which an extra line
;; gets inserted every time it is viewed. To work around that problem we are
@ -1009,7 +1153,8 @@ like \"K v\" which operate on individual MIME parts."
(when (eq mh-highlight-citation-p 'gnus)
(mh-gnus-article-highlight-citation))
(mh-display-smileys)
(mh-display-emphasis))
(mh-display-emphasis)
(mh-signature-highlight handle))
(setq region (cons (progn (goto-char (point-min))
(point-marker))
(progn (goto-char (point-max))
@ -1098,6 +1243,31 @@ button."
(goto-char point)
(set-buffer-modified-p nil)))
;;;###mh-autoload
(defun mh-display-with-external-viewer (part-index)
"View MIME PART-INDEX externally."
(interactive "P")
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action
part-index
#'(lambda ()
(let* ((part (get-text-property (point) 'mh-data))
(type (mm-handle-media-type part))
(methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
(mailcap-mime-info type 'all)))
(def (caar methods))
(prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
(method (completing-read prompt methods nil nil nil nil def))
(folder mh-show-folder-buffer)
(buffer-read-only nil))
(when (string-match "^[^% \t]+$" method)
(setq method (concat method " %s")))
(flet ((mm-handle-set-external-undisplayer (handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(unwind-protect (mm-display-external part method)
(set-buffer-modified-p nil)))))
nil))
(defun mh-widget-press-button (widget el)
"Callback for widget, WIDGET.
Parameter EL is unused."
@ -1106,9 +1276,9 @@ Parameter EL is unused."
(defun mh-mime-display-security (handle)
"Display PGP encrypted/signed message, HANDLE."
(insert "\n")
(save-restriction
(narrow-to-region (point) (point))
(insert "\n")
(mh-insert-mime-security-button handle)
(mh-mime-display-mixed (cdr handle))
(insert "\n")
@ -1116,9 +1286,7 @@ Parameter EL is unused."
mh-mime-security-button-end-line-format))
(mh-insert-mime-security-button handle))
(mm-set-handle-multipart-parameter
handle 'mh-region
(cons (set-marker (make-marker) (point-min))
(set-marker (make-marker) (point-max))))))
handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
;;; I rewrote the security part because Gnus doesn't seem to ever minimize
;;; the button. That is once the mime-security button is pressed there seems
@ -1149,8 +1317,22 @@ Parameter EL is unused."
(defun mh-mime-security-press-button (handle)
"Callback from security button for part HANDLE."
(when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)))
(if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)
(let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
point)
(setq point (point))
(goto-char (car region))
(delete-region (car region) (cdr region))
(with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
(let* ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
(unless (eq new (cdr handle))
(mm-destroy-parts (cdr handle))
(setcdr handle new))))
(mh-mime-display-security handle)
(goto-char point))))
;; These variables should already be initialized in mm-decode.el if we have a
;; recent enough Gnus. The defvars are here to avoid compiler warnings.
@ -1191,6 +1373,8 @@ Parameter EL is unused."
:action 'mh-widget-press-button
:button-keymap mh-mime-security-button-map
:help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
(dolist (ov (mh-funcall-if-exists overlays-in begin end))
(mh-funcall-if-exists overlay-put ov 'evaporate t))
(when (equal info "Failed")
(let* ((type (if (equal (car handle) "multipart/signed")
"verification" "decryption"))
@ -1204,8 +1388,8 @@ The function decodes the message and displays it. It avoids decoding the same
message multiple times."
(let ((b (point))
(clean-message-header mh-clean-message-header-flag)
(invisible-headers mh-invisible-headers)
(visible-headers mh-visible-headers))
(invisible-headers mh-invisible-header-fields-compiled)
(visible-headers nil))
(save-excursion
(save-restriction
(narrow-to-region b b)

39
lisp/mh-e/mh-pick.el
View file

@ -1,6 +1,6 @@
;;; mh-pick.el --- make a search pattern and search for a message in MH-E
;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -32,6 +32,8 @@
;;; Code:
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'easymenu)
(require 'gnus-util)
@ -44,6 +46,9 @@
(defvar mh-searching-folder nil) ;Folder this pick is searching.
(defvar mh-searching-function nil)
(defconst mh-pick-single-dash '(cc date from subject to)
"Search components that are supported by single-dash option in pick.")
;;;###mh-autoload
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
@ -138,16 +143,6 @@ with no arguments, upon entry to this mode.
(setq mh-help-messages mh-pick-mode-help-messages)
(run-hooks 'mh-pick-mode-hook))
;;;###mh-autoload
(defun mh-do-pick-search ()
"Find messages that match the qualifications in the current pattern buffer.
Messages are searched for in the folder named in `mh-searching-folder'.
Add the messages found to the sequence named `search'.
This is a deprecated function and `mh-pick-do-search' should be used instead."
(interactive)
(mh-pick-do-search))
;;;###mh-autoload
(defun mh-pick-do-search ()
"Find messages that match the qualifications in the current pattern buffer.
@ -260,6 +255,13 @@ COMPONENT is the component to search."
"-rbrace"))
(t (error "Unknown operator '%s' seen" (car expr)))))
;; All implementations of pick have special options -cc, -date, -from and
;; -subject that allow to search for corresponding components. Any other
;; component is searched using option --COMPNAME, for example: `pick
;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain
;; kludge, but it prefers the following syntax for this purpose:
;; `--component=COMPNAME --pattern=PATTERN'.
;; -- Sergey Poznyakoff, Aug 2003
(defun mh-pick-regexp-builder (pattern-list)
"Generate pick search expression from PATTERN-LIST."
(let ((result ()))
@ -267,9 +269,18 @@ COMPONENT is the component to search."
(when (cdr pattern)
(setq result `(,@result "-and" "-lbrace"
,@(mh-pick-construct-regexp
(cdr pattern) (if (car pattern)
(format "-%s" (car pattern))
"-search"))
(if (and (mh-variant-p 'mu-mh) (car pattern))
(format "--pattern=%s" (cdr pattern))
(cdr pattern))
(if (car pattern)
(cond
((mh-variant-p 'mu-mh)
(format "--component=%s" (car pattern)))
((member (car pattern) mh-pick-single-dash)
(format "-%s" (car pattern)))
(t
(format "--%s" (car pattern))))
"-search"))
"-rbrace"))))
(cdr result)))

214
lisp/mh-e/mh-seq.el
View file

@ -70,7 +70,7 @@
;;; Code:
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
@ -78,15 +78,15 @@
(defvar tool-bar-mode)
;;; Data structures (used in message threading)...
(defstruct (mh-thread-message (:conc-name mh-message-)
(:constructor mh-thread-make-message))
(mh-defstruct (mh-thread-message (:conc-name mh-message-)
(:constructor mh-thread-make-message))
(id nil)
(references ())
(subject "")
(subject-re-p nil))
(defstruct (mh-thread-container (:conc-name mh-container-)
(:constructor mh-thread-make-container))
(mh-defstruct (mh-thread-container (:conc-name mh-container-)
(:constructor mh-thread-make-container))
message parent children
(real-child-p t))
@ -201,12 +201,15 @@ redone to get the new thread tree. This makes incremental threading easier.")
;;;###mh-autoload
(defun mh-msg-is-in-seq (message)
"Display the sequences that contain MESSAGE.
Default is the displayed message."
(interactive (list (mh-get-msg-num t)))
"Display the sequences in which the current message appears.
Use a prefix argument to display the sequences in which another MESSAGE
appears."
(interactive "P")
(if (not message)
(setq message (mh-get-msg-num t)))
(let* ((dest-folder (loop for seq in mh-refile-list
until (member message (cdr seq))
finally return (car seq)))
when (member message (cdr seq)) return (car seq)
finally return nil))
(deleted-flag (unless dest-folder (member message mh-delete-list))))
(message "Message %d%s is in sequences: %s"
message
@ -269,12 +272,11 @@ interactive use."
(let* ((internal-seq-flag (mh-internal-seq sequence))
(original-msgs (mh-seq-msgs (mh-find-seq sequence)))
(folders (list mh-current-folder))
(msg-list ()))
(msg-list (mh-range-to-msg-list range)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(mh-iterate-on-range m range
(push m msg-list)
(unless (memq m original-msgs)
(mh-add-sequence-notation m internal-seq-flag)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(if (not internal-seq-flag)
(setq mh-last-seq-used sequence))
(when mh-index-data
@ -292,10 +294,8 @@ OP is one of 'widen and 'unthread."
;;;###mh-autoload
(defun mh-widen (&optional all-flag)
"Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained."
"Restore the previous limit.
If optional prefix argument ALL-FLAG is non-nil, remove all limits."
(interactive "P")
(let ((msg (mh-get-msg-num nil)))
(when mh-folder-view-stack
@ -532,28 +532,6 @@ should be replaced with:
(mh-undefine-sequence sequence (mh-seq-msgs old-seq))
(rplaca old-seq new-name)))
;;;###mh-autoload
(defun mh-map-to-seq-msgs (func seq &rest args)
"Invoke the FUNC at each message in the SEQ.
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
passed as arguments to FUNC."
(save-excursion
(let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
(while msgs
(if (mh-goto-msg (car msgs) t t)
(apply func (car msgs) args))
(setq msgs (cdr msgs))))))
;;;###mh-autoload
(defun mh-notate-seq (seq notation offset)
"Mark the scan listing.
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
the line."
(let ((msg-list (mh-seq-to-msgs seq)))
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(when (member msg msg-list)
(mh-notate nil notation offset)))))
;;;###mh-autoload
(defun mh-notate-cur ()
"Mark the MH sequence cur.
@ -577,14 +555,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs)))))
;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
;; that the folder buffer is sorted. However in this case that assumption
;; doesn't hold. So we will do this the dumb way.
;(defun mh-copy-seq-to-point (seq location)
; ;; Copy the scan listing of the messages in SEQUENCE to after the point
; ;; LOCATION in the current buffer.
; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
(defvar mh-thread-last-ancestor)
(defun mh-copy-seq-to-eob (seq)
@ -614,21 +584,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
(mh-index-data
(mh-index-insert-folder-headers)))))))
(defun mh-copy-line-to-point (msg location)
"Copy current message line to a specific location.
The argument MSG is not used. The message in the current line is copied to
LOCATION."
;; msg is not used?
;; Copy the current line to the LOCATION in the current buffer.
(beginning-of-line)
(save-excursion
(let ((beginning-of-line (point))
end)
(forward-line 1)
(setq end (point))
(goto-char location)
(insert-buffer-substring (current-buffer) beginning-of-line end))))
;;;###mh-autoload
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
"Iterate over region.
@ -702,7 +657,7 @@ a region in a cons cell."
(nreverse msg-list)))
;;;###mh-autoload
(defun mh-interactive-range (range-prompt)
(defun mh-interactive-range (range-prompt &optional default)
"Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.
@ -715,24 +670,17 @@ RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
If DEFAULT non-nil then it is returned.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions."
(cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
(current-prefix-arg (mh-read-range range-prompt nil nil t t))
(default default)
(t (mh-get-msg-num t))))
;;;###mh-autoload
(defun mh-region-to-msg-list (begin end)
"Return a list of messages within the region between BEGIN and END."
;; If end is end of buffer back up one position
(setq end (if (equal end (point-max)) (1- end) end))
(let ((result))
(mh-iterate-on-messages-in-region index begin end
(when (numberp index) (push index result)))
result))
;;; Commands to handle new 'subject sequence.
@ -772,7 +720,7 @@ Return number of messages put in the sequence:
(if (or (not (looking-at mh-scan-subject-regexp))
(not (match-string 3))
(string-equal "" (match-string 3)))
(progn (message "No subject line.")
(progn (message "No subject line")
nil)
(let ((subject (match-string-no-properties 3))
(list))
@ -835,61 +783,57 @@ This function can only be used the folder is threaded."
(mh-container-message (gethash (gethash msg mh-thread-index-id-map)
mh-thread-id-table)))))
;;;###mh-autoload
(defun mh-narrow-to-subject ()
"Narrow to a sequence containing all following messages with same subject."
(interactive)
(let ((num (mh-get-msg-num nil))
(count (mh-subject-to-sequence t)))
(cond
((not count) ; No subject line, delete msg anyway
nil)
((= 0 count) ; No other msgs, delete msg anyway.
(message "No other messages with same Subject following this one.")
nil)
(t ; We have a subject sequence.
(message "Found %d messages for subject sequence." count)
(mh-narrow-to-seq 'subject)
(if (numberp num)
(mh-goto-msg num t t))))))
(defun mh-read-pick-regexp (default)
"With prefix arg read a pick regexp.
(defun mh-edit-pick-expr (default)
"With prefix arg edit a pick expression.
If no prefix arg is given, then return DEFAULT."
(let ((default-string (loop for x in default concat (format " %s" x))))
(if (or current-prefix-arg (equal default-string ""))
(delete "" (split-string (read-string "Pick regexp: " default-string)))
(delete "" (split-string (read-string "Pick expression: "
default-string)))
default)))
;;;###mh-autoload
(defun mh-narrow-to-from (&optional regexp)
"Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(defun mh-narrow-to-subject (&optional pick-expr)
"Limit to messages with same subject.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
(mh-narrow-to-header-field 'from regexp))
(list (mh-edit-pick-expr (mh-current-message-header-field 'subject))))
(mh-narrow-to-header-field 'subject pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-cc (&optional regexp)
"Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(defun mh-narrow-to-from (&optional pick-expr)
"Limit to messages with the same `From:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
(mh-narrow-to-header-field 'cc regexp))
(list (mh-edit-pick-expr (mh-current-message-header-field 'from))))
(mh-narrow-to-header-field 'from pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-to (&optional regexp)
"Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
(mh-narrow-to-header-field 'to regexp))
(defun mh-narrow-to-cc (&optional pick-expr)
"Limit to messages with the same `Cc:' field.
With a prefix argument, edit PICK-EXPR.
(defun mh-narrow-to-header-field (header-field regexp)
"Limit to messages whose HEADER-FIELD match REGEXP.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-edit-pick-expr (mh-current-message-header-field 'cc))))
(mh-narrow-to-header-field 'cc pick-expr))
;;;###mh-autoload
(defun mh-narrow-to-to (&optional pick-expr)
"Limit to messages with the same `To:' field.
With a prefix argument, edit PICK-EXPR.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive
(list (mh-edit-pick-expr (mh-current-message-header-field 'to))))
(mh-narrow-to-header-field 'to pick-expr))
(defun mh-narrow-to-header-field (header-field pick-expr)
"Limit to messages whose HEADER-FIELD match PICK-EXPR.
The MH command pick is used to do the match."
(let ((folder mh-current-folder)
(original (mh-coalesce-msg-list
@ -897,7 +841,7 @@ The MH command pick is used to do the match."
(msg-list ()))
(with-temp-buffer
(apply #'mh-exec-cmd-output "pick" nil folder
(append original (list "-list") regexp))
(append original (list "-list") pick-expr))
(goto-char (point-min))
(while (not (eobp))
(let ((num (read-from-string
@ -939,7 +883,9 @@ The MH command pick is used to do the match."
"Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
interactive use.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive (list (mh-interactive-range "Narrow to")))
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
@ -958,7 +904,7 @@ subject sequence."
((not count) ; No subject line, delete msg anyway
(mh-delete-msg (mh-get-msg-num t)))
((= 0 count) ; No other msgs, delete msg anyway.
(message "No other messages with same Subject following this one.")
(message "No other messages with same Subject following this one")
(mh-delete-msg (mh-get-msg-num t)))
(t ; We have a subject sequence.
(message "Marked %d messages for deletion" count)
@ -1078,13 +1024,12 @@ SUBJECT and REFS fields."
message)
(container
(setf (mh-container-message container)
(mh-thread-make-message :subject subject
:subject-re-p subject-re-p
:id id :references refs)))
(t (let ((message (mh-thread-make-message
:subject subject
:subject-re-p subject-re-p
:id id :references refs)))
(mh-thread-make-message :id id :references refs
:subject subject
:subject-re-p subject-re-p)))
(t (let ((message (mh-thread-make-message :id id :references refs
:subject-re-p subject-re-p
:subject subject)))
(prog1 message
(mh-thread-get-message-container message)))))))
@ -1450,8 +1395,7 @@ MSG is the message being notated with NOTATION at OFFSET."
(cur-scan-line (and mh-thread-scan-line-map
(gethash msg mh-thread-scan-line-map)))
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack
collect (and map (gethash msg map))))
(notation (if (stringp notation) (aref notation 0) notation)))
collect (and map (gethash msg map)))))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
@ -1486,7 +1430,8 @@ MSG is the message being notated with NOTATION at OFFSET."
(setf (gethash msg mh-thread-scan-line-map) v))))
(when (> (hash-table-count mh-thread-scan-line-map) 0)
(insert (if (bobp) "" "\n") (car x) "\n")
(mh-thread-generate-scan-lines thread-tree -2)))))))
(mh-thread-generate-scan-lines thread-tree -2))))
(mh-index-create-imenu-index))))
(defun mh-thread-folder ()
"Generate thread view of folder."
@ -1711,11 +1656,12 @@ start of the region and the second is the point at the end."
(push msg unticked)
(setcdr tick-seq (delq msg (cdr tick-seq)))
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
(mh-remove-sequence-notation msg t))
(mh-remove-sequence-notation msg (mh-colors-in-use-p)))
(t
(push msg ticked)
(setq mh-last-seq-used mh-tick-seq)
(mh-add-sequence-notation msg t))))
(let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
(mh-add-sequence-notation msg (mh-colors-in-use-p))))))
(mh-add-msgs-to-seq ticked mh-tick-seq nil t)
(mh-undefine-sequence mh-tick-seq unticked)
(when mh-index-data
@ -1724,16 +1670,16 @@ start of the region and the second is the point at the end."
;;;###mh-autoload
(defun mh-narrow-to-tick ()
"Restrict display of this folder to just messages in `mh-tick-seq'.
"Limit to messages in `mh-tick-seq'.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive)
(cond ((not mh-tick-seq)
(error "Enable ticking by customizing `mh-tick-seq'"))
((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
(message "No messages in tick sequence"))
(message "No messages in %s sequence" mh-tick-seq))
(t (mh-narrow-to-seq mh-tick-seq))))
(provide 'mh-seq)
;;; Local Variables:

33
lisp/mh-e/mh-speed.el
View file

@ -34,10 +34,11 @@
;;; Code:
;; Requires
(require 'mh-utils)
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)
(require 'speedbar)
(require 'timer)
;; Global variables
(defvar mh-speed-refresh-flag nil)
@ -90,26 +91,25 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
"+" mh-speed-expand-folder
"-" mh-speed-contract-folder
"\r" mh-speed-view
"f" mh-speed-flists
"i" mh-speed-invalidate-map)
"r" mh-speed-refresh)
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
;; Menus for speedbar...
(defvar mh-folder-speedbar-menu-items
'(["Visit Folder" mh-speed-view
'("--"
["Visit Folder" mh-speed-view
(save-excursion
(set-buffer speedbar-buffer)
(get-text-property (line-beginning-position) 'mh-folder))]
["Expand nested folders" mh-speed-expand-folder
["Expand Nested Folders" mh-speed-expand-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(not (get-text-property (line-beginning-position) 'mh-expanded)))]
["Contract nested folders" mh-speed-contract-folder
["Contract Nested Folders" mh-speed-contract-folder
(and (get-text-property (line-beginning-position) 'mh-children-p)
(get-text-property (line-beginning-position) 'mh-expanded))]
["Run Flists" mh-speed-flists t]
["Invalidate cached folders" mh-speed-invalidate-map t])
["Refresh Speedbar" mh-speed-refresh t])
"Extra menu items for speedbar.")
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
@ -352,6 +352,14 @@ Optional ARGS are ignored."
(defvar mh-speed-current-folder nil)
(defvar mh-speed-flists-folder nil)
(defmacro mh-process-kill-without-query (process)
"PROCESS can be killed without query on Emacs exit.
Avoid using `process-kill-without-query' if possible since it is now
obsolete."
(if (fboundp 'set-process-query-on-exit-flag)
`(set-process-query-on-exit-flag ,process nil)
`(process-kill-without-query ,process)))
;;;###mh-autoload
(defun mh-speed-flists (force &rest folders)
"Execute flists -recurse and update message counts.
@ -396,6 +404,7 @@ only for that one folder."
(or mh-speed-flists-folder '("-recurse"))))
;; Run flists on all folders the next time around...
(setq mh-speed-flists-folder nil)
(mh-process-kill-without-query mh-speed-flists-process)
(set-process-filter mh-speed-flists-process
'mh-speed-parse-flists-output)))))))
@ -494,6 +503,14 @@ next."
(when (equal folder "")
(clrhash mh-sub-folders-cache)))))
(defun mh-speed-refresh ()
"Refresh the speedbar.
Use this function to refresh the speedbar if folders have been added or
deleted or message ranges have been updated outside of MH-E."
(interactive)
(mh-speed-flists t)
(mh-speed-invalidate-map ""))
;;;###mh-autoload
(defun mh-speed-add-folder (folder)
"Add FOLDER since it is being created.

741
lisp/mh-e/mh-utils.el
View file

File diff suppressed because it is too large Load diff