procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Upgraded to MH-E version 7.3.

Browse source 
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
This commit is contained in:
Bill Wohler 2003-04-25 05:52:00 +00:00
parent 0b325c12a2
commit 924df20809
23 changed files with 6383 additions and 1546 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2003-04-24 Bill Wohler <wohler@newt.com>
* MH-E-NEWS: Upgraded to MH-E version 7.3.
2003-04-03 Kenichi Handa <handa@etlken2>
* HELLO: Fix the malayalam line.

257
etc/MH-E-NEWS
View file

@ -1,3 +1,260 @@
Copyright (C) 2003 Free Software Foundation, Inc.
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.3
** New Features in MH-E 7.3
*** Unified function arguments
Any function with MSG-OR-SEQ in its docstring uses the displayed
message by default for this argument. However, if a prefix argument is
provided, then the user is prompted for a message sequence. If the
variable `transient-mark-mode' is non-nil and the mark is active, then
the function operates on the messages in the selected region. In a
program, MSG-OR-SEQ can be a message number, a list of message
numbers, a region in a cons cell, or a sequence.
*** MH-Index view of unseen messages
Use "F n (mh-index-new-messages)" or Folder -> View New Messages menu
item to display messages in the `mh-unseen-seq' sequence in folders
specified by `mh-index-new-messages-folders'. With a prefix argument,
enter a space-separated list of folders, or nothing to search all
folders.
Like other MH-Index folders, use "v (mh-index-visit-folder)" if you
wish to visit the original folder with the unseen message. This is
usually not necessary since the original message is annotated if you
reply, deleted if you delete the message, or refiled if you refile the
message (closes SF #701756).
*** Spam software support
MH-E now supports several spam filters including Bogofilter,
SpamProbe, and SpamAssassin. Spam that is mistakenly considered to be
good mail can be reclassified as spam with "J b (mh-junk-blacklist)".
Conversely, good mail that is accidently considered to be spam can be
reclassified with "J w (mh-junk-whitelist)" (closes SF #669518).
If a message is blacklisted, and `mh-junk-mail-folder' is a string,
then the message is refiled to that folder. If this variable is nil,
the message is deleted. If a message is whitelisted, then the message
is refiled to `mh-inbox'.
To change the spam program being used, customize `mh-junk-program'.
This should only be necessary if you have multiple filters on your
system and MH-E picked the wrong one. These customization variables
are found in the new customization group `mh-junk'.
The documentation for the following functions describes what setup is
needed for the different spam fighting programs:
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'
*** Relative folder specification @ supported
You can now use the relative folder marker @ in folder names (closes
SF #666774).
*** Marking messages
Messages can now be highlighted with "' (mh-toggle-tick)", Sequence ->
Toggle Tick Mark menu item or the "Toggle tick mark" button. These
messages are added to the "tick" sequence, although this sequence can
be changed in `mh-tick-seq'. The highlighting effect can be modified
by customizing `mh-folder-tick-face' (closes SF #623367).
There is also a new keybinding "/ ' (mh-narrow-to-tick)" and menu item
Sequence -> Narrow to Tick Sequence to narrow the view to the
highlighted messages.
*** mh-default-folder-list now takes recipients
If you wish to file a message based upon the recipient of a message
(such as a mailing list), you can now indicate that when filling out
the address in the `mh-default-folder-list' customization variable.
*** Face header field supported
In addition to the X-Face header field, the Face header field, which
can display color images, is now supported. As a bonus, the external
xface-e21 library is no longer required.
*** X-Image-URL support
Images specified in X-Image-URL header fields are now supported.
See the customization variable `mh-fetch-x-image-url' to enable this
support.
*** Fcc completion
Folders in Fcc fields in message drafts can now be completed with
M-TAB.
** New Variables in MH-E 7.3
Variables that have been added to MH-E that have not been discussed
elsewhere are listed here.
*** mh-auto-fields-list
Alist of addresses for which header lines are automatically inserted.
When a regular expression matches in the To or cc fields of a message,
the corresponding header field is automatically inserted in the
message header. It also allows the automatic setting of an identity
(using `mh-insert-identity') to set an alternate identity when sending
messages to a certain person or mailing list.
Since this is a more general use of `mh-insert-mail-followup-to-flag'
and `mh-insert-mail-followup-to-list', these variables have been removed.
*** mh-show-xface-face
Face for displaying the X-Face image.
*** mh-xemacs-toolbar-position
This customization variable allows the user to place the toolbar on
the four edges of the frame.
*** mh-xemacs-use-toolbar-flag
This customization variable is used to enable or disable the toolbar
under XEmacs.
** Variables Deleted in MH-E 7.3
Variables that have been removed from MH-E that have not been
discussed elsewhere are listed here.
*** mh-decode-content-transfer-encoded-message-flag
No longer needed since the external program mimencode is no longer
used.
*** mh-index-show-hook
This hook was never used, so it was removed.
*** mh-tool-bar-reply-3-buttons-flag
Obsolete. This functionality is present `mh-tool-bar-folder-buttons'.
** Bug Fixes in MH-E 7.3
*** Can't refile message
Messages with invalid addresses were causing errors in ali which
prevented the refiling of messages. The ali error is now shown in the
"*MH-E Log*" buffer and refiling suggests the last folder used (closes
SF #680388).
*** Empty body triggers duped header
If the body was empty the header would be treated like the body and
was therefore displayed twice. This has been fixed (closes SF
#681162).
*** mml or mhl directives not always processed
The mml and mhl directives used to create body parts were not
processed if one re-edited a draft, or if they added the directives
manually. The directives are now always processed upon sending the
letter. You may still, of course, use "C-c C-m m (mh-mml-to-mime)" or
"C-c C-e (mh-edit-mhn)" to manually create the MIME body parts from
the directives and then send the draft.
*** mh-alias-grab-from-field fails
MH-E was adding aliases with angle brackets around the address when
there wasn't a phrase (usually, the user's name), to go with it. This
caused ali to fail which caused problems in MH-E. This is probably a
bug in ali, but MH-E no longer inserts angle brackets around the
address unless there is a phrase, which avoids the problem (closes SF
#690216).
*** XEmacs fixes
MH-E is now fully supported under XEmacs and compiles without any
warnings.
In particular, the following now work under XEmacs:
- X-Face, Face, and X-Image-URL header fields
- MH-E logo in mode line
- Emphasis (bold, italics, etc.)
- Smilies
- Toolbar
*** Indexed folders should respect mh-show-threads-flag
Indexed folders are now threaded if `mh-show-threads-flag' is non-nil
(closes SF #709667).
*** Threading index view loses folder info
This has been fixed (closes SF #709672).
*** No undo information when re-editing drafts
Undo is turned on in the draft buffer when using "e (mh-edit-again)"
(closes SF #712777).
*** Forwarded base64 encoded messages are incorrectly displayed
This has been fixed (closes SF #681518).
*** Append to *MH-E Log* buffer
The last 100 lines of log messages are kept in the *MH-E Log* buffer.
Previously, the buffer was erased every time it was written (closes SF
#685476). In addition, many of the MH-E commands now send their output
into this buffer instead of a plethora of other special-purpose
buffers.
*** mh-inc-folder complains if no mail and no current message
The function `mh-inc-folder' no longer calls `mh-show' if point is not
on a valid scan line. This keeps `mh-inc-folder' from complaining
(closes SF #678115).
*** Folder normalization strips leading slash
Leading "/" characters in folder names entered by the user were being
lost. This has been fixed (closes SF #676890).
*** Print header doesn't show message
When printing a sequence, the header simply indicated that a sequence,
but not which one, was being printed and did not show the message
number. This has been fixed. If more than one message is printed, a
page of the scan lines is printed and its header indicates the
sequence or message range. The pages with the actual messages all set
the header to the folder and message displayed on that page.
*** Aliases constantly reloaded
Empty lists are now handled properly (closes SF #693859).
*** Remove RCS keywords
Removed RCS keywords per Emacs conventions (closes SF #680731).
*** Replace mimencode
MH-E was enhanced to decode message based on charset and
Content-Transfer-Encoding. This eliminates the need for the external
program mimencode (closes SF #674857).
* Changes in MH-E 7.2
This release includes the new features of filing hints, hierarchical

2
etc/NEWS
View file

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

1569
lisp/mh-e/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

@ -1,6 +1,7 @@
;;; mh-alias.el --- MH-E mail alias completion and expansion
;;
;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 1997,
;; 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -93,8 +94,6 @@
;;; Change Log:
;; $Id: mh-alias.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
(require 'mh-e)
@ -103,10 +102,12 @@
(eval-when-compile (defvar mail-abbrev-syntax-table))
;;; Autoloads
(autoload 'mail-abbrev-complete-alias "mailabbrev")
(autoload 'multi-prompt "multi-prompt")
(eval-when (compile load eval)
(ignore-errors
(require 'mailabbrev)
(require 'multi-prompt)))
(defvar mh-alias-alist nil
(defvar mh-alias-alist 'not-read
"Alist of MH aliases.")
(defvar mh-alias-blind-alist nil
"Alist of MH aliases that are blind lists.")
@ -180,7 +181,7 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(insert-file-contents "/etc/passwd")))
((stringp mh-alias-local-users)
(insert mh-alias-local-users "\n")
(shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
(shell-command-on-region (point-min) (point-max) mh-alias-local-users t)
(goto-char (point-min))))
(while (< (point) (point-max))
(cond
@ -241,7 +242,7 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(defun mh-alias-reload-maybe ()
"Load new MH aliases."
(if (or (not mh-alias-alist) ; Doesn't exist, so create it.
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
(mh-alias-tstamp nil)) ; Out of date, so recreate it.
(mh-alias-reload)))
@ -253,12 +254,16 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
ALIAS must be a string for a single alias.
If USER is t, then assume ALIAS is an address and call ali -user.
ali returns the string unchanged if not defined. The same is done here."
(save-excursion
(let ((user-arg (if user "-user" "-nouser")))
(mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
(goto-char (point-max))
(if (looking-at "^$") (delete-backward-char 1))
(buffer-substring (point-min)(point-max))))
(condition-case err
(save-excursion
(let ((user-arg (if user "-user" "-nouser")))
(mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
(goto-char (point-max))
(if (looking-at "^$") (delete-backward-char 1))
(buffer-substring (point-min)(point-max)))
(error (progn
(message (error-message-string err))
alias))))
(defun mh-alias-expand (alias)
"Return expansion for ALIAS.
@ -280,15 +285,14 @@ Blind aliases or users from /etc/passwd are not expanded."
(let* ((minibuffer-local-completion-map mh-alias-read-address-map)
(completion-ignore-case mh-alias-completion-ignore-case-flag)
(the-answer
(or (cond
((fboundp 'completing-read-multiple)
(completing-read-multiple prompt mh-alias-alist nil nil))
((featurep 'multi-prompt)
(multi-prompt "," nil prompt mh-alias-alist nil nil))
(t
(split-string
(completing-read prompt mh-alias-alist nil nil)
","))))))
(cond ((fboundp 'completing-read-multiple)
(mh-funcall-if-exists
completing-read-multiple prompt mh-alias-alist nil nil))
((featurep 'multi-prompt)
(mh-funcall-if-exists
multi-prompt "," nil prompt mh-alias-alist nil nil))
(t (split-string
(completing-read prompt mh-alias-alist nil nil) ",")))))
(if (not mh-alias-expand-aliases-flag)
(mapconcat 'identity the-answer ", ")
;; Loop over all elements, checking if in passwd aliast or blind first
@ -325,12 +329,14 @@ Blind aliases or users from /etc/passwd are not expanded."
(message "No alias for %s" the-name))))))
(self-insert-command 1))
(mh-do-in-xemacs (defvar mail-abbrevs))
;;;###mh-autoload
(defun mh-alias-letter-expand-alias ()
"Expand mail alias before point."
(mh-alias-reload-maybe)
(let ((mail-abbrevs mh-alias-alist))
(mail-abbrev-complete-alias))
(mh-funcall-if-exists mail-abbrev-complete-alias))
(when mh-alias-expand-aliases-flag
(let* ((end (point))
(syntax-table (syntax-table))
@ -350,6 +356,9 @@ Blind aliases or users from /etc/passwd are not expanded."
(defun mh-alias-suggest-alias (string)
"Suggest an alias for STRING."
(cond
((string-match "^<\\(.*\\)>$" string)
;; <somename@foo.bar> -> recurse, stripping brackets.
(mh-alias-suggest-alias (match-string 1 string)))
((string-match "^\\sw+$" string)
;; One word -> downcase it.
(downcase string))
@ -389,9 +398,25 @@ Blind aliases or users from /etc/passwd are not expanded."
(format "%s %s" (match-string 2 string) (match-string 1 string))))
(t
;; Output string, with spaces replaced by dots.
(downcase (replace-regexp-in-string
"\\.\\.+" "."
(replace-regexp-in-string " +" "." string))))))
(mh-alias-canonicalize-suggestion string))))
(defun mh-alias-canonicalize-suggestion (string)
"Process STRING to replace spacess by periods.
First all spaces are replaced by periods. Then every run of consecutive periods
are replaced with a single period. Finally the string is converted to lower
case."
(with-temp-buffer
(insert string)
;; Replace spaces with periods
(goto-char (point-min))
(replace-regexp " +" ".")
;; Replace consecutive periods with a single period
(goto-char (point-min))
(replace-regexp "\\.\\.+" ".")
;; Convert to lower case
(downcase-region (point-min) (point-max))
;; Whew! all done...
(buffer-string)))
(defun mh-alias-which-file-has-alias (alias file-list)
"Return the name of writable file which defines ALIAS from list FILE-LIST."
@ -403,7 +428,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(erase-buffer)
(when (file-writable-p (car file-list))
(insert-file-contents (car file-list))
(if (re-search-forward (concat "^" (regexp-quote alias) ":"))
(if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
(setq found (car file-list)
the-list nil)
(setq the-list (cdr the-list)))))
@ -470,14 +495,18 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
;;;###mh-autoload
(defun mh-alias-from-has-no-alias-p ()
"Return t is From has no current alias set."
"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."
(mh-alias-reload-maybe)
(save-excursion
(if (not (mh-folder-line-matches-show-buffer-p))
nil ;No corresponding show buffer
(if (eq major-mode 'mh-folder-mode)
(set-buffer mh-show-buffer))
(not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
(let ((from-header (mh-extract-from-header-value)))
(and from-header
(not (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.
@ -491,7 +520,6 @@ after it."
(goto-char (point-min))
(let ((alias-search (concat alias ":"))
(letter)
(here (point))
(case-fold-search t))
(cond
;; Search for exact match (if we had the same alias before)
@ -538,7 +566,11 @@ If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
(interactive "P\nP")
(mh-alias-reload-maybe)
(setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
(if (and address (string-match "^<\\(.*\\)>$" address))
(setq address (match-string 1 address)))
(setq address (read-string "Address: " address))
(if (string-match "^<\\(.*\\)>$" address)
(setq address (match-string 1 address)))
(let ((address-alias (mh-alias-address-to-alias address))
(alias-address (mh-alias-expand alias)))
(if (string-equal alias-address alias)
@ -571,7 +603,8 @@ already has an alias."
(insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
((eq major-mode 'mh-folder-mode)
(error "Cursor not pointing to a message")))
(let* ((address (mh-extract-from-header-value))
(let* ((address (or (mh-extract-from-header-value)
(error "Message has no From: header")))
(alias (mh-alias-suggest-alias address)))
(mh-alias-add-alias alias address))))

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

@ -1,6 +1,7 @@
;;; mh-comp.el --- MH-E functions for composing messages
;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 95, 1997,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -30,14 +31,14 @@
;;; Change Log:
;; $Id: mh-comp.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
(require 'cl)
(eval-when (compile load eval)
(ignore-errors (require 'mailabbrev)))
;; Shush the byte-compiler
(defvar adaptive-fill-first-line-regexp)
@ -309,27 +310,21 @@ See also documentation for `\\[mh-send]' function."
;;;###mh-autoload
(defun mh-forward (to cc &optional msg-or-seq)
"Forward one or more messages to the recipients TO and CC.
"Forward messages to the recipients TO and CC.
Use optional MSG-OR-SEQ argument to specify a message or sequence to forward.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is forwarded.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
Default is the displayed message. If optional prefix argument is given then
prompt for the message sequence. If variable `transient-mark-mode' is non-nil
and the mark is active, then the selected region is forwarded.
See also documentation for `\\[mh-send]' function."
(interactive (list (mh-read-address "To: ")
(mh-read-address "Cc: ")
(cond
((mh-mark-active-p t)
(mh-region-to-msg-list (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Forward" t))
(t
(mh-get-msg-num t)))))
(mh-interactive-msg-or-seq "Forward")))
(let* ((folder mh-current-folder)
(msgs (cond ((numberp msg-or-seq) (list msg-or-seq))
((listp msg-or-seq) msg-or-seq)
(t (mh-seq-to-msgs msg-or-seq))))
(msgs (mh-msg-or-seq-to-msg-list msg-or-seq))
(config (current-window-configuration))
(fwd-msg-file (mh-msg-filename (car msgs) folder))
;; forw always leaves file in "draft" since it doesn't have -draft
@ -337,7 +332,8 @@ See also documentation for `\\[mh-send]' function."
(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-current-folder msgs)
mh-current-folder
(mh-coalesce-msg-list msgs))
(prog1
(mh-read-draft "" draft-name t)
(mh-insert-fields "To:" to "Cc:" cc)
@ -353,14 +349,12 @@ See also documentation for `\\[mh-send]' function."
(setq orig-from (mh-get-header-field "From:"))
(setq orig-subject (mh-get-header-field "Subject:")))
(let ((forw-subject
(mh-forwarded-letter-subject orig-from orig-subject))
(compose))
(mh-forwarded-letter-subject orig-from orig-subject)))
(mh-insert-fields "Subject:" forw-subject)
(goto-char (point-min))
;; If using MML, translate mhn
(if (equal mh-compose-insertion 'gnus)
(save-excursion
(setq compose t)
(re-search-forward (format "^\\(%s\\)?$"
mh-mail-header-separator))
(while
@ -386,12 +380,10 @@ See also documentation for `\\[mh-send]' function."
(forward-line 1))
(delete-other-windows)
(mh-add-msgs-to-seq msgs 'forwarded t)
(mh-compose-and-send-mail draft "" folder msg-or-seq
(mh-compose-and-send-mail draft "" folder msgs
to forw-subject cc
mh-note-forw "Forwarded:"
config)
(if compose
(setq mh-mml-compose-insert-flag t))
(mh-letter-mode-message)))))
(defun mh-forwarded-letter-subject (from subject)
@ -439,38 +431,27 @@ setting of the variable `mh-redist-full-contents'. See its documentation."
(mh-goto-header-end 0)
(insert "Resent-To: " to "\n")
(if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
(mh-clean-msg-header (point-min)
"^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
nil)
(mh-clean-msg-header
(point-min)
"^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
nil)
(save-buffer)
(message "Redistributing...")
(if (not mh-redist-background)
(if mh-redist-full-contents
(call-process "/bin/sh" nil 0 nil "-c"
(format "mhdist=1 mhaltmsg=%s %s -push %s"
buffer-file-name
(expand-file-name mh-send-prog mh-progs)
buffer-file-name))
(call-process "/bin/sh" nil 0 nil "-c"
(format
"mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
(mh-msg-filename msg folder)
(expand-file-name mh-send-prog mh-progs)
buffer-file-name))))
(mh-annotate-msg msg folder mh-note-dist
"-component" "Resent:"
"-text" (format "\"%s %s\"" to cc))
(if mh-redist-background
(mh-exec-cmd-daemon "/bin/sh" nil "-c"
(format "mhdist=1 mhaltmsg=%s %s %s %s"
(if mh-redist-full-contents
buffer-file-name
(mh-msg-filename msg folder))
(if mh-redist-full-contents
""
"mhannotate=1")
(mh-expand-file-name "send" mh-progs)
buffer-file-name)))
(let ((env "mhdist=1"))
;; Setup environment...
(setq env (concat env " mhaltmsg=" (if mh-redist-full-contents
buffer-file-name
(mh-msg-filename msg folder))))
(unless mh-redist-full-contents
(setq env (concat env " mhannotate=1")))
;; Redistribute...
(if mh-redist-background
(mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
(mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
;; Annotate...
(mh-annotate-msg msg folder mh-note-dist
"-component" "Resent:"
"-text" (format "\"%s %s\"" to cc)))
(kill-buffer draft)
(message "Redistributing...done"))))
@ -501,7 +482,8 @@ Optional argument BUFFER can be used to specify the buffer."
;;;###mh-autoload
(defun mh-reply (message &optional reply-to includep)
"Reply to MESSAGE (default: current message).
"Reply to MESSAGE.
Default is the displayed message.
If the optional argument REPLY-TO is not given, prompts for type of addresses
to reply to:
from sender only,
@ -706,14 +688,15 @@ reused."
(buffer-substring (point-min) (1- (point-max)))))
(defun mh-annotate-msg (msg buffer note &rest args)
"Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
(apply 'mh-exec-cmd "anno" buffer msg args)
"Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
MSG can be a message number, a list of message numbers, or a sequence."
(apply 'mh-exec-cmd "anno" buffer
(if (listp msg) (append msg args) (cons msg args)))
(save-excursion
(cond ((get-buffer buffer) ; Buffer may be deleted
(set-buffer buffer)
(if (numberp msg)
(mh-notate msg note (1+ mh-cmd-note))
(mh-notate-seq msg note (1+ mh-cmd-note)))))))
(mh-iterate-on-msg-or-seq nil msg
(mh-notate nil note (1+ mh-cmd-note)))))))
(defun mh-insert-fields (&rest name-values)
"Insert the NAME-VALUES pairs in the current buffer.
@ -776,7 +759,7 @@ Returns t if found, nil if not."
"Extract From: string from header."
(save-excursion
(if (not (mh-goto-header-field "From:"))
(error "No From header line found")
nil
(skip-chars-forward " \t")
(buffer-substring-no-properties
(point) (progn (mh-header-field-end)(point))))))
@ -812,9 +795,9 @@ Returns t if found, nil if not."
;; 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-compose-insert-flag]
mh-edit-mhn (mh-mhn-directive-present-p)]
["Pull in All Compositions (gnus)"
mh-mml-to-mime mh-mml-compose-insert-flag]
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]))))
@ -857,6 +840,11 @@ work better in MH-Letter mode."
(mail-mode-fill-paragraph arg)
(fill-paragraph arg))))
;; Avoid compiler warnings in XEmacs and Emacs 20
(eval-when-compile
(defvar tool-bar-mode)
(defvar tool-bar-map))
;;;###autoload
(define-derived-mode mh-letter-mode text-mode "MH-Letter"
"Mode for composing letters in MH-E.\\<mh-letter-mode-map>
@ -918,8 +906,11 @@ When a message is composed, the hooks `text-mode-hook' and
(setq paragraph-separate paragraph-start)
;; --- End of code from sendmail.el ---
;; Enable undo since a show-mode buffer might have been reused.
(buffer-enable-undo)
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
(mh-funcall-if-exists mh-toolbar-init :letter)
(make-local-variable 'font-lock-defaults)
(cond
((or (equal mh-highlight-citation-p 'font-lock)
@ -933,16 +924,6 @@ When a message is composed, the hooks `text-mode-hook' and
;; ...or the header only
(setq font-lock-defaults '(mh-show-font-lock-keywords t))))
(easy-menu-add mh-letter-menu)
;; See if a "forw: -mime" message containing a MIME composition.
;; Mode clears local vars, so can't do this in mh-forward.
(save-excursion
(goto-char (point-min))
(when (and (re-search-forward
(format "^\\(%s\\)?$" mail-header-separator) nil t)
(= 0 (forward-line 1))
(looking-at "^#forw"))
(require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var
(setq mh-mhn-compose-insert-flag t)))
(setq fill-column mh-letter-fill-column)
;; If text-mode-hook turned on auto-fill, tune it for messages
(when auto-fill-function
@ -1055,16 +1036,25 @@ called, with no arguments, before the signature is actually inserted."
;;; Routines to compose and send a letter.
(defun mh-insert-x-face ()
"Append X-Face field to header.
"Append X-Face, Face or X-Image-URL field to header.
If the field already exists, this function does nothing."
(when (and (file-exists-p mh-x-face-file)
(file-readable-p mh-x-face-file))
(save-excursion
(when (null (mh-position-on-field "X-Face"))
(insert "X-Face: ")
(goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
(if (not (looking-at "^"))
(insert "\n"))))))
(unless (or (mh-position-on-field "X-Face")
(mh-position-on-field "Face")
(mh-position-on-field "X-Image-URL"))
(save-excursion
(goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
(if (not (looking-at "^"))
(insert "\n")))
(unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
(insert "X-Face: "))))))
(defvar mh-x-mailer-string nil
"*String containing the contents of the X-Mailer header field.
If nil, this variable is initialized to show the version of MH-E, Emacs, and
MH the first time a message is composed.")
(defun mh-insert-x-mailer ()
"Append an X-Mailer field to the header.
@ -1116,21 +1106,39 @@ The versions of MH-E, Emacs, and MH are shown."
(setq fields (cdr fields))))
search-result)))
(defun mh-insert-mail-followup-to ()
"Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'."
(defun mh-insert-auto-fields ()
"Insert custom fields if To or Cc match `mh-auto-fields-list'."
(save-excursion
(if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))
(not (mh-goto-header-field "Mail-Followup-To: ")))
(let ((list mh-insert-mail-followup-to-list))
(while list
(let ((regexp (nth 0 (car list)))
(entry (nth 1 (car list))))
(when (mh-regexp-in-field-p regexp "To:" "cc:")
(if (mh-goto-header-field "Mail-Followup-To: ")
(insert entry ", ")
(mh-goto-header-end 0)
(insert "Mail-Followup-To: " entry "\n")))
(setq list (cdr list))))))))
(when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list))
(while list
(let ((regexp (nth 0 (car list)))
(entries (nth 1 (car list))))
(when (mh-regexp-in-field-p regexp "To:" "cc:")
(let ((entry-list entries))
(while entry-list
(let ((field (caar entry-list))
(value (cdar entry-list)))
(cond
((equal "identity" field)
(when (assoc value mh-identity-list)
(mh-insert-identity value)))
(t
(mh-modify-header-field field value
(equal field "From")))))
(setq entry-list (cdr entry-list))))))
(setq list (cdr list)))))))
(defun mh-modify-header-field (field value &optional overwrite-flag)
"To header FIELD add VALUE.
If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
(cond ((mh-goto-header-field (concat field ":"))
(insert value)
(if overwrite-flag
(delete-region (point) (line-end-position))
(insert ", ")))
(t (mh-goto-header-end 0)
(insert field ": " value "\n"))))
(defun mh-compose-and-send-mail (draft send-args
sent-from-folder sent-from-msg
@ -1149,12 +1157,13 @@ message. In that case, the ANNOTATE-FIELD is used to build a string
for `mh-annotate-msg'.
CONFIG is the window configuration to restore after sending the letter."
(pop-to-buffer draft)
(if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
(mh-insert-auto-fields)
(mh-letter-mode)
;; mh-identity support
(if (and (boundp 'mh-identity-default)
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)
@ -1169,6 +1178,7 @@ CONFIG is the window configuration to restore after sending the letter."
(setq mh-previous-window-config config)
(setq mode-line-buffer-identification (list " {%b}"))
(mh-logo-display)
(mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
(if (and (boundp 'mh-compose-letter-function)
mh-compose-letter-function)
@ -1193,19 +1203,16 @@ This should be the last function called when composing the draft."
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 variable `mh-mhn-compose-insert-flag' is set.
Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
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."
(interactive "P")
(run-hooks 'mh-before-send-letter-hook)
(cond
((and (boundp 'mh-mhn-compose-insert-flag)
mh-mhn-compose-insert-flag)
(mh-edit-mhn))
((and (boundp 'mh-mml-compose-insert-flag)
mh-mml-compose-insert-flag)
(mh-mml-to-mime)))
(cond ((mh-mhn-directive-present-p)
(mh-edit-mhn))
((mh-mml-directive-present-p)
(mh-mml-to-mime)))
(if mh-insert-x-mailer-flag (mh-insert-x-mailer))
(mh-insert-x-face)
(save-buffer)
@ -1232,7 +1239,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
(mh-goto-header-field "Content-Type:"))
(setq mh-send-args (format "-mime %s" mh-send-args)))
(cond (arg
(pop-to-buffer "MH mail delivery")
(pop-to-buffer mh-mail-delivery-buffer)
(erase-buffer)
(mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
"-nodraftfolder" mh-send-args file-name)
@ -1339,7 +1346,7 @@ yanked message will be deleted."
(eq t mh-yank-from-start-of-msg)))
;; supercite needs the full header
(concat
(buffer-substring (point-min) (mail-header-end))
(buffer-substring (point-min) (mh-mail-header-end))
"\n"
(buffer-substring (region-beginning) (region-end))))
(yank-region
@ -1472,6 +1479,33 @@ This is useful in breaking up paragraphs in replies."
(insert " "))
(forward-line -1))))
(mh-do-in-xemacs (defvar mail-abbrevs))
(defun mh-folder-expand-at-point ()
"Do folder name completion in Fcc header field."
(let* ((end (point))
(syntax-table (syntax-table))
(beg (unwind-protect
(save-excursion
(mh-funcall-if-exists mail-abbrev-make-syntax-table)
(set-syntax-table mail-abbrev-syntax-table)
(backward-word 1)
(point))
(set-syntax-table syntax-table)))
(folder (buffer-substring beg end))
(leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
(last-slash (mh-search-from-end ?/ folder))
(prefix (and last-slash (substring folder 0 last-slash)))
(mail-abbrevs
(mapcar #'(lambda (x)
(list (cond (prefix (format "%s/%s" prefix x))
(leading-plus (format "+%s" x))
(t x))))
(mh-folder-completion-function folder nil t))))
(if (fboundp 'mail-abbrev-complete-alias)
(mh-funcall-if-exists mail-abbrev-complete-alias)
(error "Fcc completion not supported in your version of Emacs"))))
;;;###mh-autoload
(defun mh-letter-complete (arg)
"Perform completion on header field or word preceding point.
@ -1480,12 +1514,19 @@ by the function designated by `mh-letter-complete-function' elsewhere,
passing the prefix ARG if any."
(interactive "P")
(let ((case-fold-search t))
(if (and (mh-in-header-p)
(save-excursion
(mh-header-field-beginning)
(looking-at "^.*\\(to\\|cc\\|from\\):")))
(mh-alias-letter-expand-alias)
(funcall mh-letter-complete-function arg))))
(cond
((and (mh-in-header-p)
(save-excursion
(mh-header-field-beginning)
(looking-at "^fcc:")))
(mh-folder-expand-at-point))
((and (mh-in-header-p)
(save-excursion
(mh-header-field-beginning)
(looking-at "^.*\\(to\\|cc\\|from\\):")))
(mh-alias-letter-expand-alias))
(t
(funcall mh-letter-complete-function arg)))))
;;; Build the letter-mode keymap:
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
@ -1532,6 +1573,8 @@ passing the prefix ARG if any."
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
;;;###autoload(add-to-list 'auto-mode-alist '("/drafts/[0-9]+\\'" . mh-letter-mode))
(provide 'mh-comp)
;;; Local Variables:

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

File diff suppressed because it is too large Load diff

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

@ -1,10 +1,11 @@
;;; mh-e.el --- GNU Emacs interface to the MH mail system
;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc.
;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Version: 7.2
;; Version: 7.3
;; Keywords: mail
;; This file is part of GNU Emacs.
@ -79,8 +80,6 @@
;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
;; $Id: mh-e.el,v 1.262 2003/02/03 19:11:43 wohler Exp $
;;; Code:
(require 'cl)
@ -92,6 +91,7 @@
(> 50 recursive-load-depth-limit))
(setq recursive-load-depth-limit 50)))
(require 'mh-inc)
(require 'mh-utils)
(require 'gnus-util)
(require 'easymenu)
@ -102,7 +102,7 @@
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defconst mh-version "7.2" "Version number of MH-E.")
(defconst mh-version "7.3" "Version number of MH-E.")
;;; Autoloads
(autoload 'Info-goto-node "info")
@ -413,7 +413,7 @@ is done highlighting.")
(cond
((not mh-folder-unseen-seq-cache)
nil)
((not cur-msg) ;Presumably at end of buffer
((>= (point) limit) ;Presumably at end of buffer
(setq mh-folder-unseen-seq-cache nil)
nil)
((member cur-msg mh-folder-unseen-seq-cache)
@ -432,8 +432,7 @@ is done highlighting.")
;; Examine how we must have exited the loop...
(let ((cur-msg (mh-get-msg-num nil)))
(cond
((or (not cur-msg)
(<= limit (point))
((or (<= limit (point))
(not (member cur-msg mh-folder-unseen-seq-cache)))
(setq mh-folder-unseen-seq-cache nil)
nil)
@ -468,6 +467,10 @@ is done highlighting.")
(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
;nil if not narrowed.
(defvar mh-tick-seq-changed-when-narrowed-flag nil)
;Has tick sequence changed while the
;folder was narrowed to it?
(defvar mh-view-ops ()) ;Stack of ops that change the folder
;view (such as narrowing or threading).
@ -535,34 +538,27 @@ the Emacs front end to the MH mail system."
(defun mh-delete-msg (msg-or-seq)
"Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
Default is the displayed message. If optional prefix argument is given then
prompt for the message sequence. If variable `transient-mark-mode' is non-nil
and the mark is active, then the selected region is marked for deletion."
(interactive (list (cond
((mh-mark-active-p t)
(cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Delete" t))
(t
(cons (line-beginning-position) (line-end-position))))))
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is marked for deletion.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence."
(interactive (list (mh-interactive-msg-or-seq "Delete")))
(mh-delete-msg-no-motion msg-or-seq)
(mh-next-msg))
(defun mh-delete-msg-no-motion (msg-or-seq)
"Mark the specified MSG-OR-SEQ for subsequent deletion.
Default is the displayed message. If optional prefix argument is provided,
then prompt for the message sequence."
(interactive (list (if current-prefix-arg
(mh-read-seq-default "Delete" t)
(mh-get-msg-num t))))
(cond ((numberp msg-or-seq)
(mh-delete-a-msg msg-or-seq))
((and (consp msg-or-seq)
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
(mh-delete-a-msg nil)))
(t (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))))
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is marked for deletion.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence."
(interactive (list (mh-interactive-msg-or-seq "Delete")))
(mh-iterate-on-msg-or-seq () msg-or-seq
(mh-delete-a-msg nil)))
(defun mh-execute-commands ()
"Process outstanding delete and refile requests."
@ -593,7 +589,6 @@ Type \"\\[mh-show]\" to show the message normally again."
(mh-invalidate-show-buffer))
(let ((mh-decode-mime-flag nil)
(mhl-formfile nil)
(mh-decode-content-transfer-encoded-message-flag nil)
(mh-clean-message-header-flag nil))
(mh-show-msg nil)
(mh-in-show-buffer (mh-show-buffer)
@ -601,28 +596,31 @@ Type \"\\[mh-show]\" to show the message normally again."
(mh-recenter 0))
(setq mh-showing-with-headers t)))
(defun mh-inc-folder (&optional maildrop-name)
(defun mh-inc-folder (&optional maildrop-name folder)
"Inc(orporate)s new mail into the Inbox folder.
Optional argument MAILDROP-NAME specifies an alternate maildrop from the
default. If the prefix argument is given, incorporates mail into the current
folder, otherwise uses the folder named by `mh-inbox'.
default. The optional argument FOLDER specifies where to incorporate mail
instead of the default named by `mh-inbox'.
The value of `mh-inc-folder-hook' is a list of functions to be called, with no
arguments, after incorporating new mail.
Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(interactive (list (if current-prefix-arg
(expand-file-name
(read-file-name "inc mail from file: "
mh-user-path)))))
mh-user-path)))
(if current-prefix-arg
(mh-prompt-for-folder "inc mail into" mh-inbox t))))
(if (not folder)
(setq folder mh-inbox))
(let ((threading-needed-flag nil))
(let ((config (current-window-configuration)))
(if (not maildrop-name)
(cond ((not (get-buffer mh-inbox))
(mh-make-folder mh-inbox)
(setq threading-needed-flag mh-show-threads-flag)
(setq mh-previous-window-config config))
((not (eq (current-buffer) (get-buffer mh-inbox)))
(switch-to-buffer mh-inbox)
(setq mh-previous-window-config config)))))
(cond ((not (get-buffer folder))
(mh-make-folder folder)
(setq threading-needed-flag mh-show-threads-flag)
(setq mh-previous-window-config config))
((not (eq (current-buffer) (get-buffer folder)))
(switch-to-buffer folder)
(setq mh-previous-window-config config))))
(mh-get-new-mail maildrop-name)
(when (and threading-needed-flag
(save-excursion
@ -632,7 +630,8 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(and (message "Not threading since the number of messages exceeds `mh-large-folder'")
nil))))
(mh-toggle-threads))
(if mh-showing-mode (mh-show))
(beginning-of-line)
(if (and mh-showing-mode (looking-at mh-scan-valid-regexp)) (mh-show))
(run-hooks 'mh-inc-folder-hook)))
(defun mh-last-msg ()
@ -643,8 +642,10 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(forward-line -1))
(mh-recenter nil))
(defun mh-next-undeleted-msg (&optional arg)
"Move to the next undeleted message ARG in window."
(defun mh-next-undeleted-msg (&optional arg wait-after-complaining-flag)
"Move to the next undeleted message ARG in window.
If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and we are at the
last undeleted message then pause for a second after printing message."
(interactive "p")
(setq mh-next-direction 'forward)
(forward-line 1)
@ -652,38 +653,73 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(beginning-of-line)
(mh-maybe-show))
(t (forward-line -1)
(message "No more undeleted messages"))))
(message "No more undeleted messages")
(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:
a) The folder name associated with the address in the alist
`mh-default-folder-list'.
`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.
b) The address' corresponding alias from the user's personal
aliases file prefixed by `mh-default-folder-prefix'.
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."
;; Is address in mh-default-folder-list?
(let* ((address
(nth 1 (mail-extract-address-components
(mh-extract-from-header-value))))
(folder-name
(nth 1 (assoc-ignore-case address mh-default-folder-list))))
;; Loop for all entries in mh-default-folder-list
(save-excursion
(let ((folder-name
(car
(delq nil
(mapcar
(lambda (list)
(let ((address-regexp (nth 0 list))
(folder (nth 1 list))
(to-flag (nth 2 list)))
(when (or
(mh-goto-header-field (if to-flag "To:" "From:"))
; if the To: field is missing, try Cc:
(and to-flag (mh-goto-header-field "cc:")))
(let ((endfield (save-excursion
(mh-header-field-end)(point))))
(if (re-search-forward address-regexp endfield t)
folder
(when to-flag ;Try Cc: as well
(mh-goto-header-field "cc:")
(let ((endfield (save-excursion
(mh-header-field-end)(point))))
(when (re-search-forward
address-regexp endfield t)
folder))))))))
mh-default-folder-list)))))
;; If not, is there an alias for the address?
(if (not folder-name)
(let* ((alias (mh-alias-address-to-alias address)))
(setq folder-name
(and alias (concat "+" mh-default-folder-prefix alias)))))
;; Make sure a result from `mh-default-folder-list' begins with "+"
;; since 'mh-expand-file-name below depends on it
(when (and folder-name (not (eq (aref folder-name 0) ?+)))
(setq folder-name (concat "+" folder-name)))
;; If mh-default-folder-must-exist-flag set, check that folder exists.
(if (and folder-name
(or (not mh-default-folder-must-exist-flag)
(file-exists-p (mh-expand-file-name folder-name))))
folder-name)))
;; If not, is there an alias for the address?
(when (not folder-name)
(let* ((from-header (mh-extract-from-header-value))
(address (and from-header
(nth 1 (mail-extract-address-components
from-header))))
(alias (and address (mh-alias-address-to-alias address))))
(when alias
(setq folder-name
(and alias (concat "+" mh-default-folder-prefix alias))))))
;; If mh-default-folder-must-exist-flag set, check that folder exists.
(if (and folder-name
(or (not mh-default-folder-must-exist-flag)
(file-exists-p (mh-expand-file-name folder-name))))
folder-name))))
(defun mh-prompt-for-refile-folder ()
"Prompt the user for a folder in which the message should be filed.
@ -710,29 +746,26 @@ Otherwise, a default folder name is generated by `mh-folder-from-address'."
"")))
t))
(defun mh-refile-msg (msg-or-seq folder)
"Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
If optional prefix argument provided, then prompt for message sequence.
(defun mh-refile-msg (msg-or-seq folder
&optional dont-update-last-destination-flag)
"Refile MSG-OR-SEQ into FOLDER.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is marked for refiling."
(interactive
(list (cond
((mh-mark-active-p t)
(cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Refile" t))
(t
(cons (line-beginning-position) (line-end-position))))
(intern (mh-prompt-for-refile-folder))))
(setq mh-last-destination (cons 'refile folder)
mh-last-destination-folder mh-last-destination)
(cond ((numberp msg-or-seq)
(mh-refile-a-msg msg-or-seq folder))
((and (consp msg-or-seq)
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
(mh-refile-a-msg nil folder)))
(t (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)))
selected region is marked for refiling.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the
variables `mh-last-destination' and `mh-last-destination-folder' are not
updated."
(interactive (list (mh-interactive-msg-or-seq "Refile")
(intern (mh-prompt-for-refile-folder))))
(unless dont-update-last-destination-flag
(setq mh-last-destination (cons 'refile folder)
mh-last-destination-folder mh-last-destination))
(mh-iterate-on-msg-or-seq () msg-or-seq
(mh-refile-a-msg nil folder))
(mh-next-msg))
(defun mh-refile-or-write-again (message)
@ -742,13 +775,16 @@ refile or write command."
(interactive (list (mh-get-msg-num t)))
(if (null mh-last-destination)
(error "No previous refile or write"))
(cond ((eq (car mh-last-destination) 'refile)
(mh-refile-a-msg message (cdr mh-last-destination))
(message "Destination folder: %s" (cdr mh-last-destination)))
(t
(apply 'mh-write-msg-to-file message (cdr mh-last-destination))
(message "Destination: %s" (cdr mh-last-destination))))
(mh-next-msg))
(let (output)
(setq output
(cond ((eq (car mh-last-destination) 'refile)
(mh-refile-a-msg message (cdr mh-last-destination))
(format "Destination folder: %s" (cdr mh-last-destination)))
(t
(apply 'mh-write-msg-to-file message (cdr mh-last-destination))
(format "Destination: %s" (cdr mh-last-destination)))))
(mh-next-msg (interactive-p))
(message output)))
(defun mh-quit ()
"Quit the current MH-E folder.
@ -809,14 +845,17 @@ Scrolls ARG lines or a full screen if no argument is supplied."
(mh-in-show-buffer (mh-show-buffer)
(scroll-down arg)))
(defun mh-previous-undeleted-msg (&optional arg)
"Move to the previous undeleted message ARG in window."
(defun mh-previous-undeleted-msg (&optional arg wait-after-complaining-flag)
"Move to the previous undeleted message ARG in window.
If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and we are at the
first undeleted message then pause for a second after printing message."
(interactive "p")
(setq mh-next-direction 'backward)
(beginning-of-line)
(cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
(mh-maybe-show))
(t (message "No previous undeleted message"))))
(t (message "No previous undeleted message")
(if wait-after-complaining-flag (sit-for 1)))))
(defun mh-previous-unread-msg (&optional count)
"Move to previous unread message.
@ -994,7 +1033,6 @@ refiles aren't carried out."
nil)))
(setq mh-next-direction 'forward)
(let ((threaded-flag (memq 'unthread mh-view-ops)))
(mh-reset-threads-and-narrowing)
(mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
(cond (threaded-flag (mh-toggle-threads))
(mh-index-data (mh-index-insert-folder-headers)))))
@ -1040,14 +1078,10 @@ Otherwise send the entire message including the headers."
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is unmarked."
(interactive (list (cond
((mh-mark-active-p t)
(cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Undo" t))
(t
(mh-get-msg-num t)))))
selected region is unmarked.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence."
(interactive (list (mh-interactive-msg-or-seq "Undo")))
(cond ((numberp msg-or-seq)
(let ((original-position (point)))
(beginning-of-line)
@ -1064,12 +1098,8 @@ selected region is unmarked."
(mh-maybe-show))
(goto-char original-position)
(error "Nothing to undo"))))
((and (consp msg-or-seq)
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
(mh-iterate-on-messages-in-region () (car msg-or-seq) (cdr msg-or-seq)
(mh-undo-msg nil)))
(t
(mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
(t (mh-iterate-on-msg-or-seq () msg-or-seq
(mh-undo-msg nil))))
(if (not (mh-outstanding-commands-p))
(mh-set-folder-modified-p nil)))
@ -1176,10 +1206,10 @@ used to avoid problems in corner cases involving folders whose names end with a
(call-process (expand-file-name "flist" mh-progs) nil t nil
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
(goto-char (point-min))
(multiple-value-bind (folder1 unseen total)
(multiple-value-bind (folder unseen total)
(mh-parse-flist-output-line
(buffer-substring (point) (line-end-position)))
(values total unseen))))
(values total unseen folder))))
(defun mh-visit-folder (folder &optional range index-data)
"Visit FOLDER and display RANGE of messages.
@ -1197,12 +1227,12 @@ regardless of the size of the `mh-large-folder' variable."
(list folder-name
(mh-read-msg-range folder-name current-prefix-arg))))
(let ((config (current-window-configuration))
(current-buffer (current-buffer))
(threaded-view-flag mh-show-threads-flag))
(save-excursion
(when (get-buffer folder)
(set-buffer folder)
(setq threaded-view-flag (memq 'unthread mh-view-ops))
(mh-reset-threads-and-narrowing)))
(setq threaded-view-flag (memq 'unthread mh-view-ops))))
(when index-data
(mh-make-folder folder)
(setq mh-index-data (car index-data)
@ -1221,7 +1251,8 @@ regardless of the size of the `mh-large-folder' variable."
(mh-index-data
(mh-index-insert-folder-headers)))
(unless mh-showing-mode (delete-other-windows))
(setq mh-previous-window-config config))
(unless (eq current-buffer (current-buffer))
(setq mh-previous-window-config config)))
nil)
;;;###mh-autoload
@ -1305,11 +1336,14 @@ arguments, after the message has been refiled."
(mh-notate nil mh-note-refiled mh-cmd-note)
(run-hooks 'mh-refile-msg-hook)))))
(defun mh-next-msg ()
"Move backward or forward to the next undeleted message in the buffer."
(defun mh-next-msg (&optional wait-after-complaining-flag)
"Move backward or forward to the next undeleted message in the buffer.
If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and we are at the
last message, then wait for a second after telling the user that there aren't
any more unread messages."
(if (eq mh-next-direction 'forward)
(mh-next-undeleted-msg 1)
(mh-previous-undeleted-msg 1)))
(mh-next-undeleted-msg 1 wait-after-complaining-flag)
(mh-previous-undeleted-msg 1 wait-after-complaining-flag)))
(defun mh-next-unread-msg (&optional count)
"Move to next unread message.
@ -1406,7 +1440,10 @@ Make it the current folder."
["Widen from Sequence" mh-widen mh-narrowed-to-seq]
"--"
["Narrow to Subject Sequence" mh-narrow-to-subject t]
["Narrow to Tick Sequence" mh-narrow-to-tick
(and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))]
["Delete Rest of Same Subject" mh-delete-subject t]
["Toggle Tick Mark" mh-toggle-tick t]
"--"
["Push State Out to MH" mh-update-sequences t]))
@ -1459,6 +1496,7 @@ Make it the current folder."
"--"
["List Folders" mh-list-folders t]
["Visit a Folder..." mh-visit-folder t]
["View New Messages" mh-index-new-messages t]
["Search a Folder..." mh-search-folder t]
["Indexed Search..." mh-index-search t]
"--"
@ -1474,6 +1512,9 @@ Make it the current folder."
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil)))))
;; Avoid compiler warnings in XEmacs and GNU Emacs 20
(eval-when-compile (defvar tool-bar-mode))
(defmacro mh-write-file-functions-compat ()
"Return `write-file-functions' if it exists.
Otherwise return `local-write-file-hooks'. This macro exists purely for
@ -1483,6 +1524,9 @@ is used in previous versions and XEmacs."
''write-file-functions ;Emacs 21.4
''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
;; Avoid compiler warning
(defvar tool-bar-map)
(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>
@ -1519,6 +1563,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
'mh-narrowed-to-seq nil ; Sequence display is narrowed to
'mh-tick-seq-changed-when-narrowed-flag nil
; Tick seq changed while narrowed
'mh-view-ops () ; Stack that keeps track of the order
; in which narrowing/threading has been
; carried out.
@ -1537,11 +1583,11 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(setq truncate-lines t)
(auto-save-mode -1)
(setq buffer-offer-save t)
(mh-make-local-hook (mh-write-file-functions-compat))
(add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
(make-local-variable 'revert-buffer-function)
(make-local-variable 'hl-line-mode) ; avoid pollution
(if (fboundp 'hl-line-mode)
(hl-line-mode 1))
(mh-funcall-if-exists hl-line-mode 1)
(setq revert-buffer-function 'mh-undo-folder)
(or (assq 'mh-showing-mode minor-mode-alist)
(setq minor-mode-alist
@ -1551,6 +1597,7 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(easy-menu-add mh-folder-folder-menu)
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
(mh-funcall-if-exists mh-toolbar-init :folder)
(if (and mh-xemacs-flag
font-lock-auto-fontify)
(turn-on-font-lock))) ; Force font-lock in XEmacs.
@ -1570,7 +1617,9 @@ Return in the folder's buffer."
(cond ((null (get-buffer folder))
(mh-make-folder folder))
(t
(or dont-exec-pending (mh-process-or-undo-commands folder))
(unless dont-exec-pending
(mh-process-or-undo-commands folder)
(mh-reset-threads-and-narrowing))
(switch-to-buffer folder)))
(mh-regenerate-headers range)
(if (zerop (buffer-size))
@ -1578,7 +1627,7 @@ Return in the folder's buffer."
(message "Folder %s is empty" folder)
(message "No messages in %s, range %s" folder range))
(mh-goto-cur-msg))
(when dont-exec-pending
(when (mh-outstanding-commands-p)
(mh-notate-deleted-and-refiled)))
(defun mh-set-cmd-note (width)
@ -1742,6 +1791,8 @@ Return in the current buffer."
(if new-mail-flag
(progn
(mh-make-folder-mode-line)
(when (mh-speed-flists-active-p)
(mh-speed-flists t mh-current-folder))
(when (memq 'unthread mh-view-ops)
(mh-thread-inc folder start-of-inc))
(mh-goto-cur-msg))
@ -1861,8 +1912,9 @@ Called by functions like `mh-sort-folder', so also invalidate show buffer."
(if (mh-outstanding-commands-p)
(if (or mh-do-not-confirm-flag
(y-or-n-p
"Process outstanding deletes and refiles (or lose them)? "))
"Process outstanding deletes and refiles? "))
(mh-process-commands folder)
(set-buffer folder)
(mh-undo-folder)))
(mh-update-unseen)
(mh-invalidate-show-buffer))
@ -1914,6 +1966,8 @@ with no arguments, before the commands are processed."
;; Redraw folder buffer if needed
(when (and redraw-needed-flag)
(when (mh-speed-flists-active-p)
(mh-speed-flists t mh-current-folder))
(cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
(mh-index-data (mh-index-insert-folder-headers)))))
@ -1962,10 +2016,10 @@ with no arguments, after the unseen sequence is updated."
(or mh-delete-list mh-refile-list))
(defun mh-coalesce-msg-list (messages)
"Give a list of MESSAGES, return a list of message number ranges.
Sort of the opposite of `mh-read-msg-list', which expands ranges.
Message lists passed to MH programs go through this so
command line arguments won't exceed system limits."
"Given a list of MESSAGES, return a list of message number ranges.
This is the inverse of `mh-read-msg-list', which expands ranges.
Message lists passed to MH programs should be processed by this function
to avoid exceeding system command line argument limits."
(let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
(range-high nil)
(prev -1)
@ -2059,44 +2113,84 @@ Expands ranges into set of individual numbers."
(setq msgs (cons num msgs)))))
msgs))
(defun mh-notate-user-sequences ()
"Mark the scan listing of all messages in user-defined sequences."
(defun mh-notate-user-sequences (&optional msg-or-seq)
"Mark user-defined sequences in the messages specified by MSG-OR-SEQ.
The optional argument MSG-OR-SEQ can be a message number, a list of message
numbers, a sequence, a region in a cons cell, or nil in which case all
messages in the folder buffer are notated."
(unless msg-or-seq
(setq msg-or-seq (cons (point-min) (point-max))))
(let ((seqs mh-seq-list)
(msg-hash (make-hash-table)))
(msg-hash (make-hash-table))
(tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))))
(dolist (seq seqs)
(unless (mh-internal-seq (mh-seq-name seq))
(dolist (msg (mh-seq-msgs seq))
(setf (gethash msg msg-hash) t))))
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(mh-iterate-on-msg-or-seq msg msg-or-seq
(when (gethash msg msg-hash)
(mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
(mh-notate nil mh-note-seq (1+ mh-cmd-note)))
(mh-notate-tick msg tick-msgs))))
(defun mh-internal-seq (name)
"Return non-nil if NAME is the name of an internal MH-E sequence."
(or (memq name '(answered cur deleted forwarded printed))
(eq name mh-unseen-seq)
(and mh-tick-seq (eq name mh-tick-seq))
(eq name mh-previous-seq)
(mh-folder-name-p name)))
(defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
"Delete MESSAGE from SEQUENCE.
MESSAGE defaults to displayed message. From Lisp, optional third arg
INTERNAL-FLAG non-nil means do not inform MH of the change."
(interactive (list (mh-get-msg-num t)
(defun mh-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag)
"Delete MSG-OR-SEQ from SEQUENCE.
Default value of MSG-OR-SEQ is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is deleted from SEQUENCE..
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil
means do not inform MH of the change."
(interactive (list (mh-interactive-msg-or-seq "Delete")
(mh-read-seq-default "Delete from" t)
nil))
(let ((entry (mh-find-seq sequence)))
(cond (entry
(mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
(if (not internal-flag)
(mh-undefine-sequence sequence (list message)))
(setcdr entry (delq message (mh-seq-msgs entry)))))))
(when entry
(mh-iterate-on-msg-or-seq msg msg-or-seq
(when (memq msg (mh-seq-msgs entry))
(mh-notate nil ? (1+ mh-cmd-note)))
(mh-delete-a-msg-from-seq msg sequence internal-flag)
(mh-clear-text-properties nil))
(mh-notate-user-sequences msg-or-seq)
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(mh-speed-flists t mh-current-folder)))))
(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
"Delete MSG from SEQUENCE.
If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
(let ((entry (mh-find-seq sequence)))
(when (and entry (memq msg (mh-seq-msgs entry)))
(if (not internal-flag)
(mh-undefine-sequence sequence (list msg)))
(setcdr entry (delq msg (mh-seq-msgs entry))))))
(defun mh-clear-text-properties (message)
"Clear all text properties (except mh-tick) from the scan line for MESSAGE."
(save-excursion
(with-mh-folder-updating (t)
(when (or (not message) (mh-goto-msg message t t))
(beginning-of-line)
(let ((tick-property (get-text-property (point) 'mh-tick)))
(set-text-properties (point) (line-end-position) nil)
(when tick-property
(add-text-properties (point) (line-end-position)
`(mh-tick ,tick-property))))))))
(defun mh-undefine-sequence (seq msgs)
"Remove from the SEQ the list of MSGS."
(mh-exec-cmd "mark" mh-current-folder "-delete"
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs)))
(prog1 (mh-exec-cmd "mark" mh-current-folder "-delete"
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs))
(when (and (eq seq mh-unseen-seq) (mh-speed-flists-active-p))
(mh-speed-flists t mh-current-folder))))
(defun mh-define-sequence (seq msgs)
"Define the SEQ to contain the list of MSGS.
@ -2181,6 +2275,7 @@ range."
(gnus-define-keys mh-folder-mode-map
" " mh-page-msg
"!" mh-refile-or-write-again
"'" mh-toggle-tick
"," mh-header-display
"." mh-alt-show
">" mh-write-msg-to-file
@ -2227,6 +2322,7 @@ range."
"i" mh-index-search
"k" mh-kill-folder
"l" mh-list-folders
"n" mh-index-new-messages
"o" mh-alt-visit-folder
"p" mh-pack-folder
"r" mh-rescan-folder
@ -2234,6 +2330,13 @@ range."
"u" mh-undo-folder
"v" mh-visit-folder)
(define-key mh-folder-mode-map "I" mh-inc-spool-map)
(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
"?" mh-prefix-help
"b" mh-junk-blacklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
"?" mh-prefix-help
"d" mh-delete-msg-from-seq
@ -2254,6 +2357,7 @@ range."
"o" mh-thread-refile)
(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
"s" mh-narrow-to-subject
"w" mh-widen)
@ -2304,8 +2408,8 @@ range."
'((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
"[d]elete, [o]refile, e[x]ecute,\n"
"[s]end, [r]eply.\n"
"Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
"[T]hread, / Limit, e[X]tract, [D]igest.")
"Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
"\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.")
(?F "[l]ist, [v]isit folder;\n"
"[t]hread; [s]earch; [i]ndexed search;\n"
@ -2318,7 +2422,8 @@ range."
(?X "un[s]har, [u]udecode message")
(?D "[b]urst digest")
(?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
"[TAB] next; [SHIFT-TAB] previous"))
"[TAB] next; [SHIFT-TAB] previous")
(?J "[b]lacklist, [w]hitelist message"))
"Key binding cheat sheet.
This is an associative array which is used to show the most common commands.

178
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, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -32,8 +32,6 @@
;;; Change Log:
;; $Id: mh-funcs.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
(require 'mh-e)
@ -76,33 +74,21 @@ digest are inserted into the folder after that message."
;;;###mh-autoload
(defun mh-copy-msg (msg-or-seq folder)
"Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
Default is the displayed message. If optional prefix argument is provided,
then prompt for the message sequence."
(interactive (list (cond
((mh-mark-active-p t)
(cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Copy" t))
(t
(cons (line-beginning-position) (line-end-position))))
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is copied.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence."
(interactive (list (mh-interactive-msg-or-seq "Copy")
(mh-prompt-for-folder "Copy to" "" t)))
(let ((msg-list (cond ((numberp msg-or-seq) (list msg-or-seq))
((symbolp msg-or-seq) (mh-seq-to-msgs msg-or-seq))
((and (consp msg-or-seq) (numberp (car msg-or-seq))
(numberp (cdr msg-or-seq)))
(let ((result ()))
(mh-iterate-on-messages-in-region msg
(car msg-or-seq) (cdr msg-or-seq)
(mh-notate nil mh-note-copied mh-cmd-note)
(push msg result))
result))
(t msg-or-seq))))
(let ((msg-list (let ((result ()))
(mh-iterate-on-msg-or-seq msg msg-or-seq
(mh-notate nil mh-note-copied mh-cmd-note)
(push msg result))
result)))
(mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
"-link" "-src" mh-current-folder folder)
(cond ((numberp msg-or-seq)
(mh-notate msg-or-seq mh-note-copied mh-cmd-note))
((symbolp msg-or-seq)
(mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))))
"-link" "-src" mh-current-folder folder)))
;;;###mh-autoload
(defun mh-kill-folder ()
@ -111,7 +97,7 @@ Removes all of the messages (files) within the specified current folder,
and then removes the folder (directory) itself."
(interactive)
(if (or mh-index-data
(yes-or-no-p (format "Remove folder %s (and all included messages)?"
(yes-or-no-p (format "Remove folder %s (and all included messages)? "
mh-current-folder)))
(let ((folder mh-current-folder)
(window-config mh-previous-window-config))
@ -246,57 +232,60 @@ Otherwise just send the message's body without the headers."
;;;###mh-autoload
(defun mh-print-msg (msg-or-seq)
"Print MSG-OR-SEQ (default: displayed message) on printer.
If optional prefix argument provided, then prompt for the message sequence.
"Print MSG-OR-SEQ on printer.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is printed.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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 (if current-prefix-arg
(reverse (mh-seq-to-msgs
(mh-read-seq-default "Print" t)))
(mh-get-msg-num t))))
(if (numberp msg-or-seq)
(message "Printing message...")
(message "Printing sequence..."))
(let ((print-command
(if (numberp msg-or-seq)
(format "%s -nobell -clear %s %s | %s"
(expand-file-name "mhl" mh-lib-progs)
(mh-msg-filename msg-or-seq)
(if (stringp mhl-formfile)
(format "-form %s" mhl-formfile)
"")
(format mh-lpr-command-format
(if (numberp msg-or-seq)
(format "%s/%d" mh-current-folder
msg-or-seq)
(format "Sequence from %s" mh-current-folder))))
(format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
(mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
(expand-file-name "mhl" mh-lib-progs)
(if (stringp mhl-formfile)
(format "-form %s" mhl-formfile)
"")
(mh-msg-filenames msg-or-seq)
(format mh-lpr-command-format
(if (numberp msg-or-seq)
(format "%s/%d" mh-current-folder
msg-or-seq)
(format "Sequence from %s"
mh-current-folder)))))))
(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))
(if (numberp msg-or-seq)
(mh-notate msg-or-seq mh-note-printed mh-cmd-note)
(mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
(mh-add-msgs-to-seq msg-or-seq 'printed t)
(if (numberp msg-or-seq)
(message "Printing message...done")
(message "Printing sequence...done"))))
(defun mh-msg-filenames (msgs &optional folder)
"Return a list of file names for MSGS in FOLDER (default current folder)."
(mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
(interactive (list (mh-interactive-msg-or-seq "Print")))
(message "Printing...")
(let (msgs)
;; Gather message numbers and add them to "printed" sequence.
(mh-iterate-on-msg-or-seq msg msg-or-seq
(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 msg-or-seq)
(format "Folder: %s, Messages: %s"
mh-current-folder msgs-string))
((symbolp msg-or-seq)
(format "Folder: %s, Sequence: %s"
mh-current-folder msg-or-seq)))))
(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)
@ -314,7 +303,6 @@ argument EXTRA-ARGS is given."
(when mh-index-data
(mh-index-update-maps mh-current-folder))
(message "Sorting folder...done")
(mh-reset-threads-and-narrowing)
(mh-scan-folder mh-current-folder "all")
(cond (threaded-flag (mh-toggle-threads))
(mh-index-data (mh-index-insert-folder-headers)))))
@ -334,7 +322,9 @@ Argument IGNORE is deprecated."
(mh-unmark-all-headers t)))
(t
(message "Commands not undone.")
(sit-for 2))))
;; Remove by 2003-06-30 if nothing seems amiss. XXX
;; (sit-for 2)
)))
;;;###mh-autoload
(defun mh-store-msg (directory)
@ -378,9 +368,9 @@ Default directory is the last directory used, or initially the value of
(if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
nil ;most likely end of a uuencode
(point))))))
(log-buffer (get-buffer-create "*Store Output*"))
(command "sh")
(uudecode-filename "(unknown filename)"))
(uudecode-filename "(unknown filename)")
log-begin)
(if (not sh-start)
(save-excursion
(goto-char (point-min))
@ -389,31 +379,33 @@ Default directory is the last directory used, or initially the value of
(buffer-substring (point)
(progn (end-of-line) (point)))))))
(save-excursion
(set-buffer log-buffer)
(erase-buffer)
(set-buffer (get-buffer-create mh-log-buffer))
(setq log-begin (mh-truncate-log-buffer))
(if (not (file-directory-p store-directory))
(progn
(insert "mkdir " directory "\n")
(call-process "mkdir" nil log-buffer t store-directory)))
(call-process "mkdir" nil mh-log-buffer t store-directory)))
(insert "cd " directory "\n")
(setq mh-store-default-directory directory)
(if (not sh-start)
(progn
(setq command "uudecode")
(insert uudecode-filename " being uudecoded...\n"))))
(set-window-start (display-buffer log-buffer) 0) ;watch progress
(let (value)
(let ((default-directory (file-name-as-directory store-directory)))
(setq value (call-process-region sh-start (point-max) command
nil log-buffer t)))
(set-buffer log-buffer)
(mh-handle-process-error command value))
(insert "\n(mh-store finished)\n")))
(set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress
(let ((default-directory (file-name-as-directory store-directory)))
(if (equal (call-process-region sh-start (point-max) command
nil mh-log-buffer t)
0)
(save-excursion
(set-buffer mh-log-buffer)
(insert "\n(mh-store finished)\n"))
(error "Error occurred during execution of %s" command)))))
;;; Help Functions
;;;###mh-autoload
(defun mh-ephem-message (string)
"Display STRING in the minibuffer momentarily."
(message "%s" string)

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

@ -1,6 +1,6 @@
;;; mh-identity.el --- Multiple Identify support for MH-E.
;;; mh-identity.el --- Multiple identify support for MH-E.
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -37,8 +37,6 @@
;;; Change Log:
;; $Id: mh-identity.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
@ -169,11 +167,9 @@ Edit the `mh-identity-list' variable to define identity."
(cond
;; If MIME composition done, insert signature at the end as
;; an inline MIME part.
((and (boundp 'mh-mhn-compose-insert-flag)
mh-mhn-compose-insert-flag)
((mh-mhn-directive-present-p)
(insert "#\n" "Content-Description: Signature\n"))
((and (boundp 'mh-mml-compose-insert-flag)
mh-mml-compose-insert-flag)
((mh-mml-directive-present-p)
(mml-insert-tag 'part 'type "text/plain"
'disposition "inline"
'description "Signature")))
@ -182,12 +178,10 @@ Edit the `mh-identity-list' variable to define identity."
(funcall value))
(goto-char (point-min))
(when (not (re-search-forward "^--" nil t))
(if (and (boundp 'mh-mhn-compose-insert-flag)
mh-mhn-compose-insert-flag)
(forward-line 2))
(if (and (boundp 'mh-mml-compose-insert-flag)
mh-mml-compose-insert-flag)
(forward-line 1))
(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))

104
lisp/mh-e/mh-inc.el Normal file
View file

@ -0,0 +1,104 @@
;;; mh-inc.el --- MH-E `inc' and separate mail spool handling
;;
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Support for inc. In addition to reading from the system mailbox, inc can
;; also be used to incorporate mail from multiple spool files into separate
;; folders. See `C-h v mh-inc-spool-list'.
;;; Change Log:
;;; Code:
(eval-when-compile (require 'cl))
(defvar mh-inc-spool-map (make-sparse-keymap)
"Keymap for MH-E's mh-inc-spool commands.")
(defvar mh-inc-spool-map-help nil
"Help text to for `mh-inc-spool-map'.")
(define-key mh-inc-spool-map "?"
'(lambda ()
(interactive)
(if mh-inc-spool-map-help
(mh-ephem-message (substring mh-inc-spool-map-help 0 -1))
(mh-ephem-message
"There are no keys defined yet. Customize `mh-inc-spool-list'"))))
(defun mh-inc-spool-generator (folder spool)
"Create a command to inc into FOLDER from SPOOL file."
(let ((folder1 (make-symbol "folder"))
(spool1 (make-symbol "spool")))
(set folder1 folder)
(set spool1 spool)
(setf (symbol-function (intern (concat "mh-inc-spool-" folder)))
`(lambda ()
,(format "Inc spool file %s into folder %s" spool folder)
(interactive)
(mh-inc-folder ,spool1 (concat "+" ,folder1))))))
(defun mh-inc-spool-def-key (key folder)
"Define a KEY in `mh-inc-spool-map' to inc FOLDER and collect help string."
(when (not (= 0 key))
(define-key mh-inc-spool-map (format "%c" key)
(intern (concat "mh-inc-spool-" folder)))
(setq mh-inc-spool-map-help (concat mh-inc-spool-map-help "["
(char-to-string key)
"] inc " folder " folder\n"))))
;; Avoid compiler warning
(eval-when-compile (defvar mh-inc-spool-list))
(defun mh-inc-spool-make ()
"Make all commands and defines keys for contents of `mh-inc-spool-list'."
(when mh-inc-spool-list
(setq mh-inc-spool-map-help nil)
(loop for elem in mh-inc-spool-list
do (let ((spool (nth 0 elem))
(folder (nth 1 elem))
(key (nth 2 elem)))
(progn
(mh-inc-spool-generator folder spool)
(mh-inc-spool-def-key key folder))))))
;;;###mh-autoload
(defun mh-inc-spool-list-set (symbol value)
"Set-default SYMBOL to VALUE to update the `mh-inc-spool-list' variable.
Also rebuilds the user commands.
This is called after 'customize is used to alter `mh-inc-spool-list'."
(set-default symbol value)
(mh-inc-spool-make))
(provide 'mh-inc)
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;;; mh-inc.el ends here

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

@ -1,6 +1,6 @@
;;; mh-index -- MH-E interface to indexing programs
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -29,6 +29,7 @@
;;; (1) The following search engines are supported:
;;; swish++
;;; swish-e
;;; mairix
;;; namazu
;;; glimpse
;;; grep
@ -40,8 +41,6 @@
;;; Change Log:
;; $Id: mh-index.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
(require 'cl)
@ -165,21 +164,22 @@ The current buffer contains a list of strings, one on each line. The function
will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
strings to it. This is repeated till all the strings have been used."
(goto-char (point-min))
(let ((out (get-buffer-create " *mh-xargs-output*")))
(save-excursion
(set-buffer out)
(erase-buffer))
(while (not (eobp))
(let ((arg-list (reverse args))
(count 0))
(while (and (not (eobp)) (< count mh-index-max-cmdline-args))
(push (buffer-substring-no-properties (point) (line-end-position))
arg-list)
(incf count)
(forward-line))
(apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
(erase-buffer)
(insert-buffer-substring out)))
(let ((current-buffer (current-buffer)))
(with-temp-buffer
(let ((out (current-buffer)))
(set-buffer current-buffer)
(while (not (eobp))
(let ((arg-list (reverse args))
(count 0))
(while (and (not (eobp)) (< count mh-index-max-cmdline-args))
(push (buffer-substring-no-properties (point) (line-end-position))
arg-list)
(incf count)
(forward-line))
(apply #'call-process cmd nil (list out nil) nil
(nreverse arg-list))))
(erase-buffer)
(insert-buffer-substring out)))))
@ -230,7 +230,8 @@ checksum -> (origin-folder, origin-index) map is updated too."
(point) (line-end-position)))
(forward-line)
(save-excursion
(cond ((eolp)
(cond ((not (string-match "^[0-9]*$" msg)))
((eolp)
;; need to compute checksum
(set-buffer mh-checksum-buffer)
(insert mh-user-path (substring folder 1) "/" msg "\n"))
@ -260,6 +261,9 @@ checksum -> (origin-folder, origin-index) map is updated too."
(mh-index-update-single-msg msg checksum origin-map)))
(forward-line))))))
(defvar mh-flists-results-folder "new"
"Subfolder for `mh-index-folder' where flists output is placed.")
(defun mh-index-generate-pretty-name (string)
"Given STRING generate a name which is suitable for use as a folder name.
White space from the beginning and end are removed. All spaces in the name are
@ -288,19 +292,24 @@ they are concatenated to construct the base name."
(subst-char-in-region (point-min) (point-max) ?\n ?_ t)
(subst-char-in-region (point-min) (point-max) ?\r ?_ t)
(subst-char-in-region (point-min) (point-max) ?/ ?$ t)
(truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
(let ((out (truncate-string-to-width (buffer-string) 20)))
(cond ((eq mh-indexer 'flists) mh-flists-results-folder)
((equal out mh-flists-results-folder) (concat out "1"))
(t out)))))
;;;###mh-autoload
(defun* mh-index-search (redo-search-flag folder search-regexp
&optional window-config)
&optional window-config unseen-flag)
"Perform an indexed search in an MH mail folder.
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
index search, then the search is repeated. Otherwise, FOLDER is searched with
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
stores the window configuration that will be restored after the user quits the
folder containing the index search results.
folder containing the index search results. If optional argument UNSEEN-FLAG
is non-nil, then all the messages are marked as unseen.
Four indexing programs are supported; if none of these are present, then grep
is used. This function picks the first program that is available on your
@ -381,7 +390,7 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(message "Processing %s output... " mh-indexer)
(goto-char (point-min))
(loop for next-result = (funcall mh-index-next-result-function)
when (null next-result) return nil
while next-result
do (unless (eq next-result 'error)
(unless (gethash (car next-result) folder-results-map)
(setf (gethash (car next-result) folder-results-map)
@ -403,9 +412,13 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(cons folder msg)))))
folder-results-map)
;; Mark messages as unseen (if needed)
(when (and unseen-flag (> result-count 0))
(mh-exec-cmd "mark" index-folder "all"
"-sequence" (symbol-name mh-unseen-seq) "-add"))
;; Generate scan lines for the hits.
(let ((mh-show-threads-flag nil))
(mh-visit-folder index-folder () (list folder-results-map origin-map)))
(mh-visit-folder index-folder () (list folder-results-map origin-map))
(goto-char (point-min))
(forward-line)
@ -548,9 +561,8 @@ The function is only applicable to folders displaying index search results.
With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
results."
(interactive "P")
(if (or (null mh-index-data)
(memq 'unthread mh-view-ops))
(message "Only applicable in an unthreaded MH-E index search buffer")
(if (null mh-index-data)
(message "Only applicable in an MH-E index search buffer")
(let ((point (point)))
(forward-line (if backward-flag -1 1))
(cond ((if backward-flag
@ -627,6 +639,22 @@ we find a new folder name."
(when cur-msg (mh-goto-msg cur-msg t))
(set-buffer-modified-p old-buffer-modified-flag)))
;;;###mh-autoload
(defun mh-index-group-by-folder ()
"Partition the messages based on source folder.
Returns an alist with the the folder names in the car and the cdr being the
list of messages originally from that folder."
(save-excursion
(goto-char (point-min))
(let ((result-table (make-hash-table)))
(loop for msg being hash-keys of mh-index-msg-checksum-map
do (push msg (gethash (car (gethash
(gethash msg mh-index-msg-checksum-map)
mh-index-checksum-origin-map))
result-table)))
(loop for x being the hash-keys of result-table
collect (cons x (nreverse (gethash x result-table)))))))
;;;###mh-autoload
(defun mh-index-delete-folder-headers ()
"Delete the folder headers."
@ -662,9 +690,28 @@ we find a new folder name."
(when (not folder)
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
mh-index-checksum-origin-map))))
(mh-visit-folder
folder (loop for x being the hash-keys of (gethash folder mh-index-data)
when (mh-msg-exists-p x folder) collect x))))
(when (or (not (get-buffer folder))
(y-or-n-p (format "Reuse buffer displaying %s? " folder)))
(mh-visit-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."
@ -918,7 +965,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP-LIST is used to search."
(when (or (eobp) (and (bolp) (eolp)))
(return nil))
(unless (eq (char-after) ?/)
(return error))
(return 'error))
(let ((start (point))
end msg-start)
(setq end (line-end-position))
@ -1000,6 +1047,68 @@ REGEXP-LIST is an alist of fields and values."
;; Interface to unseen messages script
(defvar mh-flists-search-folders)
(defun mh-flists-execute (&rest args)
"Search for unseen messages in `mh-flists-search-folders'.
If `mh-recursive-folders-flag' is t, then the folders are searched
recursively. All parameters ARGS are ignored."
(set-buffer (get-buffer-create mh-index-temp-buffer))
(erase-buffer)
(unless (executable-find "sh")
(error "Didn't find sh"))
(with-temp-buffer
(let ((unseen (symbol-name mh-unseen-seq)))
(insert "for folder in `flists "
(cond ((eq mh-flists-search-folders t) mh-inbox)
((eq mh-flists-search-folders nil) "")
((listp mh-flists-search-folders)
(loop for folder in mh-flists-search-folders
concat (concat " " folder))))
(if mh-recursive-folders-flag " -recurse" "")
" -sequence " unseen " -noshowzero -fast` ; do\n"
"mhpath \"+$folder\" " unseen "\n" "done\n"))
(call-process-region
(point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
;;;###mh-autoload
(defun mh-index-new-messages (folders)
"Display new messages.
All messages in the `mh-unseen-seq' 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."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Folders to search: "))
mh-index-new-messages-folders)))
(let* ((mh-flists-search-folders folders)
(mh-indexer 'flists)
(mh-index-execute-search-function 'mh-flists-execute)
(mh-index-next-result-function 'mh-mairix-next-result)
(mh-mairix-folder mh-user-path)
(mh-index-regexp-builder nil)
(new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder))
(window-config (if (equal new-folder mh-current-folder)
mh-previous-window-config
(current-window-configuration)))
(redo-flag nil))
(cond ((buffer-live-p (get-buffer new-folder))
;; The destination folder is being visited. Trick `mh-index-search'
;; into thinking that the folder was the result of a previous search.
(set-buffer new-folder)
(setq mh-index-previous-search (list "+" mh-flists-results-folder))
(setq redo-flag t))
((mh-folder-exists-p new-folder)
;; Folder exists but we don't have it open. That means they are
;; stale results from a old flists search. Clear it out.
(mh-exec-cmd-quiet nil "rmf" new-folder)))
(mh-index-search redo-flag "+" mh-flists-results-folder window-config t)))
;; Swish interface
(defvar mh-swish-binary (executable-find "swish-e"))
@ -1163,7 +1272,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
(defun mh-swish++-regexp-builder (regexp-list)
"Generate query for swish++.
REGEXP-LIST is an alist of fields and values."
(let ((regexp "") meta)
(let ((regexp ""))
(dolist (elem regexp-list)
(when (cdr elem)
(setq regexp (concat regexp " and "
@ -1264,6 +1373,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
;;;###mh-autoload
(defun mh-index-choose ()
"Choose an indexing function.
The side-effects of this function are that the variables `mh-indexer',

416
lisp/mh-e/mh-junk.el Normal file
View file

@ -0,0 +1,416 @@
;;; mh-junk.el --- Interface to anti-spam measures
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail, spam
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Spam handling in MH-E.
;;; Change Log:
;;; Code:
(require 'mh-e)
;; Interactive functions callable from the folder buffer
;;;###mh-autoload
(defun mh-junk-blacklist (msg-or-seq)
"Blacklist MSG-OR-SEQ as spam.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is blacklisted.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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:
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'"
(interactive (list (mh-interactive-msg-or-seq "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) ?@)
(concat mh-current-folder "/"
(substring mh-junk-mail-folder 1)))
(t (concat "+" mh-junk-mail-folder)))))
(mh-iterate-on-msg-or-seq msg msg-or-seq
(funcall (symbol-function blacklist-func) msg)
(if dest
(mh-refile-a-msg nil (intern dest))
(mh-delete-a-msg nil)))
(mh-next-msg))))
;;;###mh-autoload
(defun mh-junk-whitelist (msg-or-seq)
"Whitelist MSG-OR-SEQ incorrectly classified as spam.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is whitelisted.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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."
(interactive (list (mh-interactive-msg-or-seq "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-msg-or-seq msg msg-or-seq
(funcall (symbol-function whitelist-func) 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.
Spamassassin is an excellent spam filter. For more information, see:
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\").
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.
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.
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.
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.
#
# Spam
#
:0fw
| spamc
# Anything with a spam level of 10 or more is junked immediately.
:0:
* ^X-Spam-Level: ..........
/dev/null
:0
* ^X-Spam-Status: Yes
$SPAM
If you don't use \"spamc\", use \"spamassassin -P -a\".
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.
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.
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 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.
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"))
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
(save-excursion
(message "Giving this message the Razor...")
(mh-truncate-log-buffer)
(call-process mh-spamassassin-executable msg-file mh-log-buffer nil
"--report" "--remove-from-whitelist")
(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...")
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs) nil t nil
(format "%s" msg) current-folder
"-format" "%<(mymbox{from})%|%(addr{from})%>")
(goto-char (point-min))
(if (search-forward-regexp "^\\(.+\\)$" nil t)
(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)")))))
(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."
(unless mh-spamassassin-executable
(error "Couldn't find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
(show-buffer (get-buffer mh-show-buffer))
from)
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(message "Removing spamassassin markup from message...")
(call-process mh-spamassassin-executable msg-file mh-temp-buffer nil
"--remove-markup")
(if show-buffer
(kill-buffer show-buffer))
(write-file msg-file)
(when mh-sa-learn-executable
(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:"))))
(kill-buffer nil)
(unless (equal from "")
(mh-spamassassin-add-rule "whitelist_from" from))
(message "Whitelisting address...done"))))
(defun mh-spamassassin-add-rule (rule body)
"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))
(case-fold-search t)
(file (expand-file-name "~/.spamassassin/user_prefs"))
(buffer-exists (find-buffer-visiting file)))
(find-file file)
(if (not (search-forward (format "\n%s" line) nil t))
(progn
(goto-char (point-max))
(insert (if (bolp) "" "\n") line)
(save-buffer)))
(if (not buffer-exists)
(kill-buffer nil)))))
(defun mh-spamassassin-identify-spammers ()
"Identifies 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:
blacklist_from *@*amazingoffersdirect2u.com"
(interactive)
(let* ((file (expand-file-name "~/.spamassassin/user_prefs"))
(domains (make-hash-table :test 'equal)))
(find-file file)
;; Only consider entries between last blank line and end of file.
(goto-char (1- (point-max)))
(search-backward-regexp "^$")
;; Perform frequency count.
(save-excursion
(while (search-forward-regexp "^blacklist_from\\s-*\\(.*\\)@\\(.*\\)$"
nil t)
(let ((host (match-string 2))
value)
;; Remove top-level-domain from hostname.
(setq host (cdr (reverse (split-string host "\\."))))
;; 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)
(setq host (cdr host))))))
;; Output
(delete-other-windows)
(pop-to-buffer (get-buffer-create "*MH-E Spammer Frequencies*"))
(erase-buffer)
(maphash '(lambda (key value) ""
(if (> value 2)
(insert (format "%s %s\n" key value))))
domains)
(sort-numeric-fields 2 (point-min) (point-max))
(reverse-region (point-min) (point-max))
(goto-char (point-min))))
(provide 'mh-junk)
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;;; mh-junk.el ends here

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

@ -5,7 +5,6 @@
;;; Keywords: mail
;;; Commentary:
;;; Change Log:
;; $Id: mh-loaddefs.el,v 1.36 2003/02/03 19:15:13 wohler Exp $
;;; Code:
;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
@ -13,7 +12,7 @@
;;;;;; 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"
;;;;;; (15924 43423))
;;;;;; (16039 39609))
;;; Generated autoloads from mh-comp.el
(autoload (quote mh-edit-again) "mh-comp" "\
@ -29,13 +28,15 @@ gives the headers to clean out of the original message.
See also documentation for `\\[mh-send]' function." t nil)
(autoload (quote mh-forward) "mh-comp" "\
Forward one or more messages to the recipients TO and CC.
Forward messages to the recipients TO and CC.
Use optional MSG-OR-SEQ argument to specify a message or sequence to forward.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is forwarded.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
Default is the displayed message. If optional prefix argument is given then
prompt for the message sequence. If variable `transient-mark-mode' is non-nil
and the mark is active, then the selected region is forwarded.
See also documentation for `\\[mh-send]' function." t nil)
(autoload (quote mh-redistribute) "mh-comp" "\
@ -45,7 +46,8 @@ Depending on how your copy of MH was compiled, you may need to change the
setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
(autoload (quote mh-reply) "mh-comp" "\
Reply to MESSAGE (default: current message).
Reply to MESSAGE.
Default is the displayed message.
If the optional argument REPLY-TO is not given, prompts for type of addresses
to reply to:
from sender only,
@ -107,8 +109,8 @@ Send the draft letter in the current buffer.
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 variable `mh-mhn-compose-insert-flag' is set.
Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
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)
@ -149,8 +151,8 @@ passing the prefix ARG if any." t nil)
;;;***
;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15933 21842))
;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
;;;;;; (16038 15647))
;;; Generated autoloads from mh-customize.el
(autoload (quote mh-customize) "mh-customize" "\
@ -158,16 +160,10 @@ Customize MH-E variables.
With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
are removed." t nil)
(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
Construct toolbar for `mh-letter-mode'." nil nil)
(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
Construct toolbar for `mh-folder-mode'." nil nil)
;;;***
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
;;;;;; "mh-e" "mh-e.el" (15934 48879))
;;;;;; "mh-e" "mh-e.el" (16040 30321))
;;; Generated autoloads from mh-e.el
(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
@ -186,11 +182,11 @@ recenter the folder buffer." nil nil)
;;;***
;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
;;;### (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-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"
;;;;;; (15923 15465))
;;;;;; (16039 39632))
;;; Generated autoloads from mh-funcs.el
(autoload (quote mh-burst-digest) "mh-funcs" "\
@ -200,8 +196,12 @@ digest are inserted into the folder after that message." t nil)
(autoload (quote mh-copy-msg) "mh-funcs" "\
Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
Default is the displayed message. If optional prefix argument is provided,
then prompt for the message sequence." t nil)
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is copied.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence." t nil)
(autoload (quote mh-kill-folder) "mh-funcs" "\
Remove the current folder and all included messages.
@ -229,8 +229,14 @@ Advance displayed message to next digested message." t nil)
Back up displayed message to previous digested message." t nil)
(autoload (quote mh-print-msg) "mh-funcs" "\
Print MSG-OR-SEQ (default: displayed message) on printer.
If optional prefix argument provided, then prompt for the message sequence.
Print MSG-OR-SEQ on printer.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is printed.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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)
@ -256,6 +262,9 @@ The buffer can contain a shar file or uuencoded file.
Default directory is the last directory used, or initially the value of
`mh-store-default-directory' or the current directory." t nil)
(autoload (quote mh-ephem-message) "mh-funcs" "\
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)
@ -265,7 +274,7 @@ 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" (15900 46388))
;;;;;; "mh-identity" "mh-identity.el" (16039 39644))
;;; Generated autoloads from mh-identity.el
(autoload (quote mh-identity-make-menu) "mh-identity" "\
@ -283,12 +292,24 @@ Edit the `mh-identity-list' variable to define identity." t nil)
;;;***
;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16040
;;;;;; 51164))
;;; Generated autoloads from mh-inc.el
(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
Set-default SYMBOL to VALUE to update the `mh-inc-spool-list' variable.
Also rebuilds the user commands.
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-new-messages mh-glimpse-execute-search
;;;;;; mh-index-execute-commands mh-index-update-unseen mh-index-visit-folder
;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-insert-folder-headers
;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-parse-search-regexp
;;;;;; mh-index-do-search mh-index-search mh-index-update-maps)
;;;;;; "mh-index" "mh-index.el" (15924 45743))
;;;;;; "mh-index" "mh-index.el" (16038 15647))
;;; Generated autoloads from mh-index.el
(autoload (quote mh-index-update-maps) "mh-index" "\
@ -300,13 +321,15 @@ checksum -> (origin-folder, origin-index) map is updated too." nil nil)
(autoload (quote mh-index-search) "mh-index" "\
Perform an indexed search in an MH mail folder.
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
index search, then the search is repeated. Otherwise, FOLDER is searched with
SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
stores the window configuration that will be restored after the user quits the
folder containing the index search results.
folder containing the index search results. If optional argument UNSEEN-FLAG
is non-nil, then all the messages are marked as unseen.
Four indexing programs are supported; if none of these are present, then grep
is used. This function picks the first program that is available on your
@ -358,12 +381,21 @@ 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-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
list of messages originally from that folder." nil nil)
(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
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
@ -403,6 +435,13 @@ daily from cron:
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
(autoload (quote mh-index-new-messages) "mh-index" "\
Display new messages.
All messages in the `mh-unseen-seq' 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)
(autoload (quote mh-swish-execute-search) "mh-index" "\
Execute swish-e and read the results.
@ -515,16 +554,69 @@ daily from cron:
FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
(autoload (quote mh-index-choose) "mh-index" "\
Choose an indexing function.
The side-effects of this function are that the variables `mh-indexer',
`mh-index-execute-search-function', and `mh-index-next-result-function' are
set according to the first indexer in `mh-indexer-choices' present on the
system." nil nil)
;;;***
;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
;;;;;; "mh-junk.el" (16023 25085))
;;; Generated autoloads from mh-junk.el
(autoload (quote mh-junk-blacklist) "mh-junk" "\
Blacklist MSG-OR-SEQ as spam.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is blacklisted.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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:
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'" t nil)
(autoload (quote mh-junk-whitelist) "mh-junk" "\
Whitelist MSG-OR-SEQ incorrectly classified as spam.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is whitelisted.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence.
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)
;;;***
;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
;;;;;; mh-press-button mh-mime-display 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-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
;;;;;; 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" (15923 15465))
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16039 39680))
;;; Generated autoloads from mh-mime.el
(autoload (quote mh-compose-insertion) "mh-mime" "\
@ -591,7 +683,8 @@ Process the current draft with the mhn program, which, using directives
already inserted in the draft, fills in all the MIME components and header
fields.
This step should be done last just before sending the message.
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well.
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
@ -602,8 +695,7 @@ components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
message). If these helper functions are used, `mh-edit-mhn' is run
automatically when the draft is sent.
message).
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.
@ -614,8 +706,13 @@ The mhn program is part of MH version 6.8 or later." t nil)
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)
(autoload (quote mh-mml-to-mime) "mh-mime" "\
Compose MIME message from mml directives." t nil)
Compose MIME message from mml directives.
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well." t nil)
(autoload (quote mh-mml-forward-message) "mh-mime" "\
Forward a message as attachment.
@ -640,6 +737,9 @@ Add directive to encrypt/sign the entire message." t nil)
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-directive-present-p) "mh-mime" "\
Check if the current buffer has text which may be an MML directive." nil nil)
(autoload (quote mh-mime-cleanup) "mh-mime" "\
Free the decoded MIME parts." nil nil)
@ -663,6 +763,9 @@ If ARG, prompt for directory, else use that specified by the variable
mh_profile directives, since this function calls on mhstore or mhn to do the
actual storing." t nil)
(autoload (quote mh-decode-message-header) "mh-mime" "\
Decode RFC2047 encoded message header fields." nil nil)
(autoload (quote mh-mime-display) "mh-mime" "\
Display (and possibly decode) MIME handles.
Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
@ -689,7 +792,7 @@ Toggle display of the raw MIME part." t nil)
;;;***
;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (15924 45743))
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16037 44490))
;;; Generated autoloads from mh-pick.el
(autoload (quote mh-search-folder) "mh-pick" "\
@ -719,14 +822,16 @@ indexing program specified in `mh-index-program' is used." t nil)
;;;***
;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-notate-tick
;;;;;; mh-thread-refile mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling
;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads
;;;;;; mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
;;;;;; mh-interactive-msg-or-seq mh-msg-or-seq-to-msg-list mh-iterate-on-msg-or-seq
;;;;;; 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-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" (15923 15465))
;;;;;; "mh-seq" "mh-seq.el" (16039 39691))
;;; Generated autoloads from mh-seq.el
(autoload (quote mh-delete-seq) "mh-seq" "\
@ -736,17 +841,21 @@ 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: current message)." t nil)
Display the sequences that contain MESSAGE.
Default is the displayed message." t nil)
(autoload (quote mh-narrow-to-seq) "mh-seq" "\
Restrict display of this folder to just messages in SEQUENCE.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
If optional prefix argument provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then
the selected region is added to the sequence." t nil)
Add MSG-OR-SEQ to SEQUENCE.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is added to the sequence.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence." t nil)
(autoload (quote mh-widen) "mh-seq" "\
Remove restrictions from current folder, thereby showing all messages." t nil)
@ -779,6 +888,34 @@ till END. In each step BODY is executed.
If VAR is nil then the loop is executed without any binding." nil (quote macro))
(autoload (quote mh-iterate-on-msg-or-seq) "mh-seq" "\
Iterate an operation over a region or sequence.
VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a
message number, a list of message numbers, a sequence, or a region in a cons
cell. In each iteration, BODY is executed.
The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq'
in order to provide a uniform interface to MH-E functions." nil (quote macro))
(autoload (quote mh-msg-or-seq-to-msg-list) "mh-seq" "\
Return a list of messages for MSG-OR-SEQ.
MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or
a region in a cons cell." nil nil)
(autoload (quote mh-interactive-msg-or-seq) "mh-seq" "\
Return interactive specification for message, sequence, or region.
By convention, the name of this argument is msg-or-seq.
If variable `transient-mark-mode' is non-nil and the mark is active, then this
function returns a cons-cell of the region.
If optional prefix argument provided, then prompt for message sequence with
SEQUENCE-PROMPT and return sequence.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-msg-or-seq' 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)
@ -829,11 +966,23 @@ Mark current message and all its children for subsequent deletion." t nil)
(autoload (quote mh-thread-refile) "mh-seq" "\
Mark current message and all its children for refiling to FOLDER." t nil)
(autoload (quote mh-notate-tick) "mh-seq" "\
Highlight current line if MSG is in TICKED-MSGS.
If optional argument IGNORE-NARROWING is non-nil then highlighting is carried
out even if folder is narrowed to `mh-tick-seq'." nil nil)
(autoload (quote mh-toggle-tick) "mh-seq" "\
Toggle tick mark of all messages in region BEGIN to END." t nil)
(autoload (quote mh-narrow-to-tick) "mh-seq" "\
Restrict display of this folder to just 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" (15933 21584))
;;;;;; "mh-speed" "mh-speed.el" (16037 44491))
;;; Generated autoloads from mh-speed.el
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@ -854,7 +1003,8 @@ Optional ARGS are ignored." t nil)
(autoload (quote mh-speed-flists) "mh-speed" "\
Execute flists -recurse and update message counts.
If FORCE is non-nil the timer is reset." t nil)
If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run
only for that one folder." t nil)
(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
Remove FOLDER from various optimization caches." t nil)
@ -866,7 +1016,7 @@ 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" (15924 47279))
;;;;;; "mh-utils" "mh-utils.el" (16039 40655))
;;; Generated autoloads from mh-utils.el
(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
@ -885,7 +1035,7 @@ not pointing to a message." nil nil)
;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-address-to-alias
;;;;;; mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
;;;;;; mh-read-address mh-alias-reload) "mh-alias" "mh-alias.el"
;;;;;; (15924 45743))
;;;;;; (16039 39579))
;;; Generated autoloads from mh-alias.el
(autoload (quote mh-alias-reload) "mh-alias" "\
@ -904,7 +1054,9 @@ Expand mail alias before point." nil nil)
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." nil nil)
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-add-alias) "mh-alias" "\
*Add ALIAS for ADDRESS in personal alias file.

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

@ -1,6 +1,6 @@
;;; mh-mime.el --- MH-E support for composing MIME messages
;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -32,8 +32,6 @@
;;; Change Log:
;; $Id: mh-mime.el,v 1.100 2003/01/25 19:18:51 satyaki Exp $
;;; Code:
(require 'cl)
@ -58,6 +56,7 @@
(autoload 'mml-insert-empty-tag "mml")
(autoload 'mml-to-mime "mml")
(autoload 'mml-attach-file "mml")
(autoload 'rfc2047-decode-region "rfc2047")
;;;###mh-autoload
(defun mh-compose-insertion (&optional inline)
@ -235,7 +234,6 @@ See also \\[mh-edit-mhn]."
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
used as the Content-Description field, optional set of ATTRIBUTES and an
optional COMMENT can also be included."
(setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#" type)
(and attributes
@ -306,7 +304,6 @@ DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.
See also \\[mh-edit-mhn]."
(setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#@" type)
(and attributes
@ -341,7 +338,6 @@ See also \\[mh-edit-mhn]."
(if mh-sent-from-msg
(format " [%d]" mh-sent-from-msg)
"")))))
(setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#forw [")
(and description
@ -368,7 +364,8 @@ Process the current draft with the mhn program, which, using directives
already inserted in the draft, fills in all the MIME components and header
fields.
This step should be done last just before sending the message.
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well.
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
@ -379,8 +376,7 @@ components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
message). If these helper functions are used, `mh-edit-mhn' is run
automatically when the draft is sent.
message).
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.
@ -396,7 +392,6 @@ The mhn program is part of MH version 6.8 or later."
(t
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
"mhn" (if extra-args mh-mhn-args) buffer-file-name)))
(setq mh-mhn-compose-insert-flag nil)
(revert-buffer t t)
(message "mhn editing...done")
(run-hooks 'mh-edit-mhn-hook))
@ -429,18 +424,35 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
(insert-file-contents backup-file))
(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."
(save-excursion
(block 'search-for-mhn-directive
(goto-char (point-min))
(while (re-search-forward "^#" nil 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)
(return-from 'search-for-mhn-directive t)))))))
nil)))
;;; MIME composition functions
;;;###mh-autoload
(defun mh-mml-to-mime ()
"Compose MIME message from mml directives."
"Compose MIME message from mml directives.
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well."
(interactive)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
(mml-to-mime)
(setq mh-mml-compose-insert-flag nil))
(mml-to-mime))
;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
@ -460,8 +472,7 @@ number."
(mml-attach-file (format "%s%s/%d"
mh-user-path (substring folder 1) msg)
"message/rfc822"
description))
(setq mh-mml-compose-insert-flag t))
description)))
(t (error "The message number, %s is not a integer!" msg)))))
;;;###mh-autoload
@ -488,8 +499,7 @@ automatically."
nil t nil nil
"attachment"))))
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)
(setq mh-mml-compose-insert-flag t)))
'disposition dispos 'description description)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
@ -497,8 +507,7 @@ automatically."
(interactive)
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
(mml-secure-message-sign-pgpmime)
(setq mh-mml-compose-insert-flag t)))
(mml-secure-message-sign-pgpmime)))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
@ -507,8 +516,16 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
(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)
(setq mh-mml-compose-insert-flag t)))
(mml-secure-message-encrypt-pgpmime dontsign)))
;;;###mh-autoload
(defun mh-mml-directive-present-p ()
"Check if the current buffer has text which may be an MML directive."
(save-excursion
(goto-char (point-min))
(re-search-forward
"\\(<#part\\(.\\|\n\\)*>[ \n\t]*<#/part>\\|^<#secure.+>$\\)"
nil t)))
@ -547,6 +564,8 @@ BODY."
(mh-defun-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."
@ -610,8 +629,7 @@ BODY."
"Free the decoded MIME parts."
(let ((mime-data (gethash (current-buffer) mh-globals-hash)))
;; This is for Emacs, what about XEmacs?
(cond ((fboundp 'remove-images)
(remove-images (point-min) (point-max))))
(mh-funcall-if-exists remove-images (point-min) (point-max))
(when mime-data
(mm-destroy-parts (mh-mime-handles mime-data))
(remhash (current-buffer) mh-globals-hash))))
@ -662,6 +680,7 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
(when (and mh-graphical-smileys-flag
(fboundp 'smiley-region)
(boundp 'font-lock-maximum-size)
font-lock-maximum-size
(>= (/ font-lock-maximum-size 8) (buffer-size)))
(smiley-region (point-min) (point-max))))
@ -669,8 +688,8 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
(defun mh-display-emphasis ()
"Function to display graphical emphasis."
(when (and mh-graphical-emphasis-flag
(boundp 'font-lock-maximum-size)
(>= (/ font-lock-maximum-size 8) (buffer-size)))
(if font-lock-maximum-size
(>= (/ font-lock-maximum-size 8) (buffer-size))))
(flet ((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
@ -685,7 +704,10 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
(unless (>= (string-to-number emacs-version) 21)
;; XEmacs doesn't care.
(set-keymap-parent map mh-show-mode-map))
(define-key map [mouse-2] 'mh-push-button)
(mh-do-in-gnu-emacs
(define-key map [mouse-2] 'mh-push-button))
(mh-do-in-xemacs
(define-key map '(button2) 'mh-push-button))
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
@ -708,7 +730,10 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
(unless (>= (string-to-number emacs-version) 21)
(set-keymap-parent map mh-show-mode-map))
(define-key map "\r" 'mh-press-button)
(define-key map [mouse-2] 'mh-push-button)
(mh-do-in-gnu-emacs
(define-key map [mouse-2] 'mh-push-button))
(mh-do-in-xemacs
(define-key map '(button2) 'mh-push-button))
map))
(defvar mh-mime-save-parts-directory nil
@ -755,22 +780,46 @@ actual storing."
(if (equal nil mh-mime-save-parts-default-directory)
(setq mh-mime-save-parts-directory directory))
(save-excursion
(set-buffer (get-buffer-create " *mh-store*"))
(set-buffer (get-buffer-create mh-log-buffer))
(cd directory)
(setq mh-mime-save-parts-directory directory)
(erase-buffer)
(apply 'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string (list folder msg "-auto")))
(if (> (buffer-size) 0)
(save-window-excursion
(switch-to-buffer-other-window " *mh-store*")
(sit-for 3)))))))
(let ((initial-size (mh-truncate-log-buffer)))
(apply 'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string (list folder msg "-auto")))
(if (> (buffer-size) initial-size)
(save-window-excursion
(switch-to-buffer-other-window mh-log-buffer)
(sit-for 3))))))))
;; Avoid errors if gnus-sum isn't loaded yet...
(defvar gnus-newsgroup-charset nil)
(defvar gnus-newsgroup-name nil)
(defun mh-decode-message-body ()
"Decode message based on charset.
If message has been encoded for transfer take that into account."
(let* ((ct (ignore-errors (mail-header-parse-content-type
(message-fetch-field "Content-Type" t))))
(charset (mail-content-type-get ct 'charset))
(cte (message-fetch-field "Content-Transfer-Encoding")))
(when (stringp cte) (setq cte (mail-header-strip cte)))
(when (or (not ct) (equal (car ct) "text/plain"))
(save-restriction
(narrow-to-region (min (1+ (mh-mail-header-end)) (point-max))
(point-max))
(mm-decode-body charset
(and cte (intern (downcase
(gnus-strip-whitespace cte))))
(car ct))))))
;;;###mh-autoload
(defun mh-decode-message-header ()
"Decode RFC2047 encoded message header fields."
(when mh-decode-mime-flag
(let ((buffer-read-only nil))
(rfc2047-decode-region (point-min) (mh-mail-header-end)))))
;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
"Display (and possibly decode) MIME handles.
@ -778,36 +827,43 @@ Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
present they are displayed otherwise the buffer is parsed and then
displayed."
(let ((handles ())
(folder mh-show-folder-buffer))
(folder mh-show-folder-buffer)
(raw-message-data (buffer-string)))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
;; If needed dissect the current buffer
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))
(goto-char (point-min))
(unless (search-forward "\n\n" nil t)
(goto-char (point-max))
(insert "\n\n"))
;; Use charset to decode body...
(unless handles
(let* ((ct (ignore-errors
(mail-header-parse-content-type
(message-fetch-field "Content-Type" t))))
(charset (mail-content-type-get ct 'charset)))
(when (stringp charset)
(mm-decode-body charset)))))
(condition-case err
(progn
;; If needed dissect the current buffer
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mm-merge-handles handles
(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)))
(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)))
;; 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)))
(error
(message "Please report this error. The error message is:\n %s"
(error-message-string err))
(delete-region (point-min) (point-max))
(insert raw-message-data))))))
(defun mh-mime-display-part (handle)
"Decides the viewer to call based on the type of HANDLE."
@ -868,7 +924,8 @@ This is only useful if a Content-Disposition header is not present."
(let* ((image (mm-get-image handle)))
(cond ((fboundp 'glyph-width)
;; XEmacs -- totally untested, copied from gnus
(and (< (glyph-width image)
(and (mh-funcall-if-exists glyphp image)
(< (glyph-width image)
(or mh-max-inline-image-width
(window-pixel-width)))
(< (glyph-height image)
@ -876,8 +933,9 @@ This is only useful if a Content-Disposition header is not present."
(window-pixel-height)))))
((fboundp 'image-size)
;; Emacs21 -- copied from gnus
(let ((size (image-size image)))
(and (< (cdr size)
(let ((size (mh-funcall-if-exists image-size image)))
(and size
(< (cdr size)
(or mh-max-inline-image-height
(1- (window-height))))
(< (car size)
@ -889,7 +947,8 @@ This is only useful if a Content-Disposition header is not present."
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
(let ((type (mm-handle-type handle)))
(and (consp type)
(and (or (featurep 'vcard) (fboundp 'vcard-pretty-print))
(consp type)
(equal (car type) "text/x-vcard")
(save-excursion
(save-restriction
@ -933,6 +992,10 @@ This is only useful if a Content-Disposition header is not present."
(mh-mm-display-part handle)))
(goto-char (point-max)))))
(mh-do-in-xemacs
(defvar dots)
(defvar type))
(defun mh-insert-mime-button (handle index displayed)
"Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used by commands
@ -999,9 +1062,9 @@ like \"K v\" which operate on individual MIME parts."
(progn
;; Delete the button and displayed part (if any)
(let ((region (get-text-property point 'mh-region)))
(when region
(when (fboundp 'remove-images)
(remove-images (car region) (cdr region))))
(when (and region (fboundp 'remove-images))
(mh-funcall-if-exists
remove-images (car region) (cdr region)))
(mm-display-part handle)
(when region
(delete-region (car region) (cdr region))))
@ -1067,20 +1130,33 @@ If the MIME part is visible then it is removed. Otherwise the part is
displayed. This function is called when the mouse is used to click the MIME
button."
(interactive "e")
(set-buffer (window-buffer (posn-window (event-start event))))
(select-window (posn-window (event-start event)))
(let* ((pos (posn-point (event-start event)))
(folder mh-show-folder-buffer)
(mm-inline-media-tests mh-mm-inline-media-tests)
(data (get-text-property pos 'mh-data))
(function (get-text-property pos 'mh-callback))
(buffer-read-only nil))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
(goto-char pos)
(unwind-protect (and function (funcall function data))
(set-buffer-modified-p nil)))))
(save-excursion
(let* ((event-window
(or (mh-funcall-if-exists posn-window (event-start event));GNU Emacs
(mh-funcall-if-exists event-window event))) ;XEmacs
(event-position
(or (mh-funcall-if-exists posn-point (event-start event)) ;GNU Emacs
(mh-funcall-if-exists event-closest-point event))) ;XEmacs
(original-window (selected-window))
(original-position (progn
(set-buffer (window-buffer event-window))
(set-marker (make-marker) (point))))
(folder mh-show-folder-buffer)
(mm-inline-media-tests mh-mm-inline-media-tests)
(data (get-text-property event-position 'mh-data))
(function (get-text-property event-position 'mh-callback))
(buffer-read-only nil))
(unwind-protect
(progn
(select-window event-window)
(flet ((mm-handle-set-external-undisplayer (handle func)
(mh-handle-set-external-undisplayer folder handle func)))
(goto-char event-position)
(and function (funcall function data))))
(set-buffer-modified-p nil)
(goto-char original-position)
(set-marker original-position nil)
(select-window original-window)))))
;;;###mh-autoload
(defun mh-mime-save-part ()
@ -1242,6 +1318,7 @@ message multiple times."
handles))))
(goto-char (point-min))
(mh-show-xface)
(cond (clean-message-header
(mh-clean-msg-header (point-min)
invisible-headers
@ -1249,7 +1326,7 @@ message multiple times."
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
(mh-show-xface)
(mh-decode-message-header)
(mh-show-addr)
;; The other highlighting types don't need anything special
(when (eq mh-highlight-citation-p 'gnus)

10
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 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -30,8 +30,6 @@
;;; Change Log:
;; $Id: mh-pick.el,v 1.30 2003/01/27 04:16:47 wohler Exp $
;;; Code:
(require 'mh-e)
@ -62,9 +60,9 @@ the search folder is dismissed."
(mh-make-pick-template)
(message ""))
(setq mh-searching-function 'mh-pick-do-search
mh-searching-folder pick-folder
mh-current-folder folder
mh-previous-window-config window-config)
mh-searching-folder pick-folder)
(mh-make-local-vars 'mh-current-folder folder
'mh-previous-window-config window-config)
(message "%s" (substitute-command-keys
(concat "Type \\[mh-do-search] to search messages, "
"\\[mh-help] for help.")))))

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

@ -1,6 +1,6 @@
;;; mh-seq.el --- MH-E sequences support
;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -68,8 +68,6 @@
;;; Change Log:
;; $Id: mh-seq.el,v 1.101 2003/01/26 00:57:35 jchonig Exp $
;;; Code:
(require 'cl)
@ -146,8 +144,10 @@ redone to get the new thread tree. This makes incremental threading easier.")
(mh-undefine-sequence sequence '("all"))
(mh-delete-seq-locally sequence)
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(when (and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))
(mh-notate nil ? (1+ mh-cmd-note))))))
(cond ((and mh-tick-seq (eq sequence mh-tick-seq))
(mh-notate-tick msg ()))
((and (member msg msg-list) (not (mh-seq-containing-msg msg nil)))
(mh-notate nil ? (1+ mh-cmd-note)))))))
;; Avoid compiler warnings
(defvar view-exit-action)
@ -195,10 +195,12 @@ 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: current message)."
"Display the sequences that contain MESSAGE.
Default is the displayed message."
(interactive (list (mh-get-msg-num t)))
(let* ((dest-folder (loop for seq in mh-refile-list
when (member message (cdr seq)) return (car seq)))
until (member message (cdr seq))
finally return (car seq)))
(deleted-flag (unless dest-folder (member message mh-delete-list))))
(message "Message %d%s is in sequences: %s"
message
@ -209,6 +211,9 @@ redone to get the new thread tree. This makes incremental threading easier.")
(mh-list-to-string (mh-seq-containing-msg message t))
" "))))
;; Avoid compiler warning
(defvar tool-bar-map)
;;;###mh-autoload
(defun mh-narrow-to-seq (sequence)
"Restrict display of this folder to just messages in SEQUENCE.
@ -224,6 +229,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(setq mh-thread-scan-line-map (make-hash-table :test #'eql))
(mh-copy-seq-to-eob sequence)
(narrow-to-region eob (point-max))
(setq mh-narrowed-to-seq sequence)
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
(mh-notate-cur)
@ -233,44 +239,42 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(setq mh-mode-line-annotation (symbol-name sequence))
(mh-make-folder-mode-line)
(mh-recenter nil)
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map)
mh-folder-seq-tool-bar-map))
(setq mh-narrowed-to-seq sequence)
(when (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map)
mh-folder-seq-tool-bar-map)
(when (buffer-live-p (get-buffer mh-show-buffer))
(save-excursion
(set-buffer (get-buffer mh-show-buffer))
(set (make-local-variable 'tool-bar-map)
mh-show-seq-tool-bar-map))))
(push 'widen mh-view-ops)))
(t
(error "No messages in sequence `%s'" (symbol-name sequence))))))
;;;###mh-autoload
(defun mh-put-msg-in-seq (msg-or-seq sequence)
"Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
If optional prefix argument provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then
the selected region is added to the sequence."
(interactive (list (cond
((mh-mark-active-p t)
(cons (region-beginning) (region-end)))
(current-prefix-arg
(mh-read-seq-default "Add messages from" t))
(t
(cons (line-beginning-position) (line-end-position))))
"Add MSG-OR-SEQ to SEQUENCE.
Default is the displayed message.
If optional prefix argument is provided, then prompt for the message sequence.
If variable `transient-mark-mode' is non-nil and the mark is active, then the
selected region is added to the sequence.
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
region in a cons cell, or a sequence."
(interactive (list (mh-interactive-msg-or-seq "Add messages from")
(mh-read-seq-default "Add to" nil)))
(let ((internal-seq-flag (mh-internal-seq sequence))
msg-list)
(cond ((and (consp msg-or-seq)
(numberp (car msg-or-seq)) (numberp (cdr msg-or-seq)))
(mh-iterate-on-messages-in-region m (car msg-or-seq) (cdr msg-or-seq)
(push m msg-list)
(unless internal-seq-flag
(mh-notate nil mh-note-seq (1+ mh-cmd-note))))
(mh-add-msgs-to-seq msg-list sequence internal-seq-flag t))
((or (numberp msg-or-seq) (listp msg-or-seq))
(when (numberp msg-or-seq)
(setq msg-or-seq (list msg-or-seq)))
(mh-add-msgs-to-seq msg-or-seq sequence internal-seq-flag))
(t (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) sequence)))
(when (and (interactive-p) mh-tick-seq (eq sequence mh-tick-seq))
(error "Use `mh-toggle-tick' to add messages to %s" mh-tick-seq))
(let* ((internal-seq-flag (mh-internal-seq sequence))
(note-seq (if internal-seq-flag nil mh-note-seq))
(msg-list ()))
(mh-iterate-on-msg-or-seq m msg-or-seq
(push m msg-list)
(mh-notate nil note-seq (1+ mh-cmd-note)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(if (not internal-seq-flag)
(setq mh-last-seq-used sequence))))
(setq mh-last-seq-used sequence))
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(mh-speed-flists t mh-current-folder))))
(defun mh-valid-view-change-operation-p (op)
"Check if the view change operation can be performed.
@ -300,13 +304,18 @@ OP is one of 'widen and 'unthread."
(mh-make-folder-mode-line))
(if msg
(mh-goto-msg msg t t))
(setq mh-narrowed-to-seq nil)
(setq mh-tick-seq-changed-when-narrowed-flag nil)
(mh-notate-deleted-and-refiled)
(mh-notate-user-sequences)
(mh-notate-cur)
(mh-recenter nil)))
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
(setq mh-narrowed-to-seq nil))
(when (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
(when (buffer-live-p (get-buffer mh-show-buffer))
(save-excursion
(set-buffer (get-buffer mh-show-buffer))
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
;; FIXME? We may want to clear all notations and add one for current-message
;; and process user sequences.
@ -408,8 +417,9 @@ In addition to notating the current message with `mh-note-cur' the function
uses `overlay-arrow-position' to put a marker in the fringe."
(let ((cur (car (mh-seq-to-msgs 'cur))))
(when (and cur (mh-goto-msg cur t t))
(mh-notate nil mh-note-cur mh-cmd-note)
(beginning-of-line)
(when (looking-at mh-scan-good-msg-regexp)
(mh-notate nil mh-note-cur mh-cmd-note))
(setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
(setq overlay-arrow-position mh-arrow-marker))))
@ -431,6 +441,8 @@ uses `overlay-arrow-position' to put a marker in the fringe."
; ;; 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)
"Copy SEQ to the end of the buffer."
;; It is quite involved to write something which will work at any place in
@ -455,12 +467,8 @@ uses `overlay-arrow-position' to put a marker in the fringe."
(forward-line))
;; Remove scan lines and read results from pre-computed tree
(delete-region (point-min) (point-max))
(let ((thread-tree (mh-thread-generate mh-current-folder ()))
(mh-thread-body-width
(- (window-width) mh-cmd-note
(1- mh-scan-field-subject-start-offset)))
(mh-thread-last-ancestor nil))
(mh-thread-generate-scan-lines thread-tree -2)))
(mh-thread-print-scan-lines
(mh-thread-generate mh-current-folder ())))
(mh-index-data
(mh-index-insert-folder-headers)))))))
@ -491,12 +499,83 @@ If VAR is nil then the loop is executed without any binding."
(let ((binding-needed-flag var))
`(save-excursion
(goto-char ,begin)
(beginning-of-line)
(while (and (<= (point) ,end) (not (eobp)))
(when (looking-at mh-scan-valid-regexp)
(let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
,@body))
(forward-line 1)))))
(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-iterate-on-msg-or-seq (var msg-or-seq &rest body)
"Iterate an operation over a region or sequence.
VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a
message number, a list of message numbers, a sequence, or a region in a cons
cell. In each iteration, BODY is executed.
The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq'
in order to provide a uniform interface to MH-E functions."
(unless (symbolp var)
(error "Can not bind the non-symbol %s" var))
(let ((binding-needed-flag var)
(msgs (make-symbol "msgs"))
(seq-hash-table (make-symbol "seq-hash-table")))
`(cond ((numberp ,msg-or-seq)
(when (mh-goto-msg ,msg-or-seq t t)
(let ,(if binding-needed-flag `((,var ,msg-or-seq)) ())
,@body)))
((and (consp ,msg-or-seq)
(numberp (car ,msg-or-seq)) (numberp (cdr ,msg-or-seq)))
(mh-iterate-on-messages-in-region ,var
(car ,msg-or-seq) (cdr ,msg-or-seq)
,@body))
(t (let ((,msgs (if (and ,msg-or-seq (symbolp ,msg-or-seq))
(mh-seq-to-msgs ,msg-or-seq)
,msg-or-seq))
(,seq-hash-table (make-hash-table)))
(dolist (msg ,msgs)
(setf (gethash msg ,seq-hash-table) t))
(mh-iterate-on-messages-in-region v (point-min) (point-max)
(when (gethash v ,seq-hash-table)
(let ,(if binding-needed-flag `((,var v)) ())
,@body))))))))
(put 'mh-iterate-on-msg-or-seq 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defun mh-msg-or-seq-to-msg-list (msg-or-seq)
"Return a list of messages for MSG-OR-SEQ.
MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or
a region in a cons cell."
(let (msg-list)
(mh-iterate-on-msg-or-seq msg msg-or-seq
(push msg msg-list))
(nreverse msg-list)))
;;;###mh-autoload
(defun mh-interactive-msg-or-seq (sequence-prompt)
"Return interactive specification for message, sequence, or region.
By convention, the name of this argument is msg-or-seq.
If variable `transient-mark-mode' is non-nil and the mark is active, then this
function returns a cons-cell of the region.
If optional prefix argument provided, then prompt for message sequence with
SEQUENCE-PROMPT and return sequence.
Otherwise, the message number at point is returned.
This function is usually used with `mh-iterate-on-msg-or-seq' 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-seq-default sequence-prompt t))
(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."
@ -1005,17 +1084,12 @@ All messages after START-POINT are added to the thread tree."
(buffer-read-only nil)
(old-buffer-modified-flag (buffer-modified-p)))
(delete-region (point-min) (point-max))
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
(1- mh-scan-field-subject-start-offset)))
(mh-thread-last-ancestor nil))
(mh-thread-generate-scan-lines thread-tree -2))
(mh-thread-print-scan-lines thread-tree)
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
(mh-notate-cur)
(set-buffer-modified-p old-buffer-modified-flag))))
(defvar mh-thread-last-ancestor)
(defun mh-thread-generate-scan-lines (tree level)
"Generate scan lines.
TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
@ -1099,6 +1173,25 @@ Otherwise uses the line at point as the scan line to parse."
(mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
(forward-line 1))))
(defun mh-thread-print-scan-lines (thread-tree)
"Print scan lines in THREAD-TREE in threaded mode."
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
(1- mh-scan-field-subject-start-offset)))
(mh-thread-last-ancestor nil))
(if (null mh-index-data)
(mh-thread-generate-scan-lines thread-tree -2)
(loop for x in (mh-index-group-by-folder)
do (let* ((old-map mh-thread-scan-line-map)
(mh-thread-scan-line-map (make-hash-table)))
(setq mh-thread-last-ancestor nil)
(loop for msg in (cdr x)
do (let ((v (gethash msg old-map)))
(when v
(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)))))))
(defun mh-thread-folder ()
"Generate thread view of folder."
(message "Threading %s..." (buffer-name))
@ -1115,10 +1208,7 @@ Otherwise uses the line at point as the scan line to parse."
(let* ((range (mh-coalesce-msg-list msg-list))
(thread-tree (mh-thread-generate (buffer-name) range)))
(delete-region (point-min) (point-max))
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
(1- mh-scan-field-subject-start-offset)))
(mh-thread-last-ancestor nil))
(mh-thread-generate-scan-lines thread-tree -2))
(mh-thread-print-scan-lines thread-tree)
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)
(mh-notate-cur)
@ -1137,7 +1227,7 @@ Otherwise uses the line at point as the scan line to parse."
(let ((msg-list ()))
(goto-char (point-min))
(while (not (eobp))
(let ((index (mh-get-msg-num t)))
(let ((index (mh-get-msg-num nil)))
(when index
(push index msg-list)))
(forward-line))
@ -1161,6 +1251,7 @@ Otherwise uses the line at point as the scan line to parse."
(id-index (gethash id mh-thread-id-index-map))
(duplicates (gethash id mh-thread-duplicates)))
(remhash index mh-thread-index-id-map)
(remhash index mh-thread-scan-line-map)
(cond ((and (eql index id-index) (null duplicates))
(remhash id mh-thread-id-index-map))
((eql index id-index)
@ -1308,6 +1399,85 @@ start of the region and the second is the point at the end."
(mh-refile-a-msg nil folder))
(mh-next-msg)))))
;; Tick mark handling
;; Functions to highlight and unhighlight ticked messages.
(defun mh-tick-add-overlay ()
"Add tick overlay to current line."
(with-mh-folder-updating (t)
(let ((overlay
(or (mh-funcall-if-exists make-overlay (point) (line-end-position))
(mh-funcall-if-exists make-extent (point) (line-end-position)))))
(or (mh-funcall-if-exists overlay-put overlay 'face 'mh-folder-tick-face)
(mh-funcall-if-exists set-extent-face overlay 'mh-folder-tick-face))
(mh-funcall-if-exists set-extent-priority overlay 10)
(add-text-properties (point) (line-end-position) `(mh-tick ,overlay)))))
(defun mh-tick-remove-overlay ()
"Remove tick overlay from current line."
(let ((overlay (get-text-property (point) 'mh-tick)))
(when overlay
(with-mh-folder-updating (t)
(or (mh-funcall-if-exists delete-overlay overlay)
(mh-funcall-if-exists delete-extent overlay))
(remove-text-properties (point) (line-end-position) `(mh-tick nil))))))
;;;###mh-autoload
(defun mh-notate-tick (msg ticked-msgs &optional ignore-narrowing)
"Highlight current line if MSG is in TICKED-MSGS.
If optional argument IGNORE-NARROWING is non-nil then highlighting is carried
out even if folder is narrowed to `mh-tick-seq'."
(when mh-tick-seq
(let ((narrowed-to-tick (and (not ignore-narrowing)
(eq mh-narrowed-to-seq mh-tick-seq)))
(overlay (get-text-property (point) 'mh-tick))
(in-tick (member msg ticked-msgs)))
(cond (narrowed-to-tick (mh-tick-remove-overlay))
((and (not overlay) in-tick) (mh-tick-add-overlay))
((and overlay (not in-tick)) (mh-tick-remove-overlay))))))
;; Interactive function to toggle tick.
;;;###mh-autoload
(defun mh-toggle-tick (begin end)
"Toggle tick mark of all messages in region BEGIN to END."
(interactive (cond ((mh-mark-active-p t)
(list (region-beginning) (region-end)))
(t (list (line-beginning-position) (line-end-position)))))
(unless mh-tick-seq
(error "Enable ticking by customizing `mh-tick-seq'"))
(let* ((tick-seq (mh-find-seq mh-tick-seq))
(tick-seq-msgs (mh-seq-msgs tick-seq)))
(mh-iterate-on-messages-in-region msg begin end
(cond ((member msg tick-seq-msgs)
(mh-undefine-sequence mh-tick-seq (list msg))
(setcdr tick-seq (delq msg (cdr tick-seq)))
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
(mh-tick-remove-overlay))
(t
(mh-add-msgs-to-seq (list msg) mh-tick-seq nil t)
(setq mh-last-seq-used mh-tick-seq)
(mh-tick-add-overlay))))
(when (and (eq mh-tick-seq mh-narrowed-to-seq)
(not mh-tick-seq-changed-when-narrowed-flag))
(setq mh-tick-seq-changed-when-narrowed-flag t)
(let ((ticked-msgs (mh-seq-msgs (mh-find-seq mh-tick-seq))))
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(mh-notate-tick msg ticked-msgs t))))))
;;;###mh-autoload
(defun mh-narrow-to-tick ()
"Restrict display of this folder to just 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"))
(t (mh-narrow-to-seq mh-tick-seq))))
(provide 'mh-seq)
;;; Local Variables:

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

@ -1,6 +1,6 @@
;;; mh-speed.el --- Speedbar interface for MH-E.
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -31,8 +31,6 @@
;;; Change Log:
;; $Id: mh-speed.el,v 1.37 2003/01/31 03:18:18 satyaki Exp $
;;; Code:
;; Requires
@ -70,7 +68,8 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
'mh-speedbar-folder-face 0)
(forward-line -1)
(setf (gethash nil mh-speed-folder-map)
(set-marker (make-marker) (1+ (line-beginning-position))))
(set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
(1+ (line-beginning-position))))
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
@ -278,7 +277,9 @@ Do the right thing for the different kinds of buffers that MH-E uses."
(save-excursion
(forward-line -1)
(setf (gethash folder-name mh-speed-folder-map)
(set-marker (make-marker) (1+ (line-beginning-position))))
(set-marker (or (gethash folder-name mh-speed-folder-map)
(make-marker))
(1+ (line-beginning-position))))
(add-text-properties
(line-beginning-position) (1+ (line-beginning-position))
`(mh-folder ,folder-name
@ -309,8 +310,10 @@ The otional ARGS are ignored and there for compatibilty with speedbar."
(setq start-region (point))
(while (and (get-text-property (point) 'mh-level)
(> (get-text-property (point) 'mh-level) level))
(remhash (get-text-property (point) 'mh-folder)
mh-speed-folder-map)
(let ((folder (get-text-property (point) 'mh-folder)))
(when (gethash folder mh-speed-folder-map)
(set-marker (gethash folder mh-speed-folder-map) nil)
(remhash folder mh-speed-folder-map)))
(forward-line))
(delete-region start-region (point))
(forward-line -1)
@ -344,24 +347,29 @@ Optional ARGS are ignored."
(delete-other-windows)))))
(defvar mh-speed-current-folder nil)
(defvar mh-speed-flists-folder nil)
;;;###mh-autoload
(defun mh-speed-flists (force)
(defun mh-speed-flists (force &optional folder)
"Execute flists -recurse and update message counts.
If FORCE is non-nil the timer is reset."
If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run
only for that one folder."
(interactive (list t))
(when force
(when (timerp mh-speed-flists-timer)
(cancel-timer mh-speed-flists-timer))
(setq mh-speed-flists-timer nil)
(when mh-speed-flists-timer
(cancel-timer mh-speed-flists-timer)
(setq mh-speed-flists-timer nil))
(when (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process) 'exit)))
(set-process-filter mh-speed-flists-process t)
(kill-process mh-speed-flists-process)
(setq mh-speed-partial-line "")
(setq mh-speed-flists-process nil)))
(setq mh-speed-flists-folder folder)
(unless mh-speed-flists-timer
(setq mh-speed-flists-timer
(run-at-time
nil mh-speed-flists-interval
nil (and mh-speed-run-flists-flag mh-speed-flists-interval)
(lambda ()
(unless (and (processp mh-speed-flists-process)
(not (eq (process-status mh-speed-flists-process)
@ -376,8 +384,11 @@ If FORCE is non-nil the timer is reset."
(setq mh-speed-flists-process
(start-process "*flists*" nil
(expand-file-name "flists" mh-progs)
"-recurse"
(or mh-speed-flists-folder "-recurse")
(if mh-speed-flists-folder "-noall" "-all")
"-sequence" (symbol-name mh-unseen-seq)))
;; Run flists on all folders the next time around...
(setq mh-speed-flists-folder nil)
(set-process-filter mh-speed-flists-process
'mh-speed-parse-flists-output)))))))
@ -397,7 +408,10 @@ next."
mh-speed-partial-line "")
(multiple-value-setq (folder unseen total)
(mh-parse-flist-output-line line mh-speed-current-folder))
(when (and folder unseen total)
(when (and folder unseen total
(let ((old-pair (gethash folder mh-speed-flists-cache)))
(or (not (equal (car old-pair) unseen))
(not (equal (cdr old-pair) total)))))
(setf (gethash folder mh-speed-flists-cache) (cons unseen total))
(save-excursion
(when (buffer-live-p (get-buffer speedbar-buffer))
@ -514,7 +528,8 @@ The function invalidates the latest ancestor that is present."
(insert-char char 1 t)
(put-text-property (point) (1- (point)) 'invisible nil)
;; make sure we fix the image on the text here.
(speedbar-insert-image-button-maybe (- (point) 2) 3)))))
(mh-funcall-if-exists
speedbar-insert-image-button-maybe (- (point) 2) 3)))))
(provide 'mh-speed)

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

@ -1,6 +1,7 @@
;;; mh-utils.el --- MH-E code needed for both sending and reading
;; Copyright (C) 1993, 1995, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 95, 1997,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -30,8 +31,6 @@
;;; Change Log:
;; $Id: mh-utils.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
;;; Code:
;; Is this XEmacs-land? Located here since needed by mh-customize.el.
@ -57,7 +56,7 @@
;;; Autoloads
(autoload 'gnus-article-highlight-citation "gnus-cite")
(autoload 'mail-header-end "sendmail")
(require 'sendmail)
(autoload 'Info-goto-node "info")
(unless (fboundp 'make-hash-table)
(autoload 'make-hash-table "cl"))
@ -100,7 +99,30 @@ of `search' in the CL package."
when (equal (aref string index) char) return index
finally return nil))
;;; Macro to generate correct code for different emacs variants
;;; Macros to generate correct code for different emacs variants
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
(unless mh-xemacs-flag `(progn ,@body)))
(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in GNU Emacs."
(when mh-xemacs-flag `(progn ,@body)))
(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
(if (fboundp function)
`(funcall ',function ,@args)))
(defmacro mh-make-local-hook (hook)
"Make HOOK local if needed.
XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
called."
(when (and (fboundp 'make-local-hook)
(not (get 'make-local-hook 'byte-obsolete-info)))
`(make-local-hook ,hook)))
(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
"A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
@ -287,19 +309,6 @@ passed through `regexp-quote' before being used by functions like
(".*" mm-inline-text mm-readable-p))
"Alist of media types/tests saying whether types can be displayed inline.")
;; Needed by mh-comp.el and mh-mime.el
(defvar mh-mhn-compose-insert-flag nil
"Non-nil means MIME insertion was done.
Triggers an automatic call to `mh-edit-mhn' in `mh-send-letter'.
This variable is buffer-local.")
(make-variable-buffer-local 'mh-mhn-compose-insert-flag)
(defvar mh-mml-compose-insert-flag nil
"Non-nil means that a MIME insertion was done.
This buffer-local variable is used to remember if a MIME insertion was done.
Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.")
(make-variable-buffer-local 'mh-mml-compose-insert-flag)
;; Copy of `goto-address-mail-regexp'
(defvar mh-address-mail-regexp
"[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+"
@ -318,9 +327,17 @@ address. If no e-mail address found, return nil."
(goto-char (match-beginning 0))))
(match-string-no-properties 0)))
(defun mh-mail-header-end ()
"Substitute for `mail-header-end' that doesn't widen the buffer.
In MH-E we frequently need to find the end of headers in nested messages, where
the buffer has been narrowed. This function works in this situation."
(save-excursion
(rfc822-goto-eoh)
(point)))
(defun mh-in-header-p ()
"Return non-nil if the point is in the header of a draft message."
(< (point) (mail-header-end)))
(< (point) (mh-mail-header-end)))
(defun mh-header-field-beginning ()
"Move to the beginning of the current header field.
@ -342,7 +359,7 @@ Handles RFC 822 continuation lines."
Argument LIMIT limits search."
(if (= (point) limit)
nil
(let* ((mail-header-end (save-match-data (mail-header-end)))
(let* ((mail-header-end (save-match-data (mh-mail-header-end)))
(lesser-limit (if (< mail-header-end limit) mail-header-end limit)))
(when (mh-in-header-p)
(set-match-data (list 1 lesser-limit))
@ -354,7 +371,7 @@ Argument LIMIT limits search."
Argument LIMIT limits search."
(if (= (point) limit)
nil
(let* ((mail-header-end (mail-header-end))
(let* ((mail-header-end (mh-mail-header-end))
(lesser-limit (if (< mail-header-end limit) mail-header-end limit))
(case-fold-search t))
(when (and (< (point) mail-header-end) ;Only within header
@ -424,7 +441,7 @@ Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
dealt with by gnus highlighting. The region between BEG and END is
given over to be fontified and LOUDLY controls if a user sees a
message about the fontification operation."
(let ((header-end (mail-header-end)))
(let ((header-end (mh-mail-header-end)))
(cond
((and (< beg header-end)(< end header-end))
(font-lock-default-fontify-region beg end loudly))
@ -501,6 +518,10 @@ message about the fontification operation."
(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
;; Number of lines to keep in mh-log-buffer.
(defvar mh-log-buffer-lines 100)
;; Window configuration before MH-E command.
(defvar mh-previous-window-config nil)
@ -535,14 +556,23 @@ message about the fontification operation."
(defun mh-logo-display ()
"Modify mode line to display MH-E logo."
(when (fboundp 'find-image)
(add-text-properties
0 2
`(display ,(or mh-logo-cache
(setq mh-logo-cache
(find-image '((:type xpm :ascent center
:file "mh-logo.xpm"))))))
(car mode-line-buffer-identification))))
(mh-do-in-gnu-emacs
(add-text-properties
0 2
`(display ,(or mh-logo-cache
(setq mh-logo-cache
(mh-funcall-if-exists
find-image '((:type xpm :ascent center
:file "mh-logo.xpm"))))))
(car mode-line-buffer-identification)))
(mh-do-in-xemacs
(setq modeline-buffer-identification
(list
(if mh-modeline-glyph
(cons modeline-buffer-id-left-extent mh-modeline-glyph)
(cons modeline-buffer-id-left-extent "XEmacs%N:"))
(cons modeline-buffer-id-right-extent " %17b")))))
;;; This holds a documentation string used by describe-mode.
(defun mh-showing-mode (&optional arg)
@ -585,7 +615,7 @@ flag is unchanged, otherwise it is cleared."
,@(if (not save-modification-flag)
'((mh-set-folder-modified-p nil)))))
(put 'with-mh-folder-updating 'lisp-indent-hook 1)
(put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
(defmacro mh-in-show-buffer (show-buffer &rest body)
"Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
@ -600,7 +630,7 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
,@body)
(select-window mh-in-show-buffer-saved-window))))
(put 'mh-in-show-buffer 'lisp-indent-hook 1)
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
(defmacro mh-make-seq (name msgs)
"Create sequence NAME with the given MSGS."
@ -726,11 +756,11 @@ still visible.\n")
folder-buffer)
(delete-other-windows))
(mh-goto-cur-msg t)
(and (fboundp 'deactivate-mark) (deactivate-mark))
(mh-funcall-if-exists deactivate-mark)
(unwind-protect
(prog1 (call-interactively (function ,original-function))
(setq normal-exit t))
(and (fboundp 'deactivate-mark) (deactivate-mark))
(mh-funcall-if-exists deactivate-mark)
(cond ((not normal-exit)
(set-window-configuration config))
,(if dont-return
@ -819,11 +849,17 @@ still visible.\n")
(mh-defun-show-buffer mh-show-thread-previous-sibling
mh-thread-previous-sibling)
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
;;; Populate mh-show-mode-map
(gnus-define-keys mh-show-mode-map
" " mh-show-page-msg
"!" mh-show-refile-or-write-again
"'" mh-show-toggle-tick
"," mh-show-header-display
"." mh-show-show
">" mh-show-write-message-to-file
@ -867,6 +903,7 @@ still visible.\n")
"i" mh-index-search
"k" mh-show-kill-folder
"l" mh-show-list-folders
"n" mh-index-new-messages
"o" mh-show-visit-folder
"r" mh-show-rescan-folder
"s" mh-show-search-folder
@ -884,6 +921,13 @@ still visible.\n")
"s" mh-show-msg-is-in-seq
"w" mh-show-widen)
(define-key mh-show-mode-map "I" mh-inc-spool-map)
(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
"?" mh-prefix-help
"b" mh-show-junk-blacklist
"w" mh-show-junk-whitelist)
(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
"?" mh-prefix-help
"u" mh-show-thread-ancestor
@ -894,6 +938,7 @@ still visible.\n")
"o" mh-show-thread-refile)
(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
"'" mh-show-narrow-to-tick
"?" mh-prefix-help
"s" mh-show-narrow-to-subject
"w" mh-show-widen)
@ -932,7 +977,12 @@ still visible.\n")
["Widen from Sequence" mh-show-widen t]
"--"
["Narrow to Subject Sequence" mh-show-narrow-to-subject t]
["Narrow to Tick Sequence" mh-show-narrow-to-tick
(save-excursion
(set-buffer mh-show-folder-buffer)
(and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))]
["Delete Rest of Same Subject" mh-show-delete-subject t]
["Toggle Tick Mark" mh-show-toggle-tick t]
"--"
["Push State Out to MH" mh-show-update-sequences t]))
@ -979,6 +1029,7 @@ still visible.\n")
"--"
["List Folders" mh-show-list-folders t]
["Visit a Folder..." mh-show-visit-folder t]
["View New Messages" mh-show-index-new-messages t]
["Search a Folder..." mh-show-search-folder t]
["Indexed Search..." mh-index-search t]
"--"
@ -988,6 +1039,9 @@ still visible.\n")
;;; Ensure new buffers won't get this mode if default-major-mode is nil.
(put 'mh-show-mode 'mode-class 'special)
;; Avoid compiler warning
(defvar tool-bar-map)
(define-derived-mode mh-show-mode text-mode "MH-Show"
"Major mode for showing messages in MH-E.\\<mh-show-mode-map>
The value of `mh-show-mode-hook' is a list of functions to
@ -1015,7 +1069,9 @@ be called, with no arguments, upon entry to this mode."
(turn-on-font-lock))
(if (and (boundp 'tool-bar-mode) tool-bar-mode)
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
(mh-funcall-if-exists mh-toolbar-init :show)
(when mh-decode-mime-flag
(mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
(easy-menu-add mh-show-sequence-menu)
(easy-menu-add mh-show-message-menu)
@ -1034,27 +1090,226 @@ be called, with no arguments, upon entry to this mode."
(if (fboundp 'goto-address)
(goto-address))))
;; X-Face and Face display
(defvar mh-show-xface-function
(cond ((and mh-xemacs-flag (locate-library "x-face"))
(cond ((and mh-xemacs-flag (locate-library "x-face") (not (featurep 'xface)))
(load "x-face" t t)
(if (fboundp 'x-face-xmas-wl-display-x-face)
#'x-face-xmas-wl-display-x-face
#'ignore))
((and (not mh-xemacs-flag) (>= emacs-major-version 21))
(load "x-face-e21" t t)
(if (fboundp 'x-face-decode-message-header)
#'x-face-decode-message-header
#'ignore))
#'mh-face-display-function)
((>= emacs-major-version 21)
#'mh-face-display-function)
(t #'ignore))
"Determine at run time what function should be called to display X-Face.")
(defvar mh-uncompface-executable
(and (fboundp 'executable-find) (executable-find "uncompface")))
(defun mh-face-to-png (data)
"Convert base64 encoded DATA to png image."
(with-temp-buffer
(insert data)
(ignore-errors (base64-decode-region (point-min) (point-max)))
(buffer-string)))
(defun mh-uncompface (data)
"Run DATA through `uncompface' to generate bitmap."
(with-temp-buffer
(insert data)
(when (and mh-uncompface-executable
(equal (call-process-region (point-min) (point-max)
mh-uncompface-executable t '(t nil))
0))
(mh-icontopbm)
(buffer-string))))
(defun mh-icontopbm ()
"Elisp substitute for `icontopbm'."
(goto-char (point-min))
(let ((end (point-max)))
(while (re-search-forward "0x\\(..\\)\\(..\\)," nil t)
(save-excursion
(goto-char (point-max))
(insert (string-to-number (match-string 1) 16))
(insert (string-to-number (match-string 2) 16))))
(delete-region (point-min) end)
(goto-char (point-min))
(insert "P4\n48 48\n")))
(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
(defun mh-face-display-function ()
"Display a Face or X-Face header field.
Display Face if both are present."
(save-restriction
(goto-char (point-min))
(re-search-forward "\n\n" (point-max) t)
(narrow-to-region (point-min) (point))
(let* ((case-fold-search t)
(default-enable-multibyte-characters nil)
(face (message-fetch-field "face" t))
(x-face (message-fetch-field "x-face" t))
(url (message-fetch-field "x-image-url" t))
raw type)
(cond (face (setq raw (mh-face-to-png face)
type 'png))
(x-face (setq raw (mh-uncompface x-face)
type 'pbm))
(url (setq type 'url)))
(when type
(goto-char (point-min))
(when (re-search-forward "^from:" (point-max) t)
;; GNU Emacs
(mh-do-in-gnu-emacs
(if (eq type 'url)
(mh-x-image-url-display url)
(mh-funcall-if-exists
insert-image (create-image
raw type t
:foreground (face-foreground 'mh-show-xface-face)
:background (face-background 'mh-show-xface-face))
" ")))
;; XEmacs
(mh-do-in-xemacs
(cond
((eq type 'url)
(mh-x-image-url-display url))
((eq type 'png)
(when (featurep 'png)
(set-extent-begin-glyph
(make-extent (point) (point))
(make-glyph (vector 'png ':data (mh-face-to-png face))))))
;; Try internal xface support if available...
((and (eq type 'pbm) (featurep 'xface))
(set-glyph-face
(set-extent-begin-glyph
(make-extent (point) (point))
(make-glyph (vector 'xface ':data (concat "X-Face: " x-face))))
'mh-show-xface-face))
;; Otherwise try external support with x-face...
((and (eq type 'pbm)
(fboundp 'x-face-xmas-wl-display-x-face)
(fboundp 'executable-find) (executable-find "uncompface"))
(mh-funcall-if-exists x-face-xmas-wl-display-x-face)))
(when raw (insert " "))))))))
(defun mh-show-xface ()
"Display X-Face."
(when (and mh-show-use-xface-flag
(when (and window-system mh-show-use-xface-flag
(or mh-decode-mime-flag mhl-formfile
mh-clean-message-header-flag))
(funcall mh-show-xface-function)))
;; X-Image-URL display
(defvar mh-x-image-cache-directory nil
"Directory where X-Image-URL images are cached.")
(defvar mh-convert-executable (executable-find "convert"))
(defvar mh-wget-executable (executable-find "wget"))
(defvar mh-x-image-temp-file nil)
(defvar mh-x-image-url nil)
(defvar mh-x-image-marker nil)
(defvar mh-x-image-url-cache-file nil)
(defun mh-x-image-url-cache-canonicalize (url)
"Canonicalize URL.
Replace the ?/ character with a ?! character."
(with-temp-buffer
(insert url)
(goto-char (point-min))
(while (search-forward "/" nil t) (replace-match "!"))
(format "%s/%s.png" mh-x-image-cache-directory (buffer-string))))
(defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
"Fetch and display the image specified by URL.
After the image is fetched, it is stored in CACHE-FILE. It will be displayed
in a buffer and position specified by MARKER. The actual display is carried
out by the SENTINEL function."
(if (and mh-wget-executable
mh-fetch-x-image-url
(or (eq mh-fetch-x-image-url t)
(y-or-n-p (format "Fetch %s? " url))))
(let ((buffer (get-buffer-create (generate-new-buffer-name " *mh-url*")))
(filename (make-temp-name "/tmp/mhe-wget")))
(save-excursion
(set-buffer buffer)
(set (make-local-variable 'mh-x-image-url-cache-file) cache-file)
(set (make-local-variable 'mh-x-image-marker) marker)
(set (make-local-variable 'mh-x-image-temp-file) filename))
(set-process-sentinel
(start-process "*wget*" buffer mh-wget-executable "-O" filename url)
sentinel))
;; Make sure we don't ask about this image again
(when (and mh-wget-executable (eq mh-fetch-x-image-url 'ask))
(make-symbolic-link mh-x-image-cache-directory cache-file t))))
(defun mh-x-image-display (image marker)
"Display IMAGE at MARKER."
(save-excursion
(set-buffer (marker-buffer marker))
(let ((buffer-read-only nil)
(default-enable-multibyte-characters nil)
(buffer-modified-flag (buffer-modified-p)))
(unwind-protect
(when (and (file-readable-p image) (not (file-symlink-p image)))
(goto-char marker)
(mh-do-in-gnu-emacs
(mh-funcall-if-exists insert-image (create-image image 'png)))
(mh-do-in-xemacs
(when (featurep 'png)
(set-extent-begin-glyph
(make-extent (point) (point))
(make-glyph
(vector 'png ':data (with-temp-buffer
(insert-file-contents-literally image)
(buffer-string))))))))
(set-buffer-modified-p buffer-modified-flag)))))
(defun mh-x-image-scale-and-display (process change)
"When the wget PROCESS terminates scale and display image.
The argument CHANGE is ignored."
(when (eq (process-status process) 'exit)
(let (marker temp-file cache-filename wget-buffer)
(save-excursion
(set-buffer (setq wget-buffer (process-buffer process)))
(setq marker mh-x-image-marker
cache-filename mh-x-image-url-cache-file
temp-file mh-x-image-temp-file))
(when mh-convert-executable
(call-process mh-convert-executable nil nil nil "-resize" "96x48"
temp-file cache-filename))
(if (file-exists-p cache-filename)
(mh-x-image-display cache-filename marker)
(make-symbolic-link mh-x-image-cache-directory cache-filename t))
(ignore-errors
(set-marker marker nil)
(delete-process process)
(kill-buffer wget-buffer)
(delete-file temp-file)))))
(defun mh-x-image-url-display (url)
"Display image from location URL.
If the URL isn't present in the cache then it is fetched with wget."
(let ((cache-filename (mh-x-image-url-cache-canonicalize url))
(marker (set-marker (make-marker) (point))))
(cond ((file-exists-p cache-filename)
(mh-x-image-display cache-filename marker))
((not mh-fetch-x-image-url)
(set-marker marker nil))
((and (not (file-exists-p mh-x-image-cache-directory))
(call-process "mkdir" nil nil nil mh-x-image-cache-directory)
nil))
((and (file-exists-p mh-x-image-cache-directory)
(file-directory-p mh-x-image-cache-directory))
(mh-x-image-url-fetch-image url cache-filename marker
'mh-x-image-scale-and-display)))))
(defun mh-maybe-show (&optional msg)
"Display message at cursor, but only if in show mode.
If optional arg MSG is non-nil, display that message instead."
@ -1110,6 +1365,7 @@ arguments, after the message has been displayed."
(if (not (memq msg mh-seen-list))
(setq mh-seen-list (cons msg mh-seen-list)))
(when mh-update-sequences-after-mh-show-flag
(if mh-index-data (mh-index-update-unseen msg))
(mh-update-sequences))
(run-hooks 'mh-show-hook))
@ -1147,32 +1403,12 @@ The message is displayed in raw form."
(delete-other-windows)
(switch-to-buffer edit-buffer)))
(defun mh-decode-content-transfer-encoded-message ()
"Run mimencode on message body, if needed."
(let ((case-fold-search t)
(header-end (mail-header-end)))
(goto-char (point-min))
(when (re-search-forward "^content-transfer-encoding: " header-end t)
(let ((enc (buffer-substring-no-properties (point) (line-end-position)))
cmdline)
(setq cmdline
(cond ((string-match "base64" enc) (list "-u" "-b" "-p"))
((string-match "quoted-printable" enc) (list "-u" "-q"))
(t nil)))
(when cmdline
(beginning-of-line)
(insert "Removed-")
(setq header-end (mail-header-end))
(goto-char (1+ header-end))
(apply #'call-process-region (1+ header-end) (point-max) "mimencode"
t t nil cmdline))))))
(defun mh-show-unquote-From ()
"Decode >From at beginning of lines for `mh-show-mode'."
(save-excursion
(let ((modified (buffer-modified-p))
(case-fold-search nil))
(goto-char (mail-header-end))
(goto-char (mh-mail-header-end))
(while (re-search-forward "^>From" nil t)
(replace-match "From"))
(set-buffer-modified-p modified))))
@ -1226,8 +1462,6 @@ Sets the current buffer to the show buffer."
(list "-form" formfile))
msg-filename)
(insert-file-contents-literally msg-filename))
(if mh-decode-content-transfer-encoded-message-flag
(mh-decode-content-transfer-encoded-message))
;; Cleanup old mime handles
(mh-mime-cleanup)
;; Use mm to display buffer
@ -1235,6 +1469,7 @@ Sets the current buffer to the show buffer."
(mh-add-missing-mime-version-header)
(setf (mh-buffer-data) (mh-make-buffer-data))
(mh-mime-display))
(mh-show-mode)
;; Header cleanup
(goto-char (point-min))
(cond (clean-message-header
@ -1244,6 +1479,7 @@ Sets the current buffer to the show buffer."
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
(mh-decode-message-header)
;; the parts of visiting we want to do (no locking)
(or (eq buffer-undo-list t) ;don't save undo info for prev msgs
(setq buffer-undo-list nil))
@ -1253,7 +1489,6 @@ Sets the current buffer to the show buffer."
(setq buffer-backed-up nil)
(auto-save-mode 1)
(set-mark nil)
(mh-show-mode)
(unwind-protect
(when (and mh-decode-mime-flag (not formfile))
(setq buffer-read-only nil)
@ -1276,6 +1511,7 @@ INVISIBLE-HEADERS contains a regular expression specifying lines to delete
from the header. VISIBLE-HEADERS contains a regular expression specifying the
lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
(let ((case-fold-search t)
(buffer-read-only nil)
(after-change-functions nil)) ;Work around emacs-20 font-lock bug
;causing an endless loop.
(save-restriction
@ -1306,15 +1542,17 @@ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
(defun mh-notate (msg notation offset)
"Mark MSG with the character NOTATION at position OFFSET.
Null MSG means the message at cursor."
Null MSG means the message at cursor.
If NOTATION is nil then no change in the buffer occurs."
(save-excursion
(if (or (null msg)
(mh-goto-msg msg t t))
(with-mh-folder-updating (t)
(beginning-of-line)
(forward-char offset)
(delete-char 1)
(insert notation)))))
(let ((notation (or notation (char-after))))
(delete-char 1)
(insert notation))))))
(defun mh-find-msg-get-num (step)
"Return the message number of the message nearest the cursor.
@ -1405,6 +1643,9 @@ arguments, after these variable have been set."
(setq mh-user-path
(file-name-as-directory
(expand-file-name mh-user-path (expand-file-name "~"))))
(unless mh-x-image-cache-directory
(setq mh-x-image-cache-directory
(expand-file-name ".mhe-x-image-cache" mh-user-path)))
(setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
(if mh-draft-folder
(progn
@ -1542,7 +1783,7 @@ The message number width portion of the format is discovered using
(set-buffer tmp-buffer)
(erase-buffer)
(apply 'call-process
(expand-file-name "scan" mh-progs) nil '(t nil) nil
(expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
(list folder "last" "-format" "%(msg)"))
(goto-char (point-min))
(if (re-search-forward mh-scan-msg-number-regexp nil 0 1)
@ -1582,6 +1823,7 @@ not updated."
sorted-msgs))
(defvar mh-sub-folders-cache (make-hash-table :test #'equal))
(defvar mh-current-folder-name nil)
(defun mh-normalize-folder-name (folder &optional empty-string-okay
dont-remove-trailing-slash)
@ -1602,8 +1844,18 @@ if present is retained (if present), otherwise it is removed."
(setq folder (replace-match "/" nil t folder)))
(let* ((length (length folder))
(trailing-slash-present (and (> length 0)
(equal (aref folder (1- length)) ?/))))
(let ((components (split-string folder "/"))
(equal (aref folder (1- length)) ?/)))
(leading-slash-present (and (> length 0)
(equal (aref folder 0) ?/))))
(when (and (> length 0) (equal (aref folder 0) ?@)
(stringp mh-current-folder-name))
(setq folder (format "%s/%s/" mh-current-folder-name
(substring folder 1))))
;; XXX: Purge empty strings from the list that split-string returns. In
;; XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU
;; Emacs it returns ("+foo"). In the code it is assumed that the
;; components list has no empty strings.
(let ((components (delete "" (split-string folder "/")))
(result ()))
;; Remove .. and . from the pathname.
(dolist (component components)
@ -1618,7 +1870,9 @@ if present is retained (if present), otherwise it is removed."
;; Remove trailing '/' if needed.
(unless (and trailing-slash-present dont-remove-trailing-slash)
(when (not (equal folder ""))
(setq folder (substring folder 0 (1- (length folder))))))))
(setq folder (substring folder 0 (1- (length folder))))))
(when leading-slash-present
(setq folder (concat "/" folder)))))
(cond ((and empty-string-okay (equal folder "")))
((equal folder "") (setq folder "+"))
((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder)))))
@ -1713,9 +1967,23 @@ tell us about the option +foo/bar!"
(defvar mh-folder-hist nil)
(defvar mh-speed-folder-map)
(defvar mh-speed-flists-cache)
(defvar mh-allow-root-folder-flag nil
"Non-nil means \"+\" is an acceptable folder name.
This variable is used to communicate with `mh-folder-completion-function'. That
function can have exactly three arguments so we bind this variable to t or nil.
This variable should never be set.")
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map))
(define-key mh-folder-completion-map " " 'minibuffer-complete)
(defun mh-speed-flists-active-p ()
"Check if speedbar is running with message counts enabled."
(and (featurep 'mh-speed)
(> (hash-table-count mh-speed-flists-cache) 0)))
(defun mh-folder-completion-function (name predicate flag)
"Programmable completion for folder names.
NAME is the partial folder name that has been input. PREDICATE if non-nil is a
@ -1747,14 +2015,19 @@ whether the completion is over."
(all-completions
remainder (mh-sub-folders last-complete t) predicate))
((eq flag 'lambda)
(file-exists-p
(concat mh-user-path
(substring (mh-normalize-folder-name name) 1)))))))
(let ((path (concat mh-user-path
(substring (mh-normalize-folder-name name) 1))))
(cond (mh-allow-root-folder-flag (file-exists-p path))
((equal path mh-user-path) nil)
(t (file-exists-p path))))))))
(defun mh-folder-completing-read (prompt default)
"Read folder name with PROMPT and default result DEFAULT."
(defun mh-folder-completing-read (prompt default allow-root-folder-flag)
"Read folder name with PROMPT and default result DEFAULT.
If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name
corresponding to `mh-user-path'."
(mh-normalize-folder-name
(let ((minibuffer-local-completion-map mh-folder-completion-map))
(let ((minibuffer-local-completion-map mh-folder-completion-map)
(mh-allow-root-folder-flag allow-root-folder-flag))
(completing-read prompt 'mh-folder-completion-function nil nil nil
'mh-folder-hist default))
t))
@ -1775,8 +2048,10 @@ when used in searching."
((equal "" default) "? ")
(t (format " [%s]? " default))))
(prompt (format "%s folder%s" prompt default-string))
(mh-current-folder-name mh-current-folder)
read-name folder-name)
(while (and (setq read-name (mh-folder-completing-read prompt default))
(while (and (setq read-name (mh-folder-completing-read
prompt default allow-root-folder-flag))
(equal read-name "")
(equal default "")))
(cond ((or (equal read-name "")
@ -1790,6 +2065,14 @@ when used in searching."
(cond ((and (> (length folder-name) 0)
(eq (aref folder-name (1- (length folder-name))) ?/))
(setq folder-name (substring folder-name 0 -1))))
(let* ((last-slash (mh-search-from-end ?/ folder-name))
(parent (and last-slash (substring folder-name 0 last-slash)))
(child (if last-slash
(substring folder-name (1+ last-slash))
(substring folder-name 1))))
(unless (member child
(mapcar #'car (gethash parent mh-sub-folders-cache)))
(mh-remove-from-sub-folders-cache folder-name)))
(let ((new-file-flag
(not (file-exists-p (mh-expand-file-name folder-name)))))
(cond ((and new-file-flag
@ -1809,6 +2092,24 @@ when used in searching."
(mh-expand-file-name folder-name)))))
folder-name))
(defun mh-truncate-log-buffer ()
"If `mh-log-buffer' is too big then truncate it.
If the number of lines in `mh-log-buffer' exceeds `mh-log-buffer-lines' then
keep only the last `mh-log-buffer-lines'. As a side effect the point is set to
the end of the log buffer.
The function returns the size of the final size of the log buffer."
(with-current-buffer (get-buffer-create mh-log-buffer)
(goto-char (point-max))
(save-excursion
(when (equal (forward-line (- mh-log-buffer-lines)) 0)
(delete-region (point-min) (point))))
(unless (or (bobp)
(save-excursion
(and (equal (forward-line -1) 0) (equal (char-after) ? ))))
(insert "\n \n"))
(buffer-size)))
;;; Issue commands to MH.
(defun mh-exec-cmd (command &rest args)
@ -1818,14 +2119,14 @@ Any output is assumed to be an error and is shown to the user.
The output is not read or parsed by MH-E."
(save-excursion
(set-buffer (get-buffer-create mh-log-buffer))
(erase-buffer)
(apply 'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string args))
(if (> (buffer-size) 0)
(save-window-excursion
(switch-to-buffer-other-window mh-log-buffer)
(sit-for 5)))))
(let ((initial-size (mh-truncate-log-buffer)))
(apply 'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string args))
(if (> (buffer-size) initial-size)
(save-window-excursion
(switch-to-buffer-other-window mh-log-buffer)
(sit-for 5))))))
(defun mh-exec-cmd-error (env command &rest args)
"In environment ENV, execute mh-command COMMAND with ARGS.
@ -1834,19 +2135,15 @@ Signals an error if process does not complete successfully."
(save-excursion
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(let ((status
(if env
;; the shell hacks necessary here shows just how broken Unix is
(apply 'call-process "/bin/sh" nil t nil "-c"
(format "%s %s ${1+\"$@\"}"
env
(expand-file-name command mh-progs))
command
(mh-list-to-string args))
(apply 'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string args)))))
(mh-handle-process-error command status))))
(let ((process-environment process-environment))
;; XXX: We should purge the list that split-string returns of empty
;; strings. This can happen in XEmacs if leading or trailing spaces
;; are present.
(dolist (elem (if (stringp env) (split-string env " ") ()))
(push elem process-environment))
(mh-handle-process-error
command (apply #'call-process (expand-file-name command mh-progs)
nil t nil (mh-list-to-string args))))))
(defun mh-exec-cmd-daemon (command filter &rest args)
"Execute MH command COMMAND in the background.
@ -1858,7 +2155,7 @@ details of FILTER.
ARGS are passed to COMMAND as command line arguments."
(save-excursion
(set-buffer (get-buffer-create mh-log-buffer))
(erase-buffer))
(mh-truncate-log-buffer))
(let* ((process-connection-type nil)
(process (apply 'start-process
command nil
@ -1866,6 +2163,22 @@ ARGS are passed to COMMAND as command line arguments."
(mh-list-to-string args))))
(set-process-filter process (or filter 'mh-process-daemon))))
(defun mh-exec-cmd-env-daemon (env command filter &rest args)
"In ennvironment ENV, execute mh-command COMMAND in the background.
ENV is nil or a string of space-separated \"var=value\" elements.
Signals an error if process does not complete successfully.
If FILTER is non-nil then it is used to process the output otherwise the
default filter `mh-process-daemon' is used. See `set-process-filter' for more
details of FILTER.
ARGS are passed to COMMAND as command line arguments."
(let ((process-environment process-environment))
(dolist (elem (if (stringp env) (split-string env " ") ()))
(push elem process-environment))
(apply #'mh-exec-cmd-daemon command filter args)))
(defun mh-process-daemon (process output)
"PROCESS daemon that puts OUTPUT into a temporary buffer.
Any output from the process is displayed in an asynchronous pop-up window."
@ -1933,30 +2246,20 @@ Put the output into buffer after point. Set mark after inserted text."
(apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args))
(defun mh-handle-process-error (command status)
"Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS.
STATUS is return value from `call-process'.
Program output is in current buffer.
If output is too long to include in error message, display the buffer."
(cond ((eq status 0) ;success
status)
((stringp status) ;kill string
(error "%s: %s" command status))
(t ;exit code
(cond
((= (buffer-size) 0) ;program produced no error message
(error "%s: exit code %d" command status))
(t
;; will error message fit on one line?
(goto-line 2)
(if (and (< (buffer-size) (frame-width))
(eobp))
(error "%s"
(buffer-substring 1 (progn (goto-char 1)
(end-of-line)
(point))))
(display-buffer (current-buffer))
(error "%s failed with status %d. See error message in other window"
command status)))))))
"Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS."
(if (equal status 0)
status
(goto-char (point-min))
(insert (if (integerp status)
(format "%s: exit code %d\n" command status)
(format "%s: %s\n" command status)))
(save-excursion
(let ((error-message (buffer-substring (point-min) (point-max))))
(set-buffer (get-buffer-create mh-log-buffer))
(mh-truncate-log-buffer)
(insert error-message)))
(error "%s failed, check %s buffer for error message"
command mh-log-buffer)))
(defun mh-list-to-string (l)
"Flatten the list L and make every element of the new list into a string."

42
lisp/mh-e/mh-xemacs-compat.el
View file

@ -1,6 +1,6 @@
;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: FSF
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -28,13 +28,13 @@
;;; Change Log:
;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
;;; Code:
;;; Some requires:
(require 'rfc822)
(eval-when-compile (require 'mh-utils))
;;; Simple compatibility:
(unless (fboundp 'match-string-no-properties)
@ -52,6 +52,42 @@
(unless (fboundp 'cancel-timer)
(defalias 'cancel-timer 'delete-itimer))
;; Set up the modeline glyph
(defconst mh-modeline-logo
"/* XPM */
static char * file[] = {
\"18 13 2 1\",
\"# c #666699\",
\". c None s None\",
\"........##........\",
\".......####.......\",
\"......######......\",
\"......######......\",
\"....#########.....\",
\"..##############..\",
\".##...######....#.\",
\"##...#.#.####...#.\",
\"....#..#.##.#...#.\",
\"...#..##.#.#.#....\",
\"...#..#..#..#.#...\",
\"...#..#.##..#.##..\",
\"...#..#.#..#....#.\"};"
"The image for the modeline logo.")
(mh-do-in-xemacs
(defvar mh-modeline-glyph
(progn
(let* ((data mh-modeline-logo)
(glyph (make-glyph
(cond ((and (featurep 'xpm)
(device-on-window-system-p)
has-modeline-p)
`[xpm :data ,data])
(t [string :data "MH-E"])))))
(set-glyph-face glyph 'modeline-buffer-id)
glyph))
"Cute little logo to put in the modeline of MH-E buffers."))
(provide 'mh-xemacs-compat)
;;; Local Variables:

1306
lisp/mh-e/mh-xemacs-icons.el Normal file
View file

File diff suppressed because it is too large Load diff

BIN
lisp/toolbar/highlight.pbm Normal file
View file

Binary file not shown.

33
lisp/toolbar/highlight.xpm Normal file
View file

@ -0,0 +1,33 @@
/* XPM */
static char * highlight_xpm[] = {
/* columns rows colors chars-per-pixel */
"24 24 4 1",
" c None",
". c black",
"X c #828282827474",
"o c #dd00df007e00",
/* pixels */
" ..... ",
" ..XXX.. ",
" .XXXXX. ",
" .XXXXX.. ",
" .XXXXX. ",
" .XXXXX. ",
" .XXXXX. ",
" .ooXX. ",
" ..ooo. ",
" oooo .... ",
"oo.ooo....oo ... ",
"o.o.ooo.oo.o.ooo.o ",
".ooo.oo.oo.o.ooooo ",
".ooo.oo.oo.o.ooooo ",
".ooo.oo...oo.ooooo ",
".....oo.oo.o.ooooo ",
".ooo.oo.oo.o.ooooo ",
".ooo.oo.oo.o.ooo.o ",
". oo.o....ooo...o ",
" oo oooo ",
" ",
" ",
" ",
" "};