mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-03 14:10:47 -08:00
Code Issues Projects Releases Wiki Activity

Upgraded to MH-E version 7.4.4.

Browse source 
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
This commit is contained in:
Bill Wohler 2004-07-13 03:06:25 +00:00
parent 0117451de7
commit a66894d8b4
33 changed files with 4173 additions and 2586 deletions
Download patch file Download diff file Expand all files Collapse all files

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2004-07-12 Bill Wohler <wohler@newt.com>
* NEWS, MH-E-NEWS: Upgraded to MH-E version 7.4.4.
2004-07-08 David Kastrup <dak@gnu.org>
* NEWS (Lisp changes in 21.4): document (match-data t) change.

235
etc/MH-E-NEWS
View file

@ -1,9 +1,242 @@
Copyright (C) 2003 Free Software Foundation, Inc.
* COPYRIGHT
Copyright (C) 2003, 2004 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.4.4
Version 7.4.4 addresses programmatic issues from the FSF and prepares
MH-E for inclusion into an impending GNU Emacs release (21.4). There
are no user-visible changes (unless you are using XEmacs on DOS or
don't have the cl package installed). Filenames are now unique in
their first 8 characters (DOS 8.3 requirement). The runtime dependency
on the cl package has been removed. Desktop saving and restoration
code moved here from desktop.el.
* Changes in MH-E 7.4.3
Version 7.4.3 fixes the problem where mh-identity-list was not getting
set from .emacs.
* Changes in MH-E 7.4.2
Version 7.4.2 fixes the accidental dependence on nmh (closes SF
#791021).
* Changes in MH-E 7.4.1
Version 7.4.1 fixes the Makefile so it no longer tries to compile
mh-unit.el.
* Changes in MH-E 7.4
Version 7.4 contains many new useful features including arbitrary MH
range handling, new draft features such as draft form editing, as well
as sequence propagation and manipulation. We've also fixed bugs and
added a handful of new variables.
** New Features in MH-E 7.4
*** Add Arbitrary Ranges to MH-E UI
MH-E now handles any legal MH range (such as last:5 or 4 8 10-12)
wherever you're prompted for a message number or sequence (closes SF
#728638).
*** Remove Prompting in mh-send
Brian Reid's original mhe didn't do prompting anywhere but used forms
instead. While we won't go that far, we eliminated prompting where a
form is already involved, such as in composing a message.
The new customization variable `mh-compose-prompt-flag' can be set to
t to get the original behavior (closes SF #745622).
*** Use TAB to Switch Fields in Header
When composing a message, TAB and SHIFT-TAB can be used to move
quickly between header fields. The new customization variable,
`mh-compose-skipped-header-fields', contains a list of header fields
that are skipped and truncated if they are too long (closes SF
#745627).
*** Alias Completion in Composition Buffer
Aliases can be completed in the draft with "M-TAB
(mh-letter-complete)". Or, if the customization variable
`mh-compose-space-does-completion-flag' is set to t, then a "SPC
(mh-letter-complete-or-space)" with do the same thing. If
`mh-alias-flash-on-comma' is non-nil, ", (mh-letter-confirm-address)"
will show the alias expansion in the minibuffer (closes SF #745634).
*** Auto Fields Should be Inserted During Send
Fields that were inserted by the multiple personality code when the
draft was sent now insert the header fields when the draft is composed
to give you a chance to edit them (closes SF #747890).
*** mh-index-tick-messages
The command "F ' (mh-index-ticked-messages)" creates a buffer with all
messages ticked with "' (mh-toggle-tick)" in the folders listed in the
new customization variable `mh-index-ticked-messages-folders'. Chances
are that if you set `mh-index-new-messages-folders', you'll want to
set `mh-index-ticked-messages-folders' accordingly.
In addition, a general function, "F q (mh-index-sequenced-messages)"
has been provided that displays messages in the `mh-unseen-seq' in the
folders listed `mh-index-new-messages-folders', unless a prefix
argument is given, in which case you can provide both a list of
folders and a sequence (closes SF #718833).
*** Narrow to Region
If there is a region, "/ r (mh-narrow-to-range)" will only consider
those messages in the region. In addition, there is now a stack of
folder limits which can be popped with "/ w (mh-widen)". With a prefix
arg, all the restrictions are popped off of the stack (closes SF
#732823).
*** Narrow to Ticked Sequence
The buffer can now be narrowed to ticked messages with "S '
(mh-narrow-to-tick)" (closes SF #732825).
*** Display Multiple Buttons for multipart/alternative
A new customizable variable,
`mh-display-buttons-for-alternatives-flag', was added to display
buttons for the alternatives. The default value is nil to retain the
current behavior (closes SF #741288).
*** Identity Menu Changes
A menu item has been added that inserts custom fields if the To or Cc
header fields match `mh-auto-fields-list'.
** New Variables in MH-E 7.4
*** mh-alias-local-users-prefix
This string is prepended to the real names of users from the passwd
file. If nil, use the username string unmodified instead of the real
name from the gecos field of the passwd file.
*** mh-alias-passwd-gecos-comma-separator-flag
Non-nil means the gecos field in the passwd file uses comma as a
separator. Used to construct aliases for users in the passwd file."
*** mh-interpret-number-as-range-flag
Non-nil means interpret a number as a range. If the variable is
non-nil, and you use an integer, N, when asked for a range to scan,
then MH-E uses the range "last:N".
*** mh-kill-folder-suppress-prompt-hook
This new hook is invoked at the beginning of the `F k
(mh-kill-folder)' command. It is a list of functions to be called,
with no arguments, which should return a value of non-nil if you
should not be asked if you're sure that you want to remove the folder.
This is useful for folders that are easily regenerated.
The default value of `mh-index-p' suppresses the prompt on folders
generated by an index search.
WARNING: Use this hook with care. If there is a bug in your hook which
returns t on +inbox and you hit `F k' by accident in the +inbox
buffer, you will not be happy.
*** mh-refile-preserves-sequences-flag
Non-nil means that sequences are preserved when messages are refiled.
If this variable is non-nil and a message belonging to a sequence
other than cur or Previous-Sequence (see mh-profile 5) is refiled then
it is put in the same sequence in the destination folder. Additional
sequences that should not to be preserved can be specified by setting
`mh-unpropagated-sequences' appropriately.
*** mh-visible-header-fields
Customize this instead of `mh-visible-headers', which is now a defvar.
This was done to mimic the relationship between
`mh-invisible-header-fields' and `mh-invisible-fields'.
** Variables Deleted in MH-E 7.4
*** mh-visible-headers
See the paragraph for `mh-visible-header-fields' above.
** Bug Fixes in MH-E 7.4
*** Aliases Constantly Reloaded
The system aliases are not loaded as often as they were, so the
completion speed has been dramatically improved if your passwd file is
large (closes SF #693859).
*** Folders in MH-Index View Not Saved
When you perform a search to produce an MH-Index buffer, the folders
that contain the messages are shown. If the MH-Index buffer was
deleted, or Emacs was restarted and the corresponding folder
rescanned, the folder information would be lost. This has been fixed
by saving the information in a file called ".mhe_index" (closes SF
#701762).
*** Ticking Messages in +mhe-index/new
If a new message in a buffer created by "F n" was ticked (with "'"),
the message would not be added to the tick sequence in the source
folder. This has been fixed so that any sequence changes in any index
folder (from within MH-E of course) are now reflected back to the
corresponding source folder (closes SF #709664).
*** Custom Vars Set by a Function
The default setting of customization variable `mh-summary-height' is
now `nil' which means MH-E will change the size dynamically according
to the size of the frame (closes SF #723267).
*** Folder Completion Slow
The first folder completion was very slow. This has been fixed (closes
SF #730426).
*** Tick Sequence Persistent When Refiled
Sequences are now preserved when messages are refiled (closes SF
#737128).
*** Auto-inserted Header Fields Inconsistent
For consistency, all automatically inserted header fields (such as
X-Mailer and X-Face) are added when the draft is first presented to
you. This also gives you a chance to edit or delete them if necessary
(closes SF #745624). Note that we would be distressed if you deleted
the X-Mailer field.
*** Toolbar Spec Error
The following message appeared when displaying a message in XEmacs:
Signaling: (error "Toolbar spec must be list or nil" )
This has been fixed (closes SF #745655).
*** mh-index-search Doesn't Find Short Acronyms
Swish typically ignores words with fewer than four letters, but will
still look for acronyms. Unfortunately, MH-E was downcasing the input
words which defeated this feature. This has been fixed (closes SF
#755718).
* Changes in MH-E 7.3

2
etc/NEWS
View file

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

BIN
lisp/mail/reply2.pbm
View file

Binary file not shown.

1274
lisp/mh-e/ChangeLog
View file

File diff suppressed because it is too large Load diff

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

@ -1,7 +1,7 @@
;;; mh-alias.el --- MH-E mail alias completion and expansion
;;
;; Copyright (C) 1994, 95, 96, 1997,
;; 2001, 02, 2003 Free Software Foundation, Inc.
;; 2001, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -128,6 +128,14 @@
;;; Alias Loading
(defmacro mh-assoc-ignore-case (key alist)
"Search for string KEY in ALIST.
This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
`assoc-ignore-case' which is now an obsolete function."
(cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t))
((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist))
(t (error "The macro mh-assoc-ignore-case not implemented properly"))))
(defun mh-alias-tstamp (arg)
"Check whether alias files have been modified.
Return t if any file listed in the MH profile component Aliasfile has been
@ -169,6 +177,29 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(append userlist mh-alias-system-aliases))
userlist))))
(defun mh-alias-gecos-name (gecos-name username comma-separator)
"Return a usable address string from a GECOS-NAME and USERNAME.
Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is
non-nil."
(let ((res gecos-name))
;; Keep only string until first comma if COMMA-SEPARATOR is t.
(if (and comma-separator
(string-match "^\\([^,]+\\)," res))
(setq res (match-string 1 res)))
;; Replace "&" with capitalized username
(if (string-match "&" res)
(setq res (mh-replace-in-string "&" (capitalize username) res)))
;; Remove " character
(if (string-match "\"" res)
(setq res (mh-replace-in-string "\"" "" res)))
;; If empty string, use username instead
(if (string-equal "" res)
(setq res username))
;; Surround by quotes if doesn't consist of simple characters
(if (not (string-match "^[ a-zA-Z0-9-]+$" res))
(setq res (concat "\"" res "\"")))
res))
(defun mh-alias-local-users ()
"Return an alist of local users from /etc/passwd."
(let (passwd-alist)
@ -185,23 +216,23 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(goto-char (point-min))))
(while (< (point) (point-max))
(cond
((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
(when (> (string-to-int (match-string 2)) 200)
(let* ((username (match-string 1))
(gecos-name (match-string 3))
(realname
(if (string-match "&" gecos-name)
(concat
(substring gecos-name 0 (match-beginning 0))
(capitalize username)
(substring gecos-name (match-end 0)))
gecos-name)))
(realname (mh-alias-gecos-name
gecos-name username
mh-alias-passwd-gecos-comma-separator-flag)))
(setq passwd-alist
(cons (list username
(if (string-equal "" realname)
(concat "<" username ">")
(concat realname " <" username ">")))
passwd-alist))))))
(cons
(list (if mh-alias-local-users-prefix
(concat mh-alias-local-users-prefix
(mh-alias-suggest-alias realname t))
username)
(if (string-equal username realname)
(concat "<" username ">")
(concat realname " <" username ">")))
passwd-alist))))))
(forward-line 1)))
passwd-alist))
@ -219,12 +250,12 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
(cond
((looking-at "^[ \t]")) ;Continuation line
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
(when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
(when (not (mh-assoc-ignore-case (match-string 1) mh-alias-blind-alist))
(setq mh-alias-blind-alist
(cons (list (match-string 1)) mh-alias-blind-alist))
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
((looking-at "\\(.+\\): .*$") ; A new MH alias
(when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
(when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist))
(setq mh-alias-alist
(cons (list (match-string 1)) mh-alias-alist)))))
(forward-line 1)))
@ -235,11 +266,12 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
user)
(while local-users
(setq user (car local-users))
(if (not (assoc-ignore-case (car user) mh-alias-alist))
(if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
(setq mh-alias-alist (append mh-alias-alist (list user))))
(setq local-users (cdr local-users)))))
(message "Loading MH aliases...done"))
;;;###mh-autoload
(defun mh-alias-reload-maybe ()
"Load new MH aliases."
(if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
@ -269,10 +301,10 @@ ali returns the string unchanged if not defined. The same is done here."
"Return expansion for ALIAS.
Blind aliases or users from /etc/passwd are not expanded."
(cond
((assoc-ignore-case alias mh-alias-blind-alist)
((mh-assoc-ignore-case alias mh-alias-blind-alist)
alias) ; Don't expand a blind alias
((assoc-ignore-case alias mh-alias-passwd-alist)
(cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
((mh-assoc-ignore-case alias mh-alias-passwd-alist)
(cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist)))
(t
(mh-alias-ali alias))))
@ -302,26 +334,12 @@ Blind aliases or users from /etc/passwd are not expanded."
(defun mh-alias-minibuffer-confirm-address ()
"Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
(interactive)
(if (not mh-alias-flash-on-comma)
()
(when mh-alias-flash-on-comma
(save-excursion
(let* ((case-fold-search t)
(the-name (buffer-substring
(progn (skip-chars-backward " \t")(point))
;; This moves over to previous comma, if any
(progn (or (and (not (= 0 (skip-chars-backward "^,")))
;; the skips over leading whitespace
(skip-chars-forward " "))
;; no comma, then to beginning of word
(skip-chars-backward "^ \t"))
;; In Emacs21, the beginning of the prompt
;; line is accessible, which wasn't the case
;; in emacs20. Skip over it.
(if (looking-at "^[^ \t]+:")
(skip-chars-forward "^ \t"))
(skip-chars-forward " ")
(point)))))
(if (assoc-ignore-case the-name mh-alias-alist)
(beg (mh-beginning-of-word))
(the-name (buffer-substring-no-properties beg (point))))
(if (mh-assoc-ignore-case the-name mh-alias-alist)
(message "%s -> %s" the-name (mh-alias-expand the-name))
;; Check if if was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
@ -335,30 +353,26 @@ Blind aliases or users from /etc/passwd are not expanded."
(defun mh-alias-letter-expand-alias ()
"Expand mail alias before point."
(mh-alias-reload-maybe)
(let ((mail-abbrevs mh-alias-alist))
(mh-funcall-if-exists mail-abbrev-complete-alias))
(when mh-alias-expand-aliases-flag
(let* ((end (point))
(syntax-table (syntax-table))
(beg (unwind-protect
(save-excursion
(set-syntax-table mail-abbrev-syntax-table)
(backward-word 1)
(point))
(set-syntax-table syntax-table)))
(alias (buffer-substring beg end))
(expansion (mh-alias-expand alias)))
(delete-region beg end)
(insert expansion))))
(let* ((end (point))
(begin (mh-beginning-of-word))
(input (buffer-substring-no-properties begin end)))
(mh-complete-word input mh-alias-alist begin end)
(when mh-alias-expand-aliases-flag
(let* ((end (point))
(expansion (mh-alias-expand (buffer-substring begin end))))
(delete-region begin end)
(insert expansion)))))
;;; Adding addresses to alias file.
(defun mh-alias-suggest-alias (string)
"Suggest an alias for STRING."
(defun mh-alias-suggest-alias (string &optional no-comma-swap)
"Suggest an alias for STRING.
Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is
non-nil."
(cond
((string-match "^<\\(.*\\)>$" string)
;; <somename@foo.bar> -> recurse, stripping brackets.
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\sw+$" string)
;; One word -> downcase it.
(downcase string))
@ -372,47 +386,59 @@ Blind aliases or users from /etc/passwd are not expanded."
(downcase (match-string 1 string)))
((string-match "^\"\\(.*\\)\".*" string)
;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(.*\\) +<.*>$" string)
;; Some name <somename@foo.bar> -> recurse -> Some name
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
;; somename@foo.bar (Some name) -> recurse -> Some name
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
;; Strip out title
(mh-alias-suggest-alias (match-string 2 string)))
(mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
;; Strip out tails with comma
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
;; Strip out tails
(mh-alias-suggest-alias (match-string 1 string)))
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
;; Strip out initials
(mh-alias-suggest-alias
(format "%s %s" (match-string 1 string) (match-string 2 string))))
((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
;; Reverse order of comma-separated fields
(format "%s %s" (match-string 1 string) (match-string 2 string))
no-comma-swap))
((and (not no-comma-swap)
(string-match "^\\([^,]+\\), +\\(.*\\)$" string))
;; Reverse order of comma-separated fields to handle:
;; From: "Galbraith, Peter" <psg@debian.org>
;; but don't this for a name string extracted from the passwd file
;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
(mh-alias-suggest-alias
(format "%s %s" (match-string 2 string) (match-string 1 string))))
(format "%s %s" (match-string 2 string) (match-string 1 string))
no-comma-swap))
(t
;; Output string, with spaces replaced by dots.
(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."
"Process STRING to replace spaces by periods.
First all spaces and commas 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 " +" ".")
(while (re-search-forward " +" nil t)
(replace-match "." nil nil))
;; Replace commas with periods
(goto-char (point-min))
(while (re-search-forward ",+" nil t)
(replace-match "." nil nil))
;; Replace consecutive periods with a single period
(goto-char (point-min))
(replace-regexp "\\.\\.+" ".")
(while (re-search-forward "\\.\\.+" nil t)
(replace-match "." nil nil))
;; Convert to lower case
(downcase-region (point-min) (point-max))
;; Whew! all done...
@ -617,6 +643,63 @@ already has an alias."
(mh-alias-add-alias nil address)
(message "No email address found under point."))))
;;;###mh-autoload
(defun mh-alias-apropos (regexp)
"Show all aliases that match REGEXP either in name or content."
(interactive "sAlias regexp: ")
(if mh-alias-local-users
(mh-alias-reload-maybe))
(let ((matches "")(group-matches "")(passwd-matches))
(save-excursion
(message "Reading MH aliases...")
(mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
(message "Reading MH aliases...done. Parsing...")
(while (re-search-forward regexp nil t)
(beginning-of-line)
(cond
((looking-at "^[ \t]") ;Continuation line
(setq group-matches
(concat group-matches
(buffer-substring
(save-excursion
(or (re-search-backward "^[^ \t]" nil t)
(point)))
(progn
(if (re-search-forward "^[^ \t]" nil t)
(forward-char -1))
(point))))))
(t
(setq matches
(concat matches
(buffer-substring (point)(progn (end-of-line)(point)))
"\n")))))
(message "Reading MH aliases...done. Parsing...done.")
(when mh-alias-local-users
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...")
(setq passwd-matches
(mapconcat
'(lambda (elem)
(if (or (string-match regexp (car elem))
(string-match regexp (cadr elem)))
(format "%s: %s\n" (car elem) (cadr elem))))
mh-alias-passwd-alist ""))
(message
"Reading MH aliases...done. Parsing...done. Passwd aliases...done.")))
(if (and (string-equal "" matches)
(string-equal "" group-matches)
(string-equal "" passwd-matches))
(message "No matches")
(with-output-to-temp-buffer "*Help*"
(if (not (string-equal "" matches))
(princ matches))
(when (not (string-equal group-matches ""))
(princ "\nGroup Aliases:\n\n")
(princ group-matches))
(when (not (string-equal passwd-matches ""))
(princ "\nLocal User Aliases:\n\n")
(princ passwd-matches))))))
(provide 'mh-alias)
;;; Local Variables:

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

@ -1,7 +1,7 @@
;;; mh-comp.el --- MH-E functions for composing messages
;; Copyright (C) 1993, 95, 1997,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -36,7 +36,8 @@
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
(require 'cl)
(require 'mh-utils)
(mh-require-cl)
(eval-when (compile load eval)
(ignore-errors (require 'mailabbrev)))
@ -199,6 +200,10 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
(defvar mh-annotate-field nil
"Field name for message annotation.")
(defvar mh-insert-auto-fields-done-local nil
"Buffer-local variable set when `mh-insert-auto-fields' successfully called.")
(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
;;;###autoload
(defun mh-smail ()
"Compose and send mail with the MH mail system.
@ -279,7 +284,8 @@ See also documentation for `\\[mh-send]' function."
(save-buffer)
(mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
config)
(mh-letter-mode-message)))
(mh-letter-mode-message)
(mh-letter-adjust-point)))
;;;###mh-autoload
(defun mh-extract-rejected-mail (msg)
@ -309,22 +315,20 @@ See also documentation for `\\[mh-send]' function."
(mh-letter-mode-message)))
;;;###mh-autoload
(defun mh-forward (to cc &optional msg-or-seq)
(defun mh-forward (to cc &optional range)
"Forward messages to the recipients TO and CC.
Use optional MSG-OR-SEQ argument to specify a message or sequence to forward.
Use optional RANGE 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.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function."
(interactive (list (mh-read-address "To: ")
(mh-read-address "Cc: ")
(mh-interactive-msg-or-seq "Forward")))
(interactive (list (mh-interactive-read-address "To: ")
(mh-interactive-read-address "Cc: ")
(mh-interactive-range "Forward")))
(let* ((folder mh-current-folder)
(msgs (mh-msg-or-seq-to-msg-list msg-or-seq))
(msgs (mh-range-to-msg-list range))
(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
@ -355,8 +359,7 @@ See also documentation for `\\[mh-send]' function."
;; If using MML, translate mhn
(if (equal mh-compose-insertion 'gnus)
(save-excursion
(re-search-forward (format "^\\(%s\\)?$"
mh-mail-header-separator))
(goto-char (mh-mail-header-end))
(while
(re-search-forward
"^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
@ -376,7 +379,7 @@ See also documentation for `\\[mh-send]' function."
;; Postition just before forwarded message
(if (re-search-forward "^------- Forwarded Message" nil t)
(forward-line -1)
(re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
(goto-char (mh-mail-header-end))
(forward-line 1))
(delete-other-windows)
(mh-add-msgs-to-seq msgs 'forwarded t)
@ -384,7 +387,8 @@ See also documentation for `\\[mh-send]' function."
to forw-subject cc
mh-note-forw "Forwarded:"
config)
(mh-letter-mode-message)))))
(mh-letter-mode-message)
(mh-letter-adjust-point)))))
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
@ -567,9 +571,9 @@ details.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
(interactive (list
(mh-read-address "To: ")
(mh-read-address "Cc: ")
(read-string "Subject: ")))
(mh-interactive-read-address "To: ")
(mh-interactive-read-address "Cc: ")
(mh-interactive-read-string "Subject: ")))
(let ((config (current-window-configuration)))
(delete-other-windows)
(mh-send-sub to cc subject config)))
@ -587,9 +591,9 @@ details.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
(interactive (list
(mh-read-address "To: ")
(mh-read-address "Cc: ")
(read-string "Subject: ")))
(mh-interactive-read-address "To: ")
(mh-interactive-read-address "Cc: ")
(mh-interactive-read-string "Subject: ")))
(let ((pop-up-windows t))
(mh-send-sub to cc subject (current-window-configuration))))
@ -630,7 +634,8 @@ CONFIG is the window configuration before sending mail."
(mh-compose-and-send-mail draft "" folder msg-num
to subject cc
nil nil config)
(mh-letter-mode-message))))
(mh-letter-mode-message)
(mh-letter-adjust-point))))
(defun mh-read-draft (use initial-contents delete-contents-file)
"Read draft file into a draft buffer and make that buffer the current one.
@ -695,7 +700,7 @@ MSG can be a message number, a list of message numbers, or a sequence."
(save-excursion
(cond ((get-buffer buffer) ; Buffer may be deleted
(set-buffer buffer)
(mh-iterate-on-msg-or-seq nil msg
(mh-iterate-on-range nil msg
(mh-notate nil note (1+ mh-cmd-note)))))))
(defun mh-insert-fields (&rest name-values)
@ -867,7 +872,6 @@ When a message is composed, the hooks `text-mode-hook' and
`mh-letter-mode-hook' are run.
\\{mh-letter-mode-map}"
(or mh-user-path (mh-find-path))
(make-local-variable 'mh-send-args)
(make-local-variable 'mh-annotate-char)
@ -879,6 +883,14 @@ When a message is composed, the hooks `text-mode-hook' and
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
(make-local-variable 'mh-help-messages)
(setq mh-help-messages mh-letter-mode-help-messages)
(setq buffer-invisibility-spec '((vanish . t) t))
(set (make-local-variable 'line-move-ignore-invisible) t)
;; Set mh-mail-header-end-marker to remember end of message header.
(set (make-local-variable 'mh-letter-mail-header-end-marker)
(set-marker (make-marker) (save-excursion
(goto-char (mh-mail-header-end))
(line-beginning-position 2))))
;; From sendmail.el for proper paragraph fill
;; sendmail.el also sets a normal-auto-fill-function (not done here)
@ -908,8 +920,7 @@ When a message is composed, the hooks `text-mode-hook' and
;; 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))
(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
@ -919,7 +930,7 @@ When a message is composed, the hooks `text-mode-hook' and
;; is that gnus uses static text properties which are not appropriate
;; for a buffer that will be edited. So the choice here is either fontify
;; the citations and header...
(setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
(setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
(t
;; ...or the header only
(setq font-lock-defaults '(mh-show-font-lock-keywords t))))
@ -930,6 +941,36 @@ When a message is composed, the hooks `text-mode-hook' and
(make-local-variable 'auto-fill-function)
(setq auto-fill-function 'mh-auto-fill-for-letter)))
(defun mh-font-lock-field-data (limit)
"Find header field region between point and LIMIT."
(and (< (point) (mh-letter-header-end))
(< (point) limit)
(let ((end (min limit (mh-letter-header-end)))
(point (point))
data-end data-begin field)
(end-of-line)
(setq data-end (if (re-search-forward "^[^ \t]" end t)
(match-beginning 0)
end))
(goto-char (1- data-end))
(if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
(setq data-begin (point-min))
(setq data-begin (match-end 0))
(setq field (match-string 1)))
(setq data-begin (max point data-begin))
(if (and field (mh-letter-skipped-header-field-p field))
(set-match-data nil)
(set-match-data (list data-begin data-end data-begin data-end)))
(goto-char (if (equal point data-end) (1+ data-end) data-end))
t)))
(defun mh-letter-header-end ()
"Find the end of header from `mh-letter-mail-header-end-marker'."
(save-excursion
(goto-char (marker-position mh-letter-mail-header-end-marker))
(forward-line -1)
(point)))
(defun mh-auto-fill-for-letter ()
"Perform auto-fill for message.
Header is treated specially by inserting a tab before continuation lines."
@ -1061,7 +1102,7 @@ MH the first time a message is composed.")
The versions of MH-E, Emacs, and MH are shown."
;; Lazily initialize mh-x-mailer-string.
(when (null mh-x-mailer-string)
(when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
(save-window-excursion
;; User would be confused if version info buffer disappeared magically,
;; so don't delete buffer if it already existed.
@ -1088,7 +1129,8 @@ The versions of MH-E, Emacs, and MH are shown."
(kill-buffer mh-info-buffer)))))
;; Insert X-Mailer, but only if it doesn't already exist.
(save-excursion
(when (null (mh-goto-header-field "X-Mailer"))
(when (and mh-insert-x-mailer-flag
(null (mh-goto-header-field "X-Mailer")))
(mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
(defun mh-regexp-in-field-p (regexp &rest fields)
@ -1106,39 +1148,60 @@ The versions of MH-E, Emacs, and MH are shown."
(setq fields (cdr fields))))
search-result)))
(defun mh-insert-auto-fields ()
"Insert custom fields if To or Cc match `mh-auto-fields-list'."
(save-excursion
(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)))))))
;;;###mh-autoload
(defun mh-insert-auto-fields (&optional non-interactive)
"Insert custom fields if To or Cc match `mh-auto-fields-list'.
Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually."
(interactive)
(when (or (not non-interactive) (not mh-insert-auto-fields-done-local))
(save-excursion
(when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
(let ((list mh-auto-fields-list))
(while list
(let ((regexp (nth 0 (car list)))
(entries (nth 1 (car list))))
(when (mh-regexp-in-field-p regexp "To:" "cc:")
(setq mh-insert-auto-fields-done-local t)
(if (not non-interactive)
(message "Matched for regexp %s" regexp))
(let ((entry-list entries))
(while entry-list
(let ((field (caar entry-list))
(value (cdar entry-list)))
(cond
((equal "identity" field)
(when (and (not mh-identity-local)
(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"))))
(cond ((and overwrite-flag
(mh-goto-header-field (concat field ":")))
(insert " " value)
(delete-region (point) (line-end-position)))
((and (not overwrite-flag)
(mh-regexp-in-field-p (concat "\\b" value "\\b") field))
;; Already there, do nothing.
)
((and (not overwrite-flag)
(mh-goto-header-field (concat field ":")))
(insert " " value ","))
(t
(mh-goto-header-end 0)
(insert field ": " value "\n"))))
(defvar mh-letter-mail-header-end-marker nil)
(defun mh-compose-and-send-mail (draft send-args
sent-from-folder sent-from-msg
@ -1157,8 +1220,8 @@ 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)
(mh-insert-auto-fields)
(mh-letter-mode)
(mh-insert-auto-fields t)
;; mh-identity support
(if (and (boundp 'mh-identity-default)
@ -1170,6 +1233,12 @@ CONFIG is the window configuration to restore after sending the letter."
(mh-identity-make-menu)
(easy-menu-add mh-identity-menu))
;; Extra fields
(mh-insert-x-mailer)
(mh-insert-x-face)
;; Hide skipped fields
(mh-letter-hide-all-skipped-fields)
(setq mh-sent-from-folder sent-from-folder)
(setq mh-sent-from-msg sent-from-msg)
(setq mh-send-args send-args)
@ -1209,12 +1278,11 @@ 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)
(mh-insert-auto-fields t)
(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)
(message "Sending...")
(let ((draft-buffer (current-buffer))
@ -1481,52 +1549,285 @@ This is useful in breaking up paragraphs in replies."
(mh-do-in-xemacs (defvar mail-abbrevs))
;;;###mh-autoload
(defun mh-complete-word (word choices begin end)
"Complete WORD at from CHOICES.
Any match found replaces the text from BEGIN to END."
(let ((completion (try-completion word choices)))
(cond ((eq completion t)
(message "Completed: %s" word))
((null completion)
(message "No completion for `%s'" word))
((stringp completion)
(if (equal word completion)
(with-output-to-temp-buffer "*Completions*"
(display-completion-list (all-completions word choices)))
(delete-region begin end)
(insert completion))))))
;;;###mh-autoload
(defun mh-beginning-of-word (&optional n)
"Return position of the N th word backwards."
(unless n (setq n 1))
(let ((syntax-table (syntax-table)))
(unwind-protect
(save-excursion
(mh-funcall-if-exists mail-abbrev-make-syntax-table)
(set-syntax-table mail-abbrev-syntax-table)
(backward-word n)
(point))
(set-syntax-table syntax-table))))
(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)))
(beg (mh-beginning-of-word))
(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"))))
(choices (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))))
(mh-complete-word folder choices beg end)))
;; XXX: This should probably be customizable
(defvar mh-letter-complete-function-alist
'((cc . mh-alias-letter-expand-alias)
(bcc . mh-alias-letter-expand-alias)
(dcc . mh-alias-letter-expand-alias)
(fcc . mh-folder-expand-at-point)
(from . mh-alias-letter-expand-alias)
(mail-followup-to . mh-alias-letter-expand-alias)
(reply-to . mh-alias-letter-expand-alias)
(to . mh-alias-letter-expand-alias))
"Alist of header fields and completion functions to use.")
;;;###mh-autoload
(defun mh-letter-complete (arg)
"Perform completion on header field or word preceding point.
Alias completion is done within the mail header on selected fields and
by the function designated by `mh-letter-complete-function' elsewhere,
passing the prefix ARG if any."
Alias completion is done within the mail header on selected fields based on
the matches in `mh-letter-complete-function-alist'. Elsewhere the function
designated by `mh-letter-complete-function' is used and given the prefix ARG,
if present."
(interactive "P")
(let ((case-fold-search t))
(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)))))
(let ((func nil))
(cond ((not (mh-in-header-p))
(funcall mh-letter-complete-function arg))
((setq func (cdr (assoc (mh-letter-header-field-at-point)
mh-letter-complete-function-alist)))
(funcall func))
(t (funcall mh-letter-complete-function arg)))))
(defun mh-letter-complete-or-space (arg)
"Perform completion or insert space.
If `mh-compose-space-does-completion-flag' is nil (the default) a space is
inserted.
Otherwise, if point is in the message header and the preceding character is
not whitespace then do completion. Otherwise insert a space character.
ARG is the number of spaces inserted."
(interactive "p")
(let ((func nil)
(end-of-prev (save-excursion
(goto-char (mh-beginning-of-word))
(mh-beginning-of-word -1))))
(cond ((not mh-compose-space-does-completion-flag)
(self-insert-command arg))
((not (mh-in-header-p)) (self-insert-command arg))
((> (point) end-of-prev) (self-insert-command arg))
((setq func (cdr (assoc (mh-letter-header-field-at-point)
mh-letter-complete-function-alist)))
(funcall func))
(t (self-insert-command arg)))))
(defun mh-letter-confirm-address ()
"Flash alias expansion if `mh-alias-flash-on-comma' is non-nil."
(interactive)
(cond ((not (mh-in-header-p)) (self-insert-command 1))
((eq (cdr (assoc (mh-letter-header-field-at-point)
mh-letter-complete-function-alist))
'mh-alias-letter-expand-alias)
(mh-alias-reload-maybe)
(mh-alias-minibuffer-confirm-address))
(t (self-insert-command 1))))
(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
(defun mh-letter-header-field-at-point ()
"Return the header field name at point.
A symbol is returned whose name is the string obtained by downcasing the field
name."
(save-excursion
(end-of-line)
(and (re-search-backward mh-letter-header-field-regexp nil t)
(intern (downcase (match-string 1))))))
;;;###mh-autoload
(defun mh-letter-next-header-field-or-indent (arg)
"Move to next field or indent depending on point.
In the message header, go to the next field. Elsewhere call
`indent-relative' as usual with optional prefix ARG."
(interactive "P")
(let ((header-end (save-excursion
(goto-char (mh-mail-header-end))
(forward-line)
(point))))
(if (> (point) header-end)
(indent-relative arg)
(mh-letter-next-header-field))))
(defun mh-letter-next-header-field ()
"Cycle to the next header field.
If we are at the last header field go to the start of the message body."
(let ((header-end (mh-mail-header-end)))
(cond ((>= (point) header-end) (goto-char (point-min)))
((< (point) (progn
(beginning-of-line)
(re-search-forward mh-letter-header-field-regexp
(line-end-position) t)
(point)))
(beginning-of-line))
(t (end-of-line)))
(cond ((re-search-forward mh-letter-header-field-regexp header-end t)
(if (mh-letter-skipped-header-field-p (match-string 1))
(mh-letter-next-header-field)
(mh-letter-skip-leading-whitespace-in-header-field)))
(t (goto-char header-end)
(forward-line)))))
;;;###mh-autoload
(defun mh-letter-previous-header-field ()
"Cycle to the previous header field.
If we are at the first header field go to the start of the message body."
(interactive)
(let ((header-end (mh-mail-header-end)))
(if (>= (point) header-end)
(goto-char header-end)
(mh-header-field-beginning))
(cond ((re-search-backward mh-letter-header-field-regexp nil t)
(if (mh-letter-skipped-header-field-p (match-string 1))
(mh-letter-previous-header-field)
(goto-char (match-end 0))
(mh-letter-skip-leading-whitespace-in-header-field)))
(t (goto-char header-end)
(forward-line)))))
(defun mh-letter-skipped-header-field-p (field)
"Check if FIELD is to be skipped."
(let ((field (downcase field)))
(loop for x in mh-compose-skipped-header-fields
when (equal (downcase x) field) return t
finally return nil)))
(defun mh-letter-skip-leading-whitespace-in-header-field ()
"Skip leading whitespace in a header field.
If the header field doesn't have at least one space after the colon then a
space character is added."
(let ((need-space t))
(while (memq (char-after) '(?\t ?\ ))
(forward-char)
(setq need-space nil))
(when need-space (insert " "))))
(defvar mh-hidden-header-keymap
(let ((map (make-sparse-keymap)))
(mh-do-in-gnu-emacs
(define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
(mh-do-in-xemacs
(define-key map '(button2)
'mh-letter-toggle-header-field-display-button))
map))
(defun mh-letter-toggle-header-field-display-button (event)
"Toggle header field display at location of EVENT.
This function does the same thing as `mh-letter-toggle-header-field-display'
except that it is callable from a mouse button."
(interactive "e")
(mh-do-at-event-location event
(mh-letter-toggle-header-field-display nil)))
(defun mh-letter-toggle-header-field-display (arg)
"Toggle display of header field at point.
If the header is long or spread over multiple lines then hiding it will show
the first few characters and replace the rest with an ellipsis.
If ARG is negative then header is hidden, if positive it is displayed. If ARG
is the symbol `long' then keep at most the first 4 lines."
(interactive (list nil))
(when (and (mh-in-header-p)
(progn
(end-of-line)
(re-search-backward mh-letter-header-field-regexp nil t)))
(let ((buffer-read-only nil)
(modified-flag (buffer-modified-p))
(begin (point))
end)
(end-of-line)
(setq end (1- (if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(point-max))))
(goto-char begin)
;; Make it clickable...
(add-text-properties begin end `(keymap ,mh-hidden-header-keymap
mouse-face highlight))
(unwind-protect
(cond ((or (and (not arg)
(text-property-any begin end 'invisible 'vanish))
(and (numberp arg) (>= arg 0))
(and (eq arg 'long) (> (line-beginning-position 5) end)))
(remove-text-properties begin end '(invisible nil))
(search-forward ":" (line-end-position) t)
(mh-letter-skip-leading-whitespace-in-header-field))
((eq arg 'long)
(end-of-line 4)
(mh-letter-truncate-header-field end)
(beginning-of-line))
(t (end-of-line)
(mh-letter-truncate-header-field end)
(beginning-of-line)))
(set-buffer-modified-p modified-flag)))))
(defun mh-letter-truncate-header-field (end)
"Replace text from current line till END with an ellipsis.
If the current line is too long truncate a part of it as well."
(let ((max-len (min (window-width) 62)))
(when (> (+ (current-column) 4) max-len)
(backward-char (- (+ (current-column) 5) max-len)))
(when (> end (point))
(add-text-properties (point) end '(invisible vanish)))))
(defun mh-letter-hide-all-skipped-fields ()
"Hide all skipped fields."
(save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point) (mh-mail-header-end))
(while (re-search-forward mh-letter-header-field-regexp nil t)
(if (mh-letter-skipped-header-field-p (match-string 1))
(mh-letter-toggle-header-field-display -1)
(mh-letter-toggle-header-field-display 'long))
(beginning-of-line 2)))))
(defun mh-interactive-read-address (prompt)
"Read an address.
If `mh-compose-prompt-flag' is non-nil, then read an address with PROMPT.
Otherwise return the empty string."
(if mh-compose-prompt-flag (mh-read-address prompt) ""))
(defun mh-interactive-read-string (prompt)
"Read a string.
If `mh-compose-prompt-flag' is non-nil, then read a string with PROMPT.
Otherwise return the empty string."
(if mh-compose-prompt-flag (read-string prompt) ""))
(defun mh-letter-adjust-point ()
"Move cursor to first header field if are using the no prompt mode."
(unless mh-compose-prompt-flag
(goto-char (point-max))
(mh-letter-next-header-field)))
;;; Build the letter-mode keymap:
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
@ -1534,6 +1835,7 @@ passing the prefix ARG if any."
"\C-c?" mh-help
"\C-c\C-c" mh-send-letter
"\C-c\C-d" mh-insert-identity
"\C-c\M-d" mh-insert-auto-fields
"\C-c\C-e" mh-edit-mhn
"\C-c\C-f\C-b" mh-to-field
"\C-c\C-f\C-c" mh-to-field
@ -1569,7 +1871,12 @@ passing the prefix ARG if any."
"\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
"\M-\t" mh-letter-complete)
"\C-c\C-t" mh-letter-toggle-header-field-display
" " mh-letter-complete-or-space
"\M-\t" mh-letter-complete
"\t" mh-letter-next-header-field-or-indent
[backtab] mh-letter-previous-header-field
"," mh-letter-confirm-address)
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.

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

@ -1,6 +1,6 @@
;;; mh-customize.el --- MH-E customization
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -57,7 +57,10 @@
;;; Code:
(provide 'mh-customize)
(require 'mh-e)
(require 'mh-utils)
(when mh-xemacs-flag
(require 'mh-xemacs))
;;;###mh-autoload
(defun mh-customize (&optional delete-other-windows-flag)
@ -158,6 +161,13 @@ are removed."
:group 'mh-faces
:group 'mh-folder)
(defgroup mh-index-faces nil
"Faces used in indexed searches."
:link '(custom-manual "(mh-e)Customizing mh-e")
:prefix "mh-"
:group 'mh-faces
:group 'mh-index)
(defgroup mh-show-faces nil
"Faces used in message display."
:link '(custom-manual "(mh-e)Customizing mh-e")
@ -165,12 +175,12 @@ are removed."
:group 'mh-faces
:group 'mh-show)
(defgroup mh-index-faces nil
"Faces used in indexed searches."
(defgroup mh-letter-faces nil
"Faces used when composing messages."
:link '(custom-manual "(mh-e)Customizing mh-e")
:prefix "mh-"
:group 'mh-faces
:group 'mh-index)
:group 'mh-letter)
@ -230,7 +240,6 @@ When INCLUDE-FLAG is non-nil, include message body being replied to."
;; XEmacs has a couple of extra customizations...
(mh-do-in-xemacs
(require 'mh-xemacs-icons)
(defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar)
(featurep 'xpm)
(device-on-window-system-p))
@ -283,9 +292,10 @@ buttons in the folder and show mode buffers are being specified. If it is
:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2,
FUNC3, ... are the names of the functions that the buttons would execute.
Each element of BUTTONS is a list of four things:
Each element of BUTTONS is a list consisting of four mandatory items and one
optional item as follows:
(FUNCTION MODES ICON DOC)
(FUNCTION MODES ICON DOC &optional ENABLE-EXPR)
where,
@ -308,7 +318,11 @@ where,
DOC is the documentation for the button. It is used in tool-tips and in
providing other help to the user. GNU Emacs uses only the first line of the
string. So the DOC should be formatted such that the first line is useful and
complete without the rest of the string."
complete without the rest of the string.
Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates
to nil, then the button is deactivated, otherwise it is active. If is in't
present then the button is always active."
;; The following variable names have been carefully chosen to make code
;; generation easier. Modifying the names should be done carefully.
(let (folder-buttons folder-docs folder-button-setter sequence-button-setter
@ -320,7 +334,8 @@ where,
(cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
((eq (car x) :letter) (setq letter-defaults (cdr x)))))
(dolist (button buttons)
(unless (and (listp button) (equal (length button) 4))
(unless (and (listp button)
(or (equal (length button) 4) (equal (length button) 5)))
(error "Incorrect MH-E tool-bar button specification: %s" button))
(let* ((name (nth 0 button))
(name-str (symbol-name name))
@ -331,6 +346,7 @@ where,
(doc (if (string-match "\\(.*\\)\n" full-doc)
(match-string 1 full-doc)
full-doc))
(enable-expr (or (nth 4 button) t))
(modes (nth 1 button))
functions show-sym)
(when (memq 'letter modes) (setq functions `(:letter ,name)))
@ -369,7 +385,8 @@ where,
(add-to-list
setter `(when (member ',name ,list)
(mh-funcall-if-exists
tool-bar-add-item ,icon ',function ',key :help ,doc)))
tool-bar-add-item ,icon ',function ',key
:help ,doc :enable ',enable-expr)))
(add-to-list mbuttons name)
(if docs (add-to-list docs doc))))))
(setq folder-buttons (nreverse folder-buttons)
@ -464,22 +481,22 @@ where,
(when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag)
(cond
((eq mh-xemacs-toolbar-position 'top)
(set-specifier top-toolbar (cons buffer toolbar))
(set-specifier top-toolbar toolbar buffer)
(set-specifier top-toolbar-visible-p t)
(set-specifier top-toolbar-height height))
((eq mh-xemacs-toolbar-position 'bottom)
(set-specifier bottom-toolbar (cons buffer toolbar))
(set-specifier bottom-toolbar toolbar buffer)
(set-specifier bottom-toolbar-visible-p t)
(set-specifier bottom-toolbar-height height))
((eq mh-xemacs-toolbar-position 'left)
(set-specifier left-toolbar (cons buffer toolbar))
(set-specifier left-toolbar toolbar buffer)
(set-specifier left-toolbar-visible-p t)
(set-specifier left-toolbar-width width))
((eq mh-xemacs-toolbar-position 'right)
(set-specifier right-toolbar (cons buffer toolbar))
(set-specifier right-toolbar toolbar buffer)
(set-specifier right-toolbar-visible-p t)
(set-specifier right-toolbar-width width))
(t (set-specifier default-toolbar (cons buffer toolbar))))))))
(t (set-specifier default-toolbar toolbar buffer)))))))
;; Declare customizable toolbars
(custom-declare-variable
'mh-tool-bar-folder-buttons
@ -541,7 +558,8 @@ This button runs `mh-previous-undeleted-msg'")
(mh-reply (folder) "mail/reply2"
"Reply to this message\nThis button runs `mh-reply'")
(mh-alias-grab-from-field (folder) "alias"
"Grab From alias\nThis button runs `mh-alias-grab-from-field'")
"Grab From alias\nThis button runs `mh-alias-grab-from-field'"
(mh-alias-from-has-no-alias-p))
(mh-send (folder) "mail_compose"
"Compose new message\nThis button runs `mh-send'")
(mh-rescan-folder (folder) "rescan"
@ -661,7 +679,6 @@ the `mh-progs' directory unless it is an absolute pathname."
:type 'string
:group 'mh-folder)
(defcustom mh-inc-spool-list nil
"*Alist of alternate spool files, corresponding folders and keybindings.
Here's an example. Suppose you have subscribed to the MH-E devel mailing
@ -699,6 +716,13 @@ when clicking the xbuffy box with the middle mouse button."
:set 'mh-inc-spool-list-set
:group 'mh-folder)
(defcustom mh-interpret-number-as-range-flag t
"Non-nil means interpret a number as a range.
If the variable is non-nil, and you use an integer, N, when asked for a
range to scan, then MH-E uses the range \"last:N\"."
:type 'boolean
:group 'mh-folder)
(defcustom mh-lpr-command-format "lpr -J '%s'"
"*Format for Unix command that prints a message.
The string should be a Unix command line, with the string '%s' where
@ -734,6 +758,18 @@ Recenter the summary window when the show window is toggled off if non-nil."
:type 'boolean
:group 'mh-folder)
;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following tot
;;; he docstring: "Additional sequences that should not to be preserved can be
;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX
(defcustom mh-refile-preserves-sequences-flag t
"*Non-nil means that sequences are preserved when messages are refiled.
If this variable is non-nil and a message belonging to a sequence other than
cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the
same sequence in the destination folder."
:type 'boolean
:group 'mh-folder)
(defcustom mh-scan-format-file t
"Specifies the format file to pass to the scan program.
If t, the format string will be taken from the either `mh-scan-format-mh'
@ -819,6 +855,16 @@ found in the documentation of `mh-index-search'."
(const :tag "grep" grep))
:group 'mh-index)
(defcustom mh-index-ticked-messages-folders t
"Folders searched for `mh-tick-seq'.
If t, then `mh-inbox' is searched. If nil, all the top level folders are
searched. Otherwise the list of folders specified as strings are searched.
See also `mh-recursive-folders-flag'."
:group 'mh-index
:type '(choice (const :tag "Inbox" t)
(const :tag "All" nil)
(repeat :tag "Choose folders" (string :tag "Folder"))))
;;; Spam Handling (:group 'mh-junk)
@ -878,8 +924,9 @@ first one found is used."
(defcustom mh-clean-message-header-flag t
"*Non-nil means clean headers of messages that are displayed or inserted.
The variables `mh-invisible-headers' and `mh-visible-headers' control
what is removed."
The variable `mh-invisible-headers' if set determines the header fields that
are displayed. If it isn't set, then the variable `mh-invisible-headers'
determines the header fields that are removed."
:type 'boolean
:group 'mh-show)
@ -888,6 +935,14 @@ what is removed."
:type 'boolean
:group 'mh-show)
(defcustom mh-display-buttons-for-alternatives-flag nil
"*Non-nil means display buttons for all MIME alternatives.
Default behavior is to display only the preferred alternative. If this
variable is non-nil, then the preferred part is shown inline and buttons
are shown for each of the other alternatives."
:type 'boolean
:group 'mh-show)
(defcustom mh-display-buttons-for-inline-parts-flag nil
"*Non-nil means display buttons for all inline MIME parts.
If non-nil, buttons are displayed for all MIME parts. Inline parts start off
@ -949,27 +1004,23 @@ The gnus method uses a different color for each indentation."
(defvar mh-invisible-headers nil
"*Regexp matching lines in a message header that are not to be shown.
Use the function `mh-invisible-headers' to generate this variable.
If `mh-visible-headers' is non-nil, it is used instead to specify what
to keep.")
Customize the variable `mh-invisible-header-fields' to generate this variable;
It will in turn automatically use the function `mh-invisible-headers' to
generate this variable.
If the variable `mh-visible-headers' is non-nil, it is used instead to specify
what to keep.")
(defun mh-invisible-headers ()
"Make or remake the variable `mh-invisible-headers'.
Done using `mh-invisible-header-fields' as input."
(setq mh-invisible-headers
(concat
"^"
(let ((max-specpdl-size 1000) ;workaround for insufficient default
(fields mh-invisible-header-fields))
(regexp-opt fields t)))))
(defun mh-invisible-header-fields-set (symbol value)
"Update `mh-invisible-header-fields'.
The function is called with SYMBOL bound to `mh-invisible-header-fields' and
VALUE is the the list of headers that are invisible. As a side effect, the
variable `mh-invisible-fields' is set."
(set-default symbol value)
(mh-invisible-headers))
(if mh-invisible-header-fields
(setq mh-invisible-headers
(concat
"^"
(let ((max-specpdl-size 1000) ;workaround for insufficient default
(fields mh-invisible-header-fields))
(regexp-opt fields t))))
(setq mh-invisible-headers nil)))
;; Keep fields alphabetized. Mention source, if known.
(defcustom mh-invisible-header-fields
@ -982,6 +1033,7 @@ variable `mh-invisible-fields' is set."
"Delivery-Date:" ; MH
"Delivery:"
"Encoding:"
"Envelope-to:"
"Errors-To:"
"Face:" ; Gnus Face header
"Forwarded:" ; MH
@ -1023,7 +1075,7 @@ variable `mh-invisible-fields' is set."
"Sensitivity:" ; MS Outlook
"Status:" ; sendmail
"Ua-Content-Id:" ; X400
"User-Agent:"
;; "User-Agent:" ; Similar to X-Mailer, so display it.
"Via:" ; MH
"X-Abuse-Info:"
"X-Accept-Language:"
@ -1076,6 +1128,7 @@ variable `mh-invisible-fields' is set."
"X-Orcl-Content-Type:"
"X-Original-Complaints-To:"
"X-Original-Date:" ; SourceForge mailing list manager
"X-Original-To:"
"X-Original-Trace:"
"X-OriginalArrivalTime:" ; Hotmail
"X-Originating-IP:" ; Hotmail
@ -1113,9 +1166,11 @@ variable `mh-invisible-fields' is set."
Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise,
the element can be used to render invisible an entire class of fields that
start with the same prefix.
This variable is ignored if `mh-visible-headers' is set."
This variable is ignored if the variable `mh-visible-headers' is set."
:type '(repeat (string :tag "Header field"))
:set 'mh-invisible-header-fields-set
:set (lambda (symbol value)
(set-default symbol value)
(mh-invisible-headers))
:group 'mh-show)
(defcustom mh-max-inline-image-height nil
@ -1185,19 +1240,43 @@ inline images. So face images are not displayed in these versions."
:type 'boolean
:group 'mh-show)
(defcustom mh-summary-height (or (and (fboundp 'frame-height)
(> (frame-height) 24)
(min 10 (/ (frame-height) 6)))
4)
(defcustom mh-summary-height nil
"*Number of lines in MH-Folder window (including the mode line)."
:type 'integer
:type '(choice (const :tag "Automatic" nil)
(integer :tag "Fixed sized"))
:group 'mh-show)
(defcustom mh-visible-headers nil
"*Contains a regexp specifying the headers to keep when cleaning.
(defvar mh-visible-headers nil
"*Regexp matching lines in a message header that are to be shown.
Customize the variable `mh-visible-header-fields' to generate this variable;
It will in turn automatically use the function `mh-visible-headers' to
generate this variable.
Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
the variable `mh-invisible-headers'."
:type '(choice (const nil) regexp)
the variable `mh-invisible-headers'.")
(defun mh-visible-headers ()
"Make or remake the variable `mh-visible-headers'.
Done using `mh-visible-header-fields' as input."
(if mh-visible-header-fields
(setq mh-visible-headers
(concat
"^"
(let ((max-specpdl-size 1000) ;workaround for insufficient default
(fields mh-visible-header-fields))
(regexp-opt fields t))))
(setq mh-visible-headers nil)))
(defcustom mh-visible-header-fields nil
"*List of header fields that are to be shown.
Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise,
the element can be used to render visible an entire class of fields that
start with the same prefix.
Only used if `mh-clean-message-header-flag' is non-nil.
Setting it overrides the variable `mh-invisible-headers'."
:type '(repeat (string :tag "Header field"))
:set (lambda (symbol value)
(set-default symbol value)
(mh-visible-headers))
:group 'mh-show)
(defcustom mhl-formfile nil
@ -1227,6 +1306,23 @@ It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
:type '(choice (const nil) function)
:group 'mh-letter)
(defcustom mh-compose-prompt-flag nil
"*Non-nil means prompt for header fields when composing a new draft."
:type 'boolean
:group 'mh-letter)
(defcustom mh-compose-skipped-header-fields
'("from" "organization" "references" "in-reply-to" "x-face" "face"
"x-mailer")
"List of header fields to skip over when navigating in draft."
:type '(repeat (string :tag "Field"))
:group 'mh-letter)
(defcustom mh-compose-space-does-completion-flag nil
"*Non-nil means that SPACE does completion in message header."
:type 'boolean
:group 'mh-letter)
(defcustom mh-delete-yanked-msg-window-flag nil
"*Non-nil means delete any window displaying the message.
Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
@ -1428,6 +1524,33 @@ password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
:type '(choice (boolean) (string))
:group 'mh-alias)
(defcustom mh-alias-local-users-prefix "local."
"*String prepended to the real names of users from the passwd file.
If nil, use the username string unmodified instead of the real name from
the gecos field of the passwd file.
For example, given the following passwd file line:
psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh
here are the derived aliases for different values of this variable:
\"local.\" -> local.peter.galbraith
\"\" -> peter.galbraith
nii -> psg
This variable is only meaningful if the variable `mh-alias-local-users' is
non-nil."
:type '(choice (const :tag "Use username instead of real name" nil)
(string))
:group 'mh-alias)
(defcustom mh-alias-passwd-gecos-comma-separator-flag t
"*Non-nil means the gecos field in the passwd file uses comma as a separator.
Used to construct aliases for users in the passwd file."
:type 'boolean
:group 'mh-alias)
(defcustom mh-alias-system-aliases
'("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
"*A list of system files from which to cull aliases.
@ -1442,7 +1565,52 @@ You can update the alias list manually using \\[mh-alias-reload]."
;;; Multiple personalities (:group 'mh-identity)
(defvar mh-identity-list ())
(defcustom mh-identity-list nil
"*List holding MH-E identity.
Omit the colon and trailing space from the field names.
The keyword name \"none\" is reserved for internal use.
Use the keyname name \"signature\" to specify either a signature file or a
function to call to insert a signature at point.
Providing an empty Value (\"\") will cause the field to be deleted.
Example entries using the customize interface:
Keyword name: work
From
Value: John Doe <john@work.com>
Organization
Value: Acme Inc.
Keyword name: home
From
Value: John Doe <johndoe@home.net>
Organization
Value:
This would produce the equivalent of:
(setq mh-identity-list
'((\"work\"
((\"From\" . \"John Doe <john@work.com>\")
(\"Organization\" . \"Acme Inc.\")))
(\"home\"
((\"From\" . \"John Doe <johndoe@home.net>\")
(\"Organization\" . \"\")))))"
:type '(repeat (list :tag ""
(string :tag "Keyword name")
(repeat :tag "At least one pair from below"
(choice (cons :tag "From field"
(const "From")
(string :tag "Value"))
(cons :tag "Organization field"
(const "Organization")
(string :tag "Value"))
(cons :tag "Signature"
(const "signature")
(choice (file) (function)))
(cons :tag "Other field & value pair"
(string :tag "Field")
(string :tag "Value"))))))
:set 'mh-identity-list-set
:group 'mh-identity)
(defcustom mh-auto-fields-list nil
"Alist of addresses for which header lines are automatically inserted.
@ -1491,53 +1659,6 @@ prompted for in the customization interface."
(mapcar 'car mh-identity-list))))
:group 'mh-identity)
(defcustom mh-identity-list nil
"*List holding MH-E identity.
Omit the colon and trailing space from the field names.
The keyword name \"none\" is reversed for internal use.
Use the keyname name \"signature\" to specify either a signature file or a
function to call to insert a signature at point.
Providing an empty Value (\"\") will cause the field to be deleted.
Example entries using the customize interface:
Keyword name: work
From
Value: John Doe <john@work.com>
Organization
Value: Acme Inc.
Keyword name: home
From
Value: John Doe <johndoe@home.net>
Organization
Value:
This would produce the equivalent of:
(setq mh-identity-list
'((\"work\"
((\"From\" . \"John Doe <john@work.com>\")
(\"Organization\" . \"Acme Inc.\")))
(\"home\"
((\"From\" . \"John Doe <johndoe@home.net>\")
(\"Organization\" . \"\")))))"
:type '(repeat (list :tag ""
(string :tag "Keyword name")
(repeat :tag "At least one pair from below"
(choice (cons :tag "From field"
(const "From")
(string :tag "Value"))
(cons :tag "Organization field"
(const "Organization")
(string :tag "Value"))
(cons :tag "Signature"
(const "signature")
(choice (file) (function)))
(cons :tag "Other field & value pair"
(string :tag "Field")
(string :tag "Value"))))))
:set 'mh-identity-list-set
:group 'mh-identity)
;;; Hooks (:group 'mh-hooks + group where hook defined)
@ -1597,6 +1718,23 @@ current folder, `mh-current-folder'."
:group 'mh-hooks
:group 'mh-folder)
(defcustom mh-kill-folder-suppress-prompt-hook '(mh-index-p)
"Invoked at the beginning of the \\<mh-folder-mode-map>`\\[mh-kill-folder]' command.
This hook is a list of functions to be called, with no arguments, which should
return a value of non-nil if you should not be asked if you're sure that you
want to remove the folder. This is useful for folders that are easily
regenerated.
The default value of `mh-index-p' suppresses the prompt on folders generated
by an index search.
WARNING: Use this hook with care. If there is a bug in your hook which returns
t on +inbox and you hit \\<mh-folder-mode-map>`\\[mh-kill-folder]' by accident
in the +inbox buffer, you will not be happy."
:type 'hook
:group 'mh-hooks
:group 'mh-folder)
(defcustom mh-letter-insert-signature-hook nil
"Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
Can be used to determine which signature file to use based on message content.
@ -1917,6 +2055,19 @@ The background and foreground is used in the image."
"Face for highlighting folders in MH-Index buffers."
:group 'mh-index-faces)
;;; Faces used when composing messages.
(defface mh-letter-header-field-face
'((((class color) (background light))
(:background "gray90"))
(((class color) (background dark))
(:background "gray10"))
(t (:bold t)))
"Face for displaying header fields in draft buffers."
:group 'mh-letter-faces)
;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil

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

@ -1,11 +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, 1999,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Version: 7.3
;; Version: 7.4.4
;; Keywords: mail
;; This file is part of GNU Emacs.
@ -82,7 +82,9 @@
;;; Code:
(require 'cl)
(provide 'mh-e)
(require 'mh-utils)
(mh-require-cl)
(defvar recursive-load-depth-limit)
(eval-when (compile load eval)
@ -92,17 +94,14 @@
(setq recursive-load-depth-limit 50)))
(require 'mh-inc)
(require 'mh-utils)
(require 'gnus-util)
(require 'easymenu)
(if mh-xemacs-flag
(require 'mh-xemacs-compat))
;; Shush the byte-compiler
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defconst mh-version "7.3" "Version number of MH-E.")
(defconst mh-version "7.4.3" "Version number of MH-E.")
;;; Autoloads
(autoload 'Info-goto-node "info")
@ -283,9 +282,7 @@ third should match the user name.")
'(3 mh-folder-scan-format-face))
;; Current message line
(list mh-scan-cur-msg-regexp
'(1 mh-folder-cur-msg-face prepend t))
;; Unseen messages in bold
'(mh-folder-font-lock-unseen (1 'bold append t)))
'(1 mh-folder-cur-msg-face prepend t)))
"Regexp keywords used to fontify the MH-Folder buffer.")
(defvar mh-scan-cmd-note-width 1
@ -399,50 +396,61 @@ On nmh systems.")
(goto-char (point-min))
(sort (mh-read-msg-list) '<)))))))))
(defvar mh-folder-unseen-seq-cache nil
"Internal cache variable used for font-lock in MH-E.
(defmacro mh-generate-sequence-font-lock (seq prefix face)
"Generate the appropriate code to fontify messages in SEQ.
PREFIX is used to generate unique names for the variables and functions
defined by the macro. So a different prefix should be provided for every
invocation.
FACE is the font-lock face used to display the matching scan lines."
(let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
(func (intern (format "mh-folder-font-lock-%s" prefix))))
`(progn
(defvar ,cache nil
"Internal cache variable used for font-lock in MH-E.
Should only be non-nil through font-lock stepping, and nil once font-lock
is done highlighting.")
(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
(make-variable-buffer-local ',cache)
(defun mh-folder-font-lock-unseen (limit)
"Return unseen message lines to font-lock between point and LIMIT."
(if (not mh-folder-unseen-seq-cache)
(setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
(let ((cur-msg (mh-get-msg-num nil)))
(cond
((not mh-folder-unseen-seq-cache)
nil)
((>= (point) limit) ;Presumably at end of buffer
(setq mh-folder-unseen-seq-cache nil)
nil)
((member cur-msg mh-folder-unseen-seq-cache)
(let ((bpoint (progn (beginning-of-line)(point)))
(epoint (progn (forward-line 1)(point))))
(if (<= limit (point))
(setq mh-folder-unseen-seq-cache nil))
(set-match-data (list bpoint epoint bpoint epoint))
t))
(t
;; move forward one line at a time, checking each message number.
(while (and
(= 0 (forward-line 1))
(> limit (point))
(not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
;; Examine how we must have exited the loop...
(let ((cur-msg (mh-get-msg-num nil)))
(cond
((or (<= limit (point))
(not (member cur-msg mh-folder-unseen-seq-cache)))
(setq mh-folder-unseen-seq-cache nil)
nil)
((member cur-msg mh-folder-unseen-seq-cache)
(let ((bpoint (progn (beginning-of-line)(point)))
(epoint (progn (forward-line 1)(point))))
(if (<= limit (point))
(setq mh-folder-unseen-seq-cache nil))
(set-match-data (list bpoint epoint bpoint epoint))
t))))))))
(defun ,func (limit)
"Return unseen message lines to font-lock between point and LIMIT."
(if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
(let ((cur-msg (mh-get-msg-num nil)))
(cond ((not ,cache)
nil)
((>= (point) limit) ;Presumably at end of buffer
(setq ,cache nil)
nil)
((member cur-msg ,cache)
(let ((bpoint (progn (beginning-of-line)(point)))
(epoint (progn (forward-line 1)(point))))
(if (<= limit (point)) (setq ,cache nil))
(set-match-data (list bpoint epoint bpoint epoint))
t))
(t
;; move forward one line at a time, checking each message
(while (and (= 0 (forward-line 1))
(> limit (point))
(not (member (mh-get-msg-num nil) ,cache))))
;; Examine how we must have exited the loop...
(let ((cur-msg (mh-get-msg-num nil)))
(cond ((or (<= limit (point))
(not (member cur-msg ,cache)))
(setq ,cache nil)
nil)
((member cur-msg ,cache)
(let ((bpoint (progn (beginning-of-line) (point)))
(epoint (progn (forward-line 1) (point))))
(if (<= limit (point)) (setq ,cache nil))
(set-match-data
(list bpoint epoint bpoint epoint))
t))))))))
(setq mh-folder-font-lock-keywords
(append mh-folder-font-lock-keywords
(list (list ',func (list 1 '',face 'prepend t))))))))
(mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face)
@ -464,20 +472,15 @@ is done highlighting.")
(defvar mh-next-direction 'forward) ;Direction to move to next message.
(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).
(defvar mh-folder-view-stack ()) ;Stack of previous folder views.
(defvar mh-index-data nil) ;Info about index search results
(defvar mh-index-previous-search nil)
(defvar mh-index-msg-checksum-map nil)
(defvar mh-index-checksum-origin-map nil)
(defvar mh-index-sequence-search-flag nil)
(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
@ -485,6 +488,10 @@ is done highlighting.")
(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
(defvar mh-sequence-notation-history nil)
;Rememeber original notation that
;is overwritten by `mh-note-seq'.
;;; Macros and generic functions:
(defun mh-mapc (function list)
@ -494,7 +501,7 @@ is done highlighting.")
(setq list (cdr list))))
(defun mh-scan-format ()
"Return \"-format\" argument for the scan program."
"Return the output format argument for the scan program."
(if (equal mh-scan-format-file t)
(list "-format" (if mh-nmh-flag
(list (mh-update-scan-format
@ -502,7 +509,7 @@ is done highlighting.")
(list (mh-update-scan-format
mh-scan-format-mh mh-cmd-note))))
(if (not (equal mh-scan-format-file nil))
(list "-format" mh-scan-format-file))))
(list "-form" mh-scan-format-file))))
@ -536,34 +543,29 @@ the Emacs front end to the MH mail system."
;;; User executable MH-E commands:
(defun mh-delete-msg (msg-or-seq)
"Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
(defun mh-delete-msg (range)
"Mark the specified RANGE for subsequent deletion and move to the next.
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.
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
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Delete")))
(mh-delete-msg-no-motion range)
(if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg)))
(defun mh-delete-msg-no-motion (range)
"Mark the specified RANGE for subsequent deletion.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Delete")))
(mh-iterate-on-range () range
(mh-delete-a-msg nil)))
(defun mh-execute-commands ()
"Process outstanding delete and refile requests."
(interactive)
(if mh-narrowed-to-seq (mh-widen))
(if mh-folder-view-stack (mh-widen t))
(mh-process-commands mh-current-folder)
(mh-set-scan-mode)
(mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
@ -626,7 +628,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
(save-excursion
(goto-char (point-min))
(or (null mh-large-folder)
(not (equal (forward-line mh-large-folder) 0))
(not (equal (forward-line (1+ mh-large-folder)) 0))
(and (message "Not threading since the number of messages exceeds `mh-large-folder'")
nil))))
(mh-toggle-threads))
@ -673,31 +675,19 @@ Takes the address in the From: header field, and returns one of:
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."
;; 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)))))
(save-restriction
(goto-char (point-min))
(re-search-forward "\n\n" nil t)
(narrow-to-region (point-min) (point))
(let ((to/cc (concat (or (message-fetch-field "to") "") ", "
(or (message-fetch-field "cc") "")))
(from (or (message-fetch-field "from") ""))
folder-name)
(setq folder-name
(loop for list in mh-default-folder-list
when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
return (nth 1 list)
finally return nil))
;; Make sure a result from `mh-default-folder-list' begins with "+"
;; since 'mh-expand-file-name below depends on it
@ -746,27 +736,23 @@ Otherwise, a default folder name is generated by `mh-folder-from-address'."
"")))
t))
(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.
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.
(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
"Refile RANGE into FOLDER.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
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")
(interactive (list (mh-interactive-range "Refile")
(intern (mh-prompt-for-refile-folder))))
(unless dont-update-last-destination-flag
(setq mh-last-destination (cons 'refile folder)
mh-last-destination-folder mh-last-destination))
(mh-iterate-on-msg-or-seq () msg-or-seq
(mh-iterate-on-range () range
(mh-refile-a-msg nil folder))
(mh-next-msg))
(when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
(defun mh-refile-or-write-again (message)
"Re-execute the last refile or write command on the given MESSAGE.
@ -1015,11 +1001,14 @@ end of buffer is reached) and save it."
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action part-index #'mh-mime-save-part nil))
(defvar mh-thread-scan-line-map-stack)
(defun mh-reset-threads-and-narrowing ()
"Reset all variables pertaining to threads and narrowing.
Also removes all content from the folder buffer."
(setq mh-view-ops ())
(setq mh-narrowed-to-seq nil)
(setq mh-folder-view-stack ())
(setq mh-thread-scan-line-map-stack ())
(let ((buffer-read-only nil)) (erase-buffer)))
(defun mh-rescan-folder (&optional range dont-exec-pending)
@ -1029,7 +1018,8 @@ messages to display. Otherwise show the entire folder.
If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
refiles aren't carried out."
(interactive (list (if current-prefix-arg
(mh-read-msg-range mh-current-folder t)
(mh-read-range "Rescan" mh-current-folder t nil t
mh-interpret-number-as-range-flag)
nil)))
(setq mh-next-direction 'forward)
(let ((threaded-flag (memq 'unthread mh-view-ops)))
@ -1073,16 +1063,13 @@ Otherwise send the entire message including the headers."
(mh-set-scan-mode)
(mh-show)))
(defun mh-undo (msg-or-seq)
"Undo the pending deletion or refile of the specified 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 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)
(defun mh-undo (range)
"Undo the pending deletion or refile of the specified RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Undo")))
(cond ((numberp range)
(let ((original-position (point)))
(beginning-of-line)
(while (not (or (looking-at mh-scan-deleted-msg-regexp)
@ -1098,7 +1085,7 @@ region in a cons cell, or a sequence."
(mh-maybe-show))
(goto-char original-position)
(error "Nothing to undo"))))
(t (mh-iterate-on-msg-or-seq () msg-or-seq
(t (mh-iterate-on-range () range
(mh-undo-msg nil))))
(if (not (mh-outstanding-commands-p))
(mh-set-folder-modified-p nil)))
@ -1200,8 +1187,20 @@ used to avoid problems in corner cases involving folders whose names end with a
(setq folder (substring folder 0 (1- (length folder)))))
(values (format "+%s" folder) (car unseen) (car total))))))))
(defun mh-folder-size (folder)
"Find size of FOLDER."
(defun mh-folder-size-folder (folder)
"Find size of FOLDER using `folder'."
(with-temp-buffer
(let ((u (length (cdr (assoc mh-unseen-seq
(mh-read-folder-sequences folder nil))))))
(call-process (expand-file-name "folder" mh-progs) nil t nil
"-norecurse" folder)
(goto-char (point-min))
(if (re-search-forward " has \\([0-9]+\\) " nil t)
(values (car (read-from-string (match-string 1))) u folder)
(values 0 u folder)))))
(defun mh-folder-size-flist (folder)
"Find size of FOLDER using `flist'."
(with-temp-buffer
(call-process (expand-file-name "flist" mh-progs) nil t nil
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
@ -1211,6 +1210,12 @@ used to avoid problems in corner cases involving folders whose names end with a
(buffer-substring (point) (line-end-position)))
(values total unseen folder))))
(defun mh-folder-size (folder)
"Find size of FOLDER."
(if mh-flists-present-flag
(mh-folder-size-flist folder)
(mh-folder-size-folder folder)))
(defun mh-visit-folder (folder &optional range index-data)
"Visit FOLDER and display RANGE of messages.
Do not call this function from outside MH-E; see \\[mh-rmail] instead.
@ -1225,7 +1230,9 @@ A prefix argument will cause a prompt for the RANGE of messages
regardless of the size of the `mh-large-folder' variable."
(interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
(list folder-name
(mh-read-msg-range folder-name current-prefix-arg))))
(mh-read-range "Scan" folder-name t nil
current-prefix-arg
mh-interpret-number-as-range-flag))))
(let ((config (current-window-configuration))
(current-buffer (current-buffer))
(threaded-view-flag mh-show-threads-flag))
@ -1238,13 +1245,14 @@ regardless of the size of the `mh-large-folder' variable."
(setq mh-index-data (car index-data)
mh-index-msg-checksum-map (make-hash-table :test #'equal)
mh-index-checksum-origin-map (make-hash-table :test #'equal))
(mh-index-update-maps folder (cadr index-data)))
(mh-index-update-maps folder (cadr index-data))
(mh-index-create-sequences))
(mh-scan-folder folder (or range "all"))
(cond ((and threaded-view-flag
(save-excursion
(goto-char (point-min))
(or (null mh-large-folder)
(not (equal (forward-line mh-large-folder) 0))
(not (equal (forward-line (1+ mh-large-folder)) 0))
(and (message "Not threading since the number of messages exceeds `mh-large-folder'")
nil))))
(mh-toggle-threads))
@ -1405,6 +1413,9 @@ If MSG is nil then act on the message at point"
;;; The folder data abstraction.
(defvar mh-index-data-file ".mhe_index"
"MH-E specific file where index seach info is stored.")
(defun mh-make-folder (name)
"Create a new mail folder called NAME.
Make it the current folder."
@ -1417,6 +1428,9 @@ Make it the current folder."
(mh-folder-mode)
(mh-set-folder-modified-p nil)
(setq buffer-file-name mh-folder-filename)
(when (and (not mh-index-data)
(file-exists-p (concat buffer-file-name mh-index-data-file)))
(mh-index-read-data))
(mh-make-folder-mode-line))
;;; Ensure new buffers won't get this mode if default-major-mode is nil.
@ -1437,7 +1451,7 @@ Make it the current folder."
["List Sequences in Folder..." mh-list-sequences t]
["Delete Sequence..." mh-delete-seq t]
["Narrow to Sequence..." mh-narrow-to-seq t]
["Widen from Sequence" mh-widen mh-narrowed-to-seq]
["Widen from Sequence" mh-widen mh-folder-view-stack]
"--"
["Narrow to Subject Sequence" mh-narrow-to-subject t]
["Narrow to Tick Sequence" mh-narrow-to-tick
@ -1512,9 +1526,6 @@ 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
@ -1524,8 +1535,11 @@ 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)
;; Avoid compiler warnings in non-bleeding edge versions of Emacs.
(eval-when-compile
(defvar tool-bar-mode)
(defvar tool-bar-map)
(defvar desktop-save-buffer)) ;Emacs 21.4
(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>
@ -1564,22 +1578,25 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
'mh-seq-list nil ; Alist of (seq . msgs) nums
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
'mh-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.
'mh-folder-view-stack () ; Stack of previous views of the
; folder.
'mh-index-data nil ; If the folder was created by a call
; to mh-index-search this contains info
; about the search results.
'mh-index-previous-search nil ; Previous folder and search-regexp
'mh-index-msg-checksum-map nil ; msg -> checksum map
'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
'mh-index-sequence-search-flag nil ; folder resulted from sequence search
'mh-first-msg-num nil ; Number of first msg in buffer
'mh-last-msg-num nil ; Number of last msg in buffer
'mh-msg-count nil ; Number of msgs in buffer
'mh-mode-line-annotation nil ; Indicates message range
'mh-sequence-notation-history (make-hash-table)
; Remember what is overwritten by
; mh-note-seq.
'mh-previous-window-config nil) ; Previous window configuration
(mh-remove-xemacs-horizontal-scrollbar)
(setq truncate-lines t)
@ -1597,8 +1614,7 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(easy-menu-add mh-folder-sequence-menu)
(easy-menu-add mh-folder-message-menu)
(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))
(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)
@ -1611,6 +1627,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
(set (make-local-variable (car pairs)) (car (cdr pairs)))
(setq pairs (cdr (cdr pairs)))))
;;;###autoload
(defun mh-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an MH folder buffer specified in a desktop file."
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))
(defun mh-scan-folder (folder range &optional dont-exec-pending)
"Scan the FOLDER over the RANGE.
If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
@ -1651,6 +1676,7 @@ If UPDATE, append the scan lines, otherwise replace."
(range (if (and range (atom range)) (list range) range))
scan-start)
(message "Scanning %s..." folder)
(mh-remove-all-notation)
(with-mh-folder-updating (nil)
(if update
(goto-char (point-max))
@ -1742,8 +1768,8 @@ Return in the current buffer."
(message "inc %s..." folder))
(setq mh-next-direction 'forward)
(goto-char (point-max))
(mh-remove-all-notation)
(let ((start-of-inc (point)))
(mh-remove-cur-notation)
(if maildrop-name
;; I think MH 5 used "-ms-file" instead of "-file",
;; which would make inc'ing from maildrops fail.
@ -1763,11 +1789,12 @@ Return in the current buffer."
(re-search-forward "^inc: no mail" nil t))
(message "No new mail%s%s" (if maildrop-name " in " "")
(if maildrop-name maildrop-name "")))
((and (when mh-narrowed-to-seq
((and (when mh-folder-view-stack
(let ((saved-text (buffer-substring-no-properties
start-of-inc (point-max))))
(delete-region start-of-inc (point-max))
(unwind-protect (mh-widen)
(unwind-protect (mh-widen t)
(mh-remove-all-notation)
(goto-char (point-max))
(setq start-of-inc (point))
(insert saved-text)
@ -1789,7 +1816,6 @@ Return in the current buffer."
(setq mh-seq-list (mh-read-folder-sequences folder t))
(when (equal (point-max) start-of-inc)
(mh-notate-cur))
(mh-notate-user-sequences)
(if new-mail-flag
(progn
(mh-make-folder-mode-line)
@ -1798,7 +1824,9 @@ Return in the current buffer."
(when (memq 'unthread mh-view-ops)
(mh-thread-inc folder start-of-inc))
(mh-goto-cur-msg))
(goto-char point-before-inc))))))
(goto-char point-before-inc))
(mh-notate-user-sequences)
(mh-notate-deleted-and-refiled)))))
(defun mh-make-folder-mode-line (&optional ignored)
"Set the fields of the mode line for a folder buffer.
@ -1841,10 +1869,13 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
(""))))))
(mh-logo-display))))
;;; XXX: Remove this function, if no one uses it any more...
(defun mh-unmark-all-headers (remove-all-flags)
"Remove all '+' flags from the folder listing.
With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
Optimized for speed (i.e., no regular expressions)."
Optimized for speed (i.e., no regular expressions).
This function is deprecated. Use `mh-remove-all-notation' instead."
(save-excursion
(let ((case-fold-search nil)
(last-line (1- (point-max)))
@ -1869,6 +1900,39 @@ Optimized for speed (i.e., no regular expressions)."
(insert " ")))))
(forward-line)))))
(defun mh-add-sequence-notation (msg internal-seq-flag)
"Add sequence notation to the MSG on the current line.
If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the
current line, so that font-lock would automatically refontify it."
(with-mh-folder-updating (t)
(save-excursion
(beginning-of-line)
(if internal-seq-flag
(mh-notate nil nil mh-cmd-note)
(forward-char (1+ mh-cmd-note))
(let ((stack (gethash msg mh-sequence-notation-history)))
(setf (gethash msg mh-sequence-notation-history)
(cons (char-after) stack)))
(mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
"Remove sequence notation from the MSG on the current line.
If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the
sequence. In that case, no notation needs to be removed. Otherwise the effect
of inserting `mh-note-seq' needs to be reversed.
If ALL is non-nil, then all sequence marks on the scan line are removed."
(with-mh-folder-updating (t)
;; This takes care of internal sequences...
(mh-notate nil nil mh-cmd-note)
(unless internal-seq-flag
;; ... and this takes care of user sequences.
(let ((stack (gethash msg mh-sequence-notation-history)))
(while (and all (cdr stack))
(setq stack (cdr stack)))
(when stack
(mh-notate nil (car stack) (1+ mh-cmd-note)))
(setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
(defun mh-remove-cur-notation ()
"Remove old cur notation."
(let ((cur-msg (car (mh-seq-to-msgs 'cur))))
@ -1884,12 +1948,10 @@ Optimized for speed (i.e., no regular expressions)."
(save-excursion
(setq overlay-arrow-position nil)
(goto-char (point-min))
(while (not (eobp))
(unless (or (equal (char-after) ?+) (eolp))
(mh-notate nil ? mh-cmd-note)
(when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
(mh-notate nil ? (1+ mh-cmd-note))))
(forward-line))))
(mh-iterate-on-range msg (cons (point-min) (point-max))
(mh-notate nil ? mh-cmd-note)
(mh-remove-sequence-notation msg nil t))
(clrhash mh-sequence-notation-history)))
;;;###mh-autoload
(defun mh-goto-cur-msg (&optional minimal-changes-flag)
@ -1934,22 +1996,47 @@ with no arguments, before the commands are processed."
;; Update the unseen sequence if it exists
(mh-update-unseen)
(let ((redraw-needed-flag mh-index-data))
(let ((redraw-needed-flag mh-index-data)
(folders-changed (list mh-current-folder))
(seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
(mh-create-sequence-map mh-seq-list)))
(dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
(make-hash-table))))
;; Remove invalid scan lines if we are in an index folder and then remove
;; the real messages
(when mh-index-data
(mh-index-delete-folder-headers)
(mh-index-execute-commands))
(setq folders-changed
(append folders-changed (mh-index-execute-commands))))
;; Then refile messages
(mh-mapc #'(lambda (folder-msg-list)
(let ((dest-folder (symbol-name (car folder-msg-list)))
(msgs (cdr folder-msg-list)))
(let* ((dest-folder (symbol-name (car folder-msg-list)))
(last (car (mh-translate-range dest-folder "last")))
(msgs (cdr folder-msg-list)))
(push dest-folder folders-changed)
(setq redraw-needed-flag t)
(apply #'mh-exec-cmd
"refile" "-src" folder dest-folder
(mh-coalesce-msg-list msgs))
(mh-delete-scan-msgs msgs)))
(mh-delete-scan-msgs msgs)
;; Preserve sequences in destination folder...
(when (and mh-refile-preserves-sequences-flag
(numberp last))
(clrhash dest-map)
(loop for i from (1+ last)
for msg in (sort (copy-sequence msgs) #'<)
do (loop for seq-name in (gethash msg seq-map)
do (push i (gethash seq-name dest-map))))
(maphash
#'(lambda (seq msgs)
;; Run it in the background, since we don't care
;; about the results.
(apply #'mh-exec-cmd-daemon "mark" #'ignore
"-sequence" (symbol-name seq) dest-folder
"-add" (mapcar #'(lambda (x) (format "%s" x))
(mh-coalesce-msg-list msgs))))
dest-map))))
mh-refile-list)
(setq mh-refile-list ())
@ -1969,7 +2056,7 @@ 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))
(apply #'mh-speed-flists t folders-changed))
(cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
(mh-index-data (mh-index-insert-folder-headers)))))
@ -1980,7 +2067,7 @@ with no arguments, before the commands are processed."
(mh-invalidate-show-buffer))
(setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
(mh-unmark-all-headers t)
(mh-remove-all-notation)
(mh-notate-user-sequences)
(message "Processing deletes and refiles for %s...done" folder)))
@ -2115,55 +2202,67 @@ Expands ranges into set of individual numbers."
(setq msgs (cons num msgs)))))
msgs))
(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))))
(defun mh-notate-user-sequences (&optional range)
"Mark user-defined sequences in the messages specified by RANGE.
The optional argument RANGE can be a message number, a list of message
numbers, a sequence, a region in a cons cell. If nil all messages are notated."
(unless range
(setq range (cons (point-min) (point-max))))
(let ((seqs mh-seq-list)
(msg-hash (make-hash-table))
(tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))))
(msg-hash (make-hash-table)))
(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-msg-or-seq msg msg-or-seq
(when (gethash msg msg-hash)
(mh-notate nil mh-note-seq (1+ mh-cmd-note)))
(mh-notate-tick msg tick-msgs))))
(dolist (msg (mh-seq-msgs seq))
(push (car seq) (gethash msg msg-hash))))
(mh-iterate-on-range msg range
(loop for seq in (gethash msg msg-hash)
do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
(defun mh-internal-seq (name)
"Return non-nil if NAME is the name of an internal MH-E sequence."
(or (memq name '(answered cur deleted forwarded printed))
(or (memq name mh-internal-seqs)
(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 (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")
(defun mh-valid-seq-p (name)
"Return non-nil if NAME is a valid MH sequence name."
(and (symbolp name)
(string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
(defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
"Delete RANGE from SEQUENCE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the
change."
(interactive (list (mh-interactive-range "Delete")
(mh-read-seq-default "Delete from" t)
nil))
(let ((entry (mh-find-seq sequence)))
(let ((entry (mh-find-seq sequence))
(user-sequence-flag (not (mh-internal-seq sequence)))
(folders-changed (list mh-current-folder))
(msg-list ()))
(when entry
(mh-iterate-on-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)
(mh-iterate-on-range msg range
(push msg msg-list)
;; Calling "mark" repeatedly takes too long. So we will pretend here
;; that we are just modifying an internal sequence...
(when (memq msg (cdr entry))
(mh-remove-sequence-notation msg (not user-sequence-flag)))
(mh-delete-a-msg-from-seq msg sequence t))
;; ... and here we will "mark" all the messages at one go.
(unless internal-flag (mh-undefine-sequence sequence msg-list))
(when (and mh-index-data (not internal-flag))
(setq folders-changed
(append folders-changed
(mh-index-delete-from-sequence sequence msg-list))))
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(mh-speed-flists t mh-current-folder)))))
(apply #'mh-speed-flists t folders-changed)))))
(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
"Delete MSG from SEQUENCE.
@ -2174,31 +2273,18 @@ If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
(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."
(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))))
(when (and (mh-valid-seq-p seq) msgs)
(apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
"-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
(defun mh-define-sequence (seq msgs)
"Define the SEQ to contain the list of MSGS.
Do not mark pseudo-sequences or empty sequences.
Signals an error if SEQ is an illegal name."
(if (and msgs
(mh-valid-seq-p seq)
(not (mh-folder-name-p seq)))
(save-excursion
(mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
@ -2237,31 +2323,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
;;; User prompting commands.
(defun mh-read-msg-range (folder &optional always-prompt-flag)
"Prompt for message range from FOLDER.
If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
range."
(multiple-value-bind (total unseen) (mh-folder-size folder)
(cond
((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
(list (symbol-name mh-unseen-seq)))
((or (null mh-large-folder) (not (numberp total)))
(list "all"))
((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
(let* ((prompt
(format "Range or number of messages to read (default: %s): "
total))
(in (read-string prompt nil nil (number-to-string total))))
(cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
(list (format "last:%s" (car (read-from-string in)))))
((equal in "") (list "all"))
(t (split-string in)))))
(t (list "all")))))
;;; Build the folder-mode keymap:
(suppress-keymap mh-folder-mode-map)
@ -2319,6 +2380,7 @@ range."
(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
"?" mh-prefix-help
"'" mh-index-ticked-messages
"S" mh-sort-folder
"f" mh-alt-visit-folder
"i" mh-index-search
@ -2327,6 +2389,7 @@ range."
"n" mh-index-new-messages
"o" mh-alt-visit-folder
"p" mh-pack-folder
"q" mh-index-sequenced-messages
"r" mh-rescan-folder
"s" mh-search-folder
"u" mh-undo-folder
@ -2340,6 +2403,7 @@ range."
"w" mh-junk-whitelist)
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
"d" mh-delete-msg-from-seq
"k" mh-delete-seq
@ -2361,7 +2425,11 @@ range."
(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
"c" mh-narrow-to-cc
"f" mh-narrow-to-from
"r" mh-narrow-to-range
"s" mh-narrow-to-subject
"t" mh-narrow-to-to
"w" mh-widen)
(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
@ -2411,16 +2479,16 @@ range."
"[d]elete, [o]refile, e[x]ecute,\n"
"[s]end, [r]eply.\n"
"Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
"\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.")
"\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"
(?F "[l]ist; [v]isit folder;\n"
"[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
"[p]ack; [S]ort; [r]escan; [k]ill")
(?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
(?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
"[s]equences, [l]ist,\n"
"[d]elete message from sequence, [k]ill sequence")
(?T "[t]oggle, [d]elete, [o]refile thread")
(?/ "Limit to [s]ubject; [w]iden")
(?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
(?X "un[s]har, [u]udecode message")
(?D "[b]urst digest")
(?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
@ -2443,17 +2511,6 @@ well.")
"^There is no other window$"))
(add-to-list 'debug-ignored-errors mess))
;;;; Desktop support
;;;###autoload
(defun mh-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore an mh folder buffer specified in a desktop file."
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))
(provide 'mh-e)
;;; Local Variables:

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

@ -72,18 +72,15 @@ digest are inserted into the folder after that message."
(message "Bursting digest...done")))
;;;###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.
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")
(defun mh-copy-msg (range folder)
"Copy the specified RANGE to another FOLDER without deleting them.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Copy")
(mh-prompt-for-folder "Copy to" "" t)))
(let ((msg-list (let ((result ()))
(mh-iterate-on-msg-or-seq msg msg-or-seq
(mh-iterate-on-range msg range
(mh-notate nil mh-note-copied mh-cmd-note)
(push msg result))
result)))
@ -94,9 +91,13 @@ region in a cons cell, or a sequence."
(defun mh-kill-folder ()
"Remove the current folder and all included messages.
Removes all of the messages (files) within the specified current folder,
and then removes the folder (directory) itself."
and then removes the folder (directory) itself.
The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to
be called, with no arguments, which should return a value of non-nil if
verification is not desired."
(interactive)
(if (or mh-index-data
(if (or (run-hook-with-args-until-success
'mh-kill-folder-suppress-prompt-hook)
(yes-or-no-p (format "Remove folder %s (and all included messages)? "
mh-current-folder)))
(let ((folder mh-current-folder)
@ -154,7 +155,8 @@ First, offer to execute any outstanding commands for the current folder. If
optional prefix argument provided, prompt for the RANGE of messages to display
after packing. Otherwise, show the entire folder."
(interactive (list (if current-prefix-arg
(mh-read-msg-range mh-current-folder t)
(mh-read-range "Scan" mh-current-folder t nil t
mh-interpret-number-as-range-flag)
'("all"))))
(let ((threaded-flag (memq 'unthread mh-view-ops)))
(mh-pack-folder-1 range)
@ -231,22 +233,19 @@ Otherwise just send the message's body without the headers."
(mh-recenter 0)))
;;;###mh-autoload
(defun mh-print-msg (msg-or-seq)
"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.
(defun mh-print-msg (range)
"Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'."
(interactive (list (mh-interactive-msg-or-seq "Print")))
(interactive (list (mh-interactive-range "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-iterate-on-range msg range
(mh-add-msgs-to-seq msg 'printed t)
(mh-notate nil mh-note-printed mh-cmd-note)
(push msg msgs))
@ -258,12 +257,12 @@ The messages are formatted by mhl. See the variable `mhl-formfile'."
(mh-coalesce-msg-list msgs)) " "))
(lpr-command
(format mh-lpr-command-format
(cond ((listp msg-or-seq)
(cond ((listp range)
(format "Folder: %s, Messages: %s"
mh-current-folder msgs-string))
((symbolp msg-or-seq)
((symbolp range)
(format "Folder: %s, Sequence: %s"
mh-current-folder msg-or-seq)))))
mh-current-folder range)))))
(scan-command
(format "scan %s | %s" msgs-string lpr-command)))
(if mh-print-background-flag
@ -319,7 +318,7 @@ Argument IGNORE is deprecated."
mh-seq-list nil
mh-next-direction 'forward)
(with-mh-folder-updating (nil)
(mh-unmark-all-headers t)))
(mh-remove-all-notation)))
(t
(message "Commands not undone.")
;; Remove by 2003-06-30 if nothing seems amiss. XXX

142
lisp/mh-e/mh-gnus.el Normal file
View file

@ -0,0 +1,142 @@
;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; 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:
;;; Change Log:
;;; Code:
(load "mm-decode" t t) ; Non-fatal dependency
(load "mm-uu" t t) ; Non-fatal dependency
(load "mailcap" t t) ; Non-fatal dependency
(load "smiley" t t) ; Non-fatal dependency
(defmacro mh-defun-compat (function arg-list &rest body)
"This is a macro to define functions which are not defined.
It is used for Gnus utility functions which were added recently. If FUNCTION
is not defined then it is defined to have argument list, ARG-LIST and body,
BODY."
(let ((defined-p (fboundp function)))
(unless defined-p
`(defun ,function ,arg-list ,@body))))
(put 'mh-defun-compat 'lisp-indent-function 'defun)
(defmacro mh-defmacro-compat (function arg-list &rest body)
"This is a macro to define functions which are not defined.
It is used for Gnus utility functions which were added recently. If FUNCTION
is not defined then it is defined to have argument list, ARG-LIST and body,
BODY."
(let ((defined-p (fboundp function)))
(unless defined-p
`(defmacro ,function ,arg-list ,@body))))
(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
;; Copy of original function from gnus-util.el
(mh-defun-compat gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
(cond (mh-xemacs-flag (list 'keymap map))
((>= emacs-major-version 21) (list 'keymap map))
(t (list 'local-map map))))
;; Copy of original function from mm-decode.el
(mh-defun-compat mm-merge-handles (handles1 handles2)
(append (if (listp (car handles1)) handles1 (list handles1))
(if (listp (car handles2)) handles2 (list handles2))))
;; Copy of function from mm-decode.el
(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
;; HANDLE could be a CTL.
(if handle
(put-text-property 0 (length (car handle)) parameter value
(car handle))))
;; Copy of original macro is in mm-decode.el
(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
`(get-text-property 0 ,parameter (car ,handle)))
(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
"Say whether the content of HANDLE is readable."
(and (< (with-current-buffer (mm-handle-buffer handle)
(buffer-size)) 10000)
(mm-with-unibyte-buffer
(mm-insert-part handle)
(and (eq (mm-body-7-or-8) '7bit)
(not (mm-long-lines-p 76))))))
;; Copy of original function in mm-bodies.el
(mh-defun-compat mm-long-lines-p (length)
"Say whether any of the lines in the buffer is longer than LENGTH."
(save-excursion
(goto-char (point-min))
(end-of-line)
(while (and (not (eobp))
(not (> (current-column) length)))
(forward-line 1)
(end-of-line))
(and (> (current-column) length)
(current-column))))
(mh-defun-compat mm-keep-viewer-alive-p (handle)
;; Released Gnus doesn't keep handles associated with externally displayed
;; MIME parts. So this will always return nil.
nil)
(mh-defun-compat mm-destroy-parts (list)
"Older emacs don't have this function."
nil)
;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
;;; buggy (the args to read-file-name are incorrect). When all supported
;;; versions of Emacs come with at least Gnus 5.10, we can delete this
;;; function and rename calls to mh-mm-save-part to mm-save-part.
(defun mh-mm-save-part (handle)
"Write HANDLE to a file."
(let ((name (mail-content-type-get (mm-handle-type handle) 'name))
(filename (mail-content-type-get
(mm-handle-disposition handle) 'filename))
file)
(when filename
(setq filename (file-name-nondirectory filename)))
(setq file (read-file-name "Save MIME part to: "
(or mm-default-directory
default-directory)
nil nil (or filename name "")))
(setq mm-default-directory (file-name-directory file))
(and (or (not (file-exists-p file))
(yes-or-no-p (format "File %s already exists; overwrite? "
file)))
(mm-save-part-to-file handle file))))
(provide 'mh-gnus)
;;; Local Variables:
;;; no-byte-compile: t
;;; no-update-autoloads: t
;;; End:
;;; mh-gnus.el ends here

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

@ -1,6 +1,6 @@
;;; mh-identity.el --- Multiple identify support for MH-E.
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -40,7 +40,8 @@
;;; Code:
(require 'cl)
(require 'mh-utils)
(mh-require-cl)
(eval-when (compile load eval)
(defvar mh-comp-loaded nil)
@ -63,6 +64,8 @@
;; ["home" (mh-insert-identity "home")
;; :style radio :active (not (equal mh-identity-local "home"))
;; :selected (equal mh-identity-local "home")]
'(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list]
"--")
(mapcar (function
(lambda (arg)
`[,arg (mh-insert-identity ,arg) :style radio

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

@ -1,6 +1,6 @@
;;; mh-index -- MH-E interface to indexing programs
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -43,7 +43,8 @@
;;; Code:
(require 'cl)
(require 'mh-utils)
(mh-require-cl)
(require 'mh-e)
(require 'mh-mime)
(require 'mh-pick)
@ -259,10 +260,60 @@ checksum -> (origin-folder, origin-index) map is updated too."
(save-excursion
(set-buffer folder)
(mh-index-update-single-msg msg checksum origin-map)))
(forward-line))))))
(forward-line)))))
(mh-index-write-data))
(defvar mh-flists-results-folder "new"
(defvar mh-unpropagated-sequences '(cur range subject search)
"List of sequences that aren't preserved.")
(defun mh-unpropagated-sequences ()
"Return a list of sequences that aren't propagated to the source folders.
It is just the sequences in the variable `mh-unpropagated-sequences' in
addition to the Previous-Sequence (see mh-profile 5)."
(if mh-previous-seq
(cons mh-previous-seq mh-unpropagated-sequences)
mh-unpropagated-sequences))
;;;###mh-autoload
(defun mh-create-sequence-map (seq-list)
"Return a map from msg number to list of sequences in which it is present.
SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the
list of messages in that sequence."
(loop with map = (make-hash-table)
for seq in seq-list
when (and (not (memq (car seq) (mh-unpropagated-sequences)))
(mh-valid-seq-p (car seq)))
do (loop for msg in (cdr seq)
do (push (car seq) (gethash msg map)))
finally return map))
;;;###mh-autoload
(defun mh-index-create-sequences ()
"Mirror sequences present in source folders in index folder."
(let ((seq-hash (make-hash-table :test #'equal))
(seq-list ()))
(loop for folder being the hash-keys of mh-index-data
do (setf (gethash folder seq-hash)
(mh-create-sequence-map
(mh-read-folder-sequences folder nil))))
(dolist (msg (mh-translate-range mh-current-folder "all"))
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(pair (gethash checksum mh-index-checksum-origin-map))
(ofolder (car pair))
(omsg (cdr pair)))
(loop for seq in (gethash omsg (gethash ofolder seq-hash))
do (if (assoc seq seq-list)
(push msg (cdr (assoc seq seq-list)))
(push (list seq msg) seq-list)))))
(loop for seq in seq-list
do (apply #'mh-exec-cmd "mark" mh-current-folder
"-sequence" (symbol-name (car seq)) "-add"
(mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
(defvar mh-flists-results-folder "sequence"
"Subfolder for `mh-index-folder' where flists output is placed.")
(defvar mh-flists-sequence)
(defvar mh-flists-called-flag nil)
(defun mh-index-generate-pretty-name (string)
"Given STRING generate a name which is suitable for use as a folder name.
@ -293,13 +344,14 @@ they are concatenated to construct the base name."
(subst-char-in-region (point-min) (point-max) ?\r ?_ t)
(subst-char-in-region (point-min) (point-max) ?/ ?$ t)
(let ((out (truncate-string-to-width (buffer-string) 20)))
(cond ((eq mh-indexer 'flists) mh-flists-results-folder)
(cond ((eq mh-indexer 'flists)
(format "%s/%s" mh-flists-results-folder mh-flists-sequence))
((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 unseen-flag)
&optional window-config)
"Perform an indexed search in an MH mail folder.
Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
@ -308,8 +360,7 @@ 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. If optional argument UNSEEN-FLAG
is non-nil, then all the messages are marked as unseen.
folder containing the index search results.
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
@ -344,7 +395,8 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(list current-prefix-arg
(progn
(unless mh-find-path-run (mh-find-path))
(or (and current-prefix-arg (car mh-index-previous-search))
(or (and current-prefix-arg mh-index-sequence-search-flag)
(and current-prefix-arg (car mh-index-previous-search))
(mh-prompt-for-folder "Search" "+" nil "all" t)))
(progn
;; Yes, we do want to call mh-index-choose every time in case the
@ -360,6 +412,13 @@ This has the effect of renaming already present X-MHE-Checksum headers."
mh-index-regexp-builder)
(current-window-configuration)
nil)))
;; Redoing a sequence search?
(when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
(not mh-flists-called-flag))
(let ((mh-flists-called-flag t))
(apply #'mh-index-sequenced-messages mh-index-previous-search))
(return-from mh-index-search))
;; We have fancy query parsing
(when (symbolp search-regexp)
(mh-search-folder folder window-config)
(setq mh-searching-function 'mh-index-do-search)
@ -401,23 +460,23 @@ This has the effect of renaming already present X-MHE-Checksum headers."
;; Copy the search results over
(maphash #'(lambda (folder msgs)
(let ((msgs (sort (loop for msg being the hash-keys of msgs
(let ((cur (car (mh-translate-range folder "cur")))
(msgs (sort (loop for msg being the hash-keys of msgs
collect msg)
#'<)))
(mh-exec-cmd "refile" msgs "-src" folder
"-link" index-folder)
;; Restore cur to old value, that refile changed
(when cur
(mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
"-sequence" "cur" (format "%s" cur)))
(loop for msg in msgs
do (incf result-count)
(setf (gethash result-count origin-map)
(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.
;; Vist the results folder
(mh-visit-folder index-folder () (list folder-results-map origin-map))
(goto-char (point-min))
@ -425,11 +484,18 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(mh-update-sequences)
(mh-recenter nil)
;; Update the speedbar, if needed
(when (mh-speed-flists-active-p)
(mh-speed-flists t mh-current-folder))
;; Maintain history
(when (or (and redo-search-flag previous-search) window-config)
(setq mh-previous-window-config old-window-config))
(setq mh-index-previous-search (list folder search-regexp))
;; Write out data to disk
(unless mh-flists-called-flag (mh-index-write-data))
(message "%s found %s matches in %s folders"
(upcase-initials (symbol-name mh-indexer))
(loop for msg-hash being hash-values of mh-index-data
@ -437,6 +503,78 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(loop for msg-hash being hash-values of mh-index-data
count (> (hash-table-count msg-hash) 0))))))
;;; Functions to serialize index data...
(defun mh-index-write-data ()
"Write index data to file."
(ignore-errors
(unless (eq major-mode 'mh-folder-mode)
(error "Can't be called from folder in `%s'" major-mode))
(let ((data mh-index-data)
(msg-checksum-map mh-index-msg-checksum-map)
(checksum-origin-map mh-index-checksum-origin-map)
(previous-search mh-index-previous-search)
(sequence-search-flag mh-index-sequence-search-flag)
(outfile (concat buffer-file-name mh-index-data-file))
(print-length nil)
(print-level nil))
(with-temp-file outfile
(mh-index-write-hashtable
data (lambda (x) (loop for y being the hash-keys of x collect y)))
(mh-index-write-hashtable msg-checksum-map #'identity)
(mh-index-write-hashtable checksum-origin-map #'identity)
(pp previous-search (current-buffer)) (insert "\n")
(pp sequence-search-flag (current-buffer)) (insert "\n")))))
;;;###mh-autoload
(defun mh-index-read-data ()
"Read index data from file."
(ignore-errors
(unless (eq major-mode 'mh-folder-mode)
(error "Can't be called from folder in `%s'" major-mode))
(let ((infile (concat buffer-file-name mh-index-data-file))
t1 t2 t3 t4 t5)
(with-temp-buffer
(insert-file-contents-literally infile)
(goto-char (point-min))
(setq t1 (mh-index-read-hashtable
(lambda (data)
(loop with table = (make-hash-table :test #'equal)
for x in data do (setf (gethash x table) t)
finally return table)))
t2 (mh-index-read-hashtable #'identity)
t3 (mh-index-read-hashtable #'identity)
t4 (read (current-buffer))
t5 (read (current-buffer))))
(setq mh-index-data t1
mh-index-msg-checksum-map t2
mh-index-checksum-origin-map t3
mh-index-previous-search t4
mh-index-sequence-search-flag t5))))
(defun mh-index-write-hashtable (table proc)
"Write TABLE to `current-buffer'.
PROC is used to serialize the values corresponding to the hash table keys."
(pp (loop for x being the hash-keys of table
collect (cons x (funcall proc (gethash x table))))
(current-buffer))
(insert "\n"))
(defun mh-index-read-hashtable (proc)
"From BUFFER read a hash table serialized as a list.
PROC is used to convert the value to actual data."
(loop with table = (make-hash-table :test #'equal)
for pair in (read (current-buffer))
do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
finally return table))
;;;###mh-autoload
(defun mh-index-p ()
"Non-nil means that this folder was generated by an index search."
mh-index-data)
;;;###mh-autoload
(defun mh-index-do-search ()
"Construct appropriate regexp and call `mh-index-search'."
@ -452,8 +590,9 @@ This has the effect of renaming already present X-MHE-Checksum headers."
(defun mh-replace-string (old new)
"Replace all occurrences of OLD with NEW in the current buffer."
(goto-char (point-min))
(while (search-forward old nil t)
(replace-match new)))
(let ((case-fold-search t))
(while (search-forward old nil t)
(replace-match new t t))))
;;;###mh-autoload
(defun mh-index-parse-search-regexp (input-string)
@ -463,16 +602,18 @@ NOT as appropriate. Then the resulting string is parsed."
(let (input)
(with-temp-buffer
(insert input-string)
(downcase-region (point-min) (point-max))
;; replace tabs
(mh-replace-string "\t" " ")
;; synonyms of AND
(mh-replace-string " AND " " and ")
(mh-replace-string "&" " and ")
(mh-replace-string " -and " " and ")
;; synonyms of OR
(mh-replace-string " OR " " or ")
(mh-replace-string "|" " or ")
(mh-replace-string " -or " " or ")
;; synonyms of NOT
(mh-replace-string " NOT " " not ")
(mh-replace-string "!" " not ")
(mh-replace-string "~" " not ")
(mh-replace-string " -not " " not ")
@ -498,21 +639,21 @@ NOT as appropriate. Then the resulting string is parsed."
(multiple-value-setq (op-stack operand-stack)
(mh-index-evaluate op-stack operand-stack))
(when (eq (car op-stack) 'not)
(pop op-stack)
(setq op-stack (cdr op-stack))
(push `(not ,(pop operand-stack)) operand-stack))
(when (eq (car op-stack) 'and)
(pop op-stack)
(setq op-stack (cdr op-stack))
(setq oper1 (pop operand-stack))
(push `(and ,(pop operand-stack) ,oper1) operand-stack)))
((eq (car op-stack) 'not)
(pop op-stack)
(setq op-stack (cdr op-stack))
(push `(not ,token) operand-stack)
(when (eq (car op-stack) 'and)
(pop op-stack)
(setq op-stack (cdr op-stack))
(setq oper1 (pop operand-stack))
(push `(and ,(pop operand-stack) ,oper1) operand-stack)))
((eq (car op-stack) 'and)
(pop op-stack)
(setq op-stack (cdr op-stack))
(push `(and ,(pop operand-stack) ,token) operand-stack))
(t (push token operand-stack))))
(prog1 (pop operand-stack)
@ -632,7 +773,7 @@ we find a new folder name."
(setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
mh-index-msg-checksum-map)
mh-index-checksum-origin-map)))
(when (and current-folder (not (eq current-folder last-folder)))
(when (and current-folder (not (equal current-folder last-folder)))
(insert (if last-folder "\n" "") current-folder "\n")
(setq last-folder current-folder))
(forward-line))
@ -646,7 +787,7 @@ 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)))
(let ((result-table (make-hash-table :test #'equal)))
(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)
@ -722,24 +863,113 @@ Also `mh-update-unseen' is called in the original folder, if we have it open."
(string-equal (buffer-substring-no-properties (point) (line-end-position))
checksum)))
(defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data)
"Return a table of original messages and folders for messages in MSGS.
If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each of the
messages, whose counter-part is found in some source folder, is removed from
`mh-index-data'."
(let ((table (make-hash-table :test #'equal)))
(dolist (msg msgs)
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(pair (gethash checksum mh-index-checksum-origin-map)))
(when (and checksum (car pair) (cdr pair)
(mh-index-match-checksum (cdr pair) (car pair) checksum))
(push (cdr pair) (gethash (car pair) table))
(when delete-from-index-data
(remhash (cdr pair) (gethash (car pair) mh-index-data))))))
table))
;;;###mh-autoload
(defun mh-index-execute-commands ()
"Delete/refile the actual messages.
The copies in the searched folder are then deleted/refiled to get the desired
result. Before deleting the messages we make sure that the message being
deleted is identical to the one that the user has marked in the index buffer."
(let ((message-table (make-hash-table :test #'equal)))
(dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
(dolist (msg msg-list)
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(pair (gethash checksum mh-index-checksum-origin-map)))
(when (and checksum (car pair) (cdr pair)
(mh-index-match-checksum (cdr pair) (car pair) checksum))
(push (cdr pair) (gethash (car pair) message-table))
(remhash (cdr pair) (gethash (car pair) mh-index-data))))))
(maphash (lambda (folder msgs)
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
message-table)))
(save-excursion
(let ((folders ())
(mh-speed-flists-inhibit-flag t))
(maphash
(lambda (folder msgs)
(push folder folders)
(if (not (get-buffer folder))
;; If source folder not open, just delete the messages...
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
;; Otherwise delete the messages in the source buffer...
(save-excursion
(set-buffer folder)
(let ((old-refile-list mh-refile-list)
(old-delete-list mh-delete-list))
(setq mh-refile-list nil
mh-delete-list msgs)
(unwind-protect (mh-execute-commands)
(setq mh-refile-list
(mapcar (lambda (x)
(cons (car x)
(loop for y in (cdr x)
unless (memq y msgs) collect y)))
old-refile-list)
mh-delete-list
(loop for x in old-delete-list
unless (memq x msgs) collect x))
(mh-set-folder-modified-p (mh-outstanding-commands-p))
(when (mh-outstanding-commands-p)
(mh-notate-deleted-and-refiled)))))))
(mh-index-matching-source-msgs (append (loop for x in mh-refile-list
append (cdr x))
mh-delete-list)
t))
folders)))
;;;###mh-autoload
(defun mh-index-add-to-sequence (seq msgs)
"Add to SEQ the messages in the list MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if we have it open."
;; Don't need to do anything for cur
(save-excursion
(when (and (not (memq seq (mh-unpropagated-sequences)))
(mh-valid-seq-p seq))
(let ((folders ())
(mh-speed-flists-inhibit-flag t))
(maphash (lambda (folder msgs)
(push folder folders)
;; Add messages to sequence in source folder...
(apply #'mh-exec-cmd-quiet nil "mark" folder
"-add" "-nozero" "-sequence" (symbol-name seq)
(mapcar (lambda (x) (format "%s" x))
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
(save-excursion
(set-buffer folder)
(mh-put-msg-in-seq msgs seq))))
(mh-index-matching-source-msgs msgs))
folders))))
;;;###mh-autoload
(defun mh-index-delete-from-sequence (seq msgs)
"Delete from SEQ the messages in MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if present."
(save-excursion
(when (and (not (memq seq (mh-unpropagated-sequences)))
(mh-valid-seq-p seq))
(let ((folders ())
(mh-speed-flists-inhibit-flag t))
(maphash (lambda (folder msgs)
(push folder folders)
;; Remove messages from sequence in source folder...
(apply #'mh-exec-cmd-quiet nil "mark" folder
"-del" "-nozero" "-sequence" (symbol-name seq)
(mapcar (lambda (x) (format "%s" x))
(mh-coalesce-msg-list msgs)))
;; Update source folder buffer if we have it open...
(when (get-buffer folder)
(save-excursion
(set-buffer folder)
(mh-delete-msg-from-seq msgs seq t))))
(mh-index-matching-source-msgs msgs))
folders))))
@ -1051,61 +1281,114 @@ REGEXP-LIST is an alist of fields and values."
(defvar mh-flists-search-folders)
;; XXX: This should probably be in mh-utils.el and used in other places where
;; MH-E calls out to /bin/sh.
(defun mh-index-quote-for-shell (string)
"Quote STRING for /bin/sh."
(concat "\""
(loop for x across string
concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
"\""))
(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."
"Execute flists.
Search for messages belonging to `mh-flists-sequence' in the folders
specified by `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)
(let ((seq (symbol-name mh-flists-sequence)))
(insert "for folder in `" (expand-file-name "flists" mh-progs) " "
(cond ((eq mh-flists-search-folders t)
(mh-index-quote-for-shell mh-inbox))
((eq mh-flists-search-folders nil) "")
((listp mh-flists-search-folders)
(loop for folder in mh-flists-search-folders
concat (concat " " folder))))
concat
(concat " " (mh-index-quote-for-shell folder)))))
(if mh-recursive-folders-flag " -recurse" "")
" -sequence " unseen " -noshowzero -fast` ; do\n"
"mhpath \"+$folder\" " unseen "\n" "done\n"))
" -sequence " seq " -noshowzero -fast` ; do\n"
(expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\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.
(defun mh-index-sequenced-messages (folders sequence)
"Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders."
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Folders to search: "))
mh-index-new-messages-folders)))
(split-string (read-string "Search folder(s) [all]? "))
mh-index-new-messages-folders)
(mh-read-seq-default "Search" nil)))
(unless sequence (setq sequence mh-unseen-seq))
(let* ((mh-flists-search-folders folders)
(mh-flists-sequence sequence)
(mh-flists-called-flag t)
(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))
(new-folder (format "%s/%s/%s" mh-index-folder
mh-flists-results-folder sequence))
(window-config (if (equal new-folder mh-current-folder)
mh-previous-window-config
(current-window-configuration)))
(redo-flag nil))
(redo-flag nil)
message)
(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.
;; into thinking that the folder resulted from a previous search.
(set-buffer new-folder)
(setq mh-index-previous-search (list "+" mh-flists-results-folder))
(setq mh-index-previous-search (list folders sequence))
(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)))
(setq message (mh-index-search redo-flag "+" mh-flists-results-folder
window-config)
mh-index-sequence-search-flag t
mh-index-previous-search (list folders sequence))
(mh-index-write-data)
(when (stringp message) (message message))))
;;;###mh-autoload
(defun mh-index-new-messages (folders)
"Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
mh-index-new-messages-folders)))
(mh-index-sequenced-messages folders mh-unseen-seq))
;;;###mh-autoload
(defun mh-index-ticked-messages (folders)
"Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders."
(interactive
(list (if current-prefix-arg
(split-string (read-string "Search folder(s) [all]? "))
mh-index-ticked-messages-folders)))
(mh-index-sequenced-messages folders mh-tick-seq))

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

@ -36,14 +36,11 @@
;; 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.
(defun mh-junk-blacklist (range)
"Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
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
@ -58,7 +55,7 @@ for the different spam fighting programs:
- `mh-bogofilter-blacklist'
- `mh-spamprobe-blacklist'
- `mh-spamassassin-blacklist'"
(interactive (list (mh-interactive-msg-or-seq "Blacklist")))
(interactive (list (mh-interactive-range "Blacklist")))
(let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
(unless blacklist-func
(error "Customize `mh-junk-program' appropriately"))
@ -70,7 +67,7 @@ for the different spam fighting programs:
(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
(mh-iterate-on-range msg range
(funcall (symbol-function blacklist-func) msg)
(if dest
(mh-refile-a-msg nil (intern dest))
@ -78,25 +75,22 @@ for the different spam fighting programs:
(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.
(defun mh-junk-whitelist (range)
"Whitelist RANGE incorrectly classified as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
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")))
(interactive (list (mh-interactive-range "Whitelist")))
(let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
(unless whitelist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-msg-or-seq msg msg-or-seq
(mh-iterate-on-range msg range
(funcall (symbol-function whitelist-func) msg)
(mh-refile-a-msg nil (intern mh-inbox)))
(mh-next-msg)))
@ -302,7 +296,7 @@ be done by adding the following to your crontab:
(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"))
"--single" "--spam" "--local" "--no-rebuild"))
(message "Blacklisting address...")
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)

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

@ -1,18 +1,19 @@
;;; mh-loaddefs.el --- automatically extracted autoloads
;;
;;; Copyright (C) 2003 Free Software Foundation, Inc.
;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;;; Author: Bill Wohler <wohler@newt.com>
;;; Keywords: mail
;;; Commentary:
;;; Change Log:
;;; Code:
;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
;;;### (autoloads (mh-letter-previous-header-field mh-letter-next-header-field-or-indent
;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft
;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields
;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
;;;;;; (16040 52697))
;;;;;; (16625 53169))
;;; Generated autoloads from mh-comp.el
(autoload (quote mh-edit-again) "mh-comp" "\
@ -29,13 +30,11 @@ See also documentation for `\\[mh-send]' function." t nil)
(autoload (quote mh-forward) "mh-comp" "\
Forward messages to the recipients TO and CC.
Use optional MSG-OR-SEQ argument to specify a message or sequence to forward.
Use optional RANGE 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.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
See also documentation for `\\[mh-send]' function." t nil)
@ -104,6 +103,14 @@ called, with no arguments, before the signature is actually inserted." t nil)
(autoload (quote mh-check-whom) "mh-comp" "\
Verify recipients of the current letter, showing expansion of any aliases." t nil)
(autoload (quote mh-insert-auto-fields) "mh-comp" "\
Insert custom fields if To or Cc match `mh-auto-fields-list'.
Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
something. If NON-INTERACTIVE is non-nil, do not be verbose and only
attempt matches if `mh-insert-auto-fields-done-local' is nil.
An `identity' entry is skipped if one was already entered manually." t nil)
(autoload (quote mh-send-letter) "mh-comp" "\
Send the draft letter in the current buffer.
If optional prefix argument ARG is provided, monitor delivery.
@ -143,16 +150,26 @@ Insert a newline and leave point after it.
In addition, insert newline and quoting characters before text after point.
This is useful in breaking up paragraphs in replies." t nil)
(autoload (quote mh-letter-complete) "mh-comp" "\
Perform completion on header field or word preceding point.
Alias completion is done within the mail header on selected fields and
by the function designated by `mh-letter-complete-function' elsewhere,
passing the prefix ARG if any." t nil)
(autoload (quote mh-complete-word) "mh-comp" "\
Complete WORD at from CHOICES.
Any match found replaces the text from BEGIN to END." nil nil)
(autoload (quote mh-beginning-of-word) "mh-comp" "\
Return position of the N th word backwards." nil nil)
(autoload (quote mh-letter-next-header-field-or-indent) "mh-comp" "\
Move to next field or indent depending on point.
In the message header, go to the next field. Elsewhere call
`indent-relative' as usual with optional prefix ARG." t nil)
(autoload (quote mh-letter-previous-header-field) "mh-comp" "\
Cycle to the previous header field.
If we are at the first header field go to the start of the message body." t nil)
;;;***
;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
;;;;;; (16040 52697))
;;;;;; (16625 53481))
;;; Generated autoloads from mh-customize.el
(autoload (quote mh-customize) "mh-customize" "\
@ -163,7 +180,7 @@ are removed." t nil)
;;;***
;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
;;;;;; "mh-e" "mh-e.el" (16040 52698))
;;;;;; "mh-e" "mh-e.el" (16627 18152))
;;; Generated autoloads from mh-e.el
(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
@ -186,7 +203,7 @@ recenter the folder buffer." nil nil)
;;;;;; 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"
;;;;;; (16040 52698))
;;;;;; (16625 54011))
;;; Generated autoloads from mh-funcs.el
(autoload (quote mh-burst-digest) "mh-funcs" "\
@ -195,18 +212,18 @@ The message is replaced by its table of contents and the messages from the
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.
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)
Copy the specified RANGE to another FOLDER without deleting them.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-kill-folder) "mh-funcs" "\
Remove the current folder and all included messages.
Removes all of the messages (files) within the specified current folder,
and then removes the folder (directory) itself." t nil)
and then removes the folder (directory) itself.
The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to
be called, with no arguments, which should return a value of non-nil if
verification is not desired." t nil)
(autoload (quote mh-list-folders) "mh-funcs" "\
List mail folders." t nil)
@ -229,13 +246,10 @@ 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 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.
Print RANGE on printer.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
The variable `mh-lpr-command-format' is used to generate the print command.
The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
@ -274,7 +288,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" (16040 52698))
;;;;;; "mh-identity" "mh-identity.el" (16625 54171))
;;; Generated autoloads from mh-identity.el
(autoload (quote mh-identity-make-menu) "mh-identity" "\
@ -292,8 +306,8 @@ Edit the `mh-identity-list' variable to define identity." t nil)
;;;***
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16040
;;;;;; 52698))
;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625
;;;;;; 54212))
;;; Generated autoloads from mh-inc.el
(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
@ -304,12 +318,15 @@ 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" (16040 52698))
;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages
;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence
;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen
;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder
;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder
;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p
;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences
;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el"
;;;;;; (16625 54348))
;;; Generated autoloads from mh-index.el
(autoload (quote mh-index-update-maps) "mh-index" "\
@ -319,6 +336,14 @@ is a hashtable which maps each message in the index folder to the original
folder and message from whence it was copied. If present the
checksum -> (origin-folder, origin-index) map is updated too." nil nil)
(autoload (quote mh-create-sequence-map) "mh-index" "\
Return a map from msg number to list of sequences in which it is present.
SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the
list of messages in that sequence." nil nil)
(autoload (quote mh-index-create-sequences) "mh-index" "\
Mirror sequences present in source folders in index folder." 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.
@ -328,8 +353,7 @@ 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. If optional argument UNSEEN-FLAG
is non-nil, then all the messages are marked as unseen.
folder containing the index search results.
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
@ -361,6 +385,12 @@ procmail recipe should avoid this:
This has the effect of renaming already present X-MHE-Checksum headers." t nil)
(autoload (quote mh-index-read-data) "mh-index" "\
Read index data from file." nil nil)
(autoload (quote mh-index-p) "mh-index" "\
Non-nil means that this folder was generated by an index search." nil nil)
(autoload (quote mh-index-do-search) "mh-index" "\
Construct appropriate regexp and call `mh-index-search'." t nil)
@ -402,6 +432,16 @@ The copies in the searched folder are then deleted/refiled to get the desired
result. Before deleting the messages we make sure that the message being
deleted is identical to the one that the user has marked in the index buffer." nil nil)
(autoload (quote mh-index-add-to-sequence) "mh-index" "\
Add to SEQ the messages in the list MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if we have it open." nil nil)
(autoload (quote mh-index-delete-from-sequence) "mh-index" "\
Delete from SEQ the messages in MSGS.
This function updates the source folder sequences. Also makes an attempt to
update the source folder buffer if present." nil nil)
(autoload (quote mh-glimpse-execute-search) "mh-index" "\
Execute glimpse and read the results.
@ -435,12 +475,29 @@ 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.
(autoload (quote mh-index-sequenced-messages) "mh-index" "\
Display messages from FOLDERS in SEQUENCE.
By default the folders specified by `mh-index-new-messages-folders' are
searched. With a prefix argument, enter a space-separated list of folders, or
nothing to search all folders." t nil)
nothing to search all folders.
Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
function searches for in each of the FOLDERS. With a prefix argument, enter a
sequence to use." t nil)
(autoload (quote mh-index-new-messages) "mh-index" "\
Display unseen messages.
All messages in the `unseen' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-new-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
(autoload (quote mh-index-ticked-messages) "mh-index" "\
Display ticked messages.
All messages in the `tick' sequence from FOLDERS are displayed.
By default the folders specified by `mh-index-ticked-messages-folders'
are searched. With a prefix argument, enter a space-separated list of
folders, or nothing to search all folders." t nil)
(autoload (quote mh-swish-execute-search) "mh-index" "\
Execute swish-e and read the results.
@ -564,17 +621,14 @@ system." nil nil)
;;;***
;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
;;;;;; "mh-junk.el" (16040 52698))
;;;;;; "mh-junk.el" (16625 54386))
;;; 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.
Blacklist RANGE as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
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
@ -591,13 +645,10 @@ for the different spam fighting programs:
- `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.
Whitelist RANGE incorrectly classified as spam.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
First the appropriate function is called depending on the value of
`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
@ -616,7 +667,7 @@ setting `mh-junk-choice' is not recommended." t nil)
;;;;;; 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" (16040 52699))
;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523))
;;; Generated autoloads from mh-mime.el
(autoload (quote mh-compose-insertion) "mh-mime" "\
@ -792,7 +843,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" (16040 52699))
;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571))
;;; Generated autoloads from mh-pick.el
(autoload (quote mh-search-folder) "mh-pick" "\
@ -822,16 +873,19 @@ indexing program specified in `mh-index-program' is used." t nil)
;;;***
;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-notate-tick
;;;;;; mh-thread-refile mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling
;;;### (autoloads (mh-narrow-to-tick mh-toggle-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" (16040 52700))
;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc
;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range
;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject
;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list
;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence
;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled
;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625
;;;;;; 54690))
;;; Generated autoloads from mh-seq.el
(autoload (quote mh-delete-seq) "mh-seq" "\
@ -849,16 +903,64 @@ 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 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)
Add RANGE to SEQUENCE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-widen) "mh-seq" "\
Remove restrictions from current folder, thereby showing all messages." t nil)
Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained." t nil)
(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\
Notate messages marked for deletion or refiling.
Messages to be deleted are given by `mh-delete-list' while messages to be
refiled are present in `mh-refile-list'." nil nil)
(autoload (quote mh-read-seq-default) "mh-seq" "\
Read and return sequence name with default narrowed or previous sequence.
PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
non-empty sequence is read." nil nil)
(autoload (quote mh-read-range) "mh-seq" "\
Read a message range with PROMPT.
If FOLDER is non-nil then a range is read from that folder, otherwise use
`mh-current-folder'.
If DEFAULT is a string then use that as default range to return. If DEFAULT is
nil then ask user with default answer a range based on the sequences that seem
relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen
messages, if present, are returned. If the folder has fewer than
`mh-large-folder' messages then \"all\" messages are returned. Finally as a
last resort prompt the user.
If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the
input is returned. If this list is empty then an error is raised. If
EXPAND-FLAG is nil just return the input string. In this case we don't check
if the range is empty.
If ASK-FLAG is non-nil, then the user is always queried for a range of
messages. If ASK-FLAG is nil, then the function checks if the unseen sequence
is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in
it depending on the value of EXPAND, is returned. Otherwise if the folder has
fewer than `mh-large-folder' messages then the list of messages corresponding
to \"all\" is returned. If neither of the above holds then as a last resort
the user is queried for a range of messages.
If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it
is interpreted as the range \"last:N\".
This function replaces the existing function `mh-read-msg-range'. Calls to:
(mh-read-msg-range folder flag)
should be replaced with:
(mh-read-range \"Suitable prompt\" folder t nil flag
mh-interpret-number-as-range-flag)" nil nil)
(autoload (quote mh-translate-range) "mh-seq" "\
In FOLDER, translate the string EXPR to a list of messages numbers." nil nil)
(autoload (quote mh-rename-seq) "mh-seq" "\
Rename SEQUENCE to have NEW-NAME." t nil)
@ -888,33 +990,39 @@ 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" "\
(autoload (quote mh-iterate-on-range) "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.
VAR is bound to each message in turn in a loop over RANGE, which can be a
message number, a list of message numbers, a sequence, a region in a cons
cell, or a MH range (something like last:20) in a string. In each iteration,
BODY is executed.
The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq'
The parameter RANGE is usually created with `mh-interactive-range'
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
(autoload (quote mh-range-to-msg-list) "mh-seq" "\
Return a list of messages for RANGE.
RANGE 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.
(autoload (quote mh-interactive-range) "mh-seq" "\
Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.
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.
If optional prefix argument is provided, then prompt for message range with
RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
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)
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions." nil nil)
(autoload (quote mh-region-to-msg-list) "mh-seq" "\
Return a list of messages within the region between BEGIN and END." nil nil)
@ -922,6 +1030,27 @@ Return a list of messages within the region between BEGIN and END." nil nil)
(autoload (quote mh-narrow-to-subject) "mh-seq" "\
Narrow to a sequence containing all following messages with same subject." t nil)
(autoload (quote mh-narrow-to-from) "mh-seq" "\
Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
(autoload (quote mh-narrow-to-cc) "mh-seq" "\
Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
(autoload (quote mh-narrow-to-to) "mh-seq" "\
Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick." t nil)
(autoload (quote mh-narrow-to-range) "mh-seq" "\
Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use." t nil)
(autoload (quote mh-delete-subject) "mh-seq" "\
Mark all following messages with same subject to be deleted.
This puts the messages in a sequence named subject. You can undo the last
@ -939,6 +1068,10 @@ subject for deletion." t nil)
Update thread tree for FOLDER.
All messages after START-POINT are added to the thread tree." nil nil)
(autoload (quote mh-thread-update-scan-line-map) "mh-seq" "\
In threaded view update `mh-thread-scan-line-map'.
MSG is the message being notated with NOTATION at OFFSET." nil nil)
(autoload (quote mh-thread-add-spaces) "mh-seq" "\
Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
@ -966,13 +1099,8 @@ 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)
Toggle tick mark of all messages in RANGE." t nil)
(autoload (quote mh-narrow-to-tick) "mh-seq" "\
Restrict display of this folder to just messages in `mh-tick-seq'.
@ -982,7 +1110,7 @@ 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" (16040 52700))
;;;;;; "mh-speed" "mh-speed.el" (16625 54721))
;;; Generated autoloads from mh-speed.el
(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@ -1003,7 +1131,9 @@ 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. If FOLDER is non-nil then flists is run
If FORCE is non-nil the timer is reset.
Any number of optional FOLDERS can be specified. If specified, flists is run
only for that one folder." t nil)
(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
@ -1016,7 +1146,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" (16040 52700))
;;;;;; "mh-utils" "mh-utils.el" (16625 54979))
;;; Generated autoloads from mh-utils.el
(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
@ -1031,16 +1161,19 @@ not pointing to a message." nil nil)
;;;***
;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
;;;;;; 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"
;;;;;; (16040 52696))
;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point
;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p
;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias"
;;;;;; "mh-alias.el" (16625 53006))
;;; Generated autoloads from mh-alias.el
(autoload (quote mh-alias-reload) "mh-alias" "\
Load MH aliases into `mh-alias-alist'." t nil)
(autoload (quote mh-alias-reload-maybe) "mh-alias" "\
Load new MH aliases." nil nil)
(autoload (quote mh-read-address) "mh-alias" "\
Read an address from the minibuffer with PROMPT." nil nil)
@ -1071,6 +1204,9 @@ already has an alias." t nil)
(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
Insert an alias for email address under point." t nil)
(autoload (quote mh-alias-apropos) "mh-alias" "\
Show all aliases that match REGEXP either in name or content." t nil)
;;;***
(provide 'mh-loaddefs)
@ -1079,6 +1215,5 @@ Insert an alias for email address under point." t nil)
;;; no-byte-compile: t
;;; no-update-autoloads: t
;;; End:
;;; arch-tag: bc36a104-1edb-45d5-8aad-a85b45648378
;;; mh-loaddefs.el ends here

253
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, 02, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,14 +34,11 @@
;;; Code:
(require 'cl)
(require 'mh-comp)
(require 'mh-utils)
(load "mm-decode" t t) ; Non-fatal dependency
(load "mm-uu" t t) ; Non-fatal dependency
(load "mailcap" t t) ; Non-fatal dependency
(load "smiley" t t) ; Non-fatal dependency
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
(require 'mh-gnus)
(autoload 'gnus-article-goto-header "gnus-art")
(autoload 'article-emphasize "gnus-art")
@ -450,6 +447,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well."
(interactive)
(require 'message)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
(mml-to-mime))
@ -529,99 +527,6 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
;;; MIME decoding
(defmacro mh-defun-compat (function arg-list &rest body)
"This is a macro to define functions which are not defined.
It is used for Gnus utility functions which were added recently. If FUNCTION
is not defined then it is defined to have argument list, ARG-LIST and body,
BODY."
(let ((defined-p (fboundp function)))
(unless defined-p
`(defun ,function ,arg-list ,@body))))
(put 'mh-defun-compat 'lisp-indent-function 'defun)
;; Copy of original function from gnus-util.el
(mh-defun-compat gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
(cond (mh-xemacs-flag (list 'keymap map))
((>= emacs-major-version 21) (list 'keymap map))
(t (list 'local-map map))))
;; Copy of original function from mm-decode.el
(mh-defun-compat mm-merge-handles (handles1 handles2)
(append (if (listp (car handles1)) handles1 (list handles1))
(if (listp (car handles2)) handles2 (list handles2))))
;; Copy of function from mm-decode.el
(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
;; HANDLE could be a CTL.
(if handle
(put-text-property 0 (length (car handle)) parameter value
(car handle))))
;; Copy of original macro is in mm-decode.el
(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."
(and (< (with-current-buffer (mm-handle-buffer handle)
(buffer-size)) 10000)
(mm-with-unibyte-buffer
(mm-insert-part handle)
(and (eq (mm-body-7-or-8) '7bit)
(not (mm-long-lines-p 76))))))
;; Copy of original function in mm-bodies.el
(mh-defun-compat mm-long-lines-p (length)
"Say whether any of the lines in the buffer is longer than LINES."
(save-excursion
(goto-char (point-min))
(end-of-line)
(while (and (not (eobp))
(not (> (current-column) length)))
(forward-line 1)
(end-of-line))
(and (> (current-column) length)
(current-column))))
(mh-defun-compat mm-keep-viewer-alive-p (handle)
;; Released Gnus doesn't keep handles associated with externally displayed
;; MIME parts. So this will always return nil.
nil)
(mh-defun-compat mm-destroy-parts (list)
"Older emacs don't have this function."
nil)
;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
;;; buggy (the args to read-file-name are incorrect). When all supported
;;; versions of Emacs come with at least Gnus 5.10, we can delete this
;;; function and rename calls to mh-mm-save-part to mm-save-part.
(defun mh-mm-save-part (handle)
"Write HANDLE to a file."
(let ((name (mail-content-type-get (mm-handle-type handle) 'name))
(filename (mail-content-type-get
(mm-handle-disposition handle) 'filename))
file)
(when filename
(setq filename (file-name-nondirectory filename)))
(setq file (read-file-name "Save MIME part to: "
(or mm-default-directory
default-directory)
nil nil (or filename name "")))
(setq mm-default-directory (file-name-directory file))
(and (or (not (file-exists-p file))
(yes-or-no-p (format "File %s already exists; overwrite? "
file)))
(mm-save-part-to-file handle file))))
;;; MIME cleanup
;;;###mh-autoload
@ -668,28 +573,36 @@ undisplayer FUNCTION."
I have seen this only in spam, so maybe we shouldn't fix this ;-)"
(save-excursion
(goto-char (point-min))
(when (and (message-fetch-field "content-type")
(not (message-fetch-field "mime-version")))
(when (search-forward "\n\n" nil t)
(forward-line -1)
(re-search-forward "\n\n" nil t)
(save-restriction
(narrow-to-region (point-min) (point))
(when (and (message-fetch-field "content-type")
(not (message-fetch-field "mime-version")))
(goto-char (point-min))
(insert "MIME-Version: 1.0\n")))))
(defun mh-small-show-buffer-p ()
"Check if show buffer is small.
This is used to decide if smileys and graphical emphasis will be displayed."
(let ((max nil))
(when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size)
(cond ((numberp font-lock-maximum-size)
(setq max font-lock-maximum-size))
((listp font-lock-maximum-size)
(setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size)
(assoc t font-lock-maximum-size)))))))
(or (not (numberp max)) (>= (/ max 8) (buffer-size)))))
;;;###mh-autoload
(defun mh-display-smileys ()
"Function to display smileys."
(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))))
(when (and mh-graphical-smileys-flag (mh-small-show-buffer-p))
(mh-funcall-if-exists smiley-region (point-min) (point-max))))
;;;###mh-autoload
(defun mh-display-emphasis ()
"Function to display graphical emphasis."
(when (and mh-graphical-emphasis-flag
(if font-lock-maximum-size
(>= (/ font-lock-maximum-size 8) (buffer-size))))
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
(flet ((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
@ -799,10 +712,15 @@ actual storing."
(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")))
(let (ct charset cte)
(goto-char (point-min))
(re-search-forward "\n\n" nil t)
(save-restriction
(narrow-to-region (point-min) (point))
(setq 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
@ -881,16 +799,31 @@ displayed."
(defun mh-mime-display-alternative (handles)
"Choose among the alternatives, HANDLES the part that will be displayed.
If no part is preferred then all the parts are displayed."
(let ((preferred (mm-preferred-alternative handles)))
(let* ((preferred (mm-preferred-alternative handles))
(others (loop for x in handles unless (eq x preferred) collect x)))
(cond ((and preferred (stringp (car preferred)))
(mh-mime-display-part preferred))
(mh-mime-display-part preferred)
(mh-mime-maybe-display-alternatives others))
(preferred
(save-restriction
(narrow-to-region (point) (if (eobp) (point) (1+ (point))))
(mh-mime-display-single preferred)
(mh-mime-maybe-display-alternatives others)
(goto-char (point-max))))
(t (mh-mime-display-mixed handles)))))
(defun mh-mime-maybe-display-alternatives (alternatives)
"Show buttons for ALTERNATIVES.
If `mh-mime-display-alternatives-flag' is non-nil then display buttons for
alternative parts that are usually suppressed."
(when (and mh-display-buttons-for-alternatives-flag alternatives)
(insert "\n----------------------------------------------------\n")
(insert "Alternatives:\n")
(dolist (x alternatives)
(insert "\n")
(mh-insert-mime-button x (mh-mime-part-index x) nil))
(insert "\n----------------------------------------------------\n")))
(defun mh-mime-display-mixed (handles)
"Display the list of MIME parts, HANDLES recursively."
(mapcar #'mh-mime-display-part handles))
@ -904,12 +837,6 @@ opened)."
(setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
(incf (mh-mime-parts-count (mh-buffer-data))))))
;;; Avoid compiler warnings for XEmacs functions...
(eval-when (compile)
(loop for function in '(glyph-width window-pixel-width
glyph-height window-pixel-height)
do (or (fboundp function) (defalias function 'ignore))))
(defun mh-small-image-p (handle)
"Decide whether HANDLE is a \"small\" image that can be displayed inline.
This is only useful if a Content-Disposition header is not present."
@ -922,27 +849,20 @@ This is only useful if a Content-Disposition header is not present."
; this only tells us if the image is
; something that emacs can display
(let* ((image (mm-get-image handle)))
(cond ((fboundp 'glyph-width)
;; XEmacs -- totally untested, copied from gnus
(and (mh-funcall-if-exists glyphp image)
(< (glyph-width image)
(or mh-max-inline-image-width
(window-pixel-width)))
(< (glyph-height image)
(or mh-max-inline-image-height
(window-pixel-height)))))
((fboundp 'image-size)
;; Emacs21 -- copied from gnus
(let ((size (mh-funcall-if-exists image-size image)))
(and size
(< (cdr size)
(or mh-max-inline-image-height
(1- (window-height))))
(< (car size)
(or mh-max-inline-image-width (window-width))))))
(t
;; Can't show image inline
nil))))))
(or (mh-do-in-xemacs
(and (mh-funcall-if-exists glyphp image)
(< (glyph-width image)
(or mh-max-inline-image-width (window-pixel-width)))
(< (glyph-height image)
(or mh-max-inline-image-height
(window-pixel-height)))))
(mh-do-in-gnu-emacs
(let ((size (mh-funcall-if-exists image-size image)))
(and size
(< (cdr size) (or mh-max-inline-image-height
(1- (window-height))))
(< (car size) (or mh-max-inline-image-width
(window-width)))))))))))
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
@ -1062,7 +982,7 @@ 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 (and region (fboundp 'remove-images))
(when region
(mh-funcall-if-exists
remove-images (car region) (cdr region)))
(mm-display-part handle)
@ -1130,33 +1050,14 @@ 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")
(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-do-at-event-location event
(let ((folder mh-show-folder-buffer)
(mm-inline-media-tests mh-mm-inline-media-tests)
(data (get-text-property (point) 'mh-data))
(function (get-text-property (point) 'mh-callback)))
(flet ((mm-handle-set-external-undisplayer (handle func)
(mh-handle-set-external-undisplayer folder handle func)))
(and function (funcall function data))))))
;;;###mh-autoload
(defun mh-mime-save-part ()
@ -1164,7 +1065,9 @@ button."
(interactive)
(let ((data (get-text-property (point) 'mh-data)))
(when data
(let ((mm-default-directory mh-mime-save-parts-directory))
(let ((mm-default-directory
(file-name-as-directory (or mh-mime-save-parts-directory
default-directory))))
(mh-mm-save-part data)
(setq mh-mime-save-parts-directory mm-default-directory)))))

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

@ -1,6 +1,6 @@
;;; mh-seq.el --- MH-E sequences support
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -70,7 +70,8 @@
;;; Code:
(require 'cl)
(require 'mh-utils)
(mh-require-cl)
(require 'mh-e)
;; Shush the byte-compiler
@ -110,7 +111,7 @@
"Table to look up message identifier from message index.")
(defvar mh-thread-scan-line-map nil
"Map of message index to various parts of the scan line.")
(defvar mh-thread-old-scan-line-map nil
(defvar mh-thread-scan-line-map-stack nil
"Old map of message index to various parts of the scan line.
This is the original map that is stored when the folder is narrowed.")
(defvar mh-thread-subject-container-hash nil
@ -131,7 +132,7 @@ redone to get the new thread tree. This makes incremental threading easier.")
(make-variable-buffer-local 'mh-thread-id-index-map)
(make-variable-buffer-local 'mh-thread-index-id-map)
(make-variable-buffer-local 'mh-thread-scan-line-map)
(make-variable-buffer-local 'mh-thread-old-scan-line-map)
(make-variable-buffer-local 'mh-thread-scan-line-map-stack)
(make-variable-buffer-local 'mh-thread-subject-container-hash)
(make-variable-buffer-local 'mh-thread-duplicates)
(make-variable-buffer-local 'mh-thread-history)
@ -140,14 +141,19 @@ redone to get the new thread tree. This makes incremental threading easier.")
(defun mh-delete-seq (sequence)
"Delete the SEQUENCE."
(interactive (list (mh-read-seq-default "Delete" t)))
(let ((msg-list (mh-seq-to-msgs sequence)))
(let ((msg-list (mh-seq-to-msgs sequence))
(internal-flag (mh-internal-seq sequence))
(folders-changed (list mh-current-folder)))
(mh-iterate-on-range msg sequence
(mh-remove-sequence-notation msg internal-flag))
(mh-undefine-sequence sequence '("all"))
(mh-delete-seq-locally sequence)
(mh-iterate-on-messages-in-region msg (point-min) (point-max)
(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)))))))
(when mh-index-data
(setq folders-changed
(append folders-changed
(mh-index-delete-from-sequence sequence msg-list))))
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(apply #'mh-speed-flists t folders-changed))))
;; Avoid compiler warnings
(defvar view-exit-action)
@ -221,16 +227,15 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(interactive (list (mh-read-seq "Narrow to" t)))
(with-mh-folder-updating (t)
(cond ((mh-seq-to-msgs sequence)
(mh-widen)
(mh-remove-all-notation)
(let ((eob (point-max))
(msg-at-cursor (mh-get-msg-num nil)))
(setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
(push mh-thread-scan-line-map mh-thread-scan-line-map-stack)
(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)
(push (buffer-substring-no-properties (point-min) eob)
mh-folder-view-stack)
(delete-region (point-min) eob)
(mh-notate-deleted-and-refiled)
(mh-notate-cur)
(when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
@ -252,29 +257,31 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
(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 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")
(defun mh-put-msg-in-seq (range sequence)
"Add RANGE to SEQUENCE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Add messages from")
(mh-read-seq-default "Add to" nil)))
(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))
(unless (mh-valid-seq-p sequence)
(error "Can't put message in invalid sequence `%s'" sequence))
(let* ((internal-seq-flag (mh-internal-seq sequence))
(note-seq (if internal-seq-flag nil mh-note-seq))
(original-msgs (mh-seq-msgs (mh-find-seq sequence)))
(folders (list mh-current-folder))
(msg-list ()))
(mh-iterate-on-msg-or-seq m msg-or-seq
(mh-iterate-on-range m range
(push m msg-list)
(mh-notate nil note-seq (1+ mh-cmd-note)))
(unless (memq m original-msgs)
(mh-add-sequence-notation m internal-seq-flag)))
(mh-add-msgs-to-seq msg-list sequence nil t)
(if (not internal-seq-flag)
(setq mh-last-seq-used sequence))
(when mh-index-data
(setq folders
(append folders (mh-index-add-to-sequence sequence msg-list))))
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
(mh-speed-flists t mh-current-folder))))
(apply #'mh-speed-flists t folders))))
(defun mh-valid-view-change-operation-p (op)
"Check if the view change operation can be performed.
@ -284,33 +291,46 @@ OP is one of 'widen and 'unthread."
(t nil)))
;;;###mh-autoload
(defun mh-widen ()
"Remove restrictions from current folder, thereby showing all messages."
(interactive)
(defun mh-widen (&optional all-flag)
"Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained."
(interactive "P")
(let ((msg (mh-get-msg-num nil)))
(when mh-narrowed-to-seq
(cond ((mh-valid-view-change-operation-p 'widen) nil)
(when mh-folder-view-stack
(cond (all-flag
(while (cdr mh-view-ops)
(setq mh-view-ops (cdr mh-view-ops)))
(when (eq (car mh-view-ops) 'widen)
(setq mh-view-ops (cdr mh-view-ops))))
((mh-valid-view-change-operation-p 'widen) nil)
((memq 'widen mh-view-ops)
(while (not (eq (car mh-view-ops) 'widen))
(setq mh-view-ops (cdr mh-view-ops)))
(pop mh-view-ops))
(setq mh-view-ops (cdr mh-view-ops)))
(t (error "Widening is not applicable")))
(when (memq 'unthread mh-view-ops)
(setq mh-thread-scan-line-map mh-thread-old-scan-line-map))
;; If ALL-FLAG is non-nil then rewind stacks
(when all-flag
(while (cdr mh-thread-scan-line-map-stack)
(setq mh-thread-scan-line-map-stack
(cdr mh-thread-scan-line-map-stack)))
(while (cdr mh-folder-view-stack)
(setq mh-folder-view-stack (cdr mh-folder-view-stack))))
(setq mh-thread-scan-line-map (pop mh-thread-scan-line-map-stack))
(with-mh-folder-updating (t)
(delete-region (point-min) (point-max))
(widen)
(insert (pop mh-folder-view-stack))
(mh-remove-all-notation)
(setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
(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)))
(when (and (boundp 'tool-bar-mode) tool-bar-mode)
(when (and (null mh-folder-view-stack) (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
@ -319,6 +339,7 @@ OP is one of 'widen and 'unthread."
;; FIXME? We may want to clear all notations and add one for current-message
;; and process user sequences.
;;;###mh-autoload
(defun mh-notate-deleted-and-refiled ()
"Notate messages marked for deletion or refiling.
Messages to be deleted are given by `mh-delete-list' while messages to be
@ -342,13 +363,15 @@ refiled are present in `mh-refile-list'."
;;; of the form:
;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
(defvar mh-sequence-history ())
;;;###mh-autoload
(defun mh-read-seq-default (prompt not-empty)
"Read and return sequence name with default narrowed or previous sequence.
PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
non-empty sequence is read."
(mh-read-seq prompt not-empty
(or mh-narrowed-to-seq
mh-last-seq-used
(or mh-last-seq-used
(car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
(defun mh-read-seq (prompt not-empty &optional default)
@ -360,7 +383,8 @@ defaults to the first sequence containing the current message."
(if default
(format "[%s] " default)
""))
(mh-seq-names mh-seq-list)))
(mh-seq-names mh-seq-list)
nil nil nil 'mh-sequence-history))
(seq (cond ((equal input "%")
(car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
((equal input "") default)
@ -370,6 +394,126 @@ defaults to the first sequence containing the current message."
(error "No messages in sequence `%s'" seq))
seq))
;;; Functions to read ranges with completion...
(defvar mh-range-seq-names)
(defvar mh-range-history ())
(defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map))
(define-key mh-range-completion-map " " 'self-insert-command)
(defun mh-range-completion-function (string predicate flag)
"Programmable completion of message ranges.
STRING is the user input that is to be completed. PREDICATE if non-nil is a
function used to filter the possible choices and FLAG determines whether the
completion is over."
(let* ((candidates mh-range-seq-names)
(last-char (and (not (equal string ""))
(aref string (1- (length string)))))
(last-word (cond ((null last-char) "")
((memq last-char '(? ?- ?:)) "")
(t (car (last (split-string string "[ -:]+"))))))
(prefix (substring string 0 (- (length string) (length last-word)))))
(cond ((eq flag nil)
(let ((res (try-completion last-word candidates predicate)))
(cond ((null res) nil)
((eq res t) t)
(t (concat prefix res)))))
((eq flag t)
(all-completions last-word candidates predicate))
((eq flag 'lambda)
(loop for x in candidates
when (equal x last-word) return t
finally return nil)))))
;;;###mh-autoload
(defun mh-read-range (prompt &optional folder default
expand-flag ask-flag number-as-range-flag)
"Read a message range with PROMPT.
If FOLDER is non-nil then a range is read from that folder, otherwise use
`mh-current-folder'.
If DEFAULT is a string then use that as default range to return. If DEFAULT is
nil then ask user with default answer a range based on the sequences that seem
relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen
messages, if present, are returned. If the folder has fewer than
`mh-large-folder' messages then \"all\" messages are returned. Finally as a
last resort prompt the user.
If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the
input is returned. If this list is empty then an error is raised. If
EXPAND-FLAG is nil just return the input string. In this case we don't check
if the range is empty.
If ASK-FLAG is non-nil, then the user is always queried for a range of
messages. If ASK-FLAG is nil, then the function checks if the unseen sequence
is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in
it depending on the value of EXPAND, is returned. Otherwise if the folder has
fewer than `mh-large-folder' messages then the list of messages corresponding
to \"all\" is returned. If neither of the above holds then as a last resort
the user is queried for a range of messages.
If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it
is interpreted as the range \"last:N\".
This function replaces the existing function `mh-read-msg-range'. Calls to:
(mh-read-msg-range folder flag)
should be replaced with:
(mh-read-range \"Suitable prompt\" folder t nil flag
mh-interpret-number-as-range-flag)"
(setq default (or default mh-last-seq-used
(car (mh-seq-containing-msg (mh-get-msg-num nil) t)))
prompt (format "%s range" prompt))
(let* ((folder (or folder mh-current-folder))
(default (cond ((or (eq default t) (stringp default)) default)
((symbolp default) (symbol-name default))))
(guess (eq default t))
(counts (and guess (mh-folder-size folder)))
(unseen (and counts (> (cadr counts) 0)))
(large (and counts mh-large-folder (> (car counts) mh-large-folder)))
(str (cond ((and guess large
(setq default (format "last:%s" mh-large-folder)
prompt (format "%s (folder has %s messages)"
prompt (car counts)))
nil))
((and guess (not large) (setq default "all") nil))
((eq default nil) "")
(t (format "[%s] " default))))
(minibuffer-local-completion-map mh-range-completion-map)
(seq-list (if (eq folder mh-current-folder)
mh-seq-list
(mh-read-folder-sequences folder nil)))
(mh-range-seq-names
(append '(("first") ("last") ("all") ("prev") ("next"))
(mh-seq-names seq-list)))
(input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq))
((and (not ask-flag) (not large)) "all")
(t (completing-read (format "%s: %s" prompt str)
'mh-range-completion-function nil nil
nil 'mh-range-history default))))
msg-list)
(when (and number-as-range-flag
(string-match "^[ \t]*\\([0-9]+\\)[ \t]*$" input))
(setq input (concat "last:" (match-string 1 input))))
(cond ((not expand-flag) input)
((assoc (intern input) seq-list)
(cdr (assoc (intern input) seq-list)))
((setq msg-list (mh-translate-range folder input)) msg-list)
(t (error "No messages in range `%s'" input)))))
;;;###mh-autoload
(defun mh-translate-range (folder expr)
"In FOLDER, translate the string EXPR to a list of messages numbers."
(save-excursion
(let ((strings (delete "" (split-string expr "[ \t\n]")))
(result ()))
(ignore-errors
(apply #'mh-exec-cmd-quiet nil "mhpath" folder strings)
(set-buffer mh-temp-buffer)
(goto-char (point-min))
(while (re-search-forward "/\\([0-9]*\\)$" nil t)
(push (car (read-from-string (match-string 1))) result))
(nreverse result)))))
(defun mh-seq-names (seq-list)
"Return an alist containing the names of the SEQ-LIST."
(mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
@ -427,7 +571,7 @@ uses `overlay-arrow-position' to put a marker in the fringe."
(defun mh-add-to-sequence (seq msgs)
"The sequence SEQ is augmented with the messages in MSGS."
;; Add to a SEQUENCE each message the list of MSGS.
(if (not (mh-folder-name-p seq))
(if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
(if msgs
(apply 'mh-exec-cmd "mark" mh-current-folder "-add"
"-sequence" (symbol-name seq)
@ -458,17 +602,15 @@ uses `overlay-arrow-position' to put a marker in the fringe."
(mh-regenerate-headers coalesced-msgs t)
(cond ((memq 'unthread mh-view-ops)
;; Populate restricted scan-line map
(goto-char (point-min))
(while (not (eobp))
(let ((msg (mh-get-msg-num nil)))
(when (numberp msg)
(setf (gethash msg mh-thread-scan-line-map)
(mh-thread-parse-scan-line))))
(forward-line))
(mh-remove-all-notation)
(mh-iterate-on-range msg (cons (point-min) (point-max))
(setf (gethash msg mh-thread-scan-line-map)
(mh-thread-parse-scan-line)))
;; Remove scan lines and read results from pre-computed tree
(delete-region (point-min) (point-max))
(mh-thread-print-scan-lines
(mh-thread-generate mh-current-folder ())))
(mh-thread-generate mh-current-folder ()))
(mh-notate-user-sequences))
(mh-index-data
(mh-index-insert-folder-headers)))))))
@ -509,32 +651,36 @@ If VAR is nil then the loop is executed without any binding."
(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)
(defmacro mh-iterate-on-range (var range &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.
VAR is bound to each message in turn in a loop over RANGE, which can be a
message number, a list of message numbers, a sequence, a region in a cons
cell, or a MH range (something like last:20) in a string. In each iteration,
BODY is executed.
The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq'
The parameter RANGE is usually created with `mh-interactive-range'
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)) ())
`(cond ((numberp ,range)
(when (mh-goto-msg ,range t t)
(let ,(if binding-needed-flag `((,var ,range)) ())
,@body)))
((and (consp ,msg-or-seq)
(numberp (car ,msg-or-seq)) (numberp (cdr ,msg-or-seq)))
((and (consp ,range)
(numberp (car ,range)) (numberp (cdr ,range)))
(mh-iterate-on-messages-in-region ,var
(car ,msg-or-seq) (cdr ,msg-or-seq)
(car ,range) (cdr ,range)
,@body))
(t (let ((,msgs (if (and ,msg-or-seq (symbolp ,msg-or-seq))
(mh-seq-to-msgs ,msg-or-seq)
,msg-or-seq))
(t (let ((,msgs (cond ((and ,range (symbolp ,range))
(mh-seq-to-msgs ,range))
((stringp ,range)
(mh-translate-range mh-current-folder
,range))
(t ,range)))
(,seq-hash-table (make-hash-table)))
(dolist (msg ,msgs)
(setf (gethash msg ,seq-hash-table) t))
@ -543,38 +689,39 @@ in order to provide a uniform interface to MH-E functions."
(let ,(if binding-needed-flag `((,var v)) ())
,@body))))))))
(put 'mh-iterate-on-msg-or-seq 'lisp-indent-hook 'defun)
(put 'mh-iterate-on-range '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
(defun mh-range-to-msg-list (range)
"Return a list of messages for RANGE.
RANGE 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
(mh-iterate-on-range msg range
(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.
(defun mh-interactive-range (range-prompt)
"Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.
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.
If optional prefix argument is provided, then prompt for message range with
RANGE-PROMPT. A list of messages in that range is returned.
If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.
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))))
This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions."
(cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
(current-prefix-arg (mh-read-range range-prompt nil nil t t))
(t (mh-get-msg-num t))))
;;;###mh-autoload
(defun mh-region-to-msg-list (begin end)
@ -591,11 +738,28 @@ provide a uniform interface to MH-E functions."
;;; Commands to handle new 'subject sequence.
;;; Or "Poor man's threading" by psg.
;;; XXX: The function mh-subject-to-sequence-unthreaded uses the magic number
;;; 41 for the max size of the subject part. Avoiding this would be desirable.
(defun mh-subject-to-sequence (all)
"Put all following messages with same subject in sequence 'subject.
If arg ALL is t, move to beginning of folder buffer to collect all messages.
If arg ALL is nil, collect only messages fron current one on forward.
Return number of messages put in the sequence:
nil -> there was no subject line.
0 -> there were no later messages with the same subject (sequence not made)
>1 -> the total number of messages including current one."
(if (memq 'unthread mh-view-ops)
(mh-subject-to-sequence-threaded all)
(mh-subject-to-sequence-unthreaded all)))
(defun mh-subject-to-sequence-unthreaded (all)
"Put all following messages with same subject in sequence 'subject.
This function only works with an unthreaded folder. If arg ALL is t, move to
beginning of folder buffer to collect all messages. If arg ALL is nil, collect
only messages fron current one on forward.
Return number of messages put in the sequence:
nil -> there was no subject line.
@ -628,8 +792,7 @@ Return number of messages put in the sequence:
;; If we created a new sequence, add the initial message to it too.
(if (not (member (mh-get-msg-num t) list))
(setq list (cons (mh-get-msg-num t) list)))
(if (member '("subject") (mh-seq-names mh-seq-list))
(mh-delete-seq 'subject))
(if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
;; sort the result into a sequence
(let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
(while sorted-list
@ -639,6 +802,39 @@ Return number of messages put in the sequence:
(t
0))))))
(defun mh-subject-to-sequence-threaded (all)
"Put all messages with the same subject in the 'subject sequence.
This function works when the folder is threaded. In this situation the subject
could get truncated and so the normal matching doesn't work.
The parameter ALL is non-nil then all the messages in the buffer are
considered, otherwise only the messages after the current one are taken into
account."
(let* ((cur (mh-get-msg-num nil))
(subject (mh-thread-find-msg-subject cur))
region msgs)
(if (null subject)
(and (message "No subject line") nil)
(setq region (cons (if all (point-min) (point)) (point-max)))
(mh-iterate-on-range msg region
(when (eq (mh-thread-find-msg-subject msg) subject)
(push msg msgs)))
(setq msgs (sort msgs #'mh-lessp))
(if (null msgs)
0
(when (assoc 'subject mh-seq-list)
(mh-delete-seq 'subject))
(mh-add-msgs-to-seq msgs 'subject)
(length msgs)))))
(defun mh-thread-find-msg-subject (msg)
"Find canonicalized subject of MSG.
This function can only be used the folder is threaded."
(ignore-errors
(mh-message-subject
(mh-container-message (gethash (gethash msg mh-thread-index-id-map)
mh-thread-id-table)))))
;;;###mh-autoload
(defun mh-narrow-to-subject ()
"Narrow to a sequence containing all following messages with same subject."
@ -657,6 +853,99 @@ Return number of messages put in the sequence:
(if (numberp num)
(mh-goto-msg num t t))))))
(defun mh-read-pick-regexp (default)
"With prefix arg read a pick regexp.
If no prefix arg is given, then return DEFAULT."
(let ((default-string (loop for x in default concat (format " %s" x))))
(if (or current-prefix-arg (equal default-string ""))
(delete "" (split-string (read-string "Pick regexp: " default-string)))
default)))
;;;###mh-autoload
(defun mh-narrow-to-from (&optional regexp)
"Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
(mh-narrow-to-header-field 'from regexp))
;;;###mh-autoload
(defun mh-narrow-to-cc (&optional regexp)
"Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
(mh-narrow-to-header-field 'cc regexp))
;;;###mh-autoload
(defun mh-narrow-to-to (&optional regexp)
"Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
(interactive
(list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
(mh-narrow-to-header-field 'to regexp))
(defun mh-narrow-to-header-field (header-field regexp)
"Limit to messages whose HEADER-FIELD match REGEXP.
The MH command pick is used to do the match."
(let ((folder mh-current-folder)
(original (mh-coalesce-msg-list
(mh-range-to-msg-list (cons (point-min) (point-max)))))
(msg-list ()))
(with-temp-buffer
(apply #'mh-exec-cmd-output "pick" nil folder
(append original (list "-list") regexp))
(goto-char (point-min))
(while (not (eobp))
(let ((num (read-from-string
(buffer-substring (point) (line-end-position)))))
(when (numberp (car num)) (push (car num) msg-list))
(forward-line))))
(if (null msg-list)
(message "No matches")
(when (assoc 'header mh-seq-list) (mh-delete-seq 'header))
(mh-add-msgs-to-seq msg-list 'header)
(mh-narrow-to-seq 'header))))
(defun mh-current-message-header-field (header-field)
"Return a pick regexp to match HEADER-FIELD of the message at point."
(let ((num (mh-get-msg-num nil)))
(when num
(let ((folder mh-current-folder))
(with-temp-buffer
(insert-file-contents-literally (mh-msg-filename num folder))
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(narrow-to-region (point-min) (point)))
(let* ((field (or (message-fetch-field (format "%s" header-field))
""))
(field-option (format "-%s" header-field))
(patterns (loop for x in (split-string field "[ ]*,[ ]*")
unless (equal x "")
collect (if (string-match "<\\(.*@.*\\)>" x)
(match-string 1 x)
x))))
(when patterns
(loop with accum = `(,field-option ,(car patterns))
for e in (cdr patterns)
do (setq accum `(,field-option ,e "-or" ,@accum))
finally return accum))))))))
;;;###mh-autoload
(defun mh-narrow-to-range (range)
"Limit to messages in RANGE.
Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
(interactive (list (mh-interactive-range "Narrow to")))
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
(mh-narrow-to-seq 'range))
;;;###mh-autoload
(defun mh-delete-subject ()
"Mark all following messages with same subject to be deleted.
@ -689,28 +978,23 @@ subject for deletion."
;;; Message threading:
(defmacro mh-thread-initialize-hash (var test)
"Initialize the hash table in VAR.
TEST is the test to use when creating a new hash table."
(unless (symbolp var) (error "Expected a symbol: %s" var))
`(if ,var (clrhash ,var) (setq ,var (make-hash-table :test ,test))))
(defun mh-thread-initialize ()
"Make hash tables, otherwise clear them."
(cond
(mh-thread-id-hash
(clrhash mh-thread-id-hash)
(clrhash mh-thread-subject-hash)
(clrhash mh-thread-id-table)
(clrhash mh-thread-id-index-map)
(clrhash mh-thread-index-id-map)
(clrhash mh-thread-scan-line-map)
(clrhash mh-thread-subject-container-hash)
(clrhash mh-thread-duplicates)
(setq mh-thread-history ()))
(t (setq mh-thread-id-hash (make-hash-table :test #'equal))
(setq mh-thread-subject-hash (make-hash-table :test #'equal))
(setq mh-thread-id-table (make-hash-table :test #'eq))
(setq mh-thread-id-index-map (make-hash-table :test #'eq))
(setq mh-thread-index-id-map (make-hash-table :test #'eql))
(setq mh-thread-scan-line-map (make-hash-table :test #'eql))
(setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
(setq mh-thread-duplicates (make-hash-table :test #'eq))
(setq mh-thread-history ()))))
"Make new hash tables, or clear them if already present."
(mh-thread-initialize-hash mh-thread-id-hash #'equal)
(mh-thread-initialize-hash mh-thread-subject-hash #'equal)
(mh-thread-initialize-hash mh-thread-id-table #'eq)
(mh-thread-initialize-hash mh-thread-id-index-map #'eq)
(mh-thread-initialize-hash mh-thread-index-id-map #'eql)
(mh-thread-initialize-hash mh-thread-scan-line-map #'eql)
(mh-thread-initialize-hash mh-thread-subject-container-hash #'eq)
(mh-thread-initialize-hash mh-thread-duplicates #'eq)
(setq mh-thread-history ()))
(defsubst mh-thread-id-container (id)
"Given ID, return the corresponding container in `mh-thread-id-table'.
@ -959,7 +1243,7 @@ preference to something that has it."
(push root results)))))
(nreverse results)))
(defsubst mh-thread-process-in-reply-to (reply-to-header)
(defun mh-thread-process-in-reply-to (reply-to-header)
"Extract message id's from REPLY-TO-HEADER.
Ideally this should have some regexp which will try to guess if a string
between < and > is a message id and not an email address. For now it will
@ -1071,6 +1355,7 @@ Only information about messages in MSG-LIST are added to the tree."
"Update thread tree for FOLDER.
All messages after START-POINT are added to the thread tree."
(mh-thread-rewind-pruning)
(mh-remove-all-notation)
(goto-char start-point)
(let ((msg-list ()))
(while (not (eobp))
@ -1085,7 +1370,6 @@ All messages after START-POINT are added to the thread tree."
(old-buffer-modified-flag (buffer-modified-p)))
(delete-region (point-min) (point-max))
(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))))
@ -1150,17 +1434,29 @@ Otherwise uses the line at point as the scan line to parse."
(let* ((string (or string
(buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
(first-string (substring string 0 (+ mh-cmd-note 8))))
(setf (elt first-string mh-cmd-note) ? )
(when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0))
(setf (elt first-string (1+ mh-cmd-note)) ? ))
(address-start (+ mh-cmd-note mh-scan-field-from-start-offset))
(body-start (+ mh-cmd-note mh-scan-field-from-end-offset))
(first-string (substring string 0 address-start)))
(list first-string
(substring string
(+ mh-cmd-note mh-scan-field-from-start-offset)
(+ mh-cmd-note mh-scan-field-from-end-offset -2))
(substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
(substring string address-start (- body-start 2))
(substring string body-start)
string)))
;;;###mh-autoload
(defun mh-thread-update-scan-line-map (msg notation offset)
"In threaded view update `mh-thread-scan-line-map'.
MSG is the message being notated with NOTATION at OFFSET."
(let* ((msg (or msg (mh-get-msg-num nil)))
(cur-scan-line (and mh-thread-scan-line-map
(gethash msg mh-thread-scan-line-map)))
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack
collect (and map (gethash msg map))))
(notation (if (stringp notation) (aref notation 0) notation)))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
(when line (setf (aref (car line) offset) notation)))))
;;;###mh-autoload
(defun mh-thread-add-spaces (count)
"Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
@ -1197,14 +1493,11 @@ Otherwise uses the line at point as the scan line to parse."
(message "Threading %s..." (buffer-name))
(mh-thread-initialize)
(goto-char (point-min))
(mh-remove-all-notation)
(let ((msg-list ()))
(while (not (eobp))
(let ((index (mh-get-msg-num nil)))
(when (numberp index)
(push index msg-list)
(setf (gethash index mh-thread-scan-line-map)
(mh-thread-parse-scan-line))))
(forward-line))
(mh-iterate-on-range msg (cons (point-min) (point-max))
(setf (gethash msg mh-thread-scan-line-map) (mh-thread-parse-scan-line))
(push msg msg-list))
(let* ((range (mh-coalesce-msg-list msg-list))
(thread-tree (mh-thread-generate (buffer-name) range)))
(delete-region (point-min) (point-max))
@ -1403,68 +1696,31 @@ start of the region and the second is the point at the end."
;; 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)))))
(defun mh-toggle-tick (range)
"Toggle tick mark of all messages in RANGE."
(interactive (list (mh-interactive-range "Tick")))
(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
(tick-seq-msgs (mh-seq-msgs tick-seq))
(ticked ())
(unticked ()))
(mh-iterate-on-range msg range
(cond ((member msg tick-seq-msgs)
(mh-undefine-sequence mh-tick-seq (list msg))
(push msg unticked)
(setcdr tick-seq (delq msg (cdr tick-seq)))
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
(mh-tick-remove-overlay))
(mh-remove-sequence-notation msg t))
(t
(mh-add-msgs-to-seq (list msg) mh-tick-seq nil t)
(push msg ticked)
(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-add-sequence-notation msg t))))
(mh-add-msgs-to-seq ticked mh-tick-seq nil t)
(mh-undefine-sequence mh-tick-seq unticked)
(when mh-index-data
(mh-index-add-to-sequence mh-tick-seq ticked)
(mh-index-delete-from-sequence mh-tick-seq unticked))))
;;;###mh-autoload
(defun mh-narrow-to-tick ()

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

@ -1,6 +1,6 @@
;;; mh-speed.el --- Speedbar interface for MH-E.
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -34,7 +34,8 @@
;;; Code:
;; Requires
(require 'cl)
(require 'mh-utils)
(mh-require-cl)
(require 'mh-e)
(require 'speedbar)
@ -340,7 +341,9 @@ Optional ARGS are ignored."
(interactive)
(declare (ignore args))
(let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
(range (and (stringp folder) (mh-read-msg-range folder))))
(range (and (stringp folder)
(mh-read-range "Scan" folder t nil nil
mh-interpret-number-as-range-flag))))
(when (stringp folder)
(speedbar-with-attached-buffer
(mh-visit-folder folder range)
@ -350,9 +353,11 @@ Optional ARGS are ignored."
(defvar mh-speed-flists-folder nil)
;;;###mh-autoload
(defun mh-speed-flists (force &optional folder)
(defun mh-speed-flists (force &rest folders)
"Execute flists -recurse and update message counts.
If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run
If FORCE is non-nil the timer is reset.
Any number of optional FOLDERS can be specified. If specified, flists is run
only for that one folder."
(interactive (list t))
(when force
@ -365,7 +370,7 @@ only for that one folder."
(kill-process mh-speed-flists-process)
(setq mh-speed-partial-line "")
(setq mh-speed-flists-process nil)))
(setq mh-speed-flists-folder folder)
(setq mh-speed-flists-folder folders)
(unless mh-speed-flists-timer
(setq mh-speed-flists-timer
(run-at-time
@ -376,17 +381,19 @@ only for that one folder."
'exit)))
(setq mh-speed-current-folder
(concat
(with-temp-buffer
(call-process (expand-file-name "folder" mh-progs)
nil '(t nil) nil "-fast")
(buffer-substring (point-min) (1- (point-max))))
(if mh-speed-flists-folder
(substring (car (reverse mh-speed-flists-folder)) 1)
(with-temp-buffer
(call-process (expand-file-name "folder" mh-progs)
nil '(t nil) nil "-fast")
(buffer-substring (point-min) (1- (point-max)))))
"+"))
(setq mh-speed-flists-process
(start-process "*flists*" nil
(expand-file-name "flists" mh-progs)
(or mh-speed-flists-folder "-recurse")
(if mh-speed-flists-folder "-noall" "-all")
"-sequence" (symbol-name mh-unseen-seq)))
(apply #'start-process "*flists*" nil
(expand-file-name "flists" mh-progs)
(if mh-speed-flists-folder "-noall" "-all")
"-sequence" (symbol-name mh-unseen-seq)
(or mh-speed-flists-folder '("-recurse"))))
;; Run flists on all folders the next time around...
(setq mh-speed-flists-folder nil)
(set-process-filter mh-speed-flists-process

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

@ -1,7 +1,7 @@
;;; mh-utils.el --- MH-E code needed for both sending and reading
;; Copyright (C) 1993, 95, 1997,
;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@ -37,14 +37,28 @@
(defvar mh-xemacs-flag (featurep 'xemacs)
"Non-nil means the current Emacs is XEmacs.")
(require 'cl)
;; The Emacs coding conventions require that the cl package not be required at
;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
;; routines in their macro expansions. Use mh-require-cl to provide the cl
;; routines in the best way possible.
(eval-when-compile (require 'cl))
(defmacro mh-require-cl ()
(if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
`(require 'cl)
`(eval-when-compile (require 'cl))))
(mh-require-cl)
(require 'gnus-util)
(require 'font-lock)
(require 'mouse)
(load "tool-bar" t t)
(require 'mh-loaddefs)
(require 'mh-customize)
(require 'mh-inc)
(load "mm-decode" t t) ; Non-fatal dependency
(load "mm-view" t t) ; Non-fatal dependency
(load "hl-line" t t) ; Non-fatal dependency
(load "executable" t t) ; Non-fatal dependency on
; executable-find
@ -52,7 +66,6 @@
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defvar mark-active)
(defvar tool-bar-mode)
;;; Autoloads
(autoload 'gnus-article-highlight-citation "gnus-cite")
@ -81,6 +94,9 @@ This directory contains, among other things, the mhl program.")
(defvar mh-nmh-flag nil
"Non-nil means nmh is installed on this system instead of MH.")
(defvar mh-flists-present-flag nil
"Non-nil means that we have `flists'.")
;;;###autoload
(put 'mh-progs 'risky-local-variable t)
;;;###autoload
@ -311,7 +327,7 @@ passed through `regexp-quote' before being used by functions like
;; Copy of `goto-address-mail-regexp'
(defvar mh-address-mail-regexp
"[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+"
"[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
"A regular expression probably matching an e-mail address.")
;; From goto-addr.el, which we don't want to force-load on users.
@ -435,6 +451,10 @@ Argument LIMIT limits search."
(4 font-lock-comment-face nil t)))))))
"Additional expressions to highlight in MH-show mode.")
(defvar mh-letter-font-lock-keywords
`(,@mh-show-font-lock-keywords-with-cite
(mh-font-lock-field-data (1 'mh-letter-header-field-face prepend t))))
(defun mh-show-font-lock-fontify-region (beg end loudly)
"Limit font-lock in `mh-show-mode' to the header.
Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
@ -632,6 +652,39 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
(defmacro mh-do-at-event-location (event &rest body)
"Switch to the location of EVENT and execute BODY.
After BODY has been executed return to original window. The modification flag
of the buffer in the event window is preserved."
(let ((event-window (make-symbol "event-window"))
(event-position (make-symbol "event-position"))
(original-window (make-symbol "original-window"))
(original-position (make-symbol "original-position"))
(modified-flag (make-symbol "modified-flag")))
`(save-excursion
(let* ((,event-window
(or (mh-funcall-if-exists posn-window (event-start ,event))
(mh-funcall-if-exists event-window ,event)))
(,event-position
(or (mh-funcall-if-exists posn-point (event-start ,event))
(mh-funcall-if-exists event-closest-point ,event)))
(,original-window (selected-window))
(,original-position (progn
(set-buffer (window-buffer ,event-window))
(set-marker (make-marker) (point))))
(,modified-flag (buffer-modified-p))
(buffer-read-only nil))
(unwind-protect (progn
(select-window ,event-window)
(goto-char ,event-position)
,@body)
(set-buffer-modified-p ,modified-flag)
(goto-char ,original-position)
(set-marker ,original-position nil)
(select-window ,original-window))))))
(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
(defmacro mh-make-seq (name msgs)
"Create sequence NAME with the given MSGS."
(list 'cons name msgs))
@ -761,6 +814,8 @@ still visible.\n")
(prog1 (call-interactively (function ,original-function))
(setq normal-exit t))
(mh-funcall-if-exists deactivate-mark)
(when (eq major-mode 'mh-folder-mode)
(mh-funcall-if-exists hl-line-highlight))
(cond ((not normal-exit)
(set-window-configuration config))
,(if dont-return
@ -823,8 +878,11 @@ still visible.\n")
(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
(mh-defun-show-buffer mh-show-widen mh-widen)
(mh-defun-show-buffer mh-show-narrow-to-subject
mh-narrow-to-subject)
(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
(mh-defun-show-buffer mh-show-page-digest-backwards
@ -854,6 +912,9 @@ still visible.\n")
(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)
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
(mh-defun-show-buffer mh-show-index-sequenced-messages
mh-index-sequenced-messages)
;;; Populate mh-show-mode-map
(gnus-define-keys mh-show-mode-map
@ -898,6 +959,7 @@ still visible.\n")
(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
"?" mh-prefix-help
"'" mh-index-ticked-messages
"S" mh-show-sort-folder
"f" mh-show-visit-folder
"i" mh-index-search
@ -905,6 +967,7 @@ still visible.\n")
"l" mh-show-list-folders
"n" mh-index-new-messages
"o" mh-show-visit-folder
"q" mh-show-index-sequenced-messages
"r" mh-show-rescan-folder
"s" mh-show-search-folder
"t" mh-show-toggle-threads
@ -912,6 +975,7 @@ still visible.\n")
"v" mh-show-visit-folder)
(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
"'" mh-show-narrow-to-tick
"?" mh-prefix-help
"d" mh-show-delete-msg-from-seq
"k" mh-show-delete-seq
@ -940,7 +1004,11 @@ still visible.\n")
(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
"'" mh-show-narrow-to-tick
"?" mh-prefix-help
"c" mh-show-narrow-to-cc
"f" mh-show-narrow-to-from
"r" mh-show-narrow-to-range
"s" mh-show-narrow-to-subject
"t" mh-show-narrow-to-to
"w" mh-show-widen)
(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
@ -1039,8 +1107,10 @@ 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)
;; Avoid compiler warnings in XEmacs and Emacs 20
(eval-when-compile
(defvar tool-bar-mode)
(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>
@ -1051,6 +1121,8 @@ be called, with no arguments, upon entry to this mode."
(mh-show-unquote-From)
(mh-show-xface)
(mh-show-addr)
(setq buffer-invisibility-spec '((vanish . t) t))
(set (make-local-variable 'line-move-ignore-invisible) t)
(make-local-variable 'font-lock-defaults)
;;(set (make-local-variable 'font-lock-support-mode) nil)
(cond
@ -1067,8 +1139,7 @@ be called, with no arguments, upon entry to this mode."
(if (and mh-xemacs-flag
font-lock-auto-fontify)
(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))
(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)
@ -1318,8 +1389,8 @@ If optional arg MSG is non-nil, display that message instead."
(defun mh-show (&optional message)
"Show message at cursor.
If optional argument MESSAGE is non-nil, display that message instead.
Force a two-window display with the folder window on top (size
`mh-summary-height') and the show buffer below it.
Force a two-window display with the folder window on top (size given by the
variable `mh-summary-height') and the show buffer below it.
If the message is already visible, display the start of the message.
Display of the message is controlled by setting the variables
@ -1338,6 +1409,14 @@ Type \"\\[mh-header-display]\" to see the message with all its headers."
(mouse-set-point EVENT)
(mh-show))
(defun mh-summary-height ()
"Return ideal value for the variable `mh-summary-height'.
The current frame height is taken into consideration."
(or (and (fboundp 'frame-height)
(> (frame-height) 24)
(min 10 (/ (frame-height) 6)))
4))
(defun mh-show-msg (msg)
"Show MSG.
The value of `mh-show-hook' is a list of functions to be called, with no
@ -1347,6 +1426,7 @@ arguments, after the message has been displayed."
(mh-showing-mode t)
(setq mh-page-to-next-msg-flag nil)
(let ((folder mh-current-folder)
(folders (list mh-current-folder))
(clean-message-header mh-clean-message-header-flag)
(show-window (get-buffer-window mh-show-buffer)))
(if (not (eq (next-window (minibuffer-window)) (selected-window)))
@ -1358,22 +1438,29 @@ arguments, after the message has been displayed."
(goto-char (point-min))
(if (not clean-message-header)
(mh-start-of-uncleaned-message)))
(mh-display-msg msg folder))))
(if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
(shrink-window (- (window-height) mh-summary-height)))
(mh-recenter nil)
(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))
(mh-display-msg msg folder)))
(if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
(shrink-window (- (window-height) (or mh-summary-height
(mh-summary-height)))))
(mh-recenter nil)
(if (not (memq msg mh-seen-list))
(setq mh-seen-list (cons msg mh-seen-list)))
(when mh-update-sequences-after-mh-show-flag
(mh-update-sequences)
(when mh-index-data
(setq folders
(append (mh-index-delete-from-sequence mh-unseen-seq (list msg))
folders)))
(when (mh-speed-flists-active-p)
(apply #'mh-speed-flists t folders)))
(run-hooks 'mh-show-hook)))
(defun mh-modify (&optional message)
"Edit message at cursor.
If optional argument MESSAGE is non-nil, edit that message instead.
Force a two-window display with the folder window on top (size
`mh-summary-height') and the message editing buffer below it.
Force a two-window display with the folder window on top (size given by the
value of the variable `mh-summary-height') and the message editing buffer below
it.
The message is displayed in raw form."
(interactive)
@ -1533,8 +1620,10 @@ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
(beginning-of-line)
(mh-delete-line 1)
(while (looking-at "[ \t]")
(mh-delete-line 1))))
(unlock-buffer))))
(mh-delete-line 1)))))
(let ((mh-compose-skipped-header-fields ()))
(mh-letter-hide-all-skipped-fields))
(unlock-buffer)))
(defun mh-delete-line (lines)
"Delete the next LINES lines."
@ -1550,9 +1639,26 @@ If NOTATION is nil then no change in the buffer occurs."
(with-mh-folder-updating (t)
(beginning-of-line)
(forward-char offset)
(let ((notation (or notation (char-after))))
(delete-char 1)
(insert notation))))))
(let* ((change-stack-flag (and (stringp notation)
(equal offset (1+ mh-cmd-note))
(not (eq notation mh-note-seq))))
(msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
(stack (and msg (gethash msg mh-sequence-notation-history)))
(notation (or notation (char-after))))
(if stack
;; The presence of the stack tells us that we don't need to
;; notate the message, since the notation would be replaced
;; by a sequence notation. So we will just put the notation
;; at the bottom of the stack. If the sequence is deleted,
;; the correct notation will be shown.
(setf (gethash msg mh-sequence-notation-history)
(reverse (cons (aref notation 0) (cdr (reverse stack)))))
;; Since we don't have any sequence notations in the way, just
;; notate the scan line.
(delete-char 1)
(insert notation))
(when change-stack-flag
(mh-thread-update-scan-line-map msg notation offset)))))))
(defun mh-find-msg-get-num (step)
"Return the message number of the message nearest the cursor.
@ -1666,7 +1772,8 @@ arguments, after these variable have been set."
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
(if mh-previous-seq
(setq mh-previous-seq (intern mh-previous-seq)))
(run-hooks 'mh-find-path-hook))))
(run-hooks 'mh-find-path-hook)
(mh-collect-folder-names))))
(defun mh-file-command-p (file)
"Return t if file FILE is the name of a executable regular file."
@ -1710,7 +1817,9 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
mh-nmh-flag t)))
(kill-buffer tmp-buffer))))
(unless (and mh-progs mh-lib mh-lib-progs)
(error "Unable to determine paths from `mhparam' command")))))
(error "Unable to determine paths from `mhparam' command"))
(setq mh-flists-present-flag
(file-exists-p (expand-file-name "flists" mh-progs))))))
(defun mh-path-search (path file)
"Search PATH, a list of directory names, for FILE.
@ -1799,18 +1908,21 @@ addition.
If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are
not updated."
(let ((entry (mh-find-seq seq)))
(let ((entry (mh-find-seq seq))
(internal-seq-flag (mh-internal-seq seq)))
(if (and msgs (atom msgs)) (setq msgs (list msgs)))
(unless internal-flag
(mh-add-to-sequence seq msgs)
(when (not dont-annotate-flag)
(mh-iterate-on-range msg msgs
(unless (memq msg (cdr entry))
(mh-add-sequence-notation msg internal-seq-flag)))))
(if (null entry)
(setq mh-seq-list
(cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
mh-seq-list))
(if msgs (setcdr entry (mh-canonicalize-sequence
(append msgs (mh-seq-msgs entry))))))
(cond ((not internal-flag)
(mh-add-to-sequence seq msgs)
(unless dont-annotate-flag
(mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))))
(append msgs (mh-seq-msgs entry))))))))
(defun mh-canonicalize-sequence (msgs)
"Sort MSGS in decreasing order and remove duplicates."
@ -1824,6 +1936,54 @@ not updated."
(defvar mh-sub-folders-cache (make-hash-table :test #'equal))
(defvar mh-current-folder-name nil)
(defvar mh-flists-partial-line "")
(defvar mh-flists-process nil)
;; Initialize mh-sub-folders-cache...
(defun mh-collect-folder-names ()
"Collect folder names by running `flists'."
(unless mh-flists-process
(setq mh-flists-process
(mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter
"-recurse" "-fast"))))
(defun mh-collect-folder-names-filter (process output)
"Read folder names.
PROCESS is the flists process that was run to collect folder names and the
function is called when OUTPUT is available."
(let ((position 0)
(prevailing-match-data (match-data))
line-end folder)
(unwind-protect
(while (setq line-end (string-match "\n" output position))
(setq folder (format "+%s%s"
mh-flists-partial-line
(substring output position line-end)))
(setq mh-flists-partial-line "")
(unless (equal (aref folder 1) ?.)
(mh-populate-sub-folders-cache folder))
(setq position (1+ line-end)))
(set-match-data prevailing-match-data))
(setq mh-flists-partial-line (substring output position))))
(defun mh-populate-sub-folders-cache (folder)
"Tell `mh-sub-folders-cache' about FOLDER."
(let* ((last-slash (mh-search-from-end ?/ folder))
(child1 (substring folder (1+ (or last-slash 0))))
(parent (and last-slash (substring folder 0 last-slash)))
(parent-slash (and parent (mh-search-from-end ?/ parent)))
(child2 (and parent (substring parent (1+ (or parent-slash 0)))))
(grand-parent (and parent-slash (substring parent 0 parent-slash)))
(cache-entry (gethash parent mh-sub-folders-cache)))
(unless (loop for x in cache-entry when (equal (car x) child1) return t
finally return nil)
(push (list child1) cache-entry)
(setf (gethash parent mh-sub-folders-cache)
(sort cache-entry (lambda (x y) (string< (car x) (car y)))))
(when parent
(loop for x in (gethash grand-parent mh-sub-folders-cache)
when (equal (car x) child2)
do (progn (setf (cdr x) t) (return)))))))
(defun mh-normalize-folder-name (folder &optional empty-string-okay
dont-remove-trailing-slash)
@ -1979,9 +2139,12 @@ 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)
(defvar mh-speed-flists-inhibit-flag nil)
(defun mh-speed-flists-active-p ()
"Check if speedbar is running with message counts enabled."
(and (featurep 'mh-speed)
(not mh-speed-flists-inhibit-flag)
(> (hash-table-count mh-speed-flists-cache) 0)))
(defun mh-folder-completion-function (name predicate flag)
@ -2119,14 +2282,19 @@ Any output is assumed to be an error and is shown to the user.
The output is not read or parsed by MH-E."
(save-excursion
(set-buffer (get-buffer-create mh-log-buffer))
(let ((initial-size (mh-truncate-log-buffer)))
(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))))))
(let* ((initial-size (mh-truncate-log-buffer))
(start (point))
(args (mh-list-to-string args)))
(apply 'call-process (expand-file-name command mh-progs) nil t nil args)
(when (> (buffer-size) initial-size)
(save-excursion
(goto-char start)
(insert "Errors when executing: " command)
(loop for arg in args do (insert " " arg))
(insert "\n"))
(save-window-excursion
(switch-to-buffer-other-window mh-log-buffer)
(sit-for 5))))))
(defun mh-exec-cmd-error (env command &rest args)
"In environment ENV, execute mh-command COMMAND with ARGS.
@ -2161,7 +2329,8 @@ ARGS are passed to COMMAND as command line arguments."
command nil
(expand-file-name command mh-progs)
(mh-list-to-string args))))
(set-process-filter process (or filter 'mh-process-daemon))))
(set-process-filter process (or filter 'mh-process-daemon))
process))
(defun mh-exec-cmd-env-daemon (env command filter &rest args)
"In ennvironment ENV, execute mh-command COMMAND in the background.
@ -2283,6 +2452,23 @@ Put the output into buffer after point. Set mark after inserted text."
(setq l (cdr l)))
new-list))
(defun mh-replace-in-string (regexp newtext string)
"Replace REGEXP with NEWTEXT everywhere in STRING and return result.
NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
The function body was copied from `dired-replace-in-string' in dired.el.
Emacs21 has `replace-regexp-in-string' while XEmacs has `replace-in-string'.
Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 and above
has `gnus-replace-in-string'. We should use that when we decide to not support
older versions of Gnus."
(let ((result "") (start 0) mb me)
(while (string-match regexp string start)
(setq mb (match-beginning 0)
me (match-end 0)
result (concat result (substring string start mb) newtext)
start me))
(concat result (substring string start))))
(provide 'mh-utils)
;;; Local Variables:

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

@ -1,99 +0,0 @@
;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
;; Copyright (C) 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: FSF
;; 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:
;;; Change Log:
;;; Code:
;;; Some requires:
(require 'rfc822)
(eval-when-compile (require 'mh-utils))
;;; Simple compatibility:
(unless (fboundp 'match-string-no-properties)
(defsubst match-string-no-properties (match)
(buffer-substring-no-properties
(match-beginning match) (match-end match))))
(unless (fboundp 'line-beginning-position)
(defalias 'line-beginning-position 'point-at-bol))
(unless (fboundp 'line-end-position)
(defalias 'line-end-position 'point-at-eol))
(unless (fboundp 'timerp)
(defalias 'timerp 'itimerp))
(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:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:
;;; arch-tag: f531e3cc-98ba-4f9f-b6a1-e282173a6aa9
;;; mh-xemacs-compat.el ends here

1307
lisp/mh-e/mh-xemacs-icons.el
View file

File diff suppressed because it is too large Load diff

BIN
lisp/toolbar/alias.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/execute.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/highlight.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/page-down.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/refile.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/repack.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/reply-all.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/reply-from.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/reply-to.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/rescan.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/show.pbm
View file

Binary file not shown.

BIN
lisp/toolbar/widen.pbm
View file

Binary file not shown.