aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2003-01-08 23:21:16 +0000
committerBill Wohler2003-01-08 23:21:16 +0000
commitc3d9274aea16845838647cf2a225e8f60709b3ff (patch)
treeab2accdf078f99407b22d16a5a94017ffe02efe2
parent21bd170ddef47f963b71d5ad90285a4c2ccc89ca (diff)
downloademacs-c3d9274aea16845838647cf2a225e8f60709b3ff.tar.gz
emacs-c3d9274aea16845838647cf2a225e8f60709b3ff.zip
Upgraded to MH-E version 7.1.
-rw-r--r--etc/ChangeLog4
-rw-r--r--etc/MH-E-NEWS208
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/mail/mh-alias.el590
-rw-r--r--lisp/mail/mh-comp.el1267
-rw-r--r--lisp/mail/mh-customize.el1751
-rw-r--r--lisp/mail/mh-e.el1888
-rw-r--r--lisp/mail/mh-funcs.el313
-rw-r--r--lisp/mail/mh-identity.el219
-rw-r--r--lisp/mail/mh-index.el1366
-rw-r--r--lisp/mail/mh-loaddefs.el880
-rw-r--r--lisp/mail/mh-mime.el347
-rw-r--r--lisp/mail/mh-pick.el160
-rw-r--r--lisp/mail/mh-seq.el508
-rw-r--r--lisp/mail/mh-speed.el266
-rw-r--r--lisp/mail/mh-utils.el1289
-rw-r--r--lisp/mail/mh-xemacs-compat.el4
-rw-r--r--lisp/toolbar/alias.pbm3
-rw-r--r--lisp/toolbar/alias.xpm33
20 files changed, 6756 insertions, 4352 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index d8d1b256087..956f39a710c 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
12003-01-08 Bill Wohler <wohler@newt.com>
2
3 * MH-E-NEWS: Upgraded to MH-E version 7.1.
4
12003-01-01 Steven Tamm <steventamm@mac.com> 52003-01-01 Steven Tamm <steventamm@mac.com>
2 6
3 * MACHINES: Added pointer to Mac OS X install instructions. 7 * MACHINES: Added pointer to Mac OS X install instructions.
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 1dba2d48864..e73ec462a38 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -1,3 +1,209 @@
1* Changes in mh-e 7.1
2
3This release includes the new features of multiple identities and
4alias completion. In addition, indexed searching has been revamped.
5Various other features have been added and a few bugs were fixed.
6
7** New Features in MH-E 7.1
8
9*** Multiple Identities
10
11MH-E now supports multiple identities (closes SF #628782). That means
12that you can have different From and Organization header fields (or
13any other header field of your choice) as well as different signatures
14depending on your context. Usually, the contexts are home and work.
15
16Add your identities to the variable `mh-identity-list' and set the
17default identity with the variable `mh-identity-default'. Your
18identity can be switched on the fly by using the Identity menu or by
19calling "M-x mh-insert-identity RET".
20
21This functionality can be customized within the mh-identity group.
22
23*** Alias Completion and Harvesting
24
25The contributed file mh-alias.el has been rewritten and incorporated
26into MH-E.
27
28By default, aliases are culled from the system files
29"/etc/nmh/MailAliases," "/usr/lib/mh/MailAliases," and "/etc/passwd"
30(see `mh-alias-system-aliases') and from your "AliasFile" MH profile
31component. These aliases are then used for completion in the
32minibuffer when entering addresses. Within the header of the message
33draft, "M-TAB (mh-letter-complete)" is used to do alias completion.
34
35The package also provides for alias creation based upon the From
36header field of the current message. Use the lasso button
37(mh-alias-grab-from-field).
38
39This functionality can be customized within the mh-alias group.
40
41*** Index Folder Updates
42
43The results of an index search "F i (mh-index-search)" are now stored
44in a bona fide folder so that you can refile messages and reply to
45messages directly from the result folder. This folder is a sub-folder
46of +mhe-index and the name is based upon the search string (closes SF
47#623321).
48
49If a prefix argument is given then the search in the current index
50buffer is redone.
51
52The index folder lists the names of the source folders as before.
53However, instead of using RET on the name of the folder to visit the
54folder, use "v (mh-show-index-visit-folder)" anywhere within the
55results to visit that folder narrowed to the results of the search.
56Additional functions have been added to navigate including "TAB
57(mh-index-next-folder)", and "SHIFT-TAB (mh-index-previous-folder)."
58
59*** mh-visit-folder Interface Updated
60
61A change was made to the prompting of the message range. In general,
62you can use the same format for messages and sequences as you can in
63MH with a single exception: a single number means to scan that many
64messages, rather than scan that message number. This turns out to be
65much more useful than visiting a single message and is consistent with
66Gnus and the MH-E speedbar (closes SF #655891).
67
68If mh-visit-folder is called non-interactively and RANGE is nil then
69all messages are displayed. This behavior is now documented and
70provides backwards compatibility.
71
72*** Threading Improvements
73
74After incorporating new mail into a threaded folder, unseen messages
75can be spread about. Two new functions have been added to make it
76easier to find them: these are "M-n (mh-next-unread-msg)" and "M-p
77(mh-previous-unread-msg)" (closes SF #630328)
78
79Two new functions were added to delete and refile threads. They are "T
80d (mh-thread-delete)" and "T o (mh-thread-refile)" respectively
81(closes SF #630493).
82
83In addition, the key "k" used to be bound to the function
84`mh-delete-subject': it is now bound to
85`mh-show-delete-subject-or-thread'.
86
87New functions to navigate threads include "T u (mh-thread-ancestor)",
88which can jump to the root message of the current thread given an
89optional argument, "T n (mh-thread-next-sibling)", and "T p
90(mh-thread-previous-sibling)"
91
92*** Refiling of Messages in Region
93
94If mark is active and `transient-mark-mode' is enabled then all the
95messages in the region are refiled.
96
97*** vCard Handling
98
99If a signature cannot be identified, but there is a vCard attachment,
100then that vCard will be presented as a signature (closes SF #649216).
101
102*** New Info Added to mh-version
103
104Information about Gnus versions available at both compile time and run
105time has been added.
106
107** New Variables in MH-E 7.1
108
109The defcustom groups were reorganized. Rather than iterate the
110specific changes here, you are invited to browse the groups with "M-x
111mh-customize RET".
112
113*** mh-alias-completion-ignore-case-flag
114
115Non-nil means don't consider case significant in MH alias completion.
116This is the default in plain MH, so it is the default here as well. It
117can be useful to set this to t if, for example, you use lowercase
118aliases for people and uppercase for mailing lists.
119
120*** mh-alias-expand-aliases-flag
121
122Non-nil means to expand aliases entered in the minibuffer. In other
123words, aliases entered in the minibuffer will be expanded to the full
124address in the message draft. By default, this expansion is not
125performed.
126
127*** mh-alias-flash-on-comma
128
129Specify whether to flash the translation of the alias or warn if there
130isn't a translation of the alias.
131
132*** mh-alias-insert-file
133
134Filename to use to store new MH-E aliases. This variable can also be a
135list of filenames, in which case MH-E will prompt for one of them. If
136nil, the default, then MH-E will use the first file found in the
137"AliasFile" component of the MH profile.
138
139*** mh-alias-insertion-location
140
141Specifies where new aliases are entered in alias files. Options are
142sorted alphabetically (the default), at the top of the file or at the
143bottom.
144
145*** mh-alias-local-users
146
147If t, local users are completed in MH-E To: and Cc: prompts.
148
149If you set this variable to a string, it will be executed to generate
150a password file. A value of "ypcat passwd" is helpful if NIS is in
151use.
152
153*** mh-alias-system-aliases
154
155A list of system files from which to cull aliases. If these files are
156modified, they are automatically reread. This list need include only
157system aliases and the passwd file, since personal alias files listed
158in your "AliasFile" MH profile component are automatically included.
159
160*** mh-identity-default
161
162Default identity to use when `mh-letter-mode' is called.
163
164*** mh-identity-list
165
166List holding MH-E identity.
167
168*** mh-invisible-header-fields
169
170Simple user interface to change `mh-invisible-headers'.
171
172*** mh-letter-complete-function
173
174Function to call when completing outside of fields specific to
175aliases. By default, it is bound to 'ispell-complete-word.
176
177*** mh-show-threads-flag
178
179Non-nil means new folders start in threaded mode. Threading large
180number of messages can be time consuming. So if the flag is non-nil
181then threading will be done only if the number of messages being
182threaded is less than `mh-large-folder' (closes SF #646794).
183
184*** mh-tool-bar-folder-buttons
185
186Buttons to include in MH-E folder/show toolbar.
187
188*** mh-tool-bar-letter-buttons
189
190Buttons to include in MH-E letter toolbar.
191
192** Bug Fixes in MH-E 7.1
193
194*** mh-get-new-mail
195
196Call new function `mh-add-cur-notation' to undo the work of
197`mh-remove-cur-notation' if there was no new mail (closes SF #647681).
198
199*** mh-set-cmd-note
200
201No longer updates the default `mh-cmd-note' value. This resulted in
202the misplacement of the current mark when the message number width
203changed (closes SF #643701).
204
205
206
1* Changes in mh-e 7.0 207* Changes in mh-e 7.0
2 208
3This is a major release which includes a lot of new features including 209This is a major release which includes a lot of new features including
@@ -62,7 +268,7 @@ You can now use the MH-Folder mode commands from the MH-Show buffer.
62Because of this, the MH-Show buffer is now read-only (closes SF 268Because of this, the MH-Show buffer is now read-only (closes SF
63#493749 and SF #527946) and you now have to use "M (mh-modify)" to 269#493749 and SF #527946) and you now have to use "M (mh-modify)" to
64edit a message. 270edit a message.
65 271
66*** Better Scanning 272*** Better Scanning
67 273
68You no longer have to modify your scan format if your folders have 274You no longer have to modify your scan format if your folders have
diff --git a/etc/NEWS b/etc/NEWS
index a558ee76fd4..6a53dce1bc0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -90,7 +90,7 @@ You can now put the init files .emacs and .emacs_SHELL under
90 90
91** MH-E changes. 91** MH-E changes.
92 92
93Upgraded to mh-e version 7.0. There have been major changes since 93Upgraded to MH-E version 7.1. There have been major changes since
94version 5.0.2; see MH-E-NEWS for details. 94version 5.0.2; see MH-E-NEWS for details.
95 95
96+++ 96+++
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b4c1dd9cd5b..978e41a72da 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12003-01-08 Bill Wohler <wohler@newt.com>
2
3 * mail/mh-alias.el, mail/mh-customize.el, mail/mh-identity.el,
4 mail/mh-loaddefs.el, toolbar/alias.pbm, toolbar/alias.xpm: Added.
5
6 * mail/mh-comp.el, mail/mh-e.el, mail/mh-funcs.el,
7 mail/mh-index.el, mail/mh-mime.el, mail/mh-pick.el,
8 mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el,
9 mail/mh-xemacs-compat.el: Upgraded to MH-E version 7.1.
10
12003-01-08 Kim F. Storm <storm@cua.dk> 112003-01-08 Kim F. Storm <storm@cua.dk>
2 12
3 * mail/undigest.el (unforward-rmail-message): Don't use global 13 * mail/undigest.el (unforward-rmail-message): Don't use global
diff --git a/lisp/mail/mh-alias.el b/lisp/mail/mh-alias.el
new file mode 100644
index 00000000000..b9f144fae02
--- /dev/null
+++ b/lisp/mail/mh-alias.el
@@ -0,0 +1,590 @@
1;;; mh-alias.el --- MH-E mail alias completion and expansion
2;;
3;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; [To be deleted when documented in MH-E manual.]
30;;
31;; This module provides mail alias completion when entering addresses.
32;;
33;; Use the TAB key to complete aliases (and optionally local usernames) when
34;; initially composing a message in the To: and Cc: minibuffer prompts. You
35;; may enter multiple addressees separated with a comma (but do *not* add any
36;; space after the comma).
37;;
38;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
39;; complete aliases. This is useful when you want to add an addressee as an
40;; afterthought when creating a message, or when adding an additional
41;; addressee to a reply.
42;;
43;; By default, completion is case-insensitive. This can be changed by
44;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
45;; useful, for example, to differentiate between people aliases in lowercase
46;; such as:
47;;
48;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
49;;
50;; and lists in uppercase such as:
51;;
52;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
53;;
54;; Note that this variable affects minibuffer completion only. If you have an
55;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
56;; be expanded in the letter buffer because MH is case-insensitive.
57;;
58;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
59;; the minibuffer, the expansion for the previous mail alias appears briefly.
60;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
61;;
62;; The addresses and aliases entered in the minibuffer are added to the
63;; message draft. To expand the aliases before they are added to the draft,
64;; customize the variable `mh-alias-expand-aliases-flag'.
65;;
66;; Completion is also performed on usernames extracted from the /etc/passwd
67;; file. This can be a handy tool on a machine where you and co-workers
68;; exchange messages, but should probably be disabled on a system with
69;; thousands of users you don't know. This is done by customizing the
70;; variable `mh-alias-local-users'. This variable also takes a string which
71;; is executed to generate the password file. For example, you'd use "ypcat
72;; passwd" for NIS.
73;;
74;; Aliases are loaded the first time you send mail and get the "To:" prompt
75;; and whenever a source of aliases changes. Sources of system aliases are
76;; defined in the customization variable `mh-alias-system-aliases' and
77;; include:
78;;
79;; /etc/nmh/MailAliases
80;; /usr/lib/mh/MailAliases
81;; /etc/passwd
82;;
83;; Sources of personal aliases are read from the files listed in your MH
84;; profile component Aliasfile. Multiple files are separated by white space
85;; and are relative to your mail directory.
86;;
87;; Alias Insertions
88;; ~~~~~~~~~~~~~~~~
89;; There are commands to insert new aliases into your alias file(s) (defined
90;; by the `Aliasfile' component in the .mh_profile file or by the variable
91;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
92;; an alias from the From line of the current message.
93
94;;; Code:
95
96(require 'mh-e)
97(load "cmr" t t) ; Non-fatal dependency for
98 ; completing-read-multiple.
99(eval-when-compile (defvar mail-abbrev-syntax-table))
100
101;;; Autoloads
102(autoload 'mail-abbrev-complete-alias "mailabbrev")
103(autoload 'multi-prompt "multi-prompt")
104
105(defvar mh-alias-alist nil
106 "Alist of MH aliases.")
107(defvar mh-alias-blind-alist nil
108 "Alist of MH aliases that are blind lists.")
109(defvar mh-alias-passwd-alist nil
110 "Alist of aliases extracted from passwd file and their expansions.")
111(defvar mh-alias-tstamp nil
112 "Time aliases were last loaded.")
113(defvar mh-alias-read-address-map nil)
114(if mh-alias-read-address-map
115 ()
116 (setq mh-alias-read-address-map
117 (copy-keymap minibuffer-local-completion-map))
118 (if mh-alias-flash-on-comma
119 (define-key mh-alias-read-address-map
120 "," 'mh-alias-minibuffer-confirm-address))
121 (define-key mh-alias-read-address-map " " 'self-insert-command))
122
123
124;;; Alias Loading
125
126(defun mh-alias-tstamp (arg)
127 "Check whether alias files have been modified.
128Return t if any file listed in the MH profile component Aliasfile has been
129modified since the timestamp.
130If ARG is non-nil, set timestamp with the current time."
131 (if arg
132 (let ((time (current-time)))
133 (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
134 (let ((stamp))
135 (car (memq t (mapcar
136 (function
137 (lambda (file)
138 (when (and file (file-exists-p file))
139 (setq stamp (nth 5 (file-attributes file)))
140 (or (> (car stamp) (car mh-alias-tstamp))
141 (and (= (car stamp) (car mh-alias-tstamp))
142 (> (cadr stamp) (cadr mh-alias-tstamp)))))))
143 (mh-alias-filenames t)))))))
144
145(defun mh-alias-filenames (arg)
146 "Return list of filenames that contain aliases.
147The filenames come from the MH profile component Aliasfile and are expanded.
148If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
149 (or mh-progs (mh-find-path))
150 (save-excursion
151 (let* ((filename (mh-profile-component "Aliasfile"))
152 (filelist (and filename (split-string filename "[ \t]+")))
153 (userlist
154 (mapcar
155 (function
156 (lambda (file)
157 (if (and mh-user-path file
158 (file-exists-p (expand-file-name file mh-user-path)))
159 (expand-file-name file mh-user-path))))
160 filelist)))
161 (if arg
162 (if (stringp mh-alias-system-aliases)
163 (append userlist (list mh-alias-system-aliases))
164 (append userlist mh-alias-system-aliases))
165 userlist))))
166
167(defun mh-alias-local-users ()
168 "Return an alist of local users from /etc/passwd."
169 (let (passwd-alist)
170 (save-excursion
171 (set-buffer (get-buffer-create mh-temp-buffer))
172 (erase-buffer)
173 (cond
174 ((eq mh-alias-local-users t)
175 (if (file-readable-p "/etc/passwd")
176 (insert-file-contents "/etc/passwd")))
177 ((stringp mh-alias-local-users)
178 (insert mh-alias-local-users "\n")
179 (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
180 (goto-char (point-min))))
181 (while (< (point) (point-max))
182 (cond
183 ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
184 (when (> (string-to-int (match-string 2)) 200)
185 (let* ((username (match-string 1))
186 (gecos-name (match-string 3))
187 (realname
188 (if (string-match "&" gecos-name)
189 (concat
190 (substring gecos-name 0 (match-beginning 0))
191 (capitalize username)
192 (substring gecos-name (match-end 0)))
193 gecos-name)))
194 (setq passwd-alist
195 (cons (list username
196 (if (string-equal "" realname)
197 (concat "<" username ">")
198 (concat realname " <" username ">")))
199 passwd-alist))))))
200 (forward-line 1)))
201 passwd-alist))
202
203;;;###mh-autoload
204(defun mh-alias-reload ()
205 "Load MH aliases into `mh-alias-alist'."
206 (interactive)
207 (save-excursion
208 (message "Loading MH aliases...")
209 (mh-alias-tstamp t)
210 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
211 (setq mh-alias-alist nil)
212 (setq mh-alias-blind-alist nil)
213 (while (< (point) (point-max))
214 (cond
215 ((looking-at "^[ \t]")) ;Continuation line
216 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
217 (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
218 (setq mh-alias-blind-alist
219 (cons (list (match-string 1)) mh-alias-blind-alist))
220 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
221 ((looking-at "\\(.+\\): .*$") ; A new MH alias
222 (when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
223 (setq mh-alias-alist
224 (cons (list (match-string 1)) mh-alias-alist)))))
225 (forward-line 1)))
226 (when mh-alias-local-users
227 (setq mh-alias-passwd-alist (mh-alias-local-users))
228 ;; Update aliases with local users, but leave existing aliases alone.
229 (let ((local-users mh-alias-passwd-alist)
230 user)
231 (while local-users
232 (setq user (car local-users))
233 (if (not (assoc-ignore-case (car user) mh-alias-alist))
234 (setq mh-alias-alist (append mh-alias-alist (list user))))
235 (setq local-users (cdr local-users)))))
236 (message "Loading MH aliases...done"))
237
238(defun mh-alias-reload-maybe ()
239 "Load new MH aliases."
240 (if (or (not mh-alias-alist) ; Doesn't exist, so create it.
241 (mh-alias-tstamp nil)) ; Out of date, so recreate it.
242 (mh-alias-reload)))
243
244
245;;; Alias Expansion
246
247(defun mh-alias-ali (alias &optional user)
248 "Return ali expansion for ALIAS.
249ALIAS must be a string for a single alias.
250If USER is t, then assume ALIAS is an address and call ali -user.
251ali returns the string unchanged if not defined. The same is done here."
252 (save-excursion
253 (let ((user-arg (if user "-user" "-nouser")))
254 (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
255 (goto-char (point-max))
256 (if (looking-at "^$") (delete-backward-char 1))
257 (buffer-substring (point-min)(point-max))))
258
259(defun mh-alias-expand (alias)
260 "Return expansion for ALIAS.
261Blind aliases or users from /etc/passwd are not expanded."
262 (cond
263 ((assoc-ignore-case alias mh-alias-blind-alist)
264 alias) ; Don't expand a blind alias
265 ((assoc-ignore-case alias mh-alias-passwd-alist)
266 (cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
267 (t
268 (mh-alias-ali alias))))
269
270;;;###mh-autoload
271(defun mh-read-address (prompt)
272 "Read an address from the minibuffer with PROMPT."
273 (mh-alias-reload-maybe)
274 (if (not mh-alias-alist) ; If still no aliases, just prompt
275 (read-string prompt)
276 (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
277 (completion-ignore-case mh-alias-completion-ignore-case-flag)
278 (the-answer
279 (or (cond
280 ((fboundp 'completing-read-multiple)
281 (completing-read-multiple prompt mh-alias-alist nil nil))
282 ((featurep 'multi-prompt)
283 (multi-prompt "," nil prompt mh-alias-alist nil nil))
284 (t
285 (split-string
286 (completing-read "To: " mh-alias-alist nil nil)
287 ","))))))
288 (if (not mh-alias-expand-aliases-flag)
289 (mapconcat 'identity the-answer ", ")
290 ;; Loop over all elements, checking if in passwd aliast or blind first
291 (mapconcat 'mh-alias-expand the-answer ",\n ")))))
292
293;;;###mh-autoload
294(defun mh-alias-minibuffer-confirm-address ()
295 "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
296 (interactive)
297 (if (not mh-alias-flash-on-comma)
298 ()
299 (save-excursion
300 (let* ((case-fold-search t)
301 (the-name (buffer-substring
302 (progn (skip-chars-backward " \t")(point))
303 ;; This moves over to previous comma, if any
304 (progn (or (and (not (= 0 (skip-chars-backward "^,")))
305 ;; the skips over leading whitespace
306 (skip-chars-forward " "))
307 ;; no comma, then to beginning of word
308 (skip-chars-backward "^ \t"))
309 ;; In Emacs21, the beginning of the prompt
310 ;; line is accessible, which wasn't the case
311 ;; in emacs20. Skip over it.
312 (if (looking-at "^[^ \t]+:")
313 (skip-chars-forward "^ \t"))
314 (skip-chars-forward " ")
315 (point)))))
316 (if (assoc-ignore-case the-name mh-alias-alist)
317 (message "%s -> %s" the-name (mh-alias-expand the-name))
318 ;; Check if if was a single word likely to be an alias
319 (if (and (equal mh-alias-flash-on-comma 1)
320 (not (string-match " " the-name)))
321 (message "No alias for %s" the-name))))))
322 (self-insert-command 1))
323
324;;;###mh-autoload
325(defun mh-alias-letter-expand-alias ()
326 "Expand mail alias before point."
327 (mh-alias-reload-maybe)
328 (let ((mail-abbrevs mh-alias-alist))
329 (mail-abbrev-complete-alias))
330 (when mh-alias-expand-aliases-flag
331 (let* ((end (point))
332 (syntax-table (syntax-table))
333 (beg (unwind-protect
334 (save-excursion
335 (set-syntax-table mail-abbrev-syntax-table)
336 (backward-word 1)
337 (point))
338 (set-syntax-table syntax-table)))
339 (alias (buffer-substring beg end))
340 (expansion (mh-alias-expand alias)))
341 (delete-region beg end)
342 (insert expansion))))
343
344;;; Adding addresses to alias file.
345
346(defun mh-alias-suggest-alias (string)
347 "Suggest an alias for STRING."
348 (cond
349 ((string-match "^\\sw+$" string)
350 ;; One word -> downcase it.
351 (downcase string))
352 ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
353 ;; Two words -> first.last
354 (downcase
355 (format "%s.%s" (match-string 1 string) (match-string 2 string))))
356 ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
357 string)
358 ;; email only -> downcase username
359 (downcase (match-string 1 string)))
360 ((string-match "^\"\\(.*\\)\".*" string)
361 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
362 (mh-alias-suggest-alias (match-string 1 string)))
363 ((string-match "^\\(.*\\) +<.*>$" string)
364 ;; Some name <somename@foo.bar> -> recurse -> Some name
365 (mh-alias-suggest-alias (match-string 1 string)))
366 ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
367 ;; somename@foo.bar (Some name) -> recurse -> Some name
368 (mh-alias-suggest-alias (match-string 1 string)))
369 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
370 ;; Strip out title
371 (mh-alias-suggest-alias (match-string 2 string)))
372 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
373 ;; Strip out tails with comma
374 (mh-alias-suggest-alias (match-string 1 string)))
375 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
376 ;; Strip out tails
377 (mh-alias-suggest-alias (match-string 1 string)))
378 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
379 ;; Strip out initials
380 (mh-alias-suggest-alias
381 (format "%s %s" (match-string 1 string) (match-string 2 string))))
382 ((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
383 ;; Reverse order of comma-separated fields
384 (mh-alias-suggest-alias
385 (format "%s %s" (match-string 2 string) (match-string 1 string))))
386 (t
387 ;; Output string, with spaces replaced by dots.
388 (downcase (replace-regexp-in-string
389 "\\.\\.+" "."
390 (replace-regexp-in-string " +" "." string))))))
391
392(defun mh-alias-which-file-has-alias (alias file-list)
393 "Return the name of writable file which defines ALIAS from list FILE-LIST."
394 (save-excursion
395 (set-buffer (get-buffer-create mh-temp-buffer))
396 (let ((the-list file-list)
397 (found))
398 (while the-list
399 (erase-buffer)
400 (when (file-writable-p (car file-list))
401 (insert-file-contents (car file-list))
402 (if (re-search-forward (concat "^" (regexp-quote alias) ":"))
403 (setq found (car file-list)
404 the-list nil)
405 (setq the-list (cdr the-list)))))
406 found)))
407
408(defun mh-alias-insert-file (&optional alias)
409 "Return the alias file to write a new entry for ALIAS in.
410Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
411value.
412If ALIAS is specified and it already exists, try to return the file that
413contains it."
414 (cond
415 ((and mh-alias-insert-file (listp mh-alias-insert-file))
416 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
417 (car mh-alias-insert-file)
418 (if (or (not alias)
419 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
420 (completing-read "Alias file [press Tab]: "
421 (mapcar 'list mh-alias-insert-file) nil t)
422 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
423 (completing-read "Alias file [press Tab]: "
424 (mapcar 'list mh-alias-insert-file) nil t)))))
425 ((and mh-alias-insert-file (stringp mh-alias-insert-file))
426 mh-alias-insert-file)
427 (t
428 ;; writable ones returned from (mh-alias-filenames):
429 (let ((autolist (delq nil (mapcar (lambda (file)
430 (if (and (file-writable-p file)
431 (not (string-equal
432 file "/etc/passwd")))
433 file))
434 (mh-alias-filenames t)))))
435 (cond
436 ((not autolist)
437 (error "No writable alias file.
438Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
439 ((not (elt autolist 1)) ; Only one entry, use it
440 (car autolist))
441 ((or (not alias)
442 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
443 (completing-read "Alias file [press Tab]: "
444 (mapcar 'list autolist) nil t))
445 (t
446 (or (mh-alias-which-file-has-alias alias autolist)
447 (completing-read "Alias file [press Tab]: "
448 (mapcar 'list autolist) nil t))))))))
449
450(defun mh-alias-address-to-alias (address)
451 "Return the ADDRESS alias if defined, or nil."
452 (let* ((aliases (mh-alias-ali address t)))
453 (if (string-equal aliases address)
454 nil ; ali returned same string -> no.
455 ;; For the comma-separated aliases reyurned by ali, check that one of
456 ;; them doesn't expand into a list. e.g. we do have an individual
457 ;; alias for that adress.
458 (car (delq nil (mapcar
459 (function
460 (lambda (alias)
461 (let ((recurse (mh-alias-ali alias nil)))
462 (if (string-match ".*,.*" recurse)
463 nil
464 alias))))
465 (split-string aliases ", +")))))))
466
467;;;###mh-autoload
468(defun mh-alias-from-has-no-alias-p ()
469 "Return t is From has no current alias set."
470 (mh-alias-reload-maybe)
471 (save-excursion
472 (if (not (mh-folder-line-matches-show-buffer-p))
473 nil ;No corresponding show buffer
474 (if (eq major-mode 'mh-folder-mode)
475 (set-buffer mh-show-buffer))
476 (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
477
478(defun mh-alias-add-alias-to-file (alias address &optional file)
479 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
480Prompt for alias file if not provided and there is more than one candidate.
481If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
482after it."
483 (if (not file)
484 (setq file (mh-alias-insert-file alias)))
485 (save-excursion
486 (set-buffer (find-file-noselect file))
487 (goto-char (point-min))
488 (let ((alias-search (concat alias ":"))
489 (letter)
490 (here (point))
491 (case-fold-search t))
492 (cond
493 ;; Search for exact match (if we had the same alias before)
494 ((re-search-forward
495 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
496 (let ((answer (read-string
497 (format "Exists for %s; [i]nsert, [a]ppend: "
498 (match-string 1))))
499 (case-fold-search t))
500 (cond ((string-match "^i" answer))
501 ((string-match "^a" answer)
502 (forward-line 1))
503 (t
504 error "Quitting."))))
505 ;; No, so sort-in at the right place
506 ;; search for "^alias", then "^alia", etc.
507 ((eq mh-alias-insertion-location 'sorted)
508 (setq letter (substring alias-search -1)
509 alias-search (substring alias-search 0 -1))
510 (while (and (not (equal alias-search ""))
511 (not (re-search-forward
512 (concat "^" (regexp-quote alias-search)) nil t)))
513 (setq letter (substring alias-search -1)
514 alias-search (substring alias-search 0 -1)))
515 ;; Next, move forward to sort alphabetically for following letters
516 (beginning-of-line)
517 (while (re-search-forward
518 (concat "^" (regexp-quote alias-search) "[a-" letter "]")
519 nil t)
520 (forward-line 1)))
521 ((eq mh-alias-insertion-location 'bottom)
522 (goto-char (point-max)))
523 ((eq mh-alias-insertion-location 'top)
524 (goto-char (point-min)))))
525 (beginning-of-line)
526 (insert (format "%s: %s\n" alias address))
527 (save-buffer)))
528
529;;;###mh-autoload
530(defun mh-alias-add-alias (alias address)
531 "*Add ALIAS for ADDRESS in personal alias file.
532Prompts for confirmation if the address already has an alias.
533If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
534 (interactive "P\nP")
535 (mh-alias-reload-maybe)
536 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
537 (setq address (read-string "Address: " address))
538 (let ((address-alias (mh-alias-address-to-alias address))
539 (alias-address (mh-alias-expand alias)))
540 (if (string-equal alias-address alias)
541 (setq alias-address nil))
542 (cond
543 ((and (equal alias address-alias)
544 (equal address alias-address))
545 (message "Already defined as: %s" alias-address))
546 (address-alias
547 (if (y-or-n-p (format "Address has alias %s; set new one? "
548 address-alias))
549 (mh-alias-add-alias-to-file alias address)))
550 (t
551 (mh-alias-add-alias-to-file alias address)))))
552
553;;;###mh-autoload
554(defun mh-alias-grab-from-field ()
555 "*Add ALIAS for ADDRESS in personal alias file.
556Prompts for confirmation if the alias is already in use or if the address
557already has an alias."
558 (interactive)
559 (mh-alias-reload-maybe)
560 (save-excursion
561 (cond
562 ((mh-folder-line-matches-show-buffer-p)
563 (set-buffer mh-show-buffer))
564 ((and (eq major-mode 'mh-folder-mode)
565 (mh-get-msg-num nil))
566 (set-buffer (get-buffer-create mh-temp-buffer))
567 (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
568 ((eq major-mode 'mh-folder-mode)
569 (error "Cursor not pointing to a message")))
570 (let* ((address (mh-extract-from-header-value))
571 (alias (mh-alias-suggest-alias address)))
572 (mh-alias-add-alias alias address))))
573
574;;;###mh-autoload
575(defun mh-alias-add-address-under-point ()
576 "Insert an alias for email address under point."
577 (interactive)
578 (let ((address (mh-goto-address-find-address-at-point)))
579 (if address
580 (mh-alias-add-alias nil address)
581 (message "No email address found under point."))))
582
583(provide 'mh-alias)
584
585;;; Local Variables:
586;;; indent-tabs-mode: nil
587;;; sentence-end-double-space: nil
588;;; End:
589
590;;; mh-alias.el ends here
diff --git a/lisp/mail/mh-comp.el b/lisp/mail/mh-comp.el
index c332f431f4b..c1e28a97011 100644
--- a/lisp/mail/mh-comp.el
+++ b/lisp/mail/mh-comp.el
@@ -30,12 +30,11 @@
30 30
31;;; Change Log: 31;;; Change Log:
32 32
33;; $Id: mh-comp.el,v 1.145 2002/11/29 16:49:43 wohler Exp $ 33;; $Id: mh-comp.el,v 1.164 2003/01/07 21:16:25 satyaki Exp $
34 34
35;;; Code: 35;;; Code:
36 36
37(require 'mh-e) 37(require 'mh-e)
38(require 'mh-utils)
39(require 'gnus-util) 38(require 'gnus-util)
40(require 'easymenu) 39(require 'easymenu)
41(require 'cl) 40(require 'cl)
@@ -45,94 +44,11 @@
45(defvar font-lock-defaults) 44(defvar font-lock-defaults)
46(defvar mark-active) 45(defvar mark-active)
47(defvar sendmail-coding-system) 46(defvar sendmail-coding-system)
48(defvar tool-bar-mode) 47(defvar mh-identity-list)
49 48(defvar mh-identity-default)
50;;; autoloads from mh-mime 49(defvar mh-identity-menu)
51(autoload 'mh-press-button "mh-mime")
52
53;;; autoloads for mh-seq
54(autoload 'mh-notate-seq "mh-seq")
55
56(autoload 'mh-compose-insertion "mh-mime"
57 "Add a MIME directive to insert a file, using mhn or gnus.
58If the variable mh-compose-insertion is set to 'mhn, then that will be used.
59If it is set to 'gnus, then that will be used instead.")
60
61(autoload 'mh-compose-forward "mh-mime"
62 "Add a MIME directive to forward a message, using mhn or gnus.
63If the variable mh-compose-insertion is set to 'mhn, then that will be used.
64If it is set to 'gnus, then that will be used instead.")
65
66(autoload 'mh-mhn-compose-insertion "mh-mime"
67 "Add a directive to insert a MIME message part from a file.
68This is the typical way to insert non-text parts in a message.
69See also \\[mh-edit-mhn]." t)
70
71(autoload 'mh-mhn-compose-anon-ftp "mh-mime"
72 "Add a directive for a MIME anonymous ftp external body part.
73This directive tells MH to include a reference to a
74message/external-body part retrievable by anonymous FTP.
75See also \\[mh-edit-mhn]." t)
76
77(autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
78 "Add a directive to include a MIME reference to a compressed tar file.
79The file should be available via anonymous ftp. This directive
80tells MH to include a reference to a message/external-body part.
81See also \\[mh-edit-mhn]." t)
82
83(autoload 'mh-mhn-compose-forw "mh-mime"
84 "Add a forw directive to this message, to forward a message with MIME.
85This directive tells MH to include another message in this one.
86See also \\[mh-edit-mhn]." t)
87
88(autoload 'mh-edit-mhn "mh-mime"
89 "Format the current draft for MIME, expanding any mhn directives.
90Process the current draft with the mhn program, which,
91using directives already inserted in the draft, fills in
92all the MIME components and header fields.
93This step should be done last just before sending the message.
94The mhn program is part of MH version 6.8 or later.
95The \\[mh-revert-mhn-edit] command undoes this command.
96For assistance with creating mhn directives to insert
97various types of components in a message, see
98\\[mh-mhn-compose-insertion] (generic insertion from a file),
99\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
100\\[mh-mhn-compose-external-compressed-tar] \
101\(reference to compressed tar file via anonymous ftp), and
102\\[mh-mhn-compose-forw] (forward message)." t)
103
104(autoload 'mh-revert-mhn-edit "mh-mime"
105 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
106Optional non-nil argument means don't ask for confirmation." t)
107
108(autoload 'mh-mml-to-mime "mh-mime"
109 "Compose MIME message from mml directives.")
110
111(autoload 'mh-mml-forward-message "mh-mime"
112 "Forward a message as attachment.
113The function will prompt the user for a description, a folder and message
114number.")
115
116(autoload 'mh-mml-attach-file "mh-mime"
117 "Attach a file to the outgoing MIME message.
118The file is not inserted or encoded until you send the message with
119`\\[message-send-and-exit]' or `\\[message-send]'.
120
121Message dispostion is \"inline\" is INLINE is non-nil, else the default is
122\"attachment\".
123FILE is the name of the file to attach. TYPE is its content-type, a
124string of the form \"type/subtype\". DESCRIPTION is a one-line
125description of the attachment.")
126
127(autoload 'mh-mml-secure-message-sign-pgpmime "mh-mime"
128 "Add MML tag to encrypt/sign the entire message.")
129
130(autoload 'mh-mml-secure-message-encrypt-pgpmime "mh-mime"
131 "Add MML tag to encrypt and sign the entire message.
132If called with a prefix argument, only encrypt (do NOT sign).")
133
134;;; Other Autoloads.
135 50
51;;; Autoloads
136(autoload 'Info-goto-node "info") 52(autoload 'Info-goto-node "info")
137(autoload 'mail-mode-fill-paragraph "sendmail") 53(autoload 'mail-mode-fill-paragraph "sendmail")
138(autoload 'mm-handle-displayed-p "mm-decode") 54(autoload 'mm-handle-displayed-p "mm-decode")
@@ -163,11 +79,6 @@ before, and `sc-post-hook' is run after the guts of this function.")
163 79
164;;; Site customization (see also mh-utils.el): 80;;; Site customization (see also mh-utils.el):
165 81
166(defgroup mh-compose nil
167 "MH-E functions for composing messages."
168 :prefix "mh-"
169 :group 'mh)
170
171(defvar mh-send-prog "send" 82(defvar mh-send-prog "send"
172 "Name of the MH send program. 83 "Name of the MH send program.
173Some sites need to change this because of a name conflict.") 84Some sites need to change this because of a name conflict.")
@@ -217,148 +128,6 @@ this nil and set up supercite by setting the variable
217`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, 128`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
218to 'autosupercite.") 129to 'autosupercite.")
219 130
220;;; Personal preferences:
221
222(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
223 "Use either 'gnus or 'mhn to insert MIME message directives in messages."
224 :type '(choice (const :tag "Use gnus" gnus)
225 (const :tag "Use mhn" mhn))
226 :group 'mh-compose)
227
228(defcustom mh-x-face-file "~/.face"
229 "*File name containing the encoded X-Face string to insert in outgoing mail.
230If nil, or the file does not exist, nothing is added to message headers."
231 :type 'file
232 :group 'mh-compose)
233
234(defcustom mh-insert-x-mailer-flag t
235 "*Non-nil means append an X-Mailer field to the header."
236 :type 'boolean
237 :group 'mh-compose)
238
239(defvar mh-x-mailer-string nil
240 "*String containing the contents of the X-Mailer header field.
241If nil, this variable is initialized to show the version of MH-E, Emacs, and
242MH the first time a message is composed.")
243
244(defcustom mh-insert-mail-followup-to-flag t
245 "Non-nil means maybe append a Mail-Followup-To field to the header.
246The insertion is done if the To: or Cc: fields matches an entry in
247`mh-insert-mail-followup-to-list'."
248 :type 'boolean
249 :group 'mh-compose)
250
251(defcustom mh-insert-mail-followup-to-list nil
252 "Alist of addresses for which a Mail-Followup-To field is inserted.
253Each element has the form (REGEXP ADDRESS).
254When the REGEXP appears in the To or cc fields of a message, the corresponding
255ADDRESS is inserted in a Mail-Followup-To field.
256
257Here's a customization example:
258
259 regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
260 address: mh-e-users@lists.sourceforge.net
261
262This corresponds to:
263
264 (setq mh-insert-mail-followup-to-list
265 '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
266 \"mh-e-users@lists.sourceforge.net\")))
267
268While it might be tempting to add a descriptive name to the mailing list
269address, consider that this field will appear in other people's outgoing
270mail in their To: field. It might be best to keep it simple."
271 :type '(repeat (list (string :tag "regexp") (string :tag "address")))
272 :group 'mh-compose)
273
274(defcustom mh-delete-yanked-msg-window-flag nil
275 "*Non-nil means delete any window displaying the message.
276Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
277If non-nil, yanking the current message into a draft letter deletes any
278windows displaying the message."
279 :type 'boolean
280 :group 'mh-compose)
281
282(defcustom mh-yank-from-start-of-msg 'attribution
283 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
284If t, include the entire message, with full headers. This is historically
285here for use with supercite, but is now deprecated in favor of the setting
286`supercite' below.
287
288If the symbol `body', then yank the message minus the header.
289
290If the symbol `supercite', include the entire message, with full headers.
291This also causes the invocation of `sc-cite-original' without the setting
292of `mail-citation-hook', now deprecated practice.
293
294If the symbol `autosupercite', do as for `supercite' automatically when
295show buffer matches the message being replied-to. When this option is used,
296the -noformat switch is passed to the repl program to override a -filter or
297-format switch.
298
299If the symbol `attribution', then yank the message minus the header and add
300a simple attribution line at the top.
301
302If the symbol `autoattrib', do as for `attribution' automatically when show
303buffer matches the message being replied-to. You can make sure this is
304always the case by setting `mh-reply-show-message-flag' to t (which is the
305default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
306that the show window is never displayed. When the `autoattrib' option is
307used, the -noformat switch is passed to the repl program to override a
308-filter or -format switch.
309
310If nil, yank only the portion of the message following the point.
311
312If the show buffer has a region, this variable is ignored unless its value is
313one of `attribution' or `autoattrib' in which case the attribution is added
314to the yanked region."
315 :type '(choice (const :tag "Below point" nil)
316 (const :tag "Without header" body)
317 (const :tag "Invoke supercite" supercite)
318 (const :tag "Invoke supercite, automatically" autosupercite)
319 (const :tag "Without header, with attribution" attribution)
320 (const :tag "Without header, with attribution, automatically"
321 autoattrib)
322 (const :tag "Entire message with headers" t))
323 :group 'mh-compose)
324
325(defcustom mh-extract-from-attribution-verb "wrote:"
326 "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
327 :type '(choice (const "wrote:")
328 (const "a écrit :")
329 (string :tag "Custom string"))
330 :group 'mh-compose)
331
332(defcustom mh-ins-buf-prefix "> "
333 "*String to put before each non-blank line of a yanked or inserted message.
334\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
335by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
336 :type 'string
337 :group 'mh-compose)
338
339(defcustom mh-reply-default-reply-to nil
340 "*Sets the person or persons to whom a reply will be sent.
341If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
342value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
343The values \"cc\" and \"all\" do the same thing."
344 :type '(choice (const :tag "Prompt" nil)
345 (const "from") (const "to")
346 (const "cc") (const "all"))
347 :group 'mh-compose)
348
349(defcustom mh-signature-file-name "~/.signature"
350 "*Name of file containing the user's signature.
351Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
352 :type 'file
353 :group 'mh-compose)
354
355(defcustom mh-forward-subject-format "%s: %s"
356 "*Format to generate the Subject: line contents for a forwarded message.
357The two string arguments to the format are the sender of the original
358message and the original subject line."
359 :type 'string
360 :group 'mh-compose)
361
362(defvar mh-comp-formfile "components" 131(defvar mh-comp-formfile "components"
363 "Name of file to be used as a skeleton for composing messages. 132 "Name of file to be used as a skeleton for composing messages.
364Default is \"components\". If not an absolute file name, the file 133Default is \"components\". If not an absolute file name, the file
@@ -378,65 +147,19 @@ message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
378If not an absolute file name, the file is searched for first in the user's MH 147If not an absolute file name, the file is searched for first in the user's MH
379directory, then in the system MH lib directory.") 148directory, then in the system MH lib directory.")
380 149
381(defcustom mh-reply-show-message-flag t
382 "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
383
384The setting of this variable determines whether the MH `show-buffer' is
385displayed with the current message when using `mh-reply' without a prefix
386argument. Set it to nil if you already include the message automatically
387in your draft using
388 repl: -filter repl.filter
389in your ~/.mh_profile file."
390 :type 'boolean
391 :group 'mh-compose)
392
393(defcustom mh-letter-fill-column 72
394 "*Fill column to use in `mh-letter-mode'.
395This is usually less than in other text modes because email messages get
396quoted by some prefix (sometimes many times) when they are replied to,
397and it's best to avoid quoted lines that span more than 80 columns."
398 :type 'integer
399 :group 'mh-compose)
400
401;;; Hooks:
402
403(defcustom mh-letter-mode-hook nil
404 "Invoked in `mh-letter-mode' on a new letter."
405 :type 'hook
406 :group 'mh-compose)
407
408(defcustom mh-compose-letter-function nil
409 "Invoked when setting up a letter draft.
410It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
411 :type '(choice (const nil) function)
412 :group 'mh-compose)
413
414(defcustom mh-before-send-letter-hook nil
415 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
416 :type 'hook
417 :group 'mh-compose)
418
419(defcustom mh-letter-insert-signature-hook nil
420 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
421Can be used to determine which signature file to use based on message content.
422On return, if `mh-signature-file-name' is non-nil that file will be inserted at
423the current point in the buffer."
424 :type 'hook
425 :group 'mh-compose)
426
427(defvar mh-rejected-letter-start 150(defvar mh-rejected-letter-start
428 (format "^%s$" 151 (format "^%s$"
429 (regexp-opt 152 (regexp-opt
430 '("Content-Type: message/rfc822" ;MIME MDN 153 '("Content-Type: message/rfc822" ;MIME MDN
431 " ----- Unsent message follows -----" ;from sendmail V5 154 " ----- Unsent message follows -----" ;from sendmail V5
432 " --------Unsent Message below:" ; from sendmail at BU 155 " --------Unsent Message below:" ; from sendmail at BU
433 " ----- Original message follows -----" ;from sendmail V8 156 " ----- Original message follows -----" ;from sendmail V8
434 "------- Unsent Draft" ;from MH itself 157 "------- Unsent Draft" ;from MH itself
435 "---------- Original Message ----------" ;from zmailer 158 "---------- Original Message ----------" ;from zmailer
436 " --- The unsent message follows ---" ;from AIX mail system 159 " --- The unsent message follows ---" ;from AIX mail system
437 " Your message follows:" ;from MMDF-II 160 " Your message follows:" ;from MMDF-II
438 "Content-Description: Returned Content" ;1993 KJ sendmail 161 "Content-Description: Returned Content" ;1993 KJ sendmail
439 )))) 162 ))))
440 163
441(defvar mh-new-draft-cleaned-headers 164(defvar mh-new-draft-cleaned-headers
442 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" 165 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
@@ -444,8 +167,8 @@ the current point in the buffer."
444Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") 167Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
445 168
446(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") 169(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
447 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") 170 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
448 ("d" . "Dcc:")) 171 ("d" . "Dcc:"))
449 "Alist of (final-character . field-name) choices for `mh-to-field'.") 172 "Alist of (final-character . field-name) choices for `mh-to-field'.")
450 173
451(defvar mh-letter-mode-map (copy-keymap text-mode-map) 174(defvar mh-letter-mode-map (copy-keymap text-mode-map)
@@ -456,9 +179,9 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
456 179
457(if mh-letter-mode-syntax-table 180(if mh-letter-mode-syntax-table
458 () 181 ()
459 (setq mh-letter-mode-syntax-table 182 (setq mh-letter-mode-syntax-table
460 (make-syntax-table text-mode-syntax-table)) 183 (make-syntax-table text-mode-syntax-table))
461 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) 184 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
462 185
463(defvar mh-sent-from-folder nil 186(defvar mh-sent-from-folder nil
464 "Folder of msg assoc with this letter.") 187 "Folder of msg assoc with this letter.")
@@ -486,7 +209,7 @@ See documentation of `\\[mh-send]' for more details on composing mail."
486 (mh-find-path) 209 (mh-find-path)
487 (call-interactively 'mh-send)) 210 (call-interactively 'mh-send))
488 211
489(defvar mh-error-if-no-draft nil) ;raise error over using old draft 212(defvar mh-error-if-no-draft nil) ;raise error over using old draft
490 213
491;;;###autoload 214;;;###autoload
492(defun mh-smail-batch (&optional to subject other-headers &rest ignored) 215(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
@@ -505,8 +228,8 @@ OTHER-HEADERS. Additional arguments are IGNORED."
505;; XEmacs needs this: 228;; XEmacs needs this:
506;;;###autoload 229;;;###autoload
507(defun mh-user-agent-compose (&optional to subject other-headers continue 230(defun mh-user-agent-compose (&optional to subject other-headers continue
508 switch-function yank-action 231 switch-function yank-action
509 send-actions) 232 send-actions)
510 "Set up mail composition draft with the MH mail system. 233 "Set up mail composition draft with the MH mail system.
511This is `mail-user-agent' entry point to MH-E. 234This is `mail-user-agent' entry point to MH-E.
512 235
@@ -523,9 +246,10 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
523 (mh-send to "" subject) 246 (mh-send to "" subject)
524 (while other-headers 247 (while other-headers
525 (mh-insert-fields (concat (car (car other-headers)) ":") 248 (mh-insert-fields (concat (car (car other-headers)) ":")
526 (cdr (car other-headers))) 249 (cdr (car other-headers)))
527 (setq other-headers (cdr other-headers))))) 250 (setq other-headers (cdr other-headers)))))
528 251
252;;;###mh-autoload
529(defun mh-edit-again (msg) 253(defun mh-edit-again (msg)
530 "Clean up a draft or a message MSG previously sent and make it resendable. 254 "Clean up a draft or a message MSG previously sent and make it resendable.
531Default is the current message. 255Default is the current message.
@@ -533,11 +257,11 @@ The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
533See also documentation for `\\[mh-send]' function." 257See also documentation for `\\[mh-send]' function."
534 (interactive (list (mh-get-msg-num t))) 258 (interactive (list (mh-get-msg-num t)))
535 (let* ((from-folder mh-current-folder) 259 (let* ((from-folder mh-current-folder)
536 (config (current-window-configuration)) 260 (config (current-window-configuration))
537 (draft 261 (draft
538 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) 262 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
539 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) 263 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
540 (rename-buffer (format "draft-%d" msg)) 264 (rename-buffer (format "draft-%d" msg))
541 ;; Make buffer writable... 265 ;; Make buffer writable...
542 (setq buffer-read-only nil) 266 (setq buffer-read-only nil)
543 ;; If buffer was being used to display the message reinsert 267 ;; If buffer was being used to display the message reinsert
@@ -545,17 +269,18 @@ See also documentation for `\\[mh-send]' function."
545 (when (eq major-mode 'mh-show-mode) 269 (when (eq major-mode 'mh-show-mode)
546 (erase-buffer) 270 (erase-buffer)
547 (insert-file-contents buffer-file-name)) 271 (insert-file-contents buffer-file-name))
548 (buffer-name)) 272 (buffer-name))
549 (t 273 (t
550 (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) 274 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
551 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) 275 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
552 (mh-insert-header-separator) 276 (mh-insert-header-separator)
553 (goto-char (point-min)) 277 (goto-char (point-min))
554 (save-buffer) 278 (save-buffer)
555 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil 279 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
556 config) 280 config)
557 (mh-letter-mode-message))) 281 (mh-letter-mode-message)))
558 282
283;;;###mh-autoload
559(defun mh-extract-rejected-mail (msg) 284(defun mh-extract-rejected-mail (msg)
560 "Extract message MSG returned by the mail system and make it resendable. 285 "Extract message MSG returned by the mail system and make it resendable.
561Default is the current message. The variable `mh-new-draft-cleaned-headers' 286Default is the current message. The variable `mh-new-draft-cleaned-headers'
@@ -563,27 +288,28 @@ gives the headers to clean out of the original message.
563See also documentation for `\\[mh-send]' function." 288See also documentation for `\\[mh-send]' function."
564 (interactive (list (mh-get-msg-num t))) 289 (interactive (list (mh-get-msg-num t)))
565 (let ((from-folder mh-current-folder) 290 (let ((from-folder mh-current-folder)
566 (config (current-window-configuration)) 291 (config (current-window-configuration))
567 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) 292 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
568 (goto-char (point-min)) 293 (goto-char (point-min))
569 (cond ((re-search-forward mh-rejected-letter-start nil t) 294 (cond ((re-search-forward mh-rejected-letter-start nil t)
570 (skip-chars-forward " \t\n") 295 (skip-chars-forward " \t\n")
571 (delete-region (point-min) (point)) 296 (delete-region (point-min) (point))
572 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) 297 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
573 (t 298 (t
574 (message "Does not appear to be a rejected letter."))) 299 (message "Does not appear to be a rejected letter.")))
575 (mh-insert-header-separator) 300 (mh-insert-header-separator)
576 (goto-char (point-min)) 301 (goto-char (point-min))
577 (save-buffer) 302 (save-buffer)
578 (mh-compose-and-send-mail draft "" from-folder msg 303 (mh-compose-and-send-mail draft "" from-folder msg
579 (mh-get-header-field "To:") 304 (mh-get-header-field "To:")
580 (mh-get-header-field "From:") 305 (mh-get-header-field "From:")
581 (mh-get-header-field "Cc:") 306 (mh-get-header-field "Cc:")
582 nil nil config) 307 nil nil config)
583 (mh-letter-mode-message))) 308 (mh-letter-mode-message)))
584 309
310;;;###mh-autoload
585(defun mh-forward (to cc &optional msg-or-seq) 311(defun mh-forward (to cc &optional msg-or-seq)
586"Forward one or more messages to the recipients TO and CC. 312 "Forward one or more messages to the recipients TO and CC.
587 313
588Use the optional MSG-OR-SEQ to specify a message or sequence to forward. 314Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
589 315
@@ -592,90 +318,93 @@ prompt for the message sequence. If variable `transient-mark-mode' is non-nil
592and the mark is active, then the selected region is forwarded. 318and the mark is active, then the selected region is forwarded.
593See also documentation for `\\[mh-send]' function." 319See also documentation for `\\[mh-send]' function."
594 (interactive (list (mh-read-address "To: ") 320 (interactive (list (mh-read-address "To: ")
595 (mh-read-address "Cc: ") 321 (mh-read-address "Cc: ")
596 (cond 322 (cond
597 ((mh-mark-active-p t) 323 ((mh-mark-active-p t)
598 (mh-region-to-sequence (region-beginning) (region-end)) 324 (mh-region-to-msg-list (region-beginning) (region-end)))
599 'region)
600 (current-prefix-arg 325 (current-prefix-arg
601 (mh-read-seq-default "Forward" t)) 326 (mh-read-seq-default "Forward" t))
602 (t 327 (t
603 (mh-get-msg-num t))))) 328 (mh-get-msg-num t)))))
604 (let* ((folder mh-current-folder) 329 (let* ((folder mh-current-folder)
605 (msgs (if (numberp msg-or-seq) 330 (msgs (cond ((numberp msg-or-seq) (list msg-or-seq))
606 (list msg-or-seq) 331 ((listp msg-or-seq) msg-or-seq)
607 (mh-seq-to-msgs msg-or-seq))) 332 (t (mh-seq-to-msgs msg-or-seq))))
608 (config (current-window-configuration)) 333 (config (current-window-configuration))
609 (fwd-msg-file (mh-msg-filename (car msgs) folder)) 334 (fwd-msg-file (mh-msg-filename (car msgs) folder))
610 ;; forw always leaves file in "draft" since it doesn't have -draft 335 ;; forw always leaves file in "draft" since it doesn't have -draft
611 (draft-name (expand-file-name "draft" mh-user-path)) 336 (draft-name (expand-file-name "draft" mh-user-path))
612 (draft (cond ((or (not (file-exists-p draft-name)) 337 (draft (cond ((or (not (file-exists-p draft-name))
613 (y-or-n-p "The file 'draft' exists. Discard it? ")) 338 (y-or-n-p "The file 'draft' exists. Discard it? "))
614 (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") 339 (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
615 mh-current-folder msgs) 340 mh-current-folder msgs)
616 (prog1 341 (prog1
617 (mh-read-draft "" draft-name t) 342 (mh-read-draft "" draft-name t)
618 (mh-insert-fields "To:" to "Cc:" cc) 343 (mh-insert-fields "To:" to "Cc:" cc)
619 (save-buffer))) 344 (save-buffer)))
620 (t 345 (t
621 (mh-read-draft "" draft-name nil))))) 346 (mh-read-draft "" draft-name nil)))))
622 (let (orig-from 347 (let (orig-from
623 orig-subject) 348 orig-subject)
624 (save-excursion 349 (save-excursion
625 (set-buffer (get-buffer-create mh-temp-buffer)) 350 (set-buffer (get-buffer-create mh-temp-buffer))
626 (erase-buffer) 351 (erase-buffer)
627 (insert-file-contents fwd-msg-file) 352 (insert-file-contents fwd-msg-file)
628 (setq orig-from (mh-get-header-field "From:")) 353 (setq orig-from (mh-get-header-field "From:"))
629 (setq orig-subject (mh-get-header-field "Subject:"))) 354 (setq orig-subject (mh-get-header-field "Subject:")))
630 (let ((forw-subject 355 (let ((forw-subject
631 (mh-forwarded-letter-subject orig-from orig-subject)) 356 (mh-forwarded-letter-subject orig-from orig-subject))
632 (mail-header-separator mh-mail-header-separator) 357 (compose))
633 (compose)) 358 (mh-insert-fields "Subject:" forw-subject)
634 (mh-insert-fields "Subject:" forw-subject) 359 (goto-char (point-min))
635 (goto-char (point-min)) 360 ;; If using MML, translate mhn
636 ;; If using MML, translate mhn 361 (if (equal mh-compose-insertion 'gnus)
637 (if (equal mh-compose-insertion 'gnus) 362 (save-excursion
638 (save-excursion 363 (setq compose t)
639 (setq compose t) 364 (re-search-forward (format "^\\(%s\\)?$"
640 (re-search-forward (format "^\\(%s\\)?$" mail-header-separator)) 365 mh-mail-header-separator))
641 (while 366 (while
642 (re-search-forward "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" (point-max) t) 367 (re-search-forward
643 (let ((description (if (equal (match-string 1) "forwarded messages") 368 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
644 "forwarded message %d" 369 (point-max) t)
645 (match-string 1))) 370 (let ((description (if (equal (match-string 1)
646 (msgs (split-string (match-string 3))) 371 "forwarded messages")
647 (i 0)) 372 "forwarded message %d"
648 (beginning-of-line) 373 (match-string 1)))
649 (delete-region (point)(progn (forward-line 1)(point))) 374 (msgs (split-string (match-string 3)))
650 (dolist (msg msgs) 375 (i 0))
651 (setq i (1+ i)) 376 (beginning-of-line)
652 (mh-mml-forward-message (format description i) folder msg)))))) 377 (delete-region (point) (progn (forward-line 1) (point)))
653 ;; Postition just before forwarded message 378 (dolist (msg msgs)
654 (if (re-search-forward "^------- Forwarded Message" nil t) 379 (setq i (1+ i))
655 (forward-line -1) 380 (mh-mml-forward-message (format description i)
656 (re-search-forward (format "^\\(%s\\)?$" mail-header-separator)) 381 folder msg))))))
657 (forward-line 1)) 382 ;; Postition just before forwarded message
658 (delete-other-windows) 383 (if (re-search-forward "^------- Forwarded Message" nil t)
659 (mh-add-msgs-to-seq msgs 'forwarded t) 384 (forward-line -1)
660 (mh-compose-and-send-mail draft "" folder msg-or-seq 385 (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
661 to forw-subject cc 386 (forward-line 1))
662 mh-note-forw "Forwarded:" 387 (delete-other-windows)
663 config) 388 (mh-add-msgs-to-seq msgs 'forwarded t)
664 (if compose 389 (mh-compose-and-send-mail draft "" folder msg-or-seq
665 (setq mh-mml-compose-insert-flag t)) 390 to forw-subject cc
666 (mh-letter-mode-message))))) 391 mh-note-forw "Forwarded:"
392 config)
393 (if compose
394 (setq mh-mml-compose-insert-flag t))
395 (mh-letter-mode-message)))))
667 396
668(defun mh-forwarded-letter-subject (from subject) 397(defun mh-forwarded-letter-subject (from subject)
669 "Return a Subject suitable for a forwarded message. 398 "Return a Subject suitable for a forwarded message.
670Original message has headers FROM and SUBJECT." 399Original message has headers FROM and SUBJECT."
671 (let ((addr-start (string-match "<" from)) 400 (let ((addr-start (string-match "<" from))
672 (comment (string-match "(" from))) 401 (comment (string-match "(" from)))
673 (cond ((and addr-start (> addr-start 0)) 402 (cond ((and addr-start (> addr-start 0))
674 ;; Full Name <luser@host> 403 ;; Full Name <luser@host>
675 (setq from (substring from 0 (1- addr-start)))) 404 (setq from (substring from 0 (1- addr-start))))
676 (comment 405 (comment
677 ;; luser@host (Full Name) 406 ;; luser@host (Full Name)
678 (setq from (substring from (1+ comment) (1- (length from))))))) 407 (setq from (substring from (1+ comment) (1- (length from)))))))
679 (format mh-forward-subject-format from subject)) 408 (format mh-forward-subject-format from subject))
680 409
681;;;###autoload 410;;;###autoload
@@ -689,57 +418,59 @@ See documentation of `\\[mh-send]' for more details on composing mail."
689 (mh-find-path) 418 (mh-find-path)
690 (call-interactively 'mh-send-other-window)) 419 (call-interactively 'mh-send-other-window))
691 420
421;;;###mh-autoload
692(defun mh-redistribute (to cc &optional msg) 422(defun mh-redistribute (to cc &optional msg)
693 "Redistribute displayed message to recipients TO and CC. 423 "Redistribute displayed message to recipients TO and CC.
694Use optional argument MSG to redistribute another message. 424Use optional argument MSG to redistribute another message.
695Depending on how your copy of MH was compiled, you may need to change the 425Depending on how your copy of MH was compiled, you may need to change the
696setting of the variable `mh-redist-full-contents'. See its documentation." 426setting of the variable `mh-redist-full-contents'. See its documentation."
697 (interactive (list (mh-read-address "Redist-To: ") 427 (interactive (list (mh-read-address "Redist-To: ")
698 (mh-read-address "Redist-Cc: ") 428 (mh-read-address "Redist-Cc: ")
699 (mh-get-msg-num t))) 429 (mh-get-msg-num t)))
700 (or msg 430 (or msg
701 (setq msg (mh-get-msg-num t))) 431 (setq msg (mh-get-msg-num t)))
702 (save-window-excursion 432 (save-window-excursion
703 (let ((folder mh-current-folder) 433 (let ((folder mh-current-folder)
704 (draft (mh-read-draft "redistribution" 434 (draft (mh-read-draft "redistribution"
705 (if mh-redist-full-contents 435 (if mh-redist-full-contents
706 (mh-msg-filename msg) 436 (mh-msg-filename msg)
707 nil) 437 nil)
708 nil))) 438 nil)))
709 (mh-goto-header-end 0) 439 (mh-goto-header-end 0)
710 (insert "Resent-To: " to "\n") 440 (insert "Resent-To: " to "\n")
711 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) 441 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
712 (mh-clean-msg-header (point-min) 442 (mh-clean-msg-header (point-min)
713 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" 443 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
714 nil) 444 nil)
715 (save-buffer) 445 (save-buffer)
716 (message "Redistributing...") 446 (message "Redistributing...")
717 (if (not mh-redist-background) 447 (if (not mh-redist-background)
718 (if mh-redist-full-contents 448 (if mh-redist-full-contents
719 (call-process "/bin/sh" nil 0 nil "-c" 449 (call-process "/bin/sh" nil 0 nil "-c"
720 (format "mhdist=1 mhaltmsg=%s %s -push %s" 450 (format "mhdist=1 mhaltmsg=%s %s -push %s"
721 buffer-file-name 451 buffer-file-name
722 (expand-file-name mh-send-prog mh-progs) 452 (expand-file-name mh-send-prog mh-progs)
723 buffer-file-name)) 453 buffer-file-name))
724 (call-process "/bin/sh" nil 0 nil "-c" 454 (call-process "/bin/sh" nil 0 nil "-c"
725 (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" 455 (format
726 (mh-msg-filename msg folder) 456 "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
727 (expand-file-name mh-send-prog mh-progs) 457 (mh-msg-filename msg folder)
728 buffer-file-name)))) 458 (expand-file-name mh-send-prog mh-progs)
459 buffer-file-name))))
729 (mh-annotate-msg msg folder mh-note-dist 460 (mh-annotate-msg msg folder mh-note-dist
730 "-component" "Resent:" 461 "-component" "Resent:"
731 "-text" (format "\"%s %s\"" to cc)) 462 "-text" (format "\"%s %s\"" to cc))
732 (if mh-redist-background 463 (if mh-redist-background
733 (mh-exec-cmd-daemon "/bin/sh" "-c" 464 (mh-exec-cmd-daemon "/bin/sh" "-c"
734 (format "mhdist=1 mhaltmsg=%s %s %s %s" 465 (format "mhdist=1 mhaltmsg=%s %s %s %s"
735 (if mh-redist-full-contents 466 (if mh-redist-full-contents
736 buffer-file-name 467 buffer-file-name
737 (mh-msg-filename msg folder)) 468 (mh-msg-filename msg folder))
738 (if mh-redist-full-contents 469 (if mh-redist-full-contents
739 "" 470 ""
740 "mhannotate=1") 471 "mhannotate=1")
741 (mh-expand-file-name "send" mh-progs) 472 (mh-expand-file-name "send" mh-progs)
742 buffer-file-name))) 473 buffer-file-name)))
743 (kill-buffer draft) 474 (kill-buffer draft)
744 (message "Redistributing...done")))) 475 (message "Redistributing...done"))))
745 476
@@ -754,9 +485,9 @@ Optional argument BUFFER can be used to specify the buffer."
754 (if buffer 485 (if buffer
755 (set-buffer buffer)) 486 (set-buffer buffer))
756 (cond ((eq major-mode 'mh-show-mode) 487 (cond ((eq major-mode 'mh-show-mode)
757 (let ((number-start (search "/" buffer-file-name :from-end t))) 488 (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
758 (car (read-from-string (subseq buffer-file-name 489 (car (read-from-string (substring buffer-file-name
759 (1+ number-start)))))) 490 (1+ number-start))))))
760 ((and (eq major-mode 'mh-folder-mode) 491 ((and (eq major-mode 'mh-folder-mode)
761 mh-show-buffer 492 mh-show-buffer
762 (get-buffer mh-show-buffer)) 493 (get-buffer mh-show-buffer))
@@ -768,6 +499,7 @@ Optional argument BUFFER can be used to specify the buffer."
768 (t 499 (t
769 nil)))) 500 nil))))
770 501
502;;;###mh-autoload
771(defun mh-reply (message &optional reply-to includep) 503(defun mh-reply (message &optional reply-to includep)
772 "Reply to MESSAGE (default: current message). 504 "Reply to MESSAGE (default: current message).
773If the optional argument REPLY-TO is not given, prompts for type of addresses 505If the optional argument REPLY-TO is not given, prompts for type of addresses
@@ -810,11 +542,11 @@ for the reply. See also documentation for `\\[mh-send]' function."
810 (group-reply (if mh-nmh-flag 542 (group-reply (if mh-nmh-flag
811 '("-group" "-nocc" "me") 543 '("-group" "-nocc" "me")
812 '("-cc" "all" "-nocc" "me")))) 544 '("-cc" "all" "-nocc" "me"))))
813 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) 545 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
814 (eq mh-yank-from-start-of-msg 'autoattrib)) 546 (eq mh-yank-from-start-of-msg 'autoattrib))
815 '("-noformat")) 547 '("-noformat"))
816 (includep '("-filter" "mhl.reply")) 548 (includep '("-filter" "mhl.reply"))
817 (t '()))) 549 (t '())))
818 (let ((draft (mh-read-draft "reply" 550 (let ((draft (mh-read-draft "reply"
819 (expand-file-name "reply" mh-user-path) 551 (expand-file-name "reply" mh-user-path)
820 t))) 552 t)))
@@ -841,6 +573,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
841 (mh-yank-cur-msg)) 573 (mh-yank-cur-msg))
842 (mh-letter-mode-message)))) 574 (mh-letter-mode-message))))
843 575
576;;;###mh-autoload
844(defun mh-send (to cc subject) 577(defun mh-send (to cc subject)
845 "Compose and send a letter. 578 "Compose and send a letter.
846 579
@@ -852,13 +585,14 @@ details.
852If `mh-compose-letter-function' is defined, it is called on the draft and 585If `mh-compose-letter-function' is defined, it is called on the draft and
853passed three arguments: TO, CC, and SUBJECT." 586passed three arguments: TO, CC, and SUBJECT."
854 (interactive (list 587 (interactive (list
855 (mh-read-address "To: ") 588 (mh-read-address "To: ")
856 (mh-read-address "Cc: ") 589 (mh-read-address "Cc: ")
857 (read-string "Subject: "))) 590 (read-string "Subject: ")))
858 (let ((config (current-window-configuration))) 591 (let ((config (current-window-configuration)))
859 (delete-other-windows) 592 (delete-other-windows)
860 (mh-send-sub to cc subject config))) 593 (mh-send-sub to cc subject config)))
861 594
595;;;###mh-autoload
862(defun mh-send-other-window (to cc subject) 596(defun mh-send-other-window (to cc subject)
863 "Compose and send a letter in another window. 597 "Compose and send a letter in another window.
864 598
@@ -871,9 +605,9 @@ details.
871If `mh-compose-letter-function' is defined, it is called on the draft and 605If `mh-compose-letter-function' is defined, it is called on the draft and
872passed three arguments: TO, CC, and SUBJECT." 606passed three arguments: TO, CC, and SUBJECT."
873 (interactive (list 607 (interactive (list
874 (mh-read-address "To: ") 608 (mh-read-address "To: ")
875 (mh-read-address "Cc: ") 609 (mh-read-address "Cc: ")
876 (read-string "Subject: "))) 610 (read-string "Subject: ")))
877 (let ((pop-up-windows t)) 611 (let ((pop-up-windows t))
878 (mh-send-sub to cc subject (current-window-configuration)))) 612 (mh-send-sub to cc subject (current-window-configuration))))
879 613
@@ -882,38 +616,38 @@ passed three arguments: TO, CC, and SUBJECT."
882Expects the TO, CC, and SUBJECT fields as arguments. 616Expects the TO, CC, and SUBJECT fields as arguments.
883CONFIG is the window configuration before sending mail." 617CONFIG is the window configuration before sending mail."
884 (let ((folder mh-current-folder) 618 (let ((folder mh-current-folder)
885 (msg-num (mh-get-msg-num nil))) 619 (msg-num (mh-get-msg-num nil)))
886 (message "Composing a message...") 620 (message "Composing a message...")
887 (let ((draft (mh-read-draft 621 (let ((draft (mh-read-draft
888 "message" 622 "message"
889 (let (components) 623 (let (components)
890 (cond 624 (cond
891 ((file-exists-p 625 ((file-exists-p
892 (setq components 626 (setq components
893 (expand-file-name mh-comp-formfile mh-user-path))) 627 (expand-file-name mh-comp-formfile mh-user-path)))
894 components) 628 components)
895 ((file-exists-p 629 ((file-exists-p
896 (setq components 630 (setq components
897 (expand-file-name mh-comp-formfile mh-lib))) 631 (expand-file-name mh-comp-formfile mh-lib)))
898 components) 632 components)
899 ((file-exists-p 633 ((file-exists-p
900 (setq components 634 (setq components
901 (expand-file-name mh-comp-formfile 635 (expand-file-name mh-comp-formfile
902 ;; What is this mh-etc ?? -sm 636 ;; What is this mh-etc ?? -sm
903 ;; This is dead code, so 637 ;; This is dead code, so
904 ;; remove it. 638 ;; remove it.
905 ;(and (boundp 'mh-etc) mh-etc) 639 ;(and (boundp 'mh-etc) mh-etc)
906 ))) 640 )))
907 components) 641 components)
908 (t 642 (t
909 (error (format "Can't find components file \"%s\"" 643 (error (format "Can't find components file \"%s\""
910 components))))) 644 components)))))
911 nil))) 645 nil)))
912 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) 646 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
913 (goto-char (point-max)) 647 (goto-char (point-max))
914 (mh-compose-and-send-mail draft "" folder msg-num 648 (mh-compose-and-send-mail draft "" folder msg-num
915 to subject cc 649 to subject cc
916 nil nil config) 650 nil nil config)
917 (mh-letter-mode-message)))) 651 (mh-letter-mode-message))))
918 652
919(defun mh-read-draft (use initial-contents delete-contents-file) 653(defun mh-read-draft (use initial-contents delete-contents-file)
@@ -927,42 +661,42 @@ If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
927used each time and saved in the draft folder. The draft file can then be 661used each time and saved in the draft folder. The draft file can then be
928reused." 662reused."
929 (cond (mh-draft-folder 663 (cond (mh-draft-folder
930 (let ((orig-default-dir default-directory) 664 (let ((orig-default-dir default-directory)
931 (draft-file-name (mh-new-draft-name))) 665 (draft-file-name (mh-new-draft-name)))
932 (pop-to-buffer (generate-new-buffer 666 (pop-to-buffer (generate-new-buffer
933 (format "draft-%s" 667 (format "draft-%s"
934 (file-name-nondirectory draft-file-name)))) 668 (file-name-nondirectory draft-file-name))))
935 (condition-case () 669 (condition-case ()
936 (insert-file-contents draft-file-name t) 670 (insert-file-contents draft-file-name t)
937 (file-error)) 671 (file-error))
938 (setq default-directory orig-default-dir))) 672 (setq default-directory orig-default-dir)))
939 (t 673 (t
940 (let ((draft-name (expand-file-name "draft" mh-user-path))) 674 (let ((draft-name (expand-file-name "draft" mh-user-path)))
941 (pop-to-buffer "draft") ; Create if necessary 675 (pop-to-buffer "draft") ; Create if necessary
942 (if (buffer-modified-p) 676 (if (buffer-modified-p)
943 (if (y-or-n-p "Draft has been modified; kill anyway? ") 677 (if (y-or-n-p "Draft has been modified; kill anyway? ")
944 (set-buffer-modified-p nil) 678 (set-buffer-modified-p nil)
945 (error "Draft preserved"))) 679 (error "Draft preserved")))
946 (setq buffer-file-name draft-name) 680 (setq buffer-file-name draft-name)
947 (clear-visited-file-modtime) 681 (clear-visited-file-modtime)
948 (unlock-buffer) 682 (unlock-buffer)
949 (cond ((and (file-exists-p draft-name) 683 (cond ((and (file-exists-p draft-name)
950 (not (equal draft-name initial-contents))) 684 (not (equal draft-name initial-contents)))
951 (insert-file-contents draft-name) 685 (insert-file-contents draft-name)
952 (delete-file draft-name)))))) 686 (delete-file draft-name))))))
953 (cond ((and initial-contents 687 (cond ((and initial-contents
954 (or (zerop (buffer-size)) 688 (or (zerop (buffer-size))
955 (if (y-or-n-p 689 (if (y-or-n-p
956 (format "A draft exists. Use for %s? " use)) 690 (format "A draft exists. Use for %s? " use))
957 (if mh-error-if-no-draft 691 (if mh-error-if-no-draft
958 (error "A prior draft exists")) 692 (error "A prior draft exists"))
959 t))) 693 t)))
960 (erase-buffer) 694 (erase-buffer)
961 (insert-file-contents initial-contents) 695 (insert-file-contents initial-contents)
962 (if delete-contents-file (delete-file initial-contents)))) 696 (if delete-contents-file (delete-file initial-contents))))
963 (auto-save-mode 1) 697 (auto-save-mode 1)
964 (if mh-draft-folder 698 (if mh-draft-folder
965 (save-buffer)) ; Do not reuse draft name 699 (save-buffer)) ; Do not reuse draft name
966 (buffer-name)) 700 (buffer-name))
967 701
968(defun mh-new-draft-name () 702(defun mh-new-draft-name ()
@@ -975,11 +709,11 @@ reused."
975 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS." 709 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
976 (apply 'mh-exec-cmd "anno" buffer msg args) 710 (apply 'mh-exec-cmd "anno" buffer msg args)
977 (save-excursion 711 (save-excursion
978 (cond ((get-buffer buffer) ; Buffer may be deleted 712 (cond ((get-buffer buffer) ; Buffer may be deleted
979 (set-buffer buffer) 713 (set-buffer buffer)
980 (if (symbolp msg) 714 (if (numberp msg)
981 (mh-notate-seq msg note (1+ mh-cmd-note)) 715 (mh-notate msg note (1+ mh-cmd-note))
982 (mh-notate msg note (1+ mh-cmd-note))))))) 716 (mh-notate-seq msg note (1+ mh-cmd-note)))))))
983 717
984(defun mh-insert-fields (&rest name-values) 718(defun mh-insert-fields (&rest name-values)
985 "Insert the NAME-VALUES pairs in the current buffer. 719 "Insert the NAME-VALUES pairs in the current buffer.
@@ -988,14 +722,14 @@ Do not insert any pairs whose value is the empty string."
988 (let ((case-fold-search t)) 722 (let ((case-fold-search t))
989 (while name-values 723 (while name-values
990 (let ((field-name (car name-values)) 724 (let ((field-name (car name-values))
991 (value (car (cdr name-values)))) 725 (value (car (cdr name-values))))
992 (cond ((equal value "") 726 (cond ((equal value "")
993 nil) 727 nil)
994 ((mh-position-on-field field-name) 728 ((mh-position-on-field field-name)
995 (insert " " (or value ""))) 729 (insert " " (or value "")))
996 (t 730 (t
997 (insert field-name " " value "\n"))) 731 (insert field-name " " value "\n")))
998 (setq name-values (cdr (cdr name-values))))))) 732 (setq name-values (cdr (cdr name-values)))))))
999 733
1000(defun mh-position-on-field (field &optional ignored) 734(defun mh-position-on-field (field &optional ignored)
1001 "Move to the end of the FIELD in the header. 735 "Move to the end of the FIELD in the header.
@@ -1003,10 +737,10 @@ Move to end of entire header if FIELD not found.
1003Returns non-nil iff FIELD was found. 737Returns non-nil iff FIELD was found.
1004The optional second arg is for pre-version 4 compatibility and is IGNORED." 738The optional second arg is for pre-version 4 compatibility and is IGNORED."
1005 (cond ((mh-goto-header-field field) 739 (cond ((mh-goto-header-field field)
1006 (mh-header-field-end) 740 (mh-header-field-end)
1007 t) 741 t)
1008 ((mh-goto-header-end 0) 742 ((mh-goto-header-end 0)
1009 nil))) 743 nil)))
1010 744
1011(defun mh-get-header-field (field) 745(defun mh-get-header-field (field)
1012 "Find and return the body of FIELD in the mail header. 746 "Find and return the body of FIELD in the mail header.
@@ -1014,10 +748,10 @@ Returns the empty string if the field is not in the header of the
1014current buffer." 748current buffer."
1015 (if (mh-goto-header-field field) 749 (if (mh-goto-header-field field)
1016 (progn 750 (progn
1017 (skip-chars-forward " \t") ;strip leading white space in body 751 (skip-chars-forward " \t") ;strip leading white space in body
1018 (let ((start (point))) 752 (let ((start (point)))
1019 (mh-header-field-end) 753 (mh-header-field-end)
1020 (buffer-substring start (point)))) 754 (buffer-substring-no-properties start (point))))
1021 "")) 755 ""))
1022 756
1023(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility 757(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
@@ -1028,9 +762,9 @@ Move to the end of the FIELD name, which should end in a colon.
1028Returns t if found, nil if not." 762Returns t if found, nil if not."
1029 (goto-char (point-min)) 763 (goto-char (point-min))
1030 (let ((case-fold-search t) 764 (let ((case-fold-search t)
1031 (headers-end (save-excursion 765 (headers-end (save-excursion
1032 (mh-goto-header-end 0) 766 (mh-goto-header-end 0)
1033 (point)))) 767 (point))))
1034 (re-search-forward (format "^%s" field) headers-end t))) 768 (re-search-forward (format "^%s" field) headers-end t)))
1035 769
1036(defun mh-goto-header-end (arg) 770(defun mh-goto-header-end (arg)
@@ -1038,11 +772,14 @@ Returns t if found, nil if not."
1038 (if (re-search-forward "^-*$" nil nil) 772 (if (re-search-forward "^-*$" nil nil)
1039 (forward-line arg))) 773 (forward-line arg)))
1040 774
1041 775(defun mh-extract-from-header-value ()
1042(defun mh-read-address (prompt) 776 "Extract From: string from header."
1043 "Read a To: or Cc: address, prompting in the minibuffer with PROMPT. 777 (save-excursion
1044May someday do completion on aliases." 778 (if (not (mh-goto-header-field "From:"))
1045 (read-string prompt)) 779 (error "No From header line found")
780 (skip-chars-forward " \t")
781 (buffer-substring-no-properties
782 (point) (progn (mh-header-field-end)(point))))))
1046 783
1047 784
1048 785
@@ -1050,37 +787,6 @@ May someday do completion on aliases."
1050 787
1051(put 'mh-letter-mode 'mode-class 'special) 788(put 'mh-letter-mode 'mode-class 'special)
1052 789
1053;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1054(eval-when-compile (defvar tool-bar-map))
1055(defvar mh-letter-tool-bar-map nil)
1056(when (and (fboundp 'tool-bar-add-item)
1057 tool-bar-mode)
1058 (setq mh-letter-tool-bar-map
1059 (let ((tool-bar-map (make-sparse-keymap)))
1060 (tool-bar-add-item "mail_send" 'mh-send-letter 'mh-lettertoolbar-send
1061 :help "Send this letter")
1062 (tool-bar-add-item "attach" 'mh-compose-insertion
1063 'mh-lettertoolbar-compose
1064 :help "Insert attachment")
1065 (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
1066 :help "Check spelling")
1067 (tool-bar-add-item-from-menu 'save-buffer "save")
1068 (tool-bar-add-item-from-menu 'undo "undo")
1069 (tool-bar-add-item-from-menu 'kill-region "cut")
1070 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
1071 (tool-bar-add-item "close" 'mh-fully-kill-draft 'mh-lettertoolbar-kill
1072 :help "Kill this draft")
1073 (tool-bar-add-item "preferences" (lambda ()
1074 (interactive)
1075 (customize-group "mh-compose"))
1076 'mh-lettertoolbar-customize
1077 :help "MH-E composition preferences")
1078 (tool-bar-add-item "help" (lambda ()
1079 (interactive)
1080 (Info-goto-node "(mh-e)Draft Editing"))
1081 'mh-lettertoolbar-help :help "Help")
1082 tool-bar-map)))
1083
1084;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) 790;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1085(eval-when-compile (defvar mh-letter-menu nil)) 791(eval-when-compile (defvar mh-letter-menu nil))
1086(cond 792(cond
@@ -1094,17 +800,23 @@ May someday do completion on aliases."
1094 ["Yank Current Message" mh-yank-cur-msg t] 800 ["Yank Current Message" mh-yank-cur-msg t]
1095 ["Insert a Message..." mh-insert-letter t] 801 ["Insert a Message..." mh-insert-letter t]
1096 ["Insert Signature" mh-insert-signature t] 802 ["Insert Signature" mh-insert-signature t]
1097 ["GPG Sign message" mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] 803 ["GPG Sign message"
1098 ["GPG Encrypt message" mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] 804 mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
805 ["GPG Encrypt message"
806 mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
1099 ["Compose Insertion (MIME)..." mh-compose-insertion t] 807 ["Compose Insertion (MIME)..." mh-compose-insertion t]
1100;; ["Compose Compressed tar (MIME)..." mh-mhn-compose-external-compressed-tar t] 808 ;; ["Compose Compressed tar (MIME)..."
1101;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] 809 ;;mh-mhn-compose-external-compressed-tar t]
810 ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
1102 ["Compose Forward (MIME)..." mh-compose-forward t] 811 ["Compose Forward (MIME)..." mh-compose-forward t]
1103;; The next two will have to be merged. But I also need to make sure the user 812 ;; The next two will have to be merged. But I also need to make sure the
1104;; can't mix directives of both types. 813 ;; user can't mix directives of both types.
1105 ["Pull in All Compositions (mhn)" mh-edit-mhn mh-mhn-compose-insert-flag] 814 ["Pull in All Compositions (mhn)"
1106 ["Pull in All Compositions (gnus)" mh-mml-to-mime mh-mml-compose-insert-flag] 815 mh-edit-mhn mh-mhn-compose-insert-flag]
1107 ["Revert to Non-MIME Edit (mhn)" mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] 816 ["Pull in All Compositions (gnus)"
817 mh-mml-to-mime mh-mml-compose-insert-flag]
818 ["Revert to Non-MIME Edit (mhn)"
819 mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
1108 ["Kill This Draft" mh-fully-kill-draft t])))) 820 ["Kill This Draft" mh-fully-kill-draft t]))))
1109 821
1110;;; Help Messages 822;;; Help Messages
@@ -1134,7 +846,7 @@ non-prefixed commands.
1134The substitutions described in `substitute-command-keys' are performed as 846The substitutions described in `substitute-command-keys' are performed as
1135well.") 847well.")
1136 848
1137 849;;;###mh-autoload
1138(defun mh-fill-paragraph-function (arg) 850(defun mh-fill-paragraph-function (arg)
1139 "Fill paragraph at or after point. 851 "Fill paragraph at or after point.
1140Prefix ARG means justify as well. This function enables `fill-paragraph' to 852Prefix ARG means justify as well. This function enables `fill-paragraph' to
@@ -1152,10 +864,13 @@ work better in MH-Letter mode."
1152When you have finished composing, type \\[mh-send-letter] to send the message 864When you have finished composing, type \\[mh-send-letter] to send the message
1153using the MH mail handling system. 865using the MH mail handling system.
1154 866
1155If MH MIME directives are added manually, you must first run \\[mh-edit-mhn] 867There are two types of MIME directives used by MH-E: Gnus and MH. The option
1156before sending the message. MIME directives that are added by MH-E commands 868`mh-compose-insertion' controls what type of directives are inserted by MH-E
1157such as \\[mh-mhn-compose-insertion] are processed automatically when the 869commands. These directives can be converted to MIME body parts by running
1158message is sent. 870\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
871This step is mandatory if these directives are added manually. If the
872directives are inserted with MH-E commands such as \\[mh-compose-insertion],
873the directives are expanded automatically when the letter is sent.
1159 874
1160Options that control this mode can be changed with 875Options that control this mode can be changed with
1161\\[customize-group]; specify the \"mh-compose\" group. 876\\[customize-group]; specify the \"mh-compose\" group.
@@ -1185,21 +900,21 @@ When a message is composed, the hooks `text-mode-hook' and
1185 (setq fill-paragraph-function 'mh-fill-paragraph-function) 900 (setq fill-paragraph-function 'mh-fill-paragraph-function)
1186 (make-local-variable 'adaptive-fill-regexp) 901 (make-local-variable 'adaptive-fill-regexp)
1187 (setq adaptive-fill-regexp 902 (setq adaptive-fill-regexp
1188 (concat adaptive-fill-regexp 903 (concat adaptive-fill-regexp
1189 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) 904 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1190 (make-local-variable 'adaptive-fill-first-line-regexp) 905 (make-local-variable 'adaptive-fill-first-line-regexp)
1191 (setq adaptive-fill-first-line-regexp 906 (setq adaptive-fill-first-line-regexp
1192 (concat adaptive-fill-first-line-regexp 907 (concat adaptive-fill-first-line-regexp
1193 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) 908 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1194 ;; `-- ' precedes the signature. `-----' appears at the start of the 909 ;; `-- ' precedes the signature. `-----' appears at the start of the
1195 ;; lines that delimit forwarded messages. 910 ;; lines that delimit forwarded messages.
1196 ;; Lines containing just >= 3 dashes, perhaps after whitespace, 911 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
1197 ;; are also sometimes used and should be separators. 912 ;; are also sometimes used and should be separators.
1198 (setq paragraph-start (concat (regexp-quote mail-header-separator) 913 (setq paragraph-start (concat (regexp-quote mail-header-separator)
1199 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" 914 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
1200 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" 915 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
1201 "-- $\\|---+$\\|" 916 "-- $\\|---+$\\|"
1202 page-delimiter)) 917 page-delimiter))
1203 (setq paragraph-separate paragraph-start) 918 (setq paragraph-separate paragraph-start)
1204 ;; --- End of code from sendmail.el --- 919 ;; --- End of code from sendmail.el ---
1205 920
@@ -1219,16 +934,17 @@ When a message is composed, the hooks `text-mode-hook' and
1219 (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) 934 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
1220 (easy-menu-add mh-letter-menu) 935 (easy-menu-add mh-letter-menu)
1221 ;; See if a "forw: -mime" message containing a MIME composition. 936 ;; See if a "forw: -mime" message containing a MIME composition.
1222 ;; mode clears local vars, so can't do this in mh-forward. 937 ;; Mode clears local vars, so can't do this in mh-forward.
1223 (save-excursion 938 (save-excursion
1224 (goto-char (point-min)) 939 (goto-char (point-min))
1225 (when (and (re-search-forward (format "^\\(%s\\)?$" mail-header-separator) nil t) 940 (when (and (re-search-forward
941 (format "^\\(%s\\)?$" mail-header-separator) nil t)
1226 (= 0 (forward-line 1)) 942 (= 0 (forward-line 1))
1227 (looking-at "^#forw")) 943 (looking-at "^#forw"))
1228 (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var 944 (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var
1229 (setq mh-mhn-compose-insert-flag t))) 945 (setq mh-mhn-compose-insert-flag t)))
1230 (setq fill-column mh-letter-fill-column) 946 (setq fill-column mh-letter-fill-column)
1231 ;; if text-mode-hook turned on auto-fill, tune it for messages 947 ;; If text-mode-hook turned on auto-fill, tune it for messages
1232 (when auto-fill-function 948 (when auto-fill-function
1233 (make-local-variable 'auto-fill-function) 949 (make-local-variable 'auto-fill-function)
1234 (setq auto-fill-function 'mh-auto-fill-for-letter))) 950 (setq auto-fill-function 'mh-auto-fill-for-letter)))
@@ -1238,7 +954,7 @@ When a message is composed, the hooks `text-mode-hook' and
1238Header is treated specially by inserting a tab before continuation lines." 954Header is treated specially by inserting a tab before continuation lines."
1239 (if (mh-in-header-p) 955 (if (mh-in-header-p)
1240 (let ((fill-prefix "\t")) 956 (let ((fill-prefix "\t"))
1241 (do-auto-fill)) 957 (do-auto-fill))
1242 (do-auto-fill))) 958 (do-auto-fill)))
1243 959
1244(defun mh-insert-header-separator () 960(defun mh-insert-header-separator ()
@@ -1247,8 +963,9 @@ Header is treated specially by inserting a tab before continuation lines."
1247 (goto-char (point-min)) 963 (goto-char (point-min))
1248 (rfc822-goto-eoh) 964 (rfc822-goto-eoh)
1249 (if (looking-at "$") 965 (if (looking-at "$")
1250 (insert mh-mail-header-separator)))) 966 (insert mh-mail-header-separator))))
1251 967
968;;;###mh-autoload
1252(defun mh-to-field () 969(defun mh-to-field ()
1253 "Move point to the end of a specified header field. 970 "Move point to the end of a specified header field.
1254The field is indicated by the previous keystroke (the last keystroke 971The field is indicated by the previous keystroke (the last keystroke
@@ -1257,48 +974,52 @@ Create the field if it does not exist. Set the mark to point before moving."
1257 (interactive) 974 (interactive)
1258 (expand-abbrev) 975 (expand-abbrev)
1259 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) 976 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
1260 mh-to-field-choices) 977 mh-to-field-choices)
1261 ;; also look for a char for version 4 compat 978 ;; also look for a char for version 4 compat
1262 (assoc (logior last-input-char ?`) mh-to-field-choices)))) 979 (assoc (logior last-input-char ?`)
1263 (case-fold-search t)) 980 mh-to-field-choices))))
981 (case-fold-search t))
1264 (push-mark) 982 (push-mark)
1265 (cond ((mh-position-on-field target) 983 (cond ((mh-position-on-field target)
1266 (let ((eol (point))) 984 (let ((eol (point)))
1267 (skip-chars-backward " \t") 985 (skip-chars-backward " \t")
1268 (delete-region (point) eol)) 986 (delete-region (point) eol))
1269 (if (and (not (eq (logior last-input-char ?`) ?s)) 987 (if (and (not (eq (logior last-input-char ?`) ?s))
1270 (save-excursion 988 (save-excursion
1271 (backward-char 1) 989 (backward-char 1)
1272 (not (looking-at "[:,]")))) 990 (not (looking-at "[:,]"))))
1273 (insert ", ") 991 (insert ", ")
1274 (insert " "))) 992 (insert " ")))
1275 (t 993 (t
1276 (if (mh-position-on-field "To:") 994 (if (mh-position-on-field "To:")
1277 (forward-line 1)) 995 (forward-line 1))
1278 (insert (format "%s \n" target)) 996 (insert (format "%s \n" target))
1279 (backward-char 1))))) 997 (backward-char 1)))))
1280 998
999;;;###mh-autoload
1281(defun mh-to-fcc (&optional folder) 1000(defun mh-to-fcc (&optional folder)
1282 "Insert an Fcc: FOLDER field in the current message. 1001 "Insert an Fcc: FOLDER field in the current message.
1283Prompt for the field name with a completion list of the current folders." 1002Prompt for the field name with a completion list of the current folders."
1284 (interactive) 1003 (interactive)
1285 (or folder 1004 (or folder
1286 (setq folder (mh-prompt-for-folder 1005 (setq folder (mh-prompt-for-folder
1287 "Fcc" 1006 "Fcc"
1288 (or (and mh-default-folder-for-message-function 1007 (or (and mh-default-folder-for-message-function
1289 (save-excursion 1008 (save-excursion
1290 (goto-char (point-min)) 1009 (goto-char (point-min))
1291 (funcall mh-default-folder-for-message-function))) 1010 (funcall
1292 "") 1011 mh-default-folder-for-message-function)))
1293 t))) 1012 "")
1013 t)))
1294 (let ((last-input-char ?\C-f)) 1014 (let ((last-input-char ?\C-f))
1295 (expand-abbrev) 1015 (expand-abbrev)
1296 (save-excursion 1016 (save-excursion
1297 (mh-to-field) 1017 (mh-to-field)
1298 (insert (if (mh-folder-name-p folder) 1018 (insert (if (mh-folder-name-p folder)
1299 (substring folder 1) 1019 (substring folder 1)
1300 folder))))) 1020 folder)))))
1301 1021
1022;;;###mh-autoload
1302(defun mh-insert-signature () 1023(defun mh-insert-signature ()
1303 "Insert the file named by `mh-signature-file-name' at point. 1024 "Insert the file named by `mh-signature-file-name' at point.
1304The value of `mh-letter-insert-signature-hook' is a list of functions to be 1025The value of `mh-letter-insert-signature-hook' is a list of functions to be
@@ -1307,9 +1028,10 @@ called, with no arguments, before the signature is actually inserted."
1307 (let ((mh-signature-file-name mh-signature-file-name)) 1028 (let ((mh-signature-file-name mh-signature-file-name))
1308 (run-hooks 'mh-letter-insert-signature-hook) 1029 (run-hooks 'mh-letter-insert-signature-hook)
1309 (if mh-signature-file-name 1030 (if mh-signature-file-name
1310 (insert-file-contents mh-signature-file-name))) 1031 (insert-file-contents mh-signature-file-name)))
1311 (force-mode-line-update)) 1032 (force-mode-line-update))
1312 1033
1034;;;###mh-autoload
1313(defun mh-check-whom () 1035(defun mh-check-whom ()
1314 "Verify recipients of the current letter, showing expansion of any aliases." 1036 "Verify recipients of the current letter, showing expansion of any aliases."
1315 (interactive) 1037 (interactive)
@@ -1348,21 +1070,21 @@ The versions of MH-E, Emacs, and MH are shown."
1348 (mh-version) 1070 (mh-version)
1349 (set-buffer mh-temp-buffer) 1071 (set-buffer mh-temp-buffer)
1350 (if mh-nmh-flag 1072 (if mh-nmh-flag
1351 (search-forward-regexp "^nmh-\\(\\S +\\)") 1073 (search-forward-regexp "^nmh-\\(\\S +\\)")
1352 (search-forward-regexp "^MH \\(\\S +\\)" nil t)) 1074 (search-forward-regexp "^MH \\(\\S +\\)" nil t))
1353 (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1)))) 1075 (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
1354 (setq mh-x-mailer-string 1076 (setq mh-x-mailer-string
1355 (format "MH-E %s; %s %s; %s %d.%d" 1077 (format "MH-E %s; %s %s; %s %d.%d"
1356 mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh 1078 mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
1357 (if mh-xemacs-flag 1079 (if mh-xemacs-flag
1358 "XEmacs" 1080 "XEmacs"
1359 "Emacs") 1081 "Emacs")
1360 emacs-major-version emacs-minor-version))) 1082 emacs-major-version emacs-minor-version)))
1361 (kill-buffer mh-temp-buffer))) 1083 (kill-buffer mh-temp-buffer)))
1362 ;; Insert X-Mailer, but only if it doesn't already exist. 1084 ;; Insert X-Mailer, but only if it doesn't already exist.
1363 (save-excursion 1085 (save-excursion
1364 (when (null (mh-goto-header-field "X-Mailer")) 1086 (when (null (mh-goto-header-field "X-Mailer"))
1365 (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) 1087 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1366 1088
1367(defun mh-regexp-in-field-p (regexp &rest fields) 1089(defun mh-regexp-in-field-p (regexp &rest fields)
1368 "Non-nil means REGEXP was found in FIELDS." 1090 "Non-nil means REGEXP was found in FIELDS."
@@ -1396,10 +1118,10 @@ The versions of MH-E, Emacs, and MH are shown."
1396 (setq list (cdr list)))))))) 1118 (setq list (cdr list))))))))
1397 1119
1398(defun mh-compose-and-send-mail (draft send-args 1120(defun mh-compose-and-send-mail (draft send-args
1399 sent-from-folder sent-from-msg 1121 sent-from-folder sent-from-msg
1400 to subject cc 1122 to subject cc
1401 annotate-char annotate-field 1123 annotate-char annotate-field
1402 config) 1124 config)
1403 "Edit and compose a draft message in buffer DRAFT and send or save it. 1125 "Edit and compose a draft message in buffer DRAFT and send or save it.
1404SEND-ARGS is the argument passed to the send command. 1126SEND-ARGS is the argument passed to the send command.
1405SENT-FROM-FOLDER is buffer containing scan listing of current folder, or 1127SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
@@ -1414,6 +1136,16 @@ CONFIG is the window configuration to restore after sending the letter."
1414 (pop-to-buffer draft) 1136 (pop-to-buffer draft)
1415 (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) 1137 (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
1416 (mh-letter-mode) 1138 (mh-letter-mode)
1139
1140 ;; mh-identity support
1141 (if (and (boundp 'mh-identity-default)
1142 mh-identity-default)
1143 (mh-insert-identity mh-identity-default))
1144 (when (and (boundp 'mh-identity-list)
1145 mh-identity-list)
1146 (mh-identity-make-menu)
1147 (easy-menu-add mh-identity-menu))
1148
1417 (setq mh-sent-from-folder sent-from-folder) 1149 (setq mh-sent-from-folder sent-from-folder)
1418 (setq mh-sent-from-msg sent-from-msg) 1150 (setq mh-sent-from-msg sent-from-msg)
1419 (setq mh-send-args send-args) 1151 (setq mh-send-args send-args)
@@ -1422,28 +1154,32 @@ CONFIG is the window configuration to restore after sending the letter."
1422 (setq mh-previous-window-config config) 1154 (setq mh-previous-window-config config)
1423 (setq mode-line-buffer-identification (list "{%b}")) 1155 (setq mode-line-buffer-identification (list "{%b}"))
1424 (if (and (boundp 'mh-compose-letter-function) 1156 (if (and (boundp 'mh-compose-letter-function)
1425 mh-compose-letter-function) 1157 mh-compose-letter-function)
1426 ;; run-hooks will not pass arguments. 1158 ;; run-hooks will not pass arguments.
1427 (let ((value mh-compose-letter-function)) 1159 (let ((value mh-compose-letter-function))
1428 (if (and (listp value) (not (eq (car value) 'lambda))) 1160 (if (and (listp value) (not (eq (car value) 'lambda)))
1429 (while value 1161 (while value
1430 (funcall (car value) to subject cc) 1162 (funcall (car value) to subject cc)
1431 (setq value (cdr value))) 1163 (setq value (cdr value)))
1432 (funcall mh-compose-letter-function to subject cc))))) 1164 (funcall mh-compose-letter-function to subject cc)))))
1433 1165
1434(defun mh-letter-mode-message () 1166(defun mh-letter-mode-message ()
1435 "Display a help message for users of `mh-letter-mode'. 1167 "Display a help message for users of `mh-letter-mode'.
1436This should be the last function called when composing the draft." 1168This should be the last function called when composing the draft."
1437 (message "%s" (substitute-command-keys 1169 (message "%s" (substitute-command-keys
1438 (concat "Type \\[mh-send-letter] to send message, " 1170 (concat "Type \\[mh-send-letter] to send message, "
1439 "\\[mh-help] for help.")))) 1171 "\\[mh-help] for help."))))
1440 1172
1173;;;###mh-autoload
1441(defun mh-send-letter (&optional arg) 1174(defun mh-send-letter (&optional arg)
1442 "Send the draft letter in the current buffer. 1175 "Send the draft letter in the current buffer.
1443If optional prefix argument ARG is provided, monitor delivery. 1176If optional prefix argument ARG is provided, monitor delivery.
1444The value of `mh-before-send-letter-hook' is a list of functions to be called, 1177The value of `mh-before-send-letter-hook' is a list of functions to be called,
1445with no arguments, before doing anything. 1178with no arguments, before doing anything.
1446Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set." 1179Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
1180Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
1181Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
1182Insert X-Face field if the file specified by `mh-x-face-file' exists."
1447 (interactive "P") 1183 (interactive "P")
1448 (run-hooks 'mh-before-send-letter-hook) 1184 (run-hooks 'mh-before-send-letter-hook)
1449 (cond 1185 (cond
@@ -1458,70 +1194,72 @@ Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set."
1458 (save-buffer) 1194 (save-buffer)
1459 (message "Sending...") 1195 (message "Sending...")
1460 (let ((draft-buffer (current-buffer)) 1196 (let ((draft-buffer (current-buffer))
1461 (file-name buffer-file-name) 1197 (file-name buffer-file-name)
1462 (config mh-previous-window-config) 1198 (config mh-previous-window-config)
1463 (coding-system-for-write 1199 (coding-system-for-write
1464 (if (and (local-variable-p 'buffer-file-coding-system 1200 (if (and (local-variable-p 'buffer-file-coding-system
1465 (current-buffer)) ;XEmacs needs two args 1201 (current-buffer)) ;XEmacs needs two args
1466 ;; We're not sure why, but buffer-file-coding-system 1202 ;; We're not sure why, but buffer-file-coding-system
1467 ;; tends to get set to undecided-unix. 1203 ;; tends to get set to undecided-unix.
1468 (not (memq buffer-file-coding-system 1204 (not (memq buffer-file-coding-system
1469 '(undecided undecided-unix undecided-dos)))) 1205 '(undecided undecided-unix undecided-dos))))
1470 buffer-file-coding-system 1206 buffer-file-coding-system
1471 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) 1207 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1472 (and (boundp 'default-buffer-file-coding-system ) 1208 (and (boundp 'default-buffer-file-coding-system )
1473 default-buffer-file-coding-system) 1209 default-buffer-file-coding-system)
1474 'iso-latin-1)))) 1210 'iso-latin-1))))
1475 ;; The default BCC encapsulation will make a MIME message unreadable. 1211 ;; The default BCC encapsulation will make a MIME message unreadable.
1476 ;; With nmh use the -mime arg to prevent this. 1212 ;; With nmh use the -mime arg to prevent this.
1477 (if (and mh-nmh-flag 1213 (if (and mh-nmh-flag
1478 (mh-goto-header-field "Bcc:") 1214 (mh-goto-header-field "Bcc:")
1479 (mh-goto-header-field "Content-Type:")) 1215 (mh-goto-header-field "Content-Type:"))
1480 (setq mh-send-args (format "-mime %s" mh-send-args))) 1216 (setq mh-send-args (format "-mime %s" mh-send-args)))
1481 (cond (arg 1217 (cond (arg
1482 (pop-to-buffer "MH mail delivery") 1218 (pop-to-buffer "MH mail delivery")
1483 (erase-buffer) 1219 (erase-buffer)
1484 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" 1220 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1485 "-nodraftfolder" mh-send-args file-name) 1221 "-nodraftfolder" mh-send-args file-name)
1486 (goto-char (point-max)) ; show the interesting part 1222 (goto-char (point-max)) ; show the interesting part
1487 (recenter -1) 1223 (recenter -1)
1488 (set-buffer draft-buffer)) ; for annotation below 1224 (set-buffer draft-buffer)) ; for annotation below
1489 (t 1225 (t
1490 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose" 1226 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
1491 mh-send-args file-name))) 1227 mh-send-args file-name)))
1492 (if mh-annotate-char 1228 (if mh-annotate-char
1493 (mh-annotate-msg mh-sent-from-msg 1229 (mh-annotate-msg mh-sent-from-msg
1494 mh-sent-from-folder 1230 mh-sent-from-folder
1495 mh-annotate-char 1231 mh-annotate-char
1496 "-component" mh-annotate-field 1232 "-component" mh-annotate-field
1497 "-text" (format "\"%s %s\"" 1233 "-text" (format "\"%s %s\""
1498 (mh-get-header-field "To:") 1234 (mh-get-header-field "To:")
1499 (mh-get-header-field "Cc:")))) 1235 (mh-get-header-field "Cc:"))))
1500 1236
1501 (cond ((or (not arg) 1237 (cond ((or (not arg)
1502 (y-or-n-p "Kill draft buffer? ")) 1238 (y-or-n-p "Kill draft buffer? "))
1503 (kill-buffer draft-buffer) 1239 (kill-buffer draft-buffer)
1504 (if config 1240 (if config
1505 (set-window-configuration config)))) 1241 (set-window-configuration config))))
1506 (if arg 1242 (if arg
1507 (message "Sending...done") 1243 (message "Sending...done")
1508 (message "Sending...backgrounded")))) 1244 (message "Sending...backgrounded"))))
1509 1245
1246;;;###mh-autoload
1510(defun mh-insert-letter (folder message verbatim) 1247(defun mh-insert-letter (folder message verbatim)
1511 "Insert a message into the current letter. 1248 "Insert a message into the current letter.
1512Removes the message's headers using `mh-invisible-headers'. Prefixes each 1249Removes the header fields according to the variable `mh-invisible-headers'.
1513non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg' 1250Prefixes each non-blank line with `mh-ins-buf-prefix', unless
1514is set for supercite and then use it to format the message. 1251`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
1252used to format the message.
1515Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do 1253Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
1516not indent and do not delete headers. Leaves the mark before the letter 1254not indent and do not delete headers. Leaves the mark before the letter
1517and point after it." 1255and point after it."
1518 (interactive 1256 (interactive
1519 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) 1257 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1520 (read-input (format "Message number%s: " 1258 (read-input (format "Message number%s: "
1521 (if mh-sent-from-msg 1259 (if (numberp mh-sent-from-msg)
1522 (format " [%d]" mh-sent-from-msg) 1260 (format " [%d]" mh-sent-from-msg)
1523 ""))) 1261 "")))
1524 current-prefix-arg)) 1262 current-prefix-arg))
1525 (save-restriction 1263 (save-restriction
1526 (narrow-to-region (point) (point)) 1264 (narrow-to-region (point) (point))
1527 (let ((start (point-min))) 1265 (let ((start (point-min)))
@@ -1530,9 +1268,9 @@ and point after it."
1530 (expand-file-name message (mh-expand-file-name folder))) 1268 (expand-file-name message (mh-expand-file-name folder)))
1531 (when (not verbatim) 1269 (when (not verbatim)
1532 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) 1270 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
1533 (goto-char (point-max)) ;Needed for sc-cite-original 1271 (goto-char (point-max)) ;Needed for sc-cite-original
1534 (push-mark) ;Needed for sc-cite-original 1272 (push-mark) ;Needed for sc-cite-original
1535 (goto-char (point-min)) ;Needed for sc-cite-original 1273 (goto-char (point-min)) ;Needed for sc-cite-original
1536 (mh-insert-prefix-string mh-ins-buf-prefix))))) 1274 (mh-insert-prefix-string mh-ins-buf-prefix)))))
1537 1275
1538(defun mh-extract-from-attribution () 1276(defun mh-extract-from-attribution ()
@@ -1553,6 +1291,7 @@ and point after it."
1553 ((looking-at " *\\(.+\\)$") 1291 ((looking-at " *\\(.+\\)$")
1554 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) 1292 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
1555 1293
1294;;;###mh-autoload
1556(defun mh-yank-cur-msg () 1295(defun mh-yank-cur-msg ()
1557 "Insert the current message into the draft buffer. 1296 "Insert the current message into the draft buffer.
1558Prefix each non-blank line in the message with the string in 1297Prefix each non-blank line in the message with the string in
@@ -1569,13 +1308,13 @@ yanked message will be deleted."
1569 (get-buffer mh-show-buffer)) 1308 (get-buffer mh-show-buffer))
1570 mh-sent-from-msg) 1309 mh-sent-from-msg)
1571 (let ((to-point (point)) 1310 (let ((to-point (point))
1572 (to-buffer (current-buffer))) 1311 (to-buffer (current-buffer)))
1573 (set-buffer mh-sent-from-folder) 1312 (set-buffer mh-sent-from-folder)
1574 (if mh-delete-yanked-msg-window-flag 1313 (if mh-delete-yanked-msg-window-flag
1575 (delete-windows-on mh-show-buffer)) 1314 (delete-windows-on mh-show-buffer))
1576 (set-buffer mh-show-buffer) ; Find displayed message 1315 (set-buffer mh-show-buffer) ; Find displayed message
1577 (let* ((from-attr (mh-extract-from-attribution)) 1316 (let* ((from-attr (mh-extract-from-attribution))
1578 (yank-region (mh-mark-active-p nil)) 1317 (yank-region (mh-mark-active-p nil))
1579 (mh-ins-str 1318 (mh-ins-str
1580 (cond ((and yank-region 1319 (cond ((and yank-region
1581 (or (eq 'supercite mh-yank-from-start-of-msg) 1320 (or (eq 'supercite mh-yank-from-start-of-msg)
@@ -1605,26 +1344,26 @@ yanked message will be deleted."
1605 (buffer-substring (point-min) (point-max))) 1344 (buffer-substring (point-min) (point-max)))
1606 (t 1345 (t
1607 (buffer-substring (point) (point-max)))))) 1346 (buffer-substring (point) (point-max))))))
1608 (set-buffer to-buffer) 1347 (set-buffer to-buffer)
1609 (save-restriction 1348 (save-restriction
1610 (narrow-to-region to-point to-point) 1349 (narrow-to-region to-point to-point)
1611 (insert (mh-filter-out-non-text mh-ins-str)) 1350 (insert (mh-filter-out-non-text mh-ins-str))
1612 (goto-char (point-max)) ;Needed for sc-cite-original 1351 (goto-char (point-max)) ;Needed for sc-cite-original
1613 (push-mark) ;Needed for sc-cite-original 1352 (push-mark) ;Needed for sc-cite-original
1614 (goto-char (point-min)) ;Needed for sc-cite-original 1353 (goto-char (point-min)) ;Needed for sc-cite-original
1615 (mh-insert-prefix-string mh-ins-buf-prefix) 1354 (mh-insert-prefix-string mh-ins-buf-prefix)
1616 (if (or (eq 'attribution mh-yank-from-start-of-msg) 1355 (if (or (eq 'attribution mh-yank-from-start-of-msg)
1617 (eq 'autoattrib mh-yank-from-start-of-msg)) 1356 (eq 'autoattrib mh-yank-from-start-of-msg))
1618 (insert from-attr "\n\n")) 1357 (insert from-attr "\n\n"))
1619 ;; If the user has selected a region, he has already "edited" the 1358 ;; If the user has selected a region, he has already "edited" the
1620 ;; text, so leave the cursor at the end of the yanked text. In 1359 ;; text, so leave the cursor at the end of the yanked text. In
1621 ;; either case, leave a mark at the opposite end of the included 1360 ;; either case, leave a mark at the opposite end of the included
1622 ;; text to make it easy to jump or delete to the other end of the 1361 ;; text to make it easy to jump or delete to the other end of the
1623 ;; text. 1362 ;; text.
1624 (push-mark) 1363 (push-mark)
1625 (goto-char (point-max)) 1364 (goto-char (point-max))
1626 (if (null yank-region) 1365 (if (null yank-region)
1627 (mh-exchange-point-and-mark-preserving-active-mark))))) 1366 (mh-exchange-point-and-mark-preserving-active-mark)))))
1628 (error "There is no current message"))) 1367 (error "There is no current message")))
1629 1368
1630(defun mh-filter-out-non-text (string) 1369(defun mh-filter-out-non-text (string)
@@ -1640,8 +1379,7 @@ yanked message will be deleted."
1640 (while can-move-forward 1379 (while can-move-forward
1641 (cond ((and (not (get-text-property (point) 'mh-data)) 1380 (cond ((and (not (get-text-property (point) 'mh-data))
1642 in-button) 1381 in-button)
1643 (delete-region (save-excursion (forward-line -1) (point)) 1382 (delete-region (1- (point)) (point))
1644 (point))
1645 (setq in-button nil)) 1383 (setq in-button nil))
1646 ((get-text-property (point) 'mh-data) 1384 ((get-text-property (point) 'mh-data)
1647 (delete-region (point) 1385 (delete-region (point)
@@ -1663,29 +1401,30 @@ simply insert MH-INS-STRING before each line."
1663 (eq mh-yank-from-start-of-msg 'autosupercite)) 1401 (eq mh-yank-from-start-of-msg 'autosupercite))
1664 (sc-cite-original)) 1402 (sc-cite-original))
1665 (mail-citation-hook 1403 (mail-citation-hook
1666 (run-hooks 'mail-citation-hook)) 1404 (run-hooks 'mail-citation-hook))
1667 (mh-yank-hooks ;old hook name 1405 (mh-yank-hooks ;old hook name
1668 (run-hooks 'mh-yank-hooks)) 1406 (run-hooks 'mh-yank-hooks))
1669 (t 1407 (t
1670 (or (bolp) (forward-line 1)) 1408 (or (bolp) (forward-line 1))
1671 (while (< (point) (point-max)) 1409 (while (< (point) (point-max))
1672 (insert mh-ins-string) 1410 (insert mh-ins-string)
1673 (forward-line 1)) 1411 (forward-line 1))
1674 (goto-char (point-min))))) ;leave point like sc-cite-original 1412 (goto-char (point-min))))) ;leave point like sc-cite-original
1675 1413
1414;;;###mh-autoload
1676(defun mh-fully-kill-draft () 1415(defun mh-fully-kill-draft ()
1677 "Kill the draft message file and the draft message buffer. 1416 "Kill the draft message file and the draft message buffer.
1678Use \\[kill-buffer] if you don't want to delete the draft message file." 1417Use \\[kill-buffer] if you don't want to delete the draft message file."
1679 (interactive) 1418 (interactive)
1680 (if (y-or-n-p "Kill draft message? ") 1419 (if (y-or-n-p "Kill draft message? ")
1681 (let ((config mh-previous-window-config)) 1420 (let ((config mh-previous-window-config))
1682 (if (file-exists-p buffer-file-name) 1421 (if (file-exists-p buffer-file-name)
1683 (delete-file buffer-file-name)) 1422 (delete-file buffer-file-name))
1684 (set-buffer-modified-p nil) 1423 (set-buffer-modified-p nil)
1685 (kill-buffer (buffer-name)) 1424 (kill-buffer (buffer-name))
1686 (message "") 1425 (message "")
1687 (if config 1426 (if config
1688 (set-window-configuration config))) 1427 (set-window-configuration config)))
1689 (error "Message not killed"))) 1428 (error "Message not killed")))
1690 1429
1691(defun mh-current-fill-prefix () 1430(defun mh-current-fill-prefix ()
@@ -1700,6 +1439,7 @@ Use \\[kill-buffer] if you don't want to delete the draft message file."
1700 (match-string 0) 1439 (match-string 0)
1701 ""))) 1440 "")))
1702 1441
1442;;;###mh-autoload
1703(defun mh-open-line () 1443(defun mh-open-line ()
1704 "Insert a newline and leave point after it. 1444 "Insert a newline and leave point after it.
1705In addition, insert newline and quoting characters before text after point. 1445In addition, insert newline and quoting characters before text after point.
@@ -1715,57 +1455,70 @@ This is useful in breaking up paragraphs in replies."
1715 (insert " ")) 1455 (insert " "))
1716 (forward-line -1)))) 1456 (forward-line -1))))
1717 1457
1458;;;###mh-autoload
1459(defun mh-letter-complete (arg)
1460 "Perform completion on header field or word preceding point.
1461Alias completion is done within the mail header on selected fields and
1462by the function designated by `mh-letter-complete-function' elsewhere,
1463passing the prefix ARG if any."
1464 (interactive "P")
1465 (let ((case-fold-search t))
1466 (if (and (mh-in-header-p)
1467 (save-excursion
1468 (mh-header-field-beginning)
1469 (looking-at "^.*\\(to\\|cc\\|from\\):")))
1470 (mh-alias-letter-expand-alias)
1471 (funcall mh-letter-complete-function arg))))
1472
1718;;; Build the letter-mode keymap: 1473;;; Build the letter-mode keymap:
1719;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. 1474;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
1720(gnus-define-keys mh-letter-mode-map 1475(gnus-define-keys mh-letter-mode-map
1721 "\C-c?" mh-help 1476 "\C-c?" mh-help
1722 "\C-c\C-c" mh-send-letter 1477 "\C-c\C-c" mh-send-letter
1723 "\C-c\C-e" mh-edit-mhn 1478 "\C-c\C-d" mh-insert-identity
1724 "\C-c\C-f\C-b" mh-to-field 1479 "\C-c\C-e" mh-edit-mhn
1725 "\C-c\C-f\C-c" mh-to-field 1480 "\C-c\C-f\C-b" mh-to-field
1726 "\C-c\C-f\C-d" mh-to-field 1481 "\C-c\C-f\C-c" mh-to-field
1727 "\C-c\C-f\C-f" mh-to-fcc 1482 "\C-c\C-f\C-d" mh-to-field
1728 "\C-c\C-f\C-r" mh-to-field 1483 "\C-c\C-f\C-f" mh-to-fcc
1729 "\C-c\C-f\C-s" mh-to-field 1484 "\C-c\C-f\C-r" mh-to-field
1730 "\C-c\C-f\C-t" mh-to-field 1485 "\C-c\C-f\C-s" mh-to-field
1731 "\C-c\C-fb" mh-to-field 1486 "\C-c\C-f\C-t" mh-to-field
1732 "\C-c\C-fc" mh-to-field 1487 "\C-c\C-fb" mh-to-field
1733 "\C-c\C-fd" mh-to-field 1488 "\C-c\C-fc" mh-to-field
1734 "\C-c\C-ff" mh-to-fcc 1489 "\C-c\C-fd" mh-to-field
1735 "\C-c\C-fr" mh-to-field 1490 "\C-c\C-ff" mh-to-fcc
1736 "\C-c\C-fs" mh-to-field 1491 "\C-c\C-fr" mh-to-field
1737 "\C-c\C-ft" mh-to-field 1492 "\C-c\C-fs" mh-to-field
1738 "\C-c\C-i" mh-insert-letter 1493 "\C-c\C-ft" mh-to-field
1739 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime 1494 "\C-c\C-i" mh-insert-letter
1740 "\C-c\C-m\C-f" mh-compose-forward 1495 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
1741 "\C-c\C-m\C-i" mh-compose-insertion 1496 "\C-c\C-m\C-f" mh-compose-forward
1742 "\C-c\C-m\C-m" mh-mml-to-mime 1497 "\C-c\C-m\C-i" mh-compose-insertion
1743 "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime 1498 "\C-c\C-m\C-m" mh-mml-to-mime
1744 "\C-c\C-m\C-u" mh-revert-mhn-edit 1499 "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
1745 "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime 1500 "\C-c\C-m\C-u" mh-revert-mhn-edit
1746 "\C-c\C-mf" mh-compose-forward 1501 "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
1747 "\C-c\C-mi" mh-compose-insertion 1502 "\C-c\C-mf" mh-compose-forward
1748 "\C-c\C-mm" mh-mml-to-mime 1503 "\C-c\C-mi" mh-compose-insertion
1749 "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime 1504 "\C-c\C-mm" mh-mml-to-mime
1750 "\C-c\C-mu" mh-revert-mhn-edit 1505 "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
1751 "\C-c\C-o" mh-open-line 1506 "\C-c\C-mu" mh-revert-mhn-edit
1752 "\C-c\C-q" mh-fully-kill-draft 1507 "\C-c\C-o" mh-open-line
1753 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q 1508 "\C-c\C-q" mh-fully-kill-draft
1754 "\C-c\C-s" mh-insert-signature 1509 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
1755 "\C-c\C-^" mh-insert-signature ;if no C-s 1510 "\C-c\C-s" mh-insert-signature
1756 "\C-c\C-w" mh-check-whom 1511 "\C-c\C-^" mh-insert-signature ;if no C-s
1757 "\C-c\C-y" mh-yank-cur-msg) 1512 "\C-c\C-w" mh-check-whom
1513 "\C-c\C-y" mh-yank-cur-msg
1514 "\M-\t" mh-letter-complete)
1758 1515
1759;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. 1516;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1760 1517
1761(defun mh-customize ()
1762 "Customize MH-E variables."
1763 (interactive)
1764 (customize-group 'mh))
1765
1766(provide 'mh-comp) 1518(provide 'mh-comp)
1767 1519
1768;;; Local Variables: 1520;;; Local Variables:
1521;;; indent-tabs-mode: nil
1769;;; sentence-end-double-space: nil 1522;;; sentence-end-double-space: nil
1770;;; End: 1523;;; End:
1771 1524
diff --git a/lisp/mail/mh-customize.el b/lisp/mail/mh-customize.el
new file mode 100644
index 00000000000..92b2b60f505
--- /dev/null
+++ b/lisp/mail/mh-customize.el
@@ -0,0 +1,1751 @@
1;;; mh-customize.el --- MH-E customization
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; All of the defgroups, defcustoms, and deffaces in MH-E are found here. This
30;; makes it possible to customize modules that aren't loaded yet. It also
31;; makes it easier to organize the customization groups.
32
33;; This file contains the following sections:
34;;
35;; 1. MH-E Customization Groups
36;;
37;; These are the customization group definitions. These are organized in a
38;; logical order. High-level, windows and toolbar, folder, message,
39;; composing and hooks.
40;;
41;; 2. MH-E Customization
42;;
43;; Here are the actual customization variables. There is a sub-section for
44;; each group in the MH-E Customization Groups section. Within each
45;; section, variables are sorted alphabetically. The manual section
46;; dictates which group a variable should be placed. New variables should
47;; be placed in the section where they would most likely be defined.
48;;
49;; All hooks should be placed in the 'mh-hook group; in addition, add the
50;; group in which the hook is defined in the manual (or, if it is new,
51;; where it would be defined). These two actions insures that the hooks
52;; appear last in each group.
53;;
54;; 3. Faces
55
56;;; Change Log:
57
58;; $Id: mh-customize.el,v 1.18 2003/01/08 00:45:37 wohler Exp $
59
60;;; Code:
61
62;;;###mh-autoload
63(defun mh-customize ()
64 "Customize MH-E variables."
65 (interactive)
66 (customize-group 'mh))
67
68;;; MH-E Customization Groups
69
70(defgroup mh nil
71 "GNU Emacs interface to the MH mail system."
72 :link '(custom-manual "(mh-e)Top")
73 :group 'mail)
74
75(defgroup mh-toolbar nil
76 "Toolbar configuration."
77 :prefix "mh-"
78 :group 'mh)
79
80(defgroup mh-speed nil
81 "Speedbar and folder configuration."
82 :prefix "mh-"
83 :link '(custom-manual "(mh-e)Customizing Moving Mail")
84 :group 'mh)
85
86(defgroup mh-folder nil
87 "Options for controlling scan listing."
88 :prefix "mh-"
89 :link '(custom-manual "(mh-e)Customizing Moving Mail")
90 :group 'mh)
91
92(defgroup mh-show nil
93 "Message display."
94 :prefix "mh-"
95 :link '(custom-manual "(mh-e)Customizing Reading")
96 :group 'mh)
97
98(defgroup mh-letter nil
99 "Composing messages."
100 :prefix "mh-"
101 :link '(custom-manual "(mh-e)Customizing Sending")
102 :group 'mh)
103
104(defgroup mh-alias nil
105 "Alias handling."
106 :link '(custom-manual "(mh-e)Customizing mh-e")
107 :prefix "mh-alias-"
108 :group 'mh)
109
110(defgroup mh-index nil
111 "Indexed searching."
112 :link '(custom-manual "(mh-e)Customizing mh-e")
113 :prefix "mh-"
114 :group 'mh)
115
116(defgroup mh-identity nil
117 "Multiple personalities."
118 :link '(custom-manual "(mh-e)Customizing mh-e")
119 :prefix "mh-"
120 :group 'mh)
121
122(defgroup mh-faces nil
123 "Faces used in MH-E."
124 :link '(custom-manual "(mh-e)Customizing mh-e")
125 :prefix "mh-"
126 :group 'faces
127 :group 'mh)
128
129(defgroup mh-hooks nil
130 "MH-E hooks."
131 :link '(custom-manual "(mh-e)Customizing mh-e")
132 :prefix "mh-"
133 :group 'mh)
134
135;;; Faces
136
137(defgroup mh-speed-faces nil
138 "Faces used in speedbar."
139 :link '(custom-manual "(mh-e)Customizing mh-e")
140 :prefix "mh-"
141 :group 'mh-faces
142 :group 'mh-speed)
143
144(defgroup mh-folder-faces nil
145 "Faces used in scan listing."
146 :link '(custom-manual "(mh-e)Customizing mh-e")
147 :prefix "mh-"
148 :group 'mh-faces
149 :group 'mh-folder)
150
151(defgroup mh-show-faces nil
152 "Faces used in message display."
153 :link '(custom-manual "(mh-e)Customizing mh-e")
154 :prefix "mh-"
155 :group 'mh-faces
156 :group 'mh-show)
157
158(defgroup mh-index-faces nil
159 "Faces used in indexed searches."
160 :link '(custom-manual "(mh-e)Customizing mh-e")
161 :prefix "mh-"
162 :group 'mh-faces
163 :group 'mh-index)
164
165
166
167;;; MH-E Customization (:group mh)
168
169;;; Toolbar configuration (:group 'mh-toolbar)
170
171(defconst mh-tool-bar-item-inc "Incorporate new mail in Inbox")
172(defconst mh-tool-bar-item-save-mime "Save MIME parts")
173(defconst mh-tool-bar-item-prev-msg "Previous message")
174(defconst mh-tool-bar-item-page-msg "Page this message")
175(defconst mh-tool-bar-item-next-msg "Next message")
176(defconst mh-tool-bar-item-delete "Mark for deletion")
177(defconst mh-tool-bar-item-refile "Refile this message")
178(defconst mh-tool-bar-item-undo "Undo this mark")
179(defconst mh-tool-bar-item-perform "Perform moves and deletes")
180(defconst mh-tool-bar-item-toggle-show "Toggle showing message")
181(defconst mh-tool-bar-item-reply-from "Reply to \"from\"")
182(defconst mh-tool-bar-item-reply-to "Reply to \"to\"")
183(defconst mh-tool-bar-item-reply-all "Reply to \"all\"")
184(defconst mh-tool-bar-item-reply "Reply to this message")
185(defconst mh-tool-bar-item-alias "Grab From alias")
186(defconst mh-tool-bar-item-compose "Compose new message")
187(defconst mh-tool-bar-item-rescan "Rescan this folder")
188(defconst mh-tool-bar-item-repack "Repack this folder")
189(defconst mh-tool-bar-item-search "Search")
190(defconst mh-tool-bar-item-visit "Visit other folder")
191(defconst mh-tool-bar-item-prefs "MH-E preferences")
192(defconst mh-tool-bar-item-help "Help")
193(defconst mh-tool-bar-item-widen "Widen from this sequence")
194
195(defconst mh-tool-bar-item-send "Send this letter")
196(defconst mh-tool-bar-item-attach "Insert attachment")
197(defconst mh-tool-bar-item-spell "Check spelling")
198(defconst mh-tool-bar-item-save "Save current buffer to its file")
199(defconst mh-tool-bar-item-undo-op "Undo last operation")
200(defconst mh-tool-bar-item-kill
201 "Cut (kill) text in region between mark and current position")
202(defconst mh-tool-bar-item-copy
203 "Copy text in region between mark and current position")
204(defconst mh-tool-bar-item-paste
205 "Paste (yank) text cut or copied earlier")
206(defconst mh-tool-bar-item-kill-draft "Kill this draft")
207(defconst mh-tool-bar-item-comp-prefs "MH-E composition preferences")
208
209(defcustom mh-tool-bar-reply-3-buttons-flag nil
210 "*Non-nil means use three buttons for reply commands in tool-bar.
211If you have room on your tool-bar because you are using a large font, you
212may set this variable to expand the single reply button into three buttons
213that won't lead to minibuffer prompt about who to reply to."
214 :type 'boolean
215 :group 'mh-toolbar)
216
217(defcustom mh-tool-bar-search-function 'mh-search-folder
218 "*Function called by the tool-bar search button.
219See `mh-search-folder' and `mh-index-search' for details."
220 :type '(choice (const mh-search-folder)
221 (const mh-index-search)
222 (function :tag "Other function"))
223 :group 'mh-toolbar)
224
225(eval-when-compile (defvar tool-bar-map))
226(defvar mh-show-tool-bar-map nil)
227(defun mh-tool-bar-show-set ()
228 "Construct toolbar for `mh-show-mode'."
229 (when (fboundp 'tool-bar-add-item)
230 (setq
231 mh-show-tool-bar-map
232 (let ((tool-bar-map (make-sparse-keymap)))
233 (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
234 (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder
235 :help mh-tool-bar-item-inc))
236 (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
237 (tool-bar-add-item "attach" 'mh-mime-save-parts
238 'mh-showtoolbar-mime-save-parts
239 :help mh-tool-bar-item-save-mime))
240 (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
241 (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg
242 'mh-showtoolbar-prev
243 :help mh-tool-bar-item-prev-msg))
244 (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
245 (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page
246 :help mh-tool-bar-item-page-msg))
247 (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
248 (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg
249 'mh-showtoolbar-next
250 :help mh-tool-bar-item-next-msg))
251 (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
252 (tool-bar-add-item "close" 'mh-show-delete-msg
253 'mh-showtoolbar-delete
254 :help mh-tool-bar-item-delete))
255 (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
256 (tool-bar-add-item "refile" 'mh-show-refile-msg
257 'mh-showtoolbar-refile
258 :help mh-tool-bar-item-refile))
259 (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
260 (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo
261 :help mh-tool-bar-item-undo))
262 (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
263 (tool-bar-add-item "execute" 'mh-show-execute-commands
264 'mh-showtoolbar-exec
265 :help mh-tool-bar-item-perform))
266 (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
267 (tool-bar-add-item "show" 'mh-show-toggle-showing
268 'mh-showtoolbar-toggle-show
269 :help mh-tool-bar-item-toggle-show))
270 (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
271 (tool-bar-add-item "reply-from"
272 (lambda (&optional arg)
273 (interactive "P")
274 (set-buffer mh-show-folder-buffer)
275 (mh-reply (mh-get-msg-num nil) "from" arg))
276 'mh-showtoolbar-reply-from
277 :help mh-tool-bar-item-reply-from))
278 (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
279 (tool-bar-add-item "reply-to"
280 (lambda (&optional arg)
281 (interactive "P")
282 (set-buffer mh-show-folder-buffer)
283 (mh-reply (mh-get-msg-num nil) "to" arg))
284 'mh-showtoolbar-reply-to
285 :help mh-tool-bar-item-reply-to))
286 (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
287 (tool-bar-add-item "reply-all"
288 (lambda (&optional arg)
289 (interactive "P")
290 (set-buffer mh-show-folder-buffer)
291 (mh-reply (mh-get-msg-num nil) "all" arg))
292 'mh-showtoolbar-reply-all
293 :help mh-tool-bar-item-reply-all))
294 (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
295 (tool-bar-add-item "mail/reply2" 'mh-show-reply
296 'mh-showtoolbar-reply
297 :help mh-tool-bar-item-reply))
298 (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
299 (tool-bar-add-item "alias" 'mh-alias-grab-from-field
300 'mh-showtoolbar-alias
301 :help mh-tool-bar-item-alias
302 :enable '(mh-alias-from-has-no-alias-p)))
303 (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
304 (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose
305 :help mh-tool-bar-item-compose))
306 (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
307 (tool-bar-add-item "rescan" 'mh-show-rescan-folder
308 'mh-showtoolbar-rescan
309 :help mh-tool-bar-item-rescan))
310 (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
311 (tool-bar-add-item "repack" 'mh-show-pack-folder
312 'mh-showtoolbar-pack
313 :help mh-tool-bar-item-repack))
314 (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
315 (tool-bar-add-item "search"
316 (lambda (&optional arg)
317 (interactive "P")
318 (call-interactively
319 mh-tool-bar-search-function))
320 'mh-showtoolbar-search
321 :help mh-tool-bar-item-search))
322 (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
323 (tool-bar-add-item "fld_open" 'mh-visit-folder
324 'mh-showtoolbar-visit
325 :help mh-tool-bar-item-visit))
326 (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
327 (tool-bar-add-item "preferences" (lambda ()
328 (interactive)
329 (customize-group "mh"))
330 'mh-showtoolbar-customize
331 :help mh-tool-bar-item-prefs))
332 (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
333 (tool-bar-add-item "help" (lambda ()
334 (interactive)
335 (Info-goto-node "(mh-e)Top"))
336 'mh-showtoolbar-help
337 :help mh-tool-bar-item-help))
338 tool-bar-map))))
339
340(defvar mh-letter-tool-bar-map nil)
341;;;###mh-autoload
342(defun mh-tool-bar-letter-set ()
343 "Construct toolbar for `mh-letter-mode'."
344 (when (fboundp 'tool-bar-add-item)
345 (setq
346 mh-letter-tool-bar-map
347 (let ((tool-bar-map (make-sparse-keymap)))
348 (if (member mh-tool-bar-item-send mh-tool-bar-letter-buttons)
349 (tool-bar-add-item "mail_send" 'mh-send-letter
350 'mh-lettertoolbar-send
351 :help mh-tool-bar-item-send))
352 (if (member mh-tool-bar-item-attach mh-tool-bar-letter-buttons)
353 (tool-bar-add-item "attach" 'mh-compose-insertion
354 'mh-lettertoolbar-compose
355 :help mh-tool-bar-item-attach))
356 (if (member mh-tool-bar-item-spell mh-tool-bar-letter-buttons)
357 (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
358 :help mh-tool-bar-item-spell))
359 (if (member mh-tool-bar-item-save mh-tool-bar-letter-buttons)
360 (tool-bar-add-item-from-menu 'save-buffer "save"))
361 (if (member mh-tool-bar-item-undo-op mh-tool-bar-letter-buttons)
362 (tool-bar-add-item-from-menu 'undo "undo"))
363 (if (member mh-tool-bar-item-kill mh-tool-bar-letter-buttons)
364 (tool-bar-add-item-from-menu 'kill-region "cut"))
365 (if (member mh-tool-bar-item-copy mh-tool-bar-letter-buttons)
366 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy"))
367 (if (member mh-tool-bar-item-paste mh-tool-bar-letter-buttons)
368 (tool-bar-add-item-from-menu 'yank "paste"))
369 (if (member mh-tool-bar-item-kill-draft mh-tool-bar-letter-buttons)
370 (tool-bar-add-item "close" 'mh-fully-kill-draft
371 'mh-lettertoolbar-kill
372 :help mh-tool-bar-item-kill-draft))
373 (if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons)
374 (tool-bar-add-item "preferences" (lambda ()
375 (interactive)
376 (customize-group "mh-compose"))
377 'mh-lettertoolbar-customize
378 :help mh-tool-bar-item-comp-prefs))
379 (if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons)
380 (tool-bar-add-item "help" (lambda ()
381 (interactive)
382 (Info-goto-node "(mh-e)Draft Editing"))
383 'mh-lettertoolbar-help
384 :help mh-tool-bar-item-help))
385 tool-bar-map))))
386
387(defvar mh-folder-tool-bar-map nil)
388(defvar mh-folder-seq-tool-bar-map nil
389 "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
390;;;###mh-autoload
391(defun mh-tool-bar-folder-set ()
392 "Construct toolbar for `mh-folder-mode'."
393 (when (fboundp 'tool-bar-add-item)
394 (setq
395 mh-folder-tool-bar-map
396 (let ((tool-bar-map (make-sparse-keymap)))
397 (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
398 (tool-bar-add-item "mail" 'mh-inc-folder
399 'mh-foldertoolbar-inc-folder
400 :help mh-tool-bar-item-inc))
401 (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
402 (tool-bar-add-item "attach" 'mh-mime-save-parts
403 'mh-foldertoolbar-mime-save-parts
404 :help mh-tool-bar-item-save-mime))
405 (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
406 (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
407 'mh-foldertoolbar-prev
408 :help mh-tool-bar-item-prev-msg))
409 (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
410 (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
411 :help mh-tool-bar-item-page-msg))
412 (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
413 (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
414 'mh-foldertoolbar-next
415 :help mh-tool-bar-item-next-msg))
416 (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
417 (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
418 :help mh-tool-bar-item-delete))
419 (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
420 (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
421 :help mh-tool-bar-item-refile))
422 (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
423 (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
424 :help mh-tool-bar-item-undo))
425 (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
426 (tool-bar-add-item "execute" 'mh-execute-commands
427 'mh-foldertoolbar-exec
428 :help mh-tool-bar-item-perform))
429 (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
430 (tool-bar-add-item "show" 'mh-toggle-showing
431 'mh-foldertoolbar-toggle-show
432 :help mh-tool-bar-item-toggle-show))
433 (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
434 (tool-bar-add-item "reply-from"
435 (lambda (&optional arg)
436 (interactive "P")
437 (mh-reply (mh-get-msg-num nil) "from" arg))
438 'mh-foldertoolbar-reply-from
439 :help mh-tool-bar-item-reply-from))
440 (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
441 (tool-bar-add-item "reply-to"
442 (lambda (&optional arg)
443 (interactive "P")
444 (mh-reply (mh-get-msg-num nil) "to" arg))
445 'mh-foldertoolbar-reply-to
446 :help mh-tool-bar-item-reply-to))
447 (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
448 (tool-bar-add-item "reply-all"
449 (lambda (&optional arg)
450 (interactive "P")
451 (mh-reply (mh-get-msg-num nil) "all" arg))
452 'mh-foldertoolbar-reply-all
453 :help mh-tool-bar-item-reply-all))
454 (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
455 (tool-bar-add-item "mail/reply2" 'mh-reply
456 'mh-foldertoolbar-reply
457 :help mh-tool-bar-item-reply))
458 (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
459 (tool-bar-add-item "alias" 'mh-alias-grab-from-field
460 'mh-foldertoolbar-alias
461 :help mh-tool-bar-item-alias
462 :enable '(mh-alias-from-has-no-alias-p)))
463 (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
464 (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
465 :help mh-tool-bar-item-compose))
466 (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
467 (tool-bar-add-item "rescan" 'mh-rescan-folder
468 'mh-foldertoolbar-rescan
469 :help mh-tool-bar-item-rescan))
470 (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
471 (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
472 :help mh-tool-bar-item-repack))
473 (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
474 (tool-bar-add-item "search"
475 (lambda (&optional arg)
476 (interactive "P")
477 (call-interactively
478 mh-tool-bar-search-function))
479 'mh-foldertoolbar-search
480 :help mh-tool-bar-item-search))
481 (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
482 (tool-bar-add-item "fld_open" 'mh-visit-folder
483 'mh-foldertoolbar-visit
484 :help mh-tool-bar-item-visit))
485 (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
486 (tool-bar-add-item "preferences" (lambda ()
487 (interactive)
488 (customize-group "mh"))
489 'mh-foldertoolbar-customize
490 :help mh-tool-bar-item-prefs))
491 (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
492 (tool-bar-add-item "help" (lambda ()
493 (interactive)
494 (Info-goto-node "(mh-e)Top"))
495 'mh-foldertoolbar-help
496 :help mh-tool-bar-item-help))
497 tool-bar-map))
498
499 (setq mh-folder-seq-tool-bar-map
500 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
501 (if (member mh-tool-bar-item-widen mh-tool-bar-folder-buttons)
502 (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
503 :help mh-tool-bar-item-widen))
504 tool-bar-map))))
505
506(defun mh-tool-bar-folder-buttons-set (symbol value)
507 "Update the `mh-tool-bar-folder-buttons' variable, and rebuild the tool-bar.
508Sets the default for SYMBOL (e.g. `mh-tool-bar-folder-buttons') to VALUE (as
509set in customization). This is called after 'customize is used to alter
510`mh-tool-bar-folder-buttons'."
511 (set-default symbol value)
512 (mh-tool-bar-show-set)
513 (mh-tool-bar-folder-set))
514
515(custom-declare-variable
516 'mh-tool-bar-folder-buttons
517 '(append
518 (list mh-tool-bar-item-inc
519 mh-tool-bar-item-save-mime
520 mh-tool-bar-item-prev-msg
521 mh-tool-bar-item-page-msg
522 mh-tool-bar-item-next-msg
523 mh-tool-bar-item-delete
524 mh-tool-bar-item-refile
525 mh-tool-bar-item-undo
526 mh-tool-bar-item-perform
527;;; mh-tool-bar-item-toggle-show
528 )
529 (if mh-tool-bar-reply-3-buttons-flag
530 (list mh-tool-bar-item-reply-from
531 mh-tool-bar-item-reply-to
532 mh-tool-bar-item-reply-all)
533 (list mh-tool-bar-item-reply))
534 (list mh-tool-bar-item-alias
535 mh-tool-bar-item-compose
536 mh-tool-bar-item-rescan
537;;; mh-tool-bar-item-repack
538 mh-tool-bar-item-search
539 mh-tool-bar-item-visit
540 mh-tool-bar-item-prefs
541 mh-tool-bar-item-help
542 mh-tool-bar-item-widen))
543 "Buttons to include in MH-E folder/show toolbar."
544 :group 'mh-toolbar
545 :set 'mh-tool-bar-folder-buttons-set
546 :type `(set (const ,mh-tool-bar-item-inc)
547 (const ,mh-tool-bar-item-save-mime)
548 (const ,mh-tool-bar-item-prev-msg)
549 (const ,mh-tool-bar-item-page-msg)
550 (const ,mh-tool-bar-item-next-msg)
551 (const ,mh-tool-bar-item-delete)
552 (const ,mh-tool-bar-item-refile)
553 (const ,mh-tool-bar-item-undo)
554 (const ,mh-tool-bar-item-perform)
555 (const ,mh-tool-bar-item-toggle-show)
556 (const ,mh-tool-bar-item-reply-from)
557 (const ,mh-tool-bar-item-reply-to)
558 (const ,mh-tool-bar-item-reply-all)
559 (const ,mh-tool-bar-item-reply)
560 (const ,mh-tool-bar-item-alias)
561 (const ,mh-tool-bar-item-compose)
562 (const ,mh-tool-bar-item-rescan)
563 (const ,mh-tool-bar-item-repack)
564 (const ,mh-tool-bar-item-search)
565 (const ,mh-tool-bar-item-visit)
566 (const ,mh-tool-bar-item-prefs)
567 (const ,mh-tool-bar-item-help)
568 (const ,mh-tool-bar-item-widen)))
569
570(defun mh-tool-bar-letter-buttons-set (symbol value)
571 "Update the `mh-tool-bar-letter-buttons' variable, and rebuild the tool-bar.
572Sets the default for SYMBOL (e.g. `mh-tool-bar-letter-buttons') to VALUE (as
573set in customization). This is called after 'customize is used to alter
574`mh-tool-bar-letter-buttons'."
575 (set-default symbol value)
576 (mh-tool-bar-letter-set))
577
578(custom-declare-variable
579 'mh-tool-bar-letter-buttons
580 '(list mh-tool-bar-item-send
581 mh-tool-bar-item-attach
582 mh-tool-bar-item-spell
583 mh-tool-bar-item-save
584 mh-tool-bar-item-undo-op
585 mh-tool-bar-item-kill
586 mh-tool-bar-item-copy
587 mh-tool-bar-item-paste
588 mh-tool-bar-item-kill-draft
589 mh-tool-bar-item-comp-prefs
590 mh-tool-bar-item-help)
591 "Buttons to include in MH-E letter toolbar."
592 :group 'mh-toolbar
593 :set 'mh-tool-bar-letter-buttons-set
594 :type `(set (const ,mh-tool-bar-item-send)
595 (const ,mh-tool-bar-item-attach)
596 (const ,mh-tool-bar-item-spell)
597 (const ,mh-tool-bar-item-save)
598 (const ,mh-tool-bar-item-undo-op)
599 (const ,mh-tool-bar-item-kill)
600 (const ,mh-tool-bar-item-copy)
601 (const ,mh-tool-bar-item-paste)
602 (const ,mh-tool-bar-item-kill-draft)
603 (const ,mh-tool-bar-item-comp-prefs)
604 (const ,mh-tool-bar-item-help)))
605
606
607
608;;; Speedbar and folder configuration (:group 'mh-speed)
609
610(defcustom mh-large-folder 200
611 "The number of messages that indicates a large folder.
612If a folder is deemed to be large, that is the number of messages in it exceed
613this value, then confirmation is needed when it is visited. Even when
614`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
615it is large. If set to nil all folders are treated as if they are small."
616 :type '(choice (const :tag "No limit") integer)
617 :group 'mh-speed)
618
619(defcustom mh-speed-flists-interval 60
620 "Time between calls to flists in seconds.
621If 0, flists is not called repeatedly."
622 :type 'integer
623 :group 'mh-speed)
624
625(defcustom mh-speed-run-flists-flag t
626 "Non-nil means flists is used.
627If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
628update the display of the number of unseen and total messages in each folder.
629If resources are limited, this can be set to nil and the speedbar display can
630be updated manually with the \\[mh-speed-flists] command."
631 :type 'boolean
632 :group 'mh-speed)
633
634;;; Options for controlling scan listing (:group 'mh-folder)
635
636(defcustom mh-adaptive-cmd-note-flag t
637 "*Non-nil means that the message number width is determined dynamically.
638This is done once when a folder is first opened by running scan on the last
639message of the folder. The message number for the last message is extracted
640and its width calculated. This width is used when calling `mh-set-cmd-note'.
641
642If you prefer fixed-width message numbers, set this variable to nil and call
643`mh-set-cmd-note' with the width specified by the scan format in
644`mh-scan-format-file'. For example, the default width is 4, so you would use
645\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
646 :type 'boolean
647 :group 'mh-folder)
648
649(defcustom mh-auto-folder-collect-flag t
650 "*Non-nil means to collect all folder names at startup in the background.
651Otherwise, the internal list of folder names is built as folders are
652referenced."
653 :type 'boolean
654 :group 'mh-folder)
655
656(defcustom mh-inc-prog "inc"
657 "*Program to run to incorporate new mail into a folder.
658Normally \"inc\". This file is searched for relative to
659the `mh-progs' directory unless it is an absolute pathname."
660 :type 'string
661 :group 'mh-folder)
662
663(defcustom mh-lpr-command-format "lpr -J '%s'"
664 "*Format for Unix command that prints a message.
665The string should be a Unix command line, with the string '%s' where
666the job's name (folder and message number) should appear. The formatted
667message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
668 :type 'string
669 :group 'mh-folder)
670
671(defcustom mh-mime-save-parts-default-directory t
672 "Default directory to use for `mh-mime-save-parts'.
673If nil, prompt and set for next time the command is used during same session.
674If t, prompt always"
675 :type '(choice (const :tag "Prompt the first time" nil)
676 (const :tag "Prompt always" t)
677 directory)
678 :group 'mh-folder)
679
680(defcustom mh-recenter-summary-flag nil
681 "*Non-nil means to recenter the summary window.
682Recenter the summary window when the show window is toggled off if non-nil."
683 :type 'boolean
684 :group 'mh-folder)
685
686(defcustom mh-print-background-flag nil
687 "*Non-nil means messages should be printed in the background.
688WARNING: do not delete the messages until printing is finished;
689otherwise, your output may be truncated."
690 :type 'boolean
691 :group 'mh-folder)
692
693(defcustom mh-recursive-folders-flag nil
694 "*Non-nil means that commands which operate on folders do so recursively."
695 :type 'boolean
696 :group 'mh-folder)
697
698(defcustom mh-scan-format-file t
699 "Specifies the format file to pass to the scan program.
700If t, the format string will be taken from the either `mh-scan-format-mh'
701or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
702If nil, the default scan output will be used.
703
704If you customize the scan format, you may need to modify a few variables
705containing regexps that MH-E uses to identify specific portions of the output.
706Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
707may also have to call `mh-set-cmd-note' with the width of your message
708numbers. See also `mh-adaptive-cmd-note-flag'."
709 :type '(choice (const :tag "Use MH-E scan format" t)
710 (const :tag "Use default scan format" nil)
711 (file :tag "Specify a scan format file"))
712 :group 'mh-folder)
713
714(defcustom mh-scan-prog "scan"
715 "*Program to run to generate one-line-per-message listing of a folder.
716Normally \"scan\" or a file name linked to scan. This file is searched
717for relative to the `mh-progs' directory unless it is an absolute pathname."
718 :type 'string
719 :group 'mh-folder)
720(make-variable-buffer-local 'mh-scan-prog)
721
722(defcustom mh-show-threads-flag nil
723 "Non-nil means new folders start in threaded mode.
724Threading large number of messages can be time consuming. So if the flag is
725non-nil then threading will be done only if the number of messages being
726threaded is less than `mh-large-folder'."
727 :type 'boolean
728 :group 'mh-folder)
729
730(defcustom mh-store-default-directory nil
731 "*Last directory used by \\[mh-store-msg]; default for next store.
732A directory name string, or nil to use current directory."
733 :type '(choice (const :tag "Current" nil)
734 directory)
735 :group 'mh-folder)
736
737(defcustom mh-update-sequences-after-mh-show-flag t
738 "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'.
739If set, `mh-update-sequence' is run every time a message is shown, telling
740MH or nmh that this is your current message. It's useful, for example, to
741display MIME content using \"M-! mhshow RET\""
742 :type 'boolean
743 :group 'mh-folder)
744
745;;; Message display (:group 'mh-show)
746
747(defcustom mh-bury-show-buffer-flag t
748 "*Non-nil means that the displayed show buffer for a folder is buried."
749 :type 'boolean
750 :group 'mh-show)
751
752(defcustom mh-clean-message-header-flag t
753 "*Non-nil means clean headers of messages that are displayed or inserted.
754The variables `mh-invisible-headers' and `mh-visible-headers' control
755what is removed."
756 :type 'boolean
757 :group 'mh-show)
758
759(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
760 "*Non-nil means that Gnus is used to show MIME attachments with Gnus."
761 :type 'boolean
762 :group 'mh-show)
763
764(defcustom mh-decode-quoted-printable-flag
765 (not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
766 "Non-nil means decode quoted-printable MIME part with `mimedecode'.
767
768Quoted-printable message parts are translated to 8-bit characters by the
769`mimedecode' command. However, unless there is only one quoted-printable body
770part, Gnus will have already decoded the quoted-printable parts.
771
772This variable is initialized t if `mimedecode' is available.
773
774The source code for `mimedecode' can be obtained from
775http://www.freesoft.org/CIE/FAQ/mimedeco.c."
776 :type 'boolean
777 :group 'mh-show)
778
779(defcustom mh-display-buttons-for-inline-parts-flag nil
780 "*Non-nil means display buttons for all inline MIME parts.
781If non-nil, buttons are displayed for all MIME parts. Inline parts start off
782in displayed state but they can be hidden by clicking the button. If nil no
783buttons are shown for inline parts."
784 :type 'boolean
785 :group 'mh-show)
786
787(defcustom mh-do-not-confirm-flag nil
788 "*Non-nil means do not prompt for confirmation.
789Commands such as `mh-pack-folder' prompt to confirm whether to process
790outstanding moves and deletes or not before continuing. A non-nil setting will
791perform the action--which is usually desired but cannot be retracted--without
792question."
793 :type 'boolean
794 :group 'mh-show)
795
796(defcustom mh-graphical-smileys-flag t
797 "*Non-nil means graphical smileys are displayed.
798Non-nil means that small graphics will be used in the show buffer instead of
799patterns like :-), ;-) etc. The setting only has effect if
800`mh-decode-mime-flag' is non-nil."
801 :type 'boolean
802 :group 'mh-show)
803
804(defcustom mh-graphical-emphasis-flag t
805 "*Non-nil means graphical emphasis is displayed.
806Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
807/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
808list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
809 :type 'boolean
810 :group 'mh-show)
811
812(defcustom mh-highlight-citation-p 'gnus
813 "How to highlight citations in show buffers.
814The gnus method uses a different color for each indentation."
815 :type '(choice (const :tag "Use gnus" gnus)
816 (const :tag "Use font-lock" font-lock)
817 (const :tag "Don't fontify" nil))
818 :group 'mh-show)
819
820(defcustom mh-max-inline-image-height nil
821 "*Maximum inline image height if Content-Disposition is not present.
822If nil, image will be displayed if its height is smaller than the height of
823the window."
824 :type '(choice (const nil) integer)
825 :group 'mh-show)
826
827(defcustom mh-max-inline-image-width nil
828 "*Maximum inline image width if Content-Disposition is not present.
829If nil, image will be displayed if its width is smaller than the width of the
830window."
831 :type '(choice (const nil) integer)
832 :group 'mh-show)
833
834(defcustom mh-show-maximum-size 0
835 "*Maximum size of message (in bytes) to display automatically.
836Provides an opportunity to skip over large messages which may be slow to load.
837Use a value of 0 to display all messages automatically regardless of size."
838 :type 'integer
839 :group 'mh-show)
840
841;; Use goto-addr if it was already loaded (which probably sets this
842;; variable to t), or if this variable is otherwise set to t.
843(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
844 goto-address-highlight-p)
845 "*Non-nil means highlight URLs and email addresses.
846The `goto-addr' module is used."
847 :type 'boolean
848 :group 'mh-show)
849
850(defcustom mh-show-use-xface-flag
851 (and window-system
852 (not (null (cond
853 (mh-xemacs-flag
854 (locate-library "x-face"))
855 ((>= emacs-major-version 21)
856 (locate-library "x-face-e21"))
857 (t ;Emacs20
858 nil))))
859 (not (null (and (fboundp 'executable-find)
860 (executable-find
861 "uncompface")))))
862 "*Non-nil means display faces in `mh-show-mode' with external x-face package.
863It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its
864files in the Emacs `load-path' and MH-E will invoke it automatically for you if
865this variable is non-nil.
866
867The `uncompface' binary is also required to be in the execute PATH. It can
868be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z"
869 :type 'boolean
870 :group 'mh-show)
871
872(defcustom mh-summary-height (or (and (fboundp 'frame-height)
873 (> (frame-height) 24)
874 (min 10 (/ (frame-height) 6)))
875 4)
876 "*Number of lines in MH-Folder window (including the mode line)."
877 :type 'integer
878 :group 'mh-show)
879
880(defcustom mh-visible-headers nil
881 "*Contains a regexp specifying the headers to keep when cleaning.
882Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
883the variable `mh-invisible-headers'."
884 :type '(choice (const nil) regexp)
885 :group 'mh-show)
886
887(defcustom mhl-formfile nil
888 "*Name of format file to be used by mhl to show and print messages.
889A value of t means use the default format file.
890nil means don't use mhl to format messages when showing; mhl is still used,
891with the default format file, to format messages when printing them.
892The format used should specify a non-zero value for overflowoffset so
893the message continues to conform to RFC 822 and MH-E can parse the headers."
894 :type '(choice (const nil) (const t) string)
895 :group 'mh-show)
896(put 'mhl-formfile 'info-file "mh-e")
897
898(defvar mh-invisible-headers nil
899 "*Regexp matching lines in a message header that are not to be shown.
900If `mh-visible-headers' is non-nil, it is used instead to specify what
901to keep.")
902
903(defun mh-invisible-headers ()
904 "Make or remake the variable `mh-invisible-headers'.
905Done using `mh-invisible-header-fields' as input."
906 (setq mh-invisible-headers
907 (concat
908 "^"
909 (let ((max-specpdl-size 1000)) ;workaround for insufficient default
910 (regexp-opt
911 (append
912 (if (not mh-show-use-xface-flag)
913 '("X-Face: "))
914 mh-invisible-header-fields))))))
915
916(defun mh-invisible-header-fields-set (symbol value)
917 "Update `mh-invisible-header-fields'.
918The function is called with SYMBOL bound to `mh-invisible-header-fields' and
919VALUE is the the list of headers that are invisible. As a side effect, the
920variable `mh-invisible-fields' is set."
921 (set-default symbol value)
922 (mh-invisible-headers))
923
924;; Keep fields alphabetized. Mention source, if known.
925(defcustom mh-invisible-header-fields
926 '("Autoforwarded: "
927 "Bestservhost: "
928 "Content-" ; RFC 2045
929 "Delivered-To: " ; Egroups/yahoogroups mailing list manager
930 "Delivery-Date: " ; MH
931 "Delivery: "
932 "Encoding: "
933 "Errors-To: "
934 "Forwarded: " ; MH
935 "From " ; sendmail
936 "Importance: " ; MS Outlook
937 "In-Reply-To: " ; MH
938 "Lines: "
939 "List-" ; Mailman mailing list manager
940 "List-" ; Unknown mailing list managers
941 "List-Subscribe: " ; Unknown mailing list managers
942 "List-Unsubscribe: " ; Unknown mailing list managers
943 "Mail-from: " ; MH
944 "Mailing-List: " ; Egroups/yahoogroups mailing list manager
945 "Message-Id: " ; RFC 822
946 "Mime-Version" ; RFC 2045
947 "NNTP-" ; News
948 "Old-Return-Path: "
949 "Original-Encoded-Information-Types: " ; X400
950 "P1-Content-Type: " ; X400
951 "P1-Message-Id: " ; X400
952 "P1-Recipient: " ; X400
953 "Path: "
954 "Precedence: "
955 "Prev-Resent" ; MH
956 "Priority: "
957 "Received: " ; RFC 822
958 "References: "
959 "Remailed-" ; MH
960 "Replied: " ; MH
961 "Resent" ; MH
962 "Return-Path: " ; RFC 822
963 "Sensitivity: " ; MS Outlook
964 "Status: " ; sendmail
965 "Ua-Content-Id: " ; X400
966 "User-Agent: "
967 "Via: " ; MH
968 "X-Abuse-Info: "
969 "X-Accept-Language: "
970 "X-Accept-Language: " ; Netscape/Mozilla
971 "X-Ack: "
972 "X-Apparently-From: " ; MS Outlook
973 "X-Apparently-To: " ; Egroups/yahoogroups mailing list manager
974 "X-Authentication-Warning: " ; sendmail
975 "X-Beenthere: " ; Mailman mailing list manager
976 "X-Complaints-To: "
977 "X-Cron-Env: "
978 "X-Delivered"
979 "X-Envelope-Sender: "
980 "X-Envelope-To: "
981 "X-Folder: " ; Spam
982 "X-From-Line"
983 "X-Gnus-Mail-Source: " ; gnus
984 "X-Habeas-SWE-1: " ; Spam
985 "X-Habeas-SWE-2: " ; Spam
986 "X-Habeas-SWE-3: " ; Spam
987 "X-Habeas-SWE-4: " ; Spam
988 "X-Habeas-SWE-5: " ; Spam
989 "X-Habeas-SWE-6: " ; Spam
990 "X-Habeas-SWE-7: " ; Spam
991 "X-Habeas-SWE-8: " ; Spam
992 "X-Habeas-SWE-9: " ; Spam
993 "X-Info: " ; NTMail
994 "X-Juno-" ; Juno
995 "X-List-Host: " ; Unknown mailing list managers
996 "X-List-Subscribe: " ; Unknown mailing list managers
997 "X-List-Unsubscribe: " ; Unknown mailing list managers
998 "X-Listserver: " ; Unknown mailing list managers
999 "X-Loop: " ; Unknown mailing list managers
1000 "X-MIME-Autoconverted: " ; sendmail
1001 "X-MIMETrack: "
1002 "X-MS-TNEF-Correlator: " ; MS Outlook
1003 "X-Mailing-List: " ; Unknown mailing list managers
1004 "X-Mailman-Version: " ; Mailman mailing list manager
1005 "X-Message-Id"
1006 "X-MimeOLE: " ; MS Outlook
1007 "X-Mozilla-Status: " ; Netscape/Mozilla
1008 "X-Msmail-" ; MS Outlook
1009 "X-News: " ; News
1010 "X-No-Archive: "
1011 "X-Orcl-Content-Type: "
1012 "X-Original-Complaints-To: "
1013 "X-Original-Date: " ; SourceForge mailing list manager
1014 "X-Original-Trace: "
1015 "X-OriginalArrivalTime: " ; Hotmail
1016 "X-Originating-IP: " ; Hotmail
1017 "X-Priority: " ; MS Outlook
1018 "X-Qotd-" ; User added
1019 "X-Received-Date: "
1020 "X-Received: "
1021 "X-Request-"
1022 "X-SBClass: " ; Spam
1023 "X-SBNote: " ; Spam
1024 "X-SBPass: " ; Spam
1025 "X-SBRule: " ; Spam
1026 "X-Scanned-By"
1027 "X-Sender: "
1028 "X-Server-Date: "
1029 "X-Server-Uuid: "
1030 "X-Sieve: " ; Sieve filtering
1031 "X-Spam-Level: " ; Spam
1032 "X-Spam-Score: " ; Spam
1033 "X-Spam-Status: " ; Spam
1034 "X-SpamBouncer: " ; Spam
1035 "X-Trace: "
1036 "X-UIDL: "
1037 "X-UserInfo1: "
1038 "X-VSMLoop: " ; NTMail
1039 "X-Vms-To: "
1040 "X-Wss-Id: " ; Worldtalk gateways
1041 "X-eGroups-" ; Egroups/yahoogroups mailing list manager
1042 "X-pgp: "
1043 "X-submission-address: "
1044 "X400-" ; X400
1045 "Xref: ")
1046"*List of header fields that are not to be shown.
1047Regexps are not allowed. Unique fields should have a \": \" suffix;
1048otherwise, the element can be used to render an entire class of fields
1049that start with the same prefix invisible.
1050This variable is ignored if `mh-visible-headers' is set."
1051 :type '(repeat (string :tag "Header field"))
1052 :set 'mh-invisible-header-fields-set
1053 :group 'mh-show)
1054
1055;;; Composing messages (:group 'mh-letter)
1056
1057(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
1058 "Use either 'gnus or 'mhn to insert MIME message directives in messages."
1059 :type '(choice (const :tag "Use gnus" gnus)
1060 (const :tag "Use mhn" mhn))
1061 :group 'mh-letter)
1062
1063(defcustom mh-compose-letter-function nil
1064 "Invoked when setting up a letter draft.
1065It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
1066 :type '(choice (const nil) function)
1067 :group 'mh-letter)
1068
1069(defcustom mh-delete-yanked-msg-window-flag nil
1070 "*Non-nil means delete any window displaying the message.
1071Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1072If non-nil, yanking the current message into a draft letter deletes any
1073windows displaying the message."
1074 :type 'boolean
1075 :group 'mh-letter)
1076
1077(defcustom mh-extract-from-attribution-verb "wrote:"
1078 "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
1079 :type '(choice (const "wrote:")
1080 (const "a écrit :")
1081 (string :tag "Custom string"))
1082 :group 'mh-letter)
1083
1084(defcustom mh-forward-subject-format "%s: %s"
1085 "*Format to generate the Subject: line contents for a forwarded message.
1086The two string arguments to the format are the sender of the original
1087message and the original subject line."
1088 :type 'string
1089 :group 'mh-letter)
1090
1091(defcustom mh-ins-buf-prefix "> "
1092 "*String to put before each non-blank line of a yanked or inserted message.
1093\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
1094by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
1095 :type 'string
1096 :group 'mh-letter)
1097
1098(defcustom mh-insert-mail-followup-to-flag t
1099 "Non-nil means maybe append a Mail-Followup-To field to the header.
1100The insertion is done if the To: or Cc: fields matches an entry in
1101`mh-insert-mail-followup-to-list'."
1102 :type 'boolean
1103 :group 'mh-letter)
1104
1105(defcustom mh-insert-mail-followup-to-list nil
1106 "Alist of addresses for which a Mail-Followup-To field is inserted.
1107Each element has the form (REGEXP ADDRESS).
1108When the REGEXP appears in the To or cc fields of a message, the corresponding
1109ADDRESS is inserted in a Mail-Followup-To field.
1110
1111Here's a customization example:
1112
1113 regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
1114 address: mh-e-users@lists.sourceforge.net
1115
1116This corresponds to:
1117
1118 (setq mh-insert-mail-followup-to-list
1119 '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
1120 \"mh-e-users@lists.sourceforge.net\")))
1121
1122While it might be tempting to add a descriptive name to the mailing list
1123address, consider that this field will appear in other people's outgoing
1124mail in their To: field. It might be best to keep it simple."
1125 :type '(repeat (list (string :tag "regexp") (string :tag "address")))
1126 :group 'mh-letter)
1127
1128(defcustom mh-insert-x-mailer-flag t
1129 "*Non-nil means append an X-Mailer field to the header."
1130 :type 'boolean
1131 :group 'mh-letter)
1132
1133(defcustom mh-letter-fill-column 72
1134 "*Fill column to use in `mh-letter-mode'.
1135This is usually less than in other text modes because email messages get
1136quoted by some prefix (sometimes many times) when they are replied to,
1137and it's best to avoid quoted lines that span more than 80 columns."
1138 :type 'integer
1139 :group 'mh-letter)
1140
1141(defcustom mh-reply-default-reply-to nil
1142 "*Sets the person or persons to whom a reply will be sent.
1143If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
1144value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
1145The values \"cc\" and \"all\" do the same thing."
1146 :type '(choice (const :tag "Prompt" nil)
1147 (const "from") (const "to")
1148 (const "cc") (const "all"))
1149 :group 'mh-letter)
1150
1151(defcustom mh-reply-show-message-flag t
1152 "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
1153
1154The setting of this variable determines whether the MH `show-buffer' is
1155displayed with the current message when using `mh-reply' without a prefix
1156argument. Set it to nil if you already include the message automatically
1157in your draft using
1158 repl: -filter repl.filter
1159in your ~/.mh_profile file."
1160 :type 'boolean
1161 :group 'mh-letter)
1162
1163(defcustom mh-signature-file-name "~/.signature"
1164 "*Name of file containing the user's signature.
1165Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
1166 :type 'file
1167 :group 'mh-letter)
1168
1169(defcustom mh-x-face-file "~/.face"
1170 "*File name containing the encoded X-Face string to insert in outgoing mail.
1171If nil, or the file does not exist, nothing is added to message headers."
1172 :type 'file
1173 :group 'mh-letter)
1174
1175(defvar mh-x-mailer-string nil
1176 "*String containing the contents of the X-Mailer header field.
1177If nil, this variable is initialized to show the version of MH-E, Emacs, and
1178MH the first time a message is composed.")
1179
1180(defcustom mh-yank-from-start-of-msg 'attribution
1181 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1182If t, include the entire message, with full headers. This is historically
1183here for use with supercite, but is now deprecated in favor of the setting
1184`supercite' below.
1185
1186If the symbol `body', then yank the message minus the header.
1187
1188If the symbol `supercite', include the entire message, with full headers.
1189This also causes the invocation of `sc-cite-original' without the setting
1190of `mail-citation-hook', now deprecated practice.
1191
1192If the symbol `autosupercite', do as for `supercite' automatically when
1193show buffer matches the message being replied-to. When this option is used,
1194the -noformat switch is passed to the repl program to override a -filter or
1195-format switch.
1196
1197If the symbol `attribution', then yank the message minus the header and add
1198a simple attribution line at the top.
1199
1200If the symbol `autoattrib', do as for `attribution' automatically when show
1201buffer matches the message being replied-to. You can make sure this is
1202always the case by setting `mh-reply-show-message-flag' to t (which is the
1203default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
1204that the show window is never displayed. When the `autoattrib' option is
1205used, the -noformat switch is passed to the repl program to override a
1206-filter or -format switch.
1207
1208If nil, yank only the portion of the message following the point.
1209
1210If the show buffer has a region, this variable is ignored unless its value is
1211one of `attribution' or `autoattrib' in which case the attribution is added
1212to the yanked region."
1213 :type '(choice (const :tag "Below point" nil)
1214 (const :tag "Without header" body)
1215 (const :tag "Invoke supercite" supercite)
1216 (const :tag "Invoke supercite, automatically" autosupercite)
1217 (const :tag "Without header, with attribution" attribution)
1218 (const :tag "Without header, with attribution, automatically"
1219 autoattrib)
1220 (const :tag "Entire message with headers" t))
1221 :group 'mh-letter)
1222
1223(defcustom mh-letter-complete-function 'ispell-complete-word
1224 "*Function to call when completing outside of fields specific to aliases."
1225 :type '(choice function (const nil))
1226 :group 'mh-letter)
1227
1228;;; Alias handling (:group 'mh-alias)
1229
1230(defcustom mh-alias-system-aliases
1231 '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
1232 "*A list of system files from which to cull aliases.
1233If these files are modified, they are automatically reread. This list need
1234include only system aliases and the passwd file, since personal alias files
1235listed in your \"AliasFile\" MH profile component are automatically included.
1236You can update the alias list manually using \\[mh-alias-reload]."
1237 :group 'mh-alias
1238 :type '(choice (file) (repeat file)))
1239
1240(defcustom mh-alias-expand-aliases-flag nil
1241 "*Non-nil means to expand aliases entered in the minibuffer.
1242In other words, aliases entered in the minibuffer will be expanded to the full
1243address in the message draft. By default, this expansion is not performed."
1244 :group 'mh-alias
1245 :type 'boolean)
1246
1247(defcustom mh-alias-completion-ignore-case-flag t
1248 "*Non-nil means don't consider case significant in MH alias completion.
1249This is the default in plain MH, so it is the default here as well. It
1250can be useful to set this to t if, for example, you use lowercase
1251aliases for people and uppercase for mailing lists."
1252 :group 'mh-alias
1253 :type 'boolean)
1254
1255(defcustom mh-alias-flash-on-comma t
1256 "*Specify whether to flash or warn on translation.
1257When a [comma] is pressed while entering aliases or addresses, setting this
1258variable to the following values has the listed effects:
1259t Flash alias translation but don't warn if there is no translation.
12601 Flash alias translation and warn if there is no translation.
1261nil Do not flash alias translation nor warn if there is no translation."
1262 :group 'mh-alias
1263 :type '(choice (const :tag "Flash but don't warn if no translation" t)
1264 (const :tag "Flash and warn if no translation" 1)
1265 (const :tag "Don't flash nor warn if no translation" nil)))
1266
1267(defcustom mh-alias-local-users t
1268 "*If t, local users are completed in MH-E To: and Cc: prompts.
1269
1270Users with a userid greater than some magic number (usually 200) are available
1271for completion.
1272
1273If you set this variable to a string, it will be executed to generate a
1274password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
1275 :group 'mh-alias
1276 :type '(choice (boolean) (string)))
1277
1278(defcustom mh-alias-insert-file nil
1279 "*Filename to use to store new MH-E aliases.
1280This variable can also be a list of filenames, in which case MH-E will prompt
1281for one of them. If nil, the default, then MH-E will use the first file found
1282in the \"AliasFile\" component of the MH profile."
1283 :group 'mh-alias
1284 :type '(choice (const :tag "Use AliasFile MH profile component" nil)
1285 (file :tag "Alias file")
1286 (repeat :tag "List of alias files" file)))
1287
1288(defcustom mh-alias-insertion-location 'sorted
1289 "Specifies where new aliases are entered in alias files.
1290Options are sorted alphabetically, at the top of the file or at the bottom."
1291 :type '(choice (const :tag "Sorted alphabetically" sorted)
1292 (const :tag "At the top of file" top)
1293 (const :tag "At the bottom of file" bottom))
1294 :group 'mh-alias)
1295
1296;;; Indexed searching (:group 'mh-index)
1297
1298(defcustom mh-index-program nil
1299 "Indexing program that MH-E shall use.
1300The possible choices are swish++, swish-e, namazu, glimpse and grep. By
1301default this variable is nil which means that the programs are tried in order
1302and the first one found is used."
1303 :type '(choice (const :tag "auto-detect" nil)
1304 (const :tag "swish++" swish++)
1305 (const :tag "swish-e" swish)
1306 (const :tag "namazu" namazu)
1307 (const :tag "glimpse" glimpse)
1308 (const :tag "grep" grep))
1309 :group 'mh-index)
1310
1311;;; Multiple personalities (:group 'mh-identity)
1312
1313(defcustom mh-identity-list nil
1314 "*List holding MH-E identity.
1315Omit the colon and trailing space from the field names.
1316The keyword name \"none\" is reversed for internal use.
1317Use the keyname name \"signature\" to specify either a signature file or a
1318function to call to insert a signature at point.
1319
1320Providing an empty Value (\"\") will cause the field to be deleted.
1321
1322Example entries using the customize interface:
1323 Keyword name: work
1324 From
1325 Value: John Doe <john@work.com>
1326 Organization
1327 Value: Acme Inc.
1328 Keyword name: home
1329 From
1330 Value: John Doe <johndoe@home.net>
1331 Organization
1332 Value:
1333
1334This would produce the equivalent of:
1335 (setq mh-identity-list
1336 '((\"work\"
1337 ((\"From\" . \"John Doe <john@work.com>\")
1338 (\"Organization\" . \"Acme Inc.\")))
1339 (\"home\"
1340 ((\"From\" . \"John Doe <johndoe@home.net>\")
1341 (\"Organization\" . \"\")))))"
1342 :type '(repeat (list :tag ""
1343 (string :tag "Keyword name")
1344 (repeat :tag "At least one pair from below"
1345 (choice (cons :tag "From field"
1346 (const "From")
1347 (string :tag "Value"))
1348 (cons :tag "Organization field"
1349 (const "Organization")
1350 (string :tag "Value"))
1351 (cons :tag "Signature"
1352 (const "signature")
1353 (choice (file) (function)))
1354 (cons :tag "Other field & value pair"
1355 (string :tag "Field")
1356 (string :tag "Value"))))))
1357 :set 'mh-identity-list-set
1358 :group 'mh-identity)
1359
1360(defcustom mh-identity-default nil
1361 "Default identity to use when `mh-letter-mode' is called."
1362 ;; Dynamically render :type corresponding to `mh-identity-list' entries,
1363 ;; e.g.:
1364 ;; :type '(radio (const :tag "none" nil)
1365 ;; (const "home")
1366 ;; (const "work"))
1367 :type (append
1368 '(radio)
1369 (cons '(const :tag "none" nil)
1370 (mapcar (function (lambda (arg) `(const ,arg)))
1371 (mapcar 'car mh-identity-list))))
1372 :group 'mh-identity)
1373
1374;;; Hooks (:group 'mh-hooks + group where hook defined)
1375
1376;;; These are alphabetized. All hooks should be placed in the 'mh-hook group;
1377;;; in addition, add the group in which the hook is defined in the manual (or,
1378;;; if it is new, where it would be defined).
1379
1380(defcustom mh-before-quit-hook nil
1381 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
1382See also `mh-quit-hook'."
1383 :type 'hook
1384 :group 'mh-hooks
1385 :group 'mh-folder)
1386
1387(defcustom mh-before-send-letter-hook nil
1388 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
1389 :type 'hook
1390 :group 'mh-hooks
1391 :group 'mh-letter)
1392
1393(defcustom mh-delete-msg-hook nil
1394 "Invoked after marking each message for deletion."
1395 :type 'hook
1396 :group 'mh-hooks
1397 :group 'mh-folder)
1398
1399(defcustom mh-edit-mhn-hook nil
1400 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
1401 :type 'hook
1402 :group 'mh-hooks
1403 :group 'mh-letter)
1404
1405(defcustom mh-find-path-hook nil
1406 "Invoked by `mh-find-path' after reading the user's MH profile."
1407 :type 'hook
1408 :group 'mh-hooks
1409 :group 'mh-folder)
1410
1411(defcustom mh-folder-list-change-hook nil
1412 "Invoked whenever the cached folder list `mh-folder-list' is changed."
1413 :type 'hook
1414 :group 'mh-hooks
1415 :group 'mh-folder)
1416
1417(defcustom mh-folder-mode-hook nil
1418 "Invoked in `mh-folder-mode' on a new folder."
1419 :type 'hook
1420 :group 'mh-hooks
1421 :group 'mh-folder)
1422
1423(defcustom mh-folder-updated-hook nil
1424 "Invoked when the folder actions (such as moves and deletes) are performed.
1425Variables that are useful in this hook include `mh-delete-list' and
1426`mh-refile-list' which can be used to see which changes are being made to
1427current folder, `mh-current-folder'."
1428 :type 'hook
1429 :group 'mh-hooks)
1430
1431(defcustom mh-inc-folder-hook nil
1432 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
1433 :type 'hook
1434 :group 'mh-hooks
1435 :group 'mh-folder)
1436
1437(defcustom mh-index-show-hook nil
1438 "Invoked after the message has been displayed."
1439 :type 'hook
1440 :group 'mh-hooks
1441 :group 'mh-index)
1442
1443(defcustom mh-letter-insert-signature-hook nil
1444 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
1445Can be used to determine which signature file to use based on message content.
1446On return, if `mh-signature-file-name' is non-nil that file will be inserted at
1447the current point in the buffer."
1448 :type 'hook
1449 :group 'mh-hooks
1450 :group 'mh-letter)
1451
1452(defcustom mh-letter-mode-hook nil
1453 "Invoked in `mh-letter-mode' on a new letter."
1454 :type 'hook
1455 :group 'mh-hooks
1456 :group 'mh-letter)
1457
1458(defcustom mh-pick-mode-hook nil
1459 "Invoked upon entry to `mh-pick-mode'."
1460 :type 'hook
1461 :group 'mh-hooks
1462 :group 'mh-folder)
1463
1464(defcustom mh-quit-hook nil
1465 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
1466See also `mh-before-quit-hook'."
1467 :type 'hook
1468 :group 'mh-hooks
1469 :group 'mh-folder)
1470
1471(defcustom mh-refile-msg-hook nil
1472 "Invoked after marking each message for refiling."
1473 :type 'hook
1474 :group 'mh-hooks
1475 :group 'mh-folder)
1476
1477(defcustom mh-show-hook nil
1478 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
1479 :type 'hook
1480 :group 'mh-hooks
1481 :group 'mh-show)
1482
1483(defcustom mh-show-mode-hook nil
1484 "Invoked upon entry to `mh-show-mode'."
1485 :type 'hook
1486 :group 'mh-hooks
1487 :group 'mh-show)
1488
1489(defcustom mh-unseen-updated-hook nil
1490 "Invoked after the unseen sequence has been updated.
1491The variable `mh-seen-list' can be used to obtain the list of messages which
1492will be removed from the unseen sequence."
1493 :type 'hook
1494 :group 'mh-hooks
1495 :group 'mh-folder)
1496
1497
1498
1499;;; Faces
1500
1501;;; Faces used in speedbar (:group mh-speed-faces)
1502
1503(defface mh-speedbar-folder-face
1504 '((((class color) (background light))
1505 (:foreground "blue4"))
1506 (((class color) (background dark))
1507 (:foreground "light blue")))
1508 "Face used for folders in the speedbar buffer."
1509 :group 'mh-speed-faces)
1510
1511(defface mh-speedbar-selected-folder-face
1512 '((((class color) (background light))
1513 (:foreground "red" :underline t))
1514 (((class color) (background dark))
1515 (:foreground "red" :underline t))
1516 (t (:underline t)))
1517 "Face used for the current folder."
1518 :group 'mh-speed-faces)
1519
1520(defface mh-speedbar-folder-with-unseen-messages-face
1521 '((t (:inherit mh-speedbar-folder-face :bold t)))
1522 "Face used for folders in the speedbar buffer which have unread messages."
1523 :group 'mh-speed-faces)
1524
1525(defface mh-speedbar-selected-folder-with-unseen-messages-face
1526 '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
1527 "Face used for the current folder when it has unread messages."
1528 :group 'mh-speed-faces)
1529
1530;;; Faces used in scan listing (:group mh-folder-faces)
1531
1532(defvar mh-folder-body-face 'mh-folder-body-face
1533 "Face for highlighting body text in MH-Folder buffers.")
1534(defface mh-folder-body-face
1535 '((((type tty) (class color)) (:foreground "green"))
1536 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1537 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1538 (((class color) (background light)) (:foreground "RosyBrown"))
1539 (((class color) (background dark)) (:foreground "LightSalmon"))
1540 (t (:italic t)))
1541 "Face for highlighting body text in MH-Folder buffers."
1542 :group 'mh-folder-faces)
1543
1544(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
1545 "Face for the current message line in MH-Folder buffers.")
1546(defface mh-folder-cur-msg-face
1547 '((((type tty pc) (class color))
1548 (:background "LightGreen"))
1549 (((class color) (background light))
1550 (:background "LightGreen") ;Use this for solid background colour
1551 ;; (:underline t) ;Use this for underlining
1552 )
1553 (((class color) (background dark))
1554 (:background "DarkOliveGreen4"))
1555 (t (:underline t)))
1556 "Face for the current message line in MH-Folder buffers."
1557 :group 'mh-folder-faces)
1558
1559(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
1560 "Face for highlighting the current message in MH-Folder buffers.")
1561(defface mh-folder-cur-msg-number-face
1562 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1563 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
1564 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1565 (((class color) (background light)) (:foreground "Purple"))
1566 (((class color) (background dark)) (:foreground "Cyan"))
1567 (t (:bold t)))
1568 "Face for highlighting the current message in MH-Folder buffers."
1569 :group 'mh-folder-faces)
1570
1571(defvar mh-folder-date-face 'mh-folder-date-face
1572 "Face for highlighting the date in MH-Folder buffers.")
1573(defface mh-folder-date-face
1574 '((((class color) (background light))
1575 (:foreground "snow4"))
1576 (((class color) (background dark))
1577 (:foreground "snow3"))
1578 (t
1579 (:bold t)))
1580 "Face for highlighting the date in MH-Folder buffers."
1581 :group 'mh-folder-faces)
1582
1583(defvar mh-folder-followup-face 'mh-folder-followup-face
1584 "Face for highlighting Re: (followup) subject text in MH-Folder buffers.")
1585(defface mh-folder-followup-face
1586 '((((class color) (background light))
1587 (:foreground "blue3"))
1588 (((class color) (background dark))
1589 (:foreground "LightGoldenRod"))
1590 (t
1591 (:bold t)))
1592 "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
1593 :group 'mh-folder-faces)
1594
1595(defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
1596 "Face for highlighting the message number in MH-Folder buffers.")
1597(defface mh-folder-msg-number-face
1598 '((((class color) (background light))
1599 (:foreground "snow4"))
1600 (((class color) (background dark))
1601 (:foreground "snow3"))
1602 (t
1603 (:bold t)))
1604 "Face for highlighting the message number in MH-Folder buffers."
1605 :group 'mh-folder-faces)
1606
1607(defvar mh-folder-deleted-face 'mh-folder-deleted-face
1608 "Face for highlighting deleted messages in MH-Folder buffers.")
1609(copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
1610
1611(defvar mh-folder-refiled-face 'mh-folder-refiled-face
1612 "Face for highlighting refiled messages in MH-Folder buffers.")
1613(defface mh-folder-refiled-face
1614 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1615 (((class grayscale) (background light))
1616 (:foreground "Gray90" :bold t :italic t))
1617 (((class grayscale) (background dark))
1618 (:foreground "DimGray" :bold t :italic t))
1619 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1620 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1621 (t (:bold t :italic t)))
1622 "Face for highlighting refiled messages in MH-Folder buffers."
1623 :group 'mh-folder-faces)
1624
1625(defvar mh-folder-subject-face 'mh-folder-subject-face
1626 "Face for highlighting subject text in MH-Folder buffers.")
1627(if (boundp 'facemenu-unlisted-faces)
1628 (add-to-list 'facemenu-unlisted-faces "^mh-folder"))
1629(defface mh-folder-subject-face
1630 '((((class color) (background light))
1631 (:foreground "blue4"))
1632 (((class color) (background dark))
1633 (:foreground "yellow"))
1634 (t
1635 (:bold t)))
1636 "Face for highlighting subject text in MH-Folder buffers."
1637 :group 'mh-folder-faces)
1638
1639(defvar mh-folder-address-face 'mh-folder-address-face
1640 "Face for highlighting the address in MH-Folder buffers.")
1641(copy-face 'mh-folder-subject-face 'mh-folder-address-face)
1642
1643(defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
1644 "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
1645(copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
1646
1647(defvar mh-folder-to-face 'mh-folder-to-face
1648 "Face for highlighting the To: string in MH-Folder buffers.")
1649(defface mh-folder-to-face
1650 '((((type tty) (class color)) (:foreground "green"))
1651 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1652 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1653 (((class color) (background light)) (:foreground "RosyBrown"))
1654 (((class color) (background dark)) (:foreground "LightSalmon"))
1655 (t (:italic t)))
1656 "Face for highlighting the To: string in MH-Folder buffers."
1657 :group 'mh-folder-faces)
1658
1659;;; Faces used in message display (:group mh-show-faces)
1660
1661(defvar mh-show-cc-face 'mh-show-cc-face
1662 "Face for highlighting cc header fields.")
1663(defface mh-show-cc-face
1664 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1665 (((class grayscale) (background light))
1666 (:foreground "Gray90" :bold t :italic t))
1667 (((class grayscale) (background dark))
1668 (:foreground "DimGray" :bold t :italic t))
1669 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1670 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1671 (t (:bold t :italic t)))
1672 "Face for highlighting cc header fields."
1673 :group 'mh-show-faces)
1674
1675(defvar mh-show-date-face 'mh-show-date-face
1676 "Face for highlighting the Date header field.")
1677(defface mh-show-date-face
1678 '((((type tty) (class color)) (:foreground "green"))
1679 (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
1680 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1681 (((class color) (background light)) (:foreground "ForestGreen"))
1682 (((class color) (background dark)) (:foreground "PaleGreen"))
1683 (t (:bold t :underline t)))
1684 "Face for highlighting the Date header field."
1685 :group 'mh-show-faces)
1686
1687(defvar mh-show-header-face 'mh-show-header-face
1688 "Face used to deemphasize unspecified header fields.")
1689(defface mh-show-header-face
1690 '((((type tty) (class color)) (:foreground "green"))
1691 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1692 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1693 (((class color) (background light)) (:foreground "RosyBrown"))
1694 (((class color) (background dark)) (:foreground "LightSalmon"))
1695 (t (:italic t)))
1696 "Face used to deemphasize unspecified header fields."
1697 :group 'mh-show-faces)
1698
1699(defvar mh-show-to-face 'mh-show-to-face
1700 "Face for highlighting the To: header field.")
1701(if (boundp 'facemenu-unlisted-faces)
1702 (add-to-list 'facemenu-unlisted-faces "^mh-show"))
1703(defface mh-show-to-face
1704 '((((class grayscale) (background light))
1705 (:foreground "DimGray" :underline t))
1706 (((class grayscale) (background dark))
1707 (:foreground "LightGray" :underline t))
1708 (((class color) (background light)) (:foreground "SaddleBrown"))
1709 (((class color) (background dark)) (:foreground "burlywood"))
1710 (t (:underline t)))
1711 "Face for highlighting the To: header field."
1712 :group 'mh-show-faces)
1713
1714(defvar mh-show-from-face 'mh-show-from-face
1715 "Face for highlighting the From: header field.")
1716(defface mh-show-from-face
1717 '((((class color) (background light))
1718 (:foreground "red3"))
1719 (((class color) (background dark))
1720 (:foreground "cyan"))
1721 (t
1722 (:bold t)))
1723 "Face for highlighting the From: header field."
1724 :group 'mh-show-faces)
1725
1726(defvar mh-show-subject-face 'mh-show-subject-face
1727 "Face for highlighting the Subject header field.")
1728(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
1729
1730;;; Faces used in indexed searches (:group mh-index-faces)
1731
1732(defvar mh-index-folder-face 'mh-index-folder-face
1733 "Face for highlighting folders in MH-Index buffers.")
1734(defface mh-index-folder-face
1735 '((((class color) (background light))
1736 (:foreground "dark green" :bold t))
1737 (((class color) (background dark))
1738 (:foreground "indian red" :bold t))
1739 (t
1740 (:bold t)))
1741 "Face for highlighting folders in MH-Index buffers."
1742 :group 'mh-index-faces)
1743
1744(provide 'mh-customize)
1745
1746;;; Local Variables:
1747;;; indent-tabs-mode: nil
1748;;; sentence-end-double-space: nil
1749;;; End:
1750
1751;;; mh-customize.el ends here
diff --git a/lisp/mail/mh-e.el b/lisp/mail/mh-e.el
index 61dc037524f..9a5f8967f2a 100644
--- a/lisp/mail/mh-e.el
+++ b/lisp/mail/mh-e.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Bill Wohler <wohler@newt.com> 5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Version: 7.0 7;; Version: 7.1
8;; Keywords: mail 8;; Keywords: mail
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
@@ -79,11 +79,19 @@
79;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the 79;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
80;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. 80;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
81 81
82;; $Id: mh-e.el,v 1.198 2002/11/29 15:33:37 wohler Exp $ 82;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $
83 83
84;;; Code: 84;;; Code:
85 85
86(require 'cl) 86(require 'cl)
87
88(defvar recursive-load-depth-limit)
89(eval-when (compile load eval)
90 (if (and (boundp 'recursive-load-depth-limit)
91 (integerp recursive-load-depth-limit)
92 (> 50 recursive-load-depth-limit))
93 (setq recursive-load-depth-limit 50)))
94
87(require 'mh-utils) 95(require 'mh-utils)
88(require 'gnus-util) 96(require 'gnus-util)
89(require 'easymenu) 97(require 'easymenu)
@@ -93,160 +101,14 @@
93;; Shush the byte-compiler 101;; Shush the byte-compiler
94(defvar font-lock-auto-fontify) 102(defvar font-lock-auto-fontify)
95(defvar font-lock-defaults) 103(defvar font-lock-defaults)
96(defvar tool-bar-mode)
97
98(defconst mh-version "7.0" "Version number of MH-E.")
99
100;;; Initial Autoloads
101;;; The autoloads for mh-undo-folder, mh-widen and mh-reply are needed before
102;;; they are used to avoid compiler warnings.
103(autoload 'mh-undo-folder "mh-funcs"
104 "Undo all commands in current folder." t)
105(autoload 'mh-widen "mh-seq"
106 "Remove restrictions from current folder, thereby showing all messages." t)
107(autoload 'mh-reply "mh-comp"
108 "Reply to a MESSAGE (default: displayed message).
109If optional prefix argument INCLUDEP provided, then include the message
110in the reply using filter mhl.reply in your MH directory.
111Prompts for type of addresses to reply to:
112 from sender only,
113 to sender and primary recipients,
114 cc/all sender and all recipients.
115If the file named by `mh-repl-formfile' exists, it is used as a skeleton
116for the reply. See also documentation for `\\[mh-send]' function." t)
117(autoload 'mh-map-to-seq-msgs "mh-seq")
118(autoload 'mh-notate-seq "mh-seq")
119(autoload 'mh-destroy-postponed-handles "mh-mime")
120(autoload 'mh-press-button "mh-mime")
121(autoload 'mh-mime-save-part "mh-mime")
122(autoload 'mh-mime-inline-part "mh-mime")
123(autoload 'mh-mime-save-parts "mh-mime")
124(autoload 'mh-thread-inc "mh-seq")
125(autoload 'mh-thread-forget-message "mh-seq")
126(autoload 'mh-thread-add-spaces "mh-seq")
127 104
105(defconst mh-version "7.1" "Version number of MH-E.")
106
107;;; Autoloads
128(autoload 'Info-goto-node "info") 108(autoload 'Info-goto-node "info")
129 109
130 110
131 111
132;;; Hooks:
133
134(defgroup mh nil
135 "Emacs interface to the MH mail system."
136 :group 'mail)
137
138(defgroup mh-hook nil
139 "Hooks to MH-E mode."
140 :prefix "mh-"
141 :group 'mh)
142
143(defcustom mh-folder-mode-hook nil
144 "Invoked in `mh-folder-mode' on a new folder."
145 :type 'hook
146 :group 'mh-hook)
147
148(defcustom mh-inc-folder-hook nil
149 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
150 :type 'hook
151 :group 'mh-hook)
152
153(defcustom mh-folder-updated-hook nil
154 "Invoked when the folder actions (such as moves and deletes) are performed.
155Variables that are useful in this hook include `mh-delete-list' and
156`mh-refile-list' which can be used to see which changes are being made to
157current folder, `mh-current-folder'."
158 :type 'hook
159 :group 'mh-hook)
160
161(defcustom mh-delete-msg-hook nil
162 "Invoked after marking each message for deletion."
163 :type 'hook
164 :group 'mh-hook)
165
166(defcustom mh-refile-msg-hook nil
167 "Invoked after marking each message for refiling."
168 :type 'hook
169 :group 'mh-hook)
170
171(defcustom mh-folder-list-change-hook nil
172 "Invoked whenever the cached folder list `mh-folder-list' is changed."
173 :type 'hook
174 :group 'mh-hook)
175
176(defcustom mh-before-quit-hook nil
177 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
178See also `mh-quit-hook'."
179 :type 'hook
180 :group 'mh-hook)
181
182(defcustom mh-quit-hook nil
183 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
184See also `mh-before-quit-hook'."
185 :type 'hook
186 :group 'mh-hook)
187
188(defcustom mh-unseen-updated-hook nil
189 "Invoked after the unseen sequence has been updated.
190The variable `mh-seen-list' can be used to obtain the list of messages which
191will be removed from the unseen sequence."
192 :type 'hook
193 :group 'mh-hook)
194
195;;; Personal preferences:
196
197(defcustom mh-lpr-command-format "lpr -J '%s'"
198 "*Format for Unix command that prints a message.
199The string should be a Unix command line, with the string '%s' where
200the job's name (folder and message number) should appear. The formatted
201message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
202 :type 'string
203 :group 'mh)
204
205(defcustom mh-scan-prog "scan"
206 "*Program to run to generate one-line-per-message listing of a folder.
207Normally \"scan\" or a file name linked to scan. This file is searched
208for relative to the mh-progs directory unless it is an absolute pathname."
209 :type 'string
210 :group 'mh)
211(make-variable-buffer-local 'mh-scan-prog)
212
213(defcustom mh-inc-prog "inc"
214 "*Program to run to incorporate new mail into a folder.
215Normally \"inc\". This file is searched for relative to
216the mh-progs directory unless it is an absolute pathname."
217 :type 'string
218 :group 'mh)
219
220(defcustom mh-print-background-flag nil
221 "*Non-nil means messages should be printed in the background.
222WARNING: do not delete the messages until printing is finished;
223otherwise, your output may be truncated."
224 :type 'boolean
225 :group 'mh)
226
227(defcustom mh-recenter-summary-flag nil
228 "*Non-nil means to recenter the summary window.
229
230Recenter the summary window when the show window is toggled off if non-nil."
231 :type 'boolean
232 :group 'mh)
233
234(defcustom mh-do-not-confirm-flag nil
235 "*Non-nil means do not prompt for confirmation.
236Commands such as `mh-pack-folder' prompt to confirm whether to process
237outstanding moves and deletes or not before continuing. A non-nil setting will
238perform the action--which is usually desired but cannot be retracted--without
239question."
240 :type 'boolean
241 :group 'mh)
242
243(defcustom mh-store-default-directory nil
244 "*Last directory used by \\[mh-store-msg]; default for next store.
245A directory name string, or nil to use current directory."
246 :type '(choice (const :tag "Current" nil)
247 directory)
248 :group 'mh)
249
250(defvar mh-note-deleted "D" 112(defvar mh-note-deleted "D"
251 "String whose first character is used to notate deleted messages.") 113 "String whose first character is used to notate deleted messages.")
252 114
@@ -264,22 +126,6 @@ The string is displayed after the folder's name. nil for no annotation.")
264;;; with the standard MH scan listings, in which the first 4 characters on 126;;; with the standard MH scan listings, in which the first 4 characters on
265;;; the line are the message number, followed by two places for notations. 127;;; the line are the message number, followed by two places for notations.
266 128
267(defcustom mh-scan-format-file t
268 "Specifies the format file to pass to the scan program.
269If t, the format string will be taken from the either `mh-scan-format-mh'
270or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
271If nil, the default scan output will be used.
272
273If you customize the scan format, you may need to modify a few variables
274containing regexps that MH-E uses to identify specific portions of the output.
275Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
276may also have to call `mh-set-cmd-note' with the width of your message
277numbers. See also `mh-adaptive-cmd-note-flag'."
278 :type '(choice (const :tag "Use MH-E scan format" t)
279 (const :tag "Use default scan format" nil)
280 (file :tag "Specify a scan format file"))
281 :group 'mh)
282
283;; The following scan formats are passed to the scan program if the 129;; The following scan formats are passed to the scan program if the
284;; setting of `mh-scan-format-file' above is nil. They are identical 130;; setting of `mh-scan-format-file' above is nil. They are identical
285;; except the later one makes use of the nmh `decode' function to 131;; except the later one makes use of the nmh `decode' function to
@@ -386,7 +232,7 @@ The default `mh-folder-font-lock-keywords' expects this expression to contain
386at least one parenthesized expression which matches the body text.") 232at least one parenthesized expression which matches the body text.")
387 233
388(defvar mh-scan-subject-regexp 234(defvar mh-scan-subject-regexp
389;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)" 235 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
390 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" 236 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
391 "*Regexp matching the subject string in MH folder mode. 237 "*Regexp matching the subject string in MH folder mode.
392The default `mh-folder-font-lock-keywords' expects this expression to contain 238The default `mh-folder-font-lock-keywords' expects this expression to contain
@@ -404,122 +250,13 @@ at least three parenthesized expressions. The first should match the
404fontification hint, the second is found in `mh-scan-date-regexp', and the 250fontification hint, the second is found in `mh-scan-date-regexp', and the
405third should match the user name.") 251third should match the user name.")
406 252
407(defvar mh-folder-followup-face 'mh-folder-followup-face 253
408 "Face for highlighting Re: (followup) subject text in MH-Folder buffers.") 254
409(defface mh-folder-followup-face
410 '((((class color) (background light))
411 (:foreground "blue3"))
412 (((class color) (background dark))
413 (:foreground "LightGoldenRod"))
414 (t
415 (:bold t)))
416 "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
417 :group 'mh)
418(defvar mh-folder-address-face 'mh-folder-address-face
419 "Face for highlighting the address in MH-Folder buffers.")
420(copy-face 'mh-folder-subject-face 'mh-folder-address-face)
421(defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
422 "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
423(copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
424
425(defvar mh-folder-date-face 'mh-folder-date-face
426 "Face for highlighting the date in MH-Folder buffers.")
427(defface mh-folder-date-face
428 '((((class color) (background light))
429 (:foreground "snow4"))
430 (((class color) (background dark))
431 (:foreground "snow3"))
432 (t
433 (:bold t)))
434 "Face for highlighting the date in MH-Folder buffers."
435 :group 'mh)
436
437(defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
438 "Face for highlighting the message number in MH-Folder buffers.")
439(defface mh-folder-msg-number-face
440 '((((class color) (background light))
441 (:foreground "snow4"))
442 (((class color) (background dark))
443 (:foreground "snow3"))
444 (t
445 (:bold t)))
446 "Face for highlighting the message number in MH-Folder buffers."
447 :group 'mh)
448
449(defvar mh-folder-deleted-face 'mh-folder-deleted-face
450 "Face for highlighting deleted messages in MH-Folder buffers.")
451(copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
452
453(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
454 "Face for the current message line in MH-Folder buffers.")
455(defface mh-folder-cur-msg-face
456 '((((type tty pc) (class color))
457 (:background "LightGreen"))
458 (((class color) (background light))
459 (:background "LightGreen") ;Use this for solid background colour
460;;; (:underline t) ;Use this for underlining
461 )
462 (((class color) (background dark))
463 (:background "DarkOliveGreen4"))
464 (t (:underline t)))
465 "Face for the current message line in MH-Folder buffers."
466 :group 'mh)
467
468;;mh-folder-subject-face is defined in mh-utils since it's needed there
469;;for mh-show-subject-face.
470
471(defvar mh-folder-refiled-face 'mh-folder-refiled-face
472 "Face for highlighting refiled messages in MH-Folder buffers.")
473(defface mh-folder-refiled-face
474 '((((type tty) (class color)) (:foreground "yellow" :weight light))
475 (((class grayscale) (background light))
476 (:foreground "Gray90" :bold t :italic t))
477 (((class grayscale) (background dark))
478 (:foreground "DimGray" :bold t :italic t))
479 (((class color) (background light)) (:foreground "DarkGoldenrod"))
480 (((class color) (background dark)) (:foreground "LightGoldenrod"))
481 (t (:bold t :italic t)))
482 "Face for highlighting refiled messages in MH-Folder buffers."
483 :group 'mh)
484
485(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
486 "Face for highlighting the current message in MH-Folder buffers.")
487(defface mh-folder-cur-msg-number-face
488 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
489 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
490 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
491 (((class color) (background light)) (:foreground "Purple"))
492 (((class color) (background dark)) (:foreground "Cyan"))
493 (t (:bold t)))
494 "Face for highlighting the current message in MH-Folder buffers."
495 :group 'mh)
496
497(defvar mh-folder-to-face 'mh-folder-to-face
498 "Face for highlighting the To: string in MH-Folder buffers.")
499(defface mh-folder-to-face
500 '((((type tty) (class color)) (:foreground "green"))
501 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
502 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
503 (((class color) (background light)) (:foreground "RosyBrown"))
504 (((class color) (background dark)) (:foreground "LightSalmon"))
505 (t (:italic t)))
506 "Face for highlighting the To: string in MH-Folder buffers."
507 :group 'mh)
508
509(defvar mh-folder-body-face 'mh-folder-body-face
510 "Face for highlighting body text in MH-Folder buffers.")
511(defface mh-folder-body-face
512 '((((type tty) (class color)) (:foreground "green"))
513 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
514 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
515 (((class color) (background light)) (:foreground "RosyBrown"))
516 (((class color) (background dark)) (:foreground "LightSalmon"))
517 (t (:italic t)))
518 "Face for highlighting body text in MH-Folder buffers."
519 :group 'mh)
520
521(defvar mh-folder-font-lock-keywords 255(defvar mh-folder-font-lock-keywords
522 (list 256 (list
257 ;; Folders when displaying index buffer
258 (list "^\\+.*"
259 '(0 mh-index-folder-face))
523 ;; Marked for deletion 260 ;; Marked for deletion
524 (list (concat mh-scan-deleted-msg-regexp ".*") 261 (list (concat mh-scan-deleted-msg-regexp ".*")
525 '(0 mh-folder-deleted-face)) 262 '(0 mh-folder-deleted-face))
@@ -535,11 +272,11 @@ third should match the user name.")
535 (list mh-scan-cur-msg-number-regexp 272 (list mh-scan-cur-msg-number-regexp
536 '(1 mh-folder-cur-msg-number-face)) 273 '(1 mh-folder-cur-msg-number-face))
537 (list mh-scan-good-msg-regexp 274 (list mh-scan-good-msg-regexp
538 '(1 mh-folder-msg-number-face)) ;; Msg number 275 '(1 mh-folder-msg-number-face)) ;; Msg number
539 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date 276 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
540 (list mh-scan-rcpt-regexp 277 (list mh-scan-rcpt-regexp
541 '(1 mh-folder-to-face) ;; To: 278 '(1 mh-folder-to-face) ;; To:
542 '(2 mh-folder-address-face)) ;; address 279 '(2 mh-folder-address-face)) ;; address
543 ;; scan font-lock name 280 ;; scan font-lock name
544 (list mh-scan-format-regexp 281 (list mh-scan-format-regexp
545 '(1 mh-folder-date-face) 282 '(1 mh-folder-date-face)
@@ -548,8 +285,7 @@ third should match the user name.")
548 (list mh-scan-cur-msg-regexp 285 (list mh-scan-cur-msg-regexp
549 '(1 mh-folder-cur-msg-face prepend t)) 286 '(1 mh-folder-cur-msg-face prepend t))
550 ;; Unseen messages in bold 287 ;; Unseen messages in bold
551 '(mh-folder-font-lock-unseen (1 'bold append t)) 288 '(mh-folder-font-lock-unseen (1 'bold append t)))
552 )
553 "Regexp keywords used to fontify the MH-Folder buffer.") 289 "Regexp keywords used to fontify the MH-Folder buffer.")
554 290
555(defvar mh-scan-cmd-note-width 1 291(defvar mh-scan-cmd-note-width 1
@@ -589,15 +325,15 @@ originator, or a \"To: address\" for outgoing e-mail messages.")
589This column will only ever have spaces in it.") 325This column will only ever have spaces in it.")
590 326
591(defvar mh-scan-field-from-start-offset 327(defvar mh-scan-field-from-start-offset
592 (+ mh-scan-cmd-note-width 328 (+ mh-scan-cmd-note-width
593 mh-scan-destination-width 329 mh-scan-destination-width
594 mh-scan-date-width 330 mh-scan-date-width
595 mh-scan-date-flag-width) 331 mh-scan-date-flag-width)
596 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.") 332 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
597 333
598(defvar mh-scan-field-from-end-offset 334(defvar mh-scan-field-from-end-offset
599 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width) 335 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
600 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.") 336 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
601 337
602(defvar mh-scan-field-subject-start-offset 338(defvar mh-scan-field-subject-start-offset
603 (+ mh-scan-cmd-note-width 339 (+ mh-scan-cmd-note-width
@@ -634,13 +370,13 @@ On nmh systems.")
634 (save-excursion 370 (save-excursion
635 (let ((unseen-seq-name "unseen")) 371 (let ((unseen-seq-name "unseen"))
636 (with-temp-buffer 372 (with-temp-buffer
637 (unwind-protect 373 (unwind-protect
638 (progn 374 (progn
639 (call-process (expand-file-name "mhparam" mh-progs) 375 (call-process (expand-file-name "mhparam" mh-progs)
640 nil '(t t) nil "-component" "Unseen-Sequence") 376 nil '(t t) nil "-component" "Unseen-Sequence")
641 (goto-char (point-min)) 377 (goto-char (point-min))
642 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t) 378 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
643 (setq unseen-seq-name (match-string 1)))))) 379 (setq unseen-seq-name (match-string 1))))))
644 unseen-seq-name))) 380 unseen-seq-name)))
645 381
646(defun mh-folder-unseen-seq-list () 382(defun mh-folder-unseen-seq-list ()
@@ -653,15 +389,15 @@ On nmh systems.")
653 (t 389 (t
654 (let ((folder mh-current-folder)) 390 (let ((folder mh-current-folder))
655 (save-excursion 391 (save-excursion
656 (with-temp-buffer 392 (with-temp-buffer
657 (unwind-protect 393 (unwind-protect
658 (progn 394 (progn
659 (call-process (expand-file-name "mark" mh-progs) 395 (call-process (expand-file-name "mark" mh-progs)
660 nil '(t t) nil 396 nil '(t t) nil
661 folder "-seq" mh-folder-unseen-seq-name 397 folder "-seq" mh-folder-unseen-seq-name
662 "-list") 398 "-list")
663 (goto-char (point-min)) 399 (goto-char (point-min))
664 (sort (mh-read-msg-list) '<))))))))) 400 (sort (mh-read-msg-list) '<)))))))))
665 401
666(defvar mh-folder-unseen-seq-cache nil 402(defvar mh-folder-unseen-seq-cache nil
667 "Internal cache variable used for font-lock in MH-E. 403 "Internal cache variable used for font-lock in MH-E.
@@ -713,31 +449,36 @@ is done highlighting.")
713 449
714;;; Internal variables: 450;;; Internal variables:
715 451
716(defvar mh-last-destination nil) ;Destination of last refile or write 452(defvar mh-last-destination nil) ;Destination of last refile or write
717 ;command. 453 ;command.
718(defvar mh-last-destination-folder nil) ;Destination of last refile command. 454(defvar mh-last-destination-folder nil) ;Destination of last refile command.
719(defvar mh-last-destination-write nil) ;Destination of last write command. 455(defvar mh-last-destination-write nil) ;Destination of last write command.
720 456
721(defvar mh-folder-mode-map (make-keymap) 457(defvar mh-folder-mode-map (make-keymap)
722 "Keymap for MH folders.") 458 "Keymap for MH folders.")
723 459
724(defvar mh-delete-list nil) ;List of msg numbers to delete. 460(defvar mh-delete-list nil) ;List of msg numbers to delete.
725 461
726(defvar mh-refile-list nil) ;List of folder names in mh-seq-list. 462(defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
727 463
728(defvar mh-next-direction 'forward) ;Direction to move to next message. 464(defvar mh-next-direction 'forward) ;Direction to move to next message.
729 465
730(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or 466(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
731 ;nil if not narrowed. 467 ;nil if not narrowed.
732 468
733(defvar mh-view-ops ()) ;Stack of ops that change the folder 469(defvar mh-view-ops ()) ;Stack of ops that change the folder
734 ;view (such as narrowing or threading). 470 ;view (such as narrowing or threading).
735 471
736(defvar mh-first-msg-num nil) ;Number of first msg in buffer. 472(defvar mh-index-data nil) ;Info about index search results
473(defvar mh-index-previous-search nil)
474(defvar mh-index-msg-checksum-map nil)
475(defvar mh-index-checksum-origin-map nil)
476
477(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
737 478
738(defvar mh-last-msg-num nil) ;Number of last msg in buffer. 479(defvar mh-last-msg-num nil) ;Number of last msg in buffer.
739 480
740(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. 481(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
741 482
742;;; Macros and generic functions: 483;;; Macros and generic functions:
743 484
@@ -751,12 +492,12 @@ is done highlighting.")
751 "Return \"-format\" argument for the scan program." 492 "Return \"-format\" argument for the scan program."
752 (if (equal mh-scan-format-file t) 493 (if (equal mh-scan-format-file t)
753 (list "-format" (if mh-nmh-flag 494 (list "-format" (if mh-nmh-flag
754 (list (mh-update-scan-format 495 (list (mh-update-scan-format
755 mh-scan-format-nmh mh-cmd-note)) 496 mh-scan-format-nmh mh-cmd-note))
756 (list (mh-update-scan-format 497 (list (mh-update-scan-format
757 mh-scan-format-mh mh-cmd-note)))) 498 mh-scan-format-mh mh-cmd-note))))
758 (if (not (equal mh-scan-format-file nil)) 499 (if (not (equal mh-scan-format-file nil))
759 (list "-format" mh-scan-format-file)))) 500 (list "-format" mh-scan-format-file))))
760 501
761 502
762 503
@@ -771,7 +512,7 @@ the Emacs front end to the MH mail system."
771 (mh-find-path) 512 (mh-find-path)
772 (if arg 513 (if arg
773 (call-interactively 'mh-visit-folder) 514 (call-interactively 'mh-visit-folder)
774 (mh-inc-folder))) 515 (mh-inc-folder)))
775 516
776;;;###autoload 517;;;###autoload
777(defun mh-nmail (&optional arg) 518(defun mh-nmail (&optional arg)
@@ -779,7 +520,7 @@ the Emacs front end to the MH mail system."
779Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, 520Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
780the Emacs front end to the MH mail system." 521the Emacs front end to the MH mail system."
781 (interactive "P") 522 (interactive "P")
782 (mh-find-path) ; init mh-inbox 523 (mh-find-path) ; init mh-inbox
783 (if arg 524 (if arg
784 (call-interactively 'mh-visit-folder) 525 (call-interactively 'mh-visit-folder)
785 (mh-visit-folder mh-inbox))) 526 (mh-visit-folder mh-inbox)))
@@ -788,7 +529,6 @@ the Emacs front end to the MH mail system."
788 529
789;;; User executable MH-E commands: 530;;; User executable MH-E commands:
790 531
791
792(defun mh-delete-msg (msg-or-seq) 532(defun mh-delete-msg (msg-or-seq)
793 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. 533 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
794 534
@@ -797,8 +537,7 @@ prompt for the message sequence. If variable `transient-mark-mode' is non-nil
797and the mark is active, then the selected region is marked for deletion." 537and the mark is active, then the selected region is marked for deletion."
798 (interactive (list (cond 538 (interactive (list (cond
799 ((mh-mark-active-p t) 539 ((mh-mark-active-p t)
800 (mh-region-to-sequence (region-beginning) (region-end)) 540 (mh-region-to-msg-list (region-beginning) (region-end)))
801 'region)
802 (current-prefix-arg 541 (current-prefix-arg
803 (mh-read-seq-default "Delete" t)) 542 (mh-read-seq-default "Delete" t))
804 (t 543 (t
@@ -811,11 +550,11 @@ and the mark is active, then the selected region is marked for deletion."
811Default is the displayed message. If optional prefix argument is provided, 550Default is the displayed message. If optional prefix argument is provided,
812then prompt for the message sequence." 551then prompt for the message sequence."
813 (interactive (list (if current-prefix-arg 552 (interactive (list (if current-prefix-arg
814 (mh-read-seq-default "Delete" t) 553 (mh-read-seq-default "Delete" t)
815 (mh-get-msg-num t)))) 554 (mh-get-msg-num t))))
816 (if (numberp msg-or-seq) 555 (if (numberp msg-or-seq)
817 (mh-delete-a-msg msg-or-seq) 556 (mh-delete-a-msg msg-or-seq)
818 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) 557 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
819 558
820(defun mh-execute-commands () 559(defun mh-execute-commands ()
821 "Process outstanding delete and refile requests." 560 "Process outstanding delete and refile requests."
@@ -823,9 +562,9 @@ then prompt for the message sequence."
823 (if mh-narrowed-to-seq (mh-widen)) 562 (if mh-narrowed-to-seq (mh-widen))
824 (mh-process-commands mh-current-folder) 563 (mh-process-commands mh-current-folder)
825 (mh-set-scan-mode) 564 (mh-set-scan-mode)
826 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency 565 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
827 (mh-make-folder-mode-line) 566 (mh-make-folder-mode-line)
828 t) ; return t for write-file-functions 567 t) ; return t for write-file-functions
829 568
830(defun mh-first-msg () 569(defun mh-first-msg ()
831 "Move to the first message." 570 "Move to the first message."
@@ -846,7 +585,7 @@ Type \"\\[mh-show]\" to show the message normally again."
846 (mh-invalidate-show-buffer)) 585 (mh-invalidate-show-buffer))
847 (let ((mh-decode-mime-flag nil) 586 (let ((mh-decode-mime-flag nil)
848 (mhl-formfile nil) 587 (mhl-formfile nil)
849 (mh-clean-message-header-flag nil)) 588 (mh-clean-message-header-flag nil))
850 (mh-show-msg nil) 589 (mh-show-msg nil)
851 (mh-in-show-buffer (mh-show-buffer) 590 (mh-in-show-buffer (mh-show-buffer)
852 (goto-char (point-min)) 591 (goto-char (point-min))
@@ -862,26 +601,36 @@ The value of `mh-inc-folder-hook' is a list of functions to be called, with no
862arguments, after incorporating new mail. 601arguments, after incorporating new mail.
863Do not call this function from outside MH-E; use \\[mh-rmail] instead." 602Do not call this function from outside MH-E; use \\[mh-rmail] instead."
864 (interactive (list (if current-prefix-arg 603 (interactive (list (if current-prefix-arg
865 (expand-file-name 604 (expand-file-name
866 (read-file-name "inc mail from file: " 605 (read-file-name "inc mail from file: "
867 mh-user-path))))) 606 mh-user-path)))))
868 (let ((config (current-window-configuration))) 607 (let ((threading-needed-flag nil))
869 (if (not maildrop-name) 608 (let ((config (current-window-configuration)))
870 (cond ((not (get-buffer mh-inbox)) 609 (if (not maildrop-name)
871 (mh-make-folder mh-inbox) 610 (cond ((not (get-buffer mh-inbox))
872 (setq mh-previous-window-config config)) 611 (mh-make-folder mh-inbox)
873 ((not (eq (current-buffer) (get-buffer mh-inbox))) 612 (setq threading-needed-flag mh-show-threads-flag)
874 (switch-to-buffer mh-inbox) 613 (setq mh-previous-window-config config))
875 (setq mh-previous-window-config config))))) 614 ((not (eq (current-buffer) (get-buffer mh-inbox)))
876 (mh-get-new-mail maildrop-name) 615 (switch-to-buffer mh-inbox)
877 (if mh-showing-mode (mh-show)) 616 (setq mh-previous-window-config config)))))
878 (run-hooks 'mh-inc-folder-hook)) 617 (mh-get-new-mail maildrop-name)
618 (when (and threading-needed-flag
619 (save-excursion
620 (goto-char (point-min))
621 (or (null mh-large-folder)
622 (not (equal (forward-line mh-large-folder) 0))
623 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
624 nil))))
625 (mh-toggle-threads))
626 (if mh-showing-mode (mh-show))
627 (run-hooks 'mh-inc-folder-hook)))
879 628
880(defun mh-last-msg () 629(defun mh-last-msg ()
881 "Move to the last message." 630 "Move to the last message."
882 (interactive) 631 (interactive)
883 (goto-char (point-max)) 632 (goto-char (point-max))
884 (while (and (not (bobp)) (looking-at "^$")) 633 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
885 (forward-line -1)) 634 (forward-line -1))
886 (mh-recenter nil)) 635 (mh-recenter nil))
887 636
@@ -891,9 +640,9 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
891 (setq mh-next-direction 'forward) 640 (setq mh-next-direction 'forward)
892 (forward-line 1) 641 (forward-line 1)
893 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg) 642 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
894 (beginning-of-line) 643 (beginning-of-line)
895 (mh-maybe-show)) 644 (mh-maybe-show))
896 (t (forward-line -1) 645 (t (forward-line -1)
897 (message "No more undeleted messages")))) 646 (message "No more undeleted messages"))))
898 647
899(defun mh-refile-msg (msg-or-seq folder) 648(defun mh-refile-msg (msg-or-seq folder)
@@ -904,32 +653,31 @@ selected region is marked for refiling."
904 (interactive 653 (interactive
905 (list (cond 654 (list (cond
906 ((mh-mark-active-p t) 655 ((mh-mark-active-p t)
907 (mh-region-to-sequence (region-beginning) (region-end)) 656 (mh-region-to-msg-list (region-beginning) (region-end)))
908 'region)
909 (current-prefix-arg 657 (current-prefix-arg
910 (mh-read-seq-default "Refile" t)) 658 (mh-read-seq-default "Refile" t))
911 (t 659 (t
912 (mh-get-msg-num t))) 660 (mh-get-msg-num t)))
913 (intern 661 (intern
914 (mh-prompt-for-folder 662 (mh-prompt-for-folder
915 "Destination" 663 "Destination"
916 (or (and mh-default-folder-for-message-function 664 (or (and mh-default-folder-for-message-function
917 (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) 665 (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
918 (save-excursion 666 (save-excursion
919 (set-buffer (get-buffer-create mh-temp-buffer)) 667 (set-buffer (get-buffer-create mh-temp-buffer))
920 (erase-buffer) 668 (erase-buffer)
921 (insert-file-contents refile-file) 669 (insert-file-contents refile-file)
922 (let ((buffer-file-name refile-file)) 670 (let ((buffer-file-name refile-file))
923 (funcall mh-default-folder-for-message-function))))) 671 (funcall mh-default-folder-for-message-function)))))
924 (and (eq 'refile (car mh-last-destination-folder)) 672 (and (eq 'refile (car mh-last-destination-folder))
925 (symbol-name (cdr mh-last-destination-folder))) 673 (symbol-name (cdr mh-last-destination-folder)))
926 "") 674 "")
927 t)))) 675 t))))
928 (setq mh-last-destination (cons 'refile folder) 676 (setq mh-last-destination (cons 'refile folder)
929 mh-last-destination-folder mh-last-destination) 677 mh-last-destination-folder mh-last-destination)
930 (if (numberp msg-or-seq) 678 (if (numberp msg-or-seq)
931 (mh-refile-a-msg msg-or-seq folder) 679 (mh-refile-a-msg msg-or-seq folder)
932 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) 680 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
933 (mh-next-msg)) 681 (mh-next-msg))
934 682
935(defun mh-refile-or-write-again (message) 683(defun mh-refile-or-write-again (message)
@@ -940,11 +688,11 @@ refile or write command."
940 (if (null mh-last-destination) 688 (if (null mh-last-destination)
941 (error "No previous refile or write")) 689 (error "No previous refile or write"))
942 (cond ((eq (car mh-last-destination) 'refile) 690 (cond ((eq (car mh-last-destination) 'refile)
943 (mh-refile-a-msg message (cdr mh-last-destination)) 691 (mh-refile-a-msg message (cdr mh-last-destination))
944 (message "Destination folder: %s" (cdr mh-last-destination))) 692 (message "Destination folder: %s" (cdr mh-last-destination)))
945 (t 693 (t
946 (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) 694 (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
947 (message "Destination: %s" (cdr mh-last-destination)))) 695 (message "Destination: %s" (cdr mh-last-destination))))
948 (mh-next-msg)) 696 (mh-next-msg))
949 697
950(defun mh-quit () 698(defun mh-quit ()
@@ -980,20 +728,20 @@ bottom of the current message."
980 (interactive "P") 728 (interactive "P")
981 (if mh-showing-mode 729 (if mh-showing-mode
982 (if mh-page-to-next-msg-flag 730 (if mh-page-to-next-msg-flag
983 (if (equal mh-next-direction 'backward) 731 (if (equal mh-next-direction 'backward)
984 (mh-previous-undeleted-msg) 732 (mh-previous-undeleted-msg)
985 (mh-next-undeleted-msg)) 733 (mh-next-undeleted-msg))
986 (if (mh-in-show-buffer (mh-show-buffer) 734 (if (mh-in-show-buffer (mh-show-buffer)
987 (pos-visible-in-window-p (point-max))) 735 (pos-visible-in-window-p (point-max)))
988 (progn 736 (progn
989 (message (format 737 (message (format
990 "End of message (Type %s to read %s undeleted message)" 738 "End of message (Type %s to read %s undeleted message)"
991 (single-key-description last-input-event) 739 (single-key-description last-input-event)
992 (if (equal mh-next-direction 'backward) 740 (if (equal mh-next-direction 'backward)
993 "previous" 741 "previous"
994 "next"))) 742 "next")))
995 (setq mh-page-to-next-msg-flag t)) 743 (setq mh-page-to-next-msg-flag t))
996 (scroll-other-window arg))) 744 (scroll-other-window arg)))
997 (mh-show))) 745 (mh-show)))
998 746
999(defun mh-previous-page (&optional arg) 747(defun mh-previous-page (&optional arg)
@@ -1009,8 +757,39 @@ Scrolls ARG lines or a full screen if no argument is supplied."
1009 (setq mh-next-direction 'backward) 757 (setq mh-next-direction 'backward)
1010 (beginning-of-line) 758 (beginning-of-line)
1011 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg) 759 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
1012 (mh-maybe-show)) 760 (mh-maybe-show))
1013 (t (message "No previous undeleted message")))) 761 (t (message "No previous undeleted message"))))
762
763(defun mh-previous-unread-msg (&optional count)
764 "Move to previous unread message.
765With optional argument COUNT, COUNT-1 unread messages before current message
766are skipped."
767 (interactive "p")
768 (unless (> count 0)
769 (error "The function mh-previous-unread-msg expects positive argument"))
770 (setq count (1- count))
771 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
772 (cur-msg (mh-get-msg-num nil)))
773 (cond ((and (not cur-msg) (not (bobp))
774 ;; If we are at the end of the buffer back up one line and go
775 ;; to unread message after that.
776 (progn
777 (forward-line -1)
778 (setq cur-msg (mh-get-msg-num nil)))
779 nil))
780 ((or (null unread-sequence) (not cur-msg))
781 ;; No unread message or there aren't any messages in buffer...
782 (message "No more unread messages"))
783 ((progn
784 ;; Skip count messages...
785 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
786 (setq unread-sequence (cdr unread-sequence)))
787 (while (> count 0)
788 (setq unread-sequence (cdr unread-sequence))
789 (setq count (1- count)))
790 (not (car unread-sequence)))
791 (message "No more unread messages"))
792 (t (mh-goto-msg (car unread-sequence))))))
1014 793
1015(defun mh-goto-next-button (backward-flag &optional criterion) 794(defun mh-goto-next-button (backward-flag &optional criterion)
1016 "Search for next button satisfying criterion. 795 "Search for next button satisfying criterion.
@@ -1025,35 +804,35 @@ function must return non-nil at the button we stop."
1025 (beginning-of-line) 804 (beginning-of-line)
1026 ;; Find point before current button 805 ;; Find point before current button
1027 (let ((point-before-current-button 806 (let ((point-before-current-button
1028 (save-excursion 807 (save-excursion
1029 (while (get-text-property (point) 'mh-data) 808 (while (get-text-property (point) 'mh-data)
1030 (unless (= (forward-line 809 (unless (= (forward-line
1031 (if backward-flag 1 -1)) 810 (if backward-flag 1 -1))
1032 0) 811 0)
1033 (if backward-flag 812 (if backward-flag
1034 (goto-char (point-min)) 813 (goto-char (point-min))
1035 (goto-char (point-max))))) 814 (goto-char (point-max)))))
1036 (point)))) 815 (point))))
1037 ;; Skip over current button 816 ;; Skip over current button
1038 (while (and (get-text-property (point) 'mh-data) 817 (while (and (get-text-property (point) 'mh-data)
1039 (not (if backward-flag (bobp) (eobp)))) 818 (not (if backward-flag (bobp) (eobp))))
1040 (forward-line (if backward-flag -1 1))) 819 (forward-line (if backward-flag -1 1)))
1041 ;; Stop at next MIME button if any exists. 820 ;; Stop at next MIME button if any exists.
1042 (block loop 821 (block loop
1043 (while (/= (progn 822 (while (/= (progn
1044 (unless (= (forward-line 823 (unless (= (forward-line
1045 (if backward-flag -1 1)) 824 (if backward-flag -1 1))
1046 0) 825 0)
1047 (if backward-flag 826 (if backward-flag
1048 (goto-char (point-max)) 827 (goto-char (point-max))
1049 (goto-char (point-min))) 828 (goto-char (point-min)))
1050 (beginning-of-line)) 829 (beginning-of-line))
1051 (point)) 830 (point))
1052 point-before-current-button) 831 point-before-current-button)
1053 (when (and (get-text-property (point) 'mh-data) 832 (when (and (get-text-property (point) 'mh-data)
1054 (funcall criterion (point))) 833 (funcall criterion (point)))
1055 (return-from loop (point)))) 834 (return-from loop (point))))
1056 nil))) 835 nil)))
1057 (point)))) 836 (point))))
1058 837
1059(defun mh-next-button (&optional backward-flag) 838(defun mh-next-button (&optional backward-flag)
@@ -1086,14 +865,14 @@ searching for a suitable parts."
1086 (mh-show)) 865 (mh-show))
1087 (mh-in-show-buffer (mh-show-buffer) 866 (mh-in-show-buffer (mh-show-buffer)
1088 (let ((criterion 867 (let ((criterion
1089 (cond (part-index 868 (cond (part-index
1090 (lambda (p) 869 (lambda (p)
1091 (let ((part (get-text-property p 'mh-part))) 870 (let ((part (get-text-property p 'mh-part)))
1092 (and (integerp part) (= part part-index))))) 871 (and (integerp part) (= part part-index)))))
1093 (t (lambda (p) 872 (t (lambda (p)
1094 (if include-security-flag 873 (if include-security-flag
1095 (get-text-property p 'mh-data) 874 (get-text-property p 'mh-data)
1096 (integerp (get-text-property p 'mh-part))))))) 875 (integerp (get-text-property p 'mh-part)))))))
1097 (point (point))) 876 (point (point)))
1098 (cond ((and (get-text-property point 'mh-part) 877 (cond ((and (get-text-property point 'mh-part)
1099 (or (null part-index) 878 (or (null part-index)
@@ -1153,11 +932,14 @@ messages to display. Otherwise show the entire folder.
1153If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 932If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1154refiles aren't carried out." 933refiles aren't carried out."
1155 (interactive (list (if current-prefix-arg 934 (interactive (list (if current-prefix-arg
1156 (mh-read-msg-range "Range to scan [all]? ") 935 (mh-read-msg-range mh-current-folder t)
1157 nil))) 936 nil)))
1158 (setq mh-next-direction 'forward) 937 (setq mh-next-direction 'forward)
1159 (mh-reset-threads-and-narrowing) 938 (let ((threaded-flag (memq 'unthread mh-view-ops)))
1160 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)) 939 (mh-reset-threads-and-narrowing)
940 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
941 (cond (threaded-flag (mh-toggle-threads))
942 (mh-index-data (mh-index-insert-folder-headers)))))
1161 943
1162(defun mh-write-msg-to-file (msg file no-headers) 944(defun mh-write-msg-to-file (msg file no-headers)
1163 "Append MSG to the end of a FILE. 945 "Append MSG to the end of a FILE.
@@ -1165,21 +947,21 @@ If prefix argument NO-HEADERS is provided, write only the message body.
1165Otherwise send the entire message including the headers." 947Otherwise send the entire message including the headers."
1166 (interactive 948 (interactive
1167 (list (mh-get-msg-num t) 949 (list (mh-get-msg-num t)
1168 (let ((default-dir (if (eq 'write (car mh-last-destination-write)) 950 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
1169 (file-name-directory 951 (file-name-directory
1170 (car (cdr mh-last-destination-write))) 952 (car (cdr mh-last-destination-write)))
1171 default-directory))) 953 default-directory)))
1172 (read-file-name (format "Save message%s in file: " 954 (read-file-name (format "Save message%s in file: "
1173 (if current-prefix-arg " body" "")) 955 (if current-prefix-arg " body" ""))
1174 default-dir 956 default-dir
1175 (if (eq 'write (car mh-last-destination-write)) 957 (if (eq 'write (car mh-last-destination-write))
1176 (car (cdr mh-last-destination-write)) 958 (car (cdr mh-last-destination-write))
1177 (expand-file-name "mail.out" default-dir)))) 959 (expand-file-name "mail.out" default-dir))))
1178 current-prefix-arg)) 960 current-prefix-arg))
1179 (let ((msg-file-to-output (mh-msg-filename msg)) 961 (let ((msg-file-to-output (mh-msg-filename msg))
1180 (output-file (mh-expand-file-name file))) 962 (output-file (mh-expand-file-name file)))
1181 (setq mh-last-destination (list 'write file (if no-headers 'no-headers)) 963 (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
1182 mh-last-destination-write mh-last-destination) 964 mh-last-destination-write mh-last-destination)
1183 (save-excursion 965 (save-excursion
1184 (set-buffer (get-buffer-create mh-temp-buffer)) 966 (set-buffer (get-buffer-create mh-temp-buffer))
1185 (erase-buffer) 967 (erase-buffer)
@@ -1203,33 +985,61 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then the
1203selected region is unmarked." 985selected region is unmarked."
1204 (interactive (list (cond 986 (interactive (list (cond
1205 ((mh-mark-active-p t) 987 ((mh-mark-active-p t)
1206 (mh-region-to-sequence (region-beginning) (region-end)) 988 (mh-region-to-msg-list (region-beginning) (region-end)))
1207 'region)
1208 (current-prefix-arg 989 (current-prefix-arg
1209 (mh-read-seq-default "Undo" t)) 990 (mh-read-seq-default "Undo" t))
1210 (t 991 (t
1211 (mh-get-msg-num t))))) 992 (mh-get-msg-num t)))))
1212 (cond ((numberp msg-or-seq) 993 (cond ((numberp msg-or-seq)
1213 (let ((original-position (point))) 994 (let ((original-position (point)))
1214 (beginning-of-line) 995 (beginning-of-line)
1215 (while (not (or (looking-at mh-scan-deleted-msg-regexp) 996 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
1216 (looking-at mh-scan-refiled-msg-regexp) 997 (looking-at mh-scan-refiled-msg-regexp)
1217 (and (eq mh-next-direction 'forward) (bobp)) 998 (and (eq mh-next-direction 'forward) (bobp))
1218 (and (eq mh-next-direction 'backward) 999 (and (eq mh-next-direction 'backward)
1219 (save-excursion (forward-line) (eobp))))) 1000 (save-excursion (forward-line) (eobp)))))
1220 (forward-line (if (eq mh-next-direction 'forward) -1 1))) 1001 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1221 (if (or (looking-at mh-scan-deleted-msg-regexp) 1002 (if (or (looking-at mh-scan-deleted-msg-regexp)
1222 (looking-at mh-scan-refiled-msg-regexp)) 1003 (looking-at mh-scan-refiled-msg-regexp))
1223 (progn 1004 (progn
1224 (mh-undo-msg (mh-get-msg-num t)) 1005 (mh-undo-msg (mh-get-msg-num t))
1225 (mh-maybe-show)) 1006 (mh-maybe-show))
1226 (goto-char original-position) 1007 (goto-char original-position)
1227 (error "Nothing to undo")))) 1008 (error "Nothing to undo"))))
1228 (t 1009 (t
1229 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) 1010 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
1230 (if (not (mh-outstanding-commands-p)) 1011 (if (not (mh-outstanding-commands-p))
1231 (mh-set-folder-modified-p nil))) 1012 (mh-set-folder-modified-p nil)))
1232 1013
1014;;;###mh-autoload
1015(defun mh-folder-line-matches-show-buffer-p ()
1016 "Return t if the message under point in folder-mode is in the show buffer.
1017Return nil in any other circumstance (no message under point, no show buffer,
1018the message in the show buffer doesn't match."
1019 (and (eq major-mode 'mh-folder-mode)
1020 (mh-get-msg-num nil)
1021 mh-show-buffer
1022 (get-buffer mh-show-buffer)
1023 (buffer-file-name (get-buffer mh-show-buffer))
1024 (string-match ".*/\\([0-9]+\\)$"
1025 (buffer-file-name (get-buffer mh-show-buffer)))
1026 (string-equal
1027 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1028 (int-to-string (mh-get-msg-num nil)))))
1029
1030(eval-when-compile (require 'gnus))
1031
1032(defmacro mh-macro-expansion-time-gnus-version ()
1033 "Return Gnus version available at macro expansion time.
1034The macro evaluates the Gnus version at macro expansion time. If MH-E was
1035compiled then macro expansion happens at compile time."
1036 gnus-version)
1037
1038(defun mh-run-time-gnus-version ()
1039 "Return Gnus version available at run time."
1040 (require 'gnus)
1041 gnus-version)
1042
1233;;;###autoload 1043;;;###autoload
1234(defun mh-version () 1044(defun mh-version ()
1235 "Display version information about MH-E and the MH mail handling system." 1045 "Display version information about MH-E and the MH mail handling system."
@@ -1237,22 +1047,33 @@ selected region is unmarked."
1237 (mh-find-progs) 1047 (mh-find-progs)
1238 (set-buffer (get-buffer-create mh-temp-buffer)) 1048 (set-buffer (get-buffer-create mh-temp-buffer))
1239 (erase-buffer) 1049 (erase-buffer)
1240 ;; MH-E and Emacs versions. 1050 ;; MH-E version.
1241 (insert "MH-E " mh-version "\n\n" (emacs-version) "\n\n") 1051 (insert "MH-E " mh-version "\n\n")
1052 ;; MH-E compilation details.
1053 (insert "MH-E compilation details:\n")
1054 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1055 (gnus-compiled-version (if compiled-mhe
1056 (mh-macro-expansion-time-gnus-version)
1057 "N/A")))
1058 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1059 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1060 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1061 ;; Emacs version.
1062 (insert (emacs-version) "\n\n")
1242 ;; MH version. 1063 ;; MH version.
1243 (let ((help-start (point))) 1064 (let ((help-start (point)))
1244 (condition-case err-data 1065 (condition-case err-data
1245 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) 1066 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
1246 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) 1067 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
1247 (goto-char help-start) 1068 (goto-char help-start)
1248 (if mh-nmh-flag 1069 (if mh-nmh-flag
1249 (search-forward "inc -- " nil t) 1070 (search-forward "inc -- " nil t)
1250 (search-forward "version: " nil t)) 1071 (search-forward "version: " nil t))
1251 (delete-region help-start (point))) 1072 (delete-region help-start (point)))
1252 (goto-char (point-max)) 1073 (goto-char (point-max))
1253 (insert "mh-progs:\t" mh-progs "\n" 1074 (insert " mh-progs:\t" mh-progs "\n"
1254 "mh-lib:\t\t" mh-lib "\n" 1075 " mh-lib:\t" mh-lib "\n"
1255 "mh-lib-progs:\t" mh-lib-progs "\n\n") 1076 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1256 ;; Linux version. 1077 ;; Linux version.
1257 (condition-case () 1078 (condition-case ()
1258 (call-process "uname" nil t nil "-a") 1079 (call-process "uname" nil t nil "-a")
@@ -1260,16 +1081,80 @@ selected region is unmarked."
1260 (goto-char (point-min)) 1081 (goto-char (point-min))
1261 (display-buffer mh-temp-buffer)) 1082 (display-buffer mh-temp-buffer))
1262 1083
1263(defun mh-visit-folder (folder &optional range) 1084(defun mh-parse-flist-output-line (line)
1085 "Parse LINE to generate folder name, unseen messages and total messages."
1086 (with-temp-buffer
1087 (insert line)
1088 (goto-char (point-max))
1089 (let (folder unseen total p)
1090 (when (search-backward " out of " (point-min) t)
1091 (setq total (read-from-string
1092 (buffer-substring-no-properties
1093 (match-end 0) (line-end-position))))
1094 (when (search-backward " in sequence " (point-min) t)
1095 (setq p (point))
1096 (when (search-backward " has " (point-min) t)
1097 (setq unseen (read-from-string (buffer-substring-no-properties
1098 (match-end 0) p)))
1099 (while (or (eq (char-after) ?+) (eq (char-after) ? ))
1100 (backward-char))
1101 (setq folder (buffer-substring-no-properties
1102 (point-min) (1+ (point))))
1103 (values (format "+%s" folder) (car unseen) (car total))))))))
1104
1105(defun mh-folder-size (folder)
1106 "Find size of FOLDER."
1107 (with-temp-buffer
1108 (call-process (expand-file-name "flist" mh-progs) nil t nil
1109 "-norecurse" folder)
1110 (goto-char (point-min))
1111 (multiple-value-bind (folder1 unseen total)
1112 (mh-parse-flist-output-line
1113 (buffer-substring (point) (line-end-position)))
1114 (unless (equal folder folder1)
1115 (error "Call to flist failed on folder %s" folder))
1116 (values total unseen))))
1117
1118(defun mh-visit-folder (folder &optional range index-data)
1264 "Visit FOLDER and display RANGE of messages. 1119 "Visit FOLDER and display RANGE of messages.
1265Do not call this function from outside MH-E; see \\[mh-rmail] instead." 1120Do not call this function from outside MH-E; see \\[mh-rmail] instead.
1266 (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) 1121
1267 (mh-read-msg-range "Range [all]? "))) 1122If RANGE is nil (the default if it is omitted when called non-interactively),
1268 (let ((config (current-window-configuration))) 1123then all messages in FOLDER are displayed.
1124
1125If an index buffer is being created then INDEX-DATA is used to initialize the
1126index buffer specific data structures."
1127 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1128 (list folder-name (mh-read-msg-range folder-name))))
1129 (let ((config (current-window-configuration))
1130 (threaded-view-flag mh-show-threads-flag))
1131 (save-excursion
1132 (when (get-buffer folder)
1133 (set-buffer folder)
1134 (setq threaded-view-flag (memq 'unthread mh-view-ops))
1135 (mh-reset-threads-and-narrowing)))
1136 (when index-data
1137 (mh-make-folder folder)
1138 (setq mh-index-data (car index-data)
1139 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1140 mh-index-checksum-origin-map (make-hash-table :test #'equal))
1141 (mh-index-update-maps folder (cadr index-data)))
1269 (mh-scan-folder folder (or range "all")) 1142 (mh-scan-folder folder (or range "all"))
1143 (cond ((and threaded-view-flag
1144 (save-excursion
1145 (goto-char (point-min))
1146 (or (null mh-large-folder)
1147 (not (equal (forward-line mh-large-folder) 0))
1148 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1149 nil))))
1150 (mh-toggle-threads))
1151 (mh-index-data
1152 (mh-index-insert-folder-headers)))
1153 (unless mh-showing-mode (delete-other-windows))
1270 (setq mh-previous-window-config config)) 1154 (setq mh-previous-window-config config))
1271 nil) 1155 nil)
1272 1156
1157;;;###mh-autoload
1273(defun mh-update-sequences () 1158(defun mh-update-sequences ()
1274 "Update MH's Unseen-Sequence and current folder and message. 1159 "Update MH's Unseen-Sequence and current folder and message.
1275Flush MH-E's state out to MH. The message at the cursor becomes current." 1160Flush MH-E's state out to MH. The message at the cursor becomes current."
@@ -1277,17 +1162,18 @@ Flush MH-E's state out to MH. The message at the cursor becomes current."
1277 ;; mh-update-sequences is the opposite of mh-read-folder-sequences, 1162 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
1278 ;; which updates MH-E's state from MH. 1163 ;; which updates MH-E's state from MH.
1279 (let ((folder-set (mh-update-unseen)) 1164 (let ((folder-set (mh-update-unseen))
1280 (new-cur (mh-get-msg-num nil))) 1165 (new-cur (mh-get-msg-num nil)))
1281 (if new-cur 1166 (if new-cur
1282 (let ((seq-entry (mh-find-seq 'cur))) 1167 (let ((seq-entry (mh-find-seq 'cur)))
1283 (mh-remove-cur-notation) 1168 (mh-remove-cur-notation)
1284 (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq 1169 (setcdr seq-entry
1285 (mh-define-sequence 'cur (list new-cur)) 1170 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1286 (beginning-of-line) 1171 (mh-define-sequence 'cur (list new-cur))
1287 (if (looking-at mh-scan-good-msg-regexp) 1172 (beginning-of-line)
1288 (mh-notate nil mh-note-cur mh-cmd-note))) 1173 (if (looking-at mh-scan-good-msg-regexp)
1174 (mh-notate nil mh-note-cur mh-cmd-note)))
1289 (or folder-set 1175 (or folder-set
1290 (save-excursion 1176 (save-excursion
1291 ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! 1177 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1292 ;; So I added this sanity check. 1178 ;; So I added this sanity check.
1293 (if (stringp mh-current-folder) 1179 (if (stringp mh-current-folder)
@@ -1305,13 +1191,13 @@ arguments, after the message has been deleted."
1305 (save-excursion 1191 (save-excursion
1306 (mh-goto-msg msg nil t) 1192 (mh-goto-msg msg nil t)
1307 (if (looking-at mh-scan-refiled-msg-regexp) 1193 (if (looking-at mh-scan-refiled-msg-regexp)
1308 (error "Message %d is refiled. Undo refile before deleting" msg)) 1194 (error "Message %d is refiled. Undo refile before deleting" msg))
1309 (if (looking-at mh-scan-deleted-msg-regexp) 1195 (if (looking-at mh-scan-deleted-msg-regexp)
1310 nil 1196 nil
1311 (mh-set-folder-modified-p t) 1197 (mh-set-folder-modified-p t)
1312 (setq mh-delete-list (cons msg mh-delete-list)) 1198 (setq mh-delete-list (cons msg mh-delete-list))
1313 (mh-notate msg mh-note-deleted mh-cmd-note) 1199 (mh-notate msg mh-note-deleted mh-cmd-note)
1314 (run-hooks 'mh-delete-msg-hook)))) 1200 (run-hooks 'mh-delete-msg-hook))))
1315 1201
1316(defun mh-refile-a-msg (msg folder) 1202(defun mh-refile-a-msg (msg folder)
1317 "Refile MSG in FOLDER. 1203 "Refile MSG in FOLDER.
@@ -1321,28 +1207,59 @@ arguments, after the message has been refiled."
1321 (save-excursion 1207 (save-excursion
1322 (mh-goto-msg msg nil t) 1208 (mh-goto-msg msg nil t)
1323 (cond ((looking-at mh-scan-deleted-msg-regexp) 1209 (cond ((looking-at mh-scan-deleted-msg-regexp)
1324 (error "Message %d is deleted. Undo delete before moving" msg)) 1210 (error "Message %d is deleted. Undo delete before moving" msg))
1325 ((looking-at mh-scan-refiled-msg-regexp) 1211 ((looking-at mh-scan-refiled-msg-regexp)
1326 (if (y-or-n-p 1212 (if (y-or-n-p
1327 (format "Message %d already refiled. Copy to %s as well? " 1213 (format "Message %d already refiled. Copy to %s as well? "
1328 msg folder)) 1214 msg folder))
1329 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" 1215 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1330 "-src" mh-current-folder 1216 "-src" mh-current-folder
1331 (symbol-name folder)) 1217 (symbol-name folder))
1332 (message "Message not copied."))) 1218 (message "Message not copied.")))
1333 (t 1219 (t
1334 (mh-set-folder-modified-p t) 1220 (mh-set-folder-modified-p t)
1335 (if (null (assoc folder mh-refile-list)) 1221 (cond ((null (assoc folder mh-refile-list))
1336 (push (list folder msg) mh-refile-list) 1222 (push (list folder msg) mh-refile-list))
1337 (pushnew msg (cdr (assoc folder mh-refile-list)))) 1223 ((not (member msg (cdr (assoc folder mh-refile-list))))
1338 (mh-notate msg mh-note-refiled mh-cmd-note) 1224 (push msg (cdr (assoc folder mh-refile-list)))))
1339 (run-hooks 'mh-refile-msg-hook))))) 1225 (mh-notate msg mh-note-refiled mh-cmd-note)
1226 (run-hooks 'mh-refile-msg-hook)))))
1340 1227
1341(defun mh-next-msg () 1228(defun mh-next-msg ()
1342 "Move backward or forward to the next undeleted message in the buffer." 1229 "Move backward or forward to the next undeleted message in the buffer."
1343 (if (eq mh-next-direction 'forward) 1230 (if (eq mh-next-direction 'forward)
1344 (mh-next-undeleted-msg 1) 1231 (mh-next-undeleted-msg 1)
1345 (mh-previous-undeleted-msg 1))) 1232 (mh-previous-undeleted-msg 1)))
1233
1234(defun mh-next-unread-msg (&optional count)
1235 "Move to next unread message.
1236With optional argument COUNT, COUNT-1 unread messages are skipped."
1237 (interactive "p")
1238 (unless (> count 0)
1239 (error "The function mh-next-unread-msg expects positive argument"))
1240 (setq count (1- count))
1241 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1242 (cur-msg (mh-get-msg-num nil)))
1243 (cond ((and (not cur-msg) (not (bobp))
1244 ;; If we are at the end of the buffer back up one line and go
1245 ;; to unread message after that.
1246 (progn
1247 (forward-line -1)
1248 (setq cur-msg (mh-get-msg-num nil)))
1249 nil))
1250 ((or (null unread-sequence) (not cur-msg))
1251 ;; No unread message or there aren't any messages in buffer...
1252 (message "No more unread messages"))
1253 ((progn
1254 ;; Skip messages
1255 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1256 (setq unread-sequence (cdr unread-sequence)))
1257 (while (> count 0)
1258 (setq unread-sequence (cdr unread-sequence))
1259 (setq count (1- count)))
1260 (not (car unread-sequence)))
1261 (message "No more unread messages"))
1262 (t (mh-goto-msg (car unread-sequence))))))
1346 1263
1347(defun mh-set-scan-mode () 1264(defun mh-set-scan-mode ()
1348 "Display the scan listing buffer, but do not show a message." 1265 "Display the scan listing buffer, but do not show a message."
@@ -1356,12 +1273,12 @@ arguments, after the message has been refiled."
1356(defun mh-undo-msg (msg) 1273(defun mh-undo-msg (msg)
1357 "Undo the deletion or refile of one MSG." 1274 "Undo the deletion or refile of one MSG."
1358 (cond ((memq msg mh-delete-list) 1275 (cond ((memq msg mh-delete-list)
1359 (setq mh-delete-list (delq msg mh-delete-list))) 1276 (setq mh-delete-list (delq msg mh-delete-list)))
1360 (t 1277 (t
1361 (dolist (folder-msg-list mh-refile-list) 1278 (dolist (folder-msg-list mh-refile-list)
1362 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) 1279 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1363 (setq mh-refile-list (remove-if #'(lambda (x) (null (cdr x))) 1280 (setq mh-refile-list (loop for x in mh-refile-list
1364 mh-refile-list)))) 1281 unless (null (cdr x)) collect x))))
1365 (mh-notate msg ? mh-cmd-note)) 1282 (mh-notate msg ? mh-cmd-note))
1366 1283
1367 1284
@@ -1463,100 +1380,6 @@ Make it the current folder."
1463 1380
1464 1381
1465 1382
1466;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1467(eval-when-compile (defvar tool-bar-map))
1468(defvar mh-folder-tool-bar-map nil)
1469(defvar mh-folder-seq-tool-bar-map nil
1470 "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
1471(when (and (fboundp 'tool-bar-add-item)
1472 tool-bar-mode)
1473 (setq mh-folder-tool-bar-map
1474 (let ((tool-bar-map (make-sparse-keymap)))
1475 (tool-bar-add-item "mail" 'mh-inc-folder 'mh-foldertoolbar-inc-folder
1476 :help "Incorporate new mail in Inbox")
1477 (tool-bar-add-item "attach" 'mh-mime-save-parts
1478 'mh-foldertoolbar-mime-save-parts
1479 :help "Save MIME parts")
1480
1481 (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
1482 'mh-foldertoolbar-prev :help "Previous message")
1483 (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
1484 :help "Page this message")
1485 (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
1486 'mh-foldertoolbar-next :help "Next message")
1487
1488 (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
1489 :help "Mark for deletion")
1490 (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
1491 :help "Refile this message")
1492 (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
1493 :help "Undo this mark")
1494 (tool-bar-add-item "execute" 'mh-execute-commands 'mh-foldertoolbar-exec
1495 :help "Perform moves and deletes")
1496
1497 (tool-bar-add-item "show" 'mh-toggle-showing
1498 'mh-foldertoolbar-toggle-show
1499 :help "Toggle showing message")
1500
1501 (cond
1502 (mh-tool-bar-reply-3-buttons-flag
1503 (tool-bar-add-item "reply-from" (lambda (&optional arg)
1504 (interactive "P")
1505 (mh-reply (mh-get-msg-num nil)
1506 "from" arg))
1507 'mh-foldertoolbar-reply-from
1508 :help "Reply to \"from\"")
1509 (tool-bar-add-item "reply-to" (lambda (&optional arg)
1510 (interactive "P")
1511 (mh-reply (mh-get-msg-num nil)
1512 "to" arg))
1513 'mh-foldertoolbar-reply-to
1514 :help "Reply to \"to\"")
1515 (tool-bar-add-item "reply-all" (lambda (&optional arg)
1516 (interactive "P")
1517 (mh-reply (mh-get-msg-num nil)
1518 "all" arg))
1519 'mh-foldertoolbar-reply-all
1520 :help "Reply to \"all\""))
1521 (t
1522 (tool-bar-add-item "mail/reply2" 'mh-reply 'mh-foldertoolbar-reply
1523 :help "Reply to this message")))
1524 (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
1525 :help "Compose new message")
1526
1527 (tool-bar-add-item "rescan" 'mh-rescan-folder 'mh-foldertoolbar-rescan
1528 :help "Rescan this folder")
1529 (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
1530 :help "Repack this folder")
1531
1532 (tool-bar-add-item "search"
1533 (lambda (&optional arg)
1534 (interactive "P")
1535 (call-interactively mh-tool-bar-search-function))
1536 'mh-foldertoolbar-search :help "Search")
1537 (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-foldertoolbar-visit
1538 :help "Visit other folder")
1539
1540 (tool-bar-add-item "preferences" (lambda ()
1541 (interactive)
1542 (customize-group "mh"))
1543 'mh-foldertoolbar-customize
1544 :help "mh-e preferences")
1545 (tool-bar-add-item "help" (lambda ()
1546 (interactive)
1547 (Info-goto-node "(mh-e)Top"))
1548 'mh-foldertoolbar-help :help "Help")
1549 tool-bar-map))
1550
1551 (setq mh-folder-seq-tool-bar-map
1552 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
1553 (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
1554 :help "Widen from this sequence")
1555 tool-bar-map))
1556 )
1557
1558
1559
1560(defmacro mh-remove-xemacs-horizontal-scrollbar () 1383(defmacro mh-remove-xemacs-horizontal-scrollbar ()
1561 "Get rid of the horizontal scrollbar that XEmacs insists on putting in." 1384 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1562 (when mh-xemacs-flag 1385 (when mh-xemacs-flag
@@ -1571,8 +1394,8 @@ Otherwise return `local-write-file-hooks'. This macro exists purely for
1571compatibility. The former symbol is used in Emacs 21.4 onward while the latter 1394compatibility. The former symbol is used in Emacs 21.4 onward while the latter
1572is used in previous versions and XEmacs." 1395is used in previous versions and XEmacs."
1573 (if (boundp 'write-file-functions) 1396 (if (boundp 'write-file-functions)
1574 ''write-file-functions ;Emacs 21.4 1397 ''write-file-functions ;Emacs 21.4
1575 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs 1398 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
1576 1399
1577(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" 1400(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1578 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> 1401 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
@@ -1594,48 +1417,54 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1594\\{mh-folder-mode-map}" 1417\\{mh-folder-mode-map}"
1595 1418
1596 (make-local-variable 'font-lock-defaults) 1419 (make-local-variable 'font-lock-defaults)
1597 (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) 1420 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1598 (mh-make-local-vars 1421 (mh-make-local-vars
1599 'mh-current-folder (buffer-name) ; Name of folder, a string 1422 'mh-current-folder (buffer-name) ; Name of folder, a string
1600 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 1423 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1601 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" 1424 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1602 (file-name-as-directory (mh-expand-file-name (buffer-name))) 1425 (file-name-as-directory (mh-expand-file-name (buffer-name)))
1603 'mh-showing-mode nil ; Show message also? 1426 'mh-showing-mode nil ; Show message also?
1604 'mh-delete-list nil ; List of msgs nums to delete 1427 'mh-delete-list nil ; List of msgs nums to delete
1605 'mh-refile-list nil ; List of folder names in mh-seq-list 1428 'mh-refile-list nil ; List of folder names in mh-seq-list
1606 'mh-seq-list nil ; Alist of (seq . msgs) nums 1429 'mh-seq-list nil ; Alist of (seq . msgs) nums
1607 'mh-seen-list nil ; List of displayed messages 1430 'mh-seen-list nil ; List of displayed messages
1608 'mh-next-direction 'forward ; Direction to move to next message 1431 'mh-next-direction 'forward ; Direction to move to next message
1609 'mh-narrowed-to-seq nil ; Sequence display is narrowed to 1432 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1610 'mh-view-ops () ; Stack that keeps track of the order 1433 'mh-view-ops () ; Stack that keeps track of the order
1611 ; in which narrowing/threading has been 1434 ; in which narrowing/threading has been
1612 ; carried out. 1435 ; carried out.
1613 'mh-first-msg-num nil ; Number of first msg in buffer 1436 'mh-index-data nil ; If the folder was created by a call
1614 'mh-last-msg-num nil ; Number of last msg in buffer 1437 ; to mh-index-search this contains info
1615 'mh-msg-count nil ; Number of msgs in buffer 1438 ; about the search results.
1616 'mh-mode-line-annotation nil ; Indiction this is not the full folder 1439 'mh-index-previous-search nil ; Previous folder and search-regexp
1617 'mh-previous-window-config nil) ; Previous window configuration 1440 'mh-index-msg-checksum-map nil ; msg -> checksum map
1441 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
1442 'mh-first-msg-num nil ; Number of first msg in buffer
1443 'mh-last-msg-num nil ; Number of last msg in buffer
1444 'mh-msg-count nil ; Number of msgs in buffer
1445 'mh-mode-line-annotation nil ; Indicates message range
1446 'mh-previous-window-config nil) ; Previous window configuration
1618 (mh-remove-xemacs-horizontal-scrollbar) 1447 (mh-remove-xemacs-horizontal-scrollbar)
1619 (setq truncate-lines t) 1448 (setq truncate-lines t)
1620 (auto-save-mode -1) 1449 (auto-save-mode -1)
1621 (setq buffer-offer-save t) 1450 (setq buffer-offer-save t)
1622 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) 1451 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
1623 (make-local-variable 'revert-buffer-function) 1452 (make-local-variable 'revert-buffer-function)
1624 (make-local-variable 'hl-line-mode) ; avoid pollution 1453 (make-local-variable 'hl-line-mode) ; avoid pollution
1625 (if (fboundp 'hl-line-mode) 1454 (if (fboundp 'hl-line-mode)
1626 (hl-line-mode 1)) 1455 (hl-line-mode 1))
1627 (setq revert-buffer-function 'mh-undo-folder) 1456 (setq revert-buffer-function 'mh-undo-folder)
1628 (or (assq 'mh-showing-mode minor-mode-alist) 1457 (or (assq 'mh-showing-mode minor-mode-alist)
1629 (setq minor-mode-alist 1458 (setq minor-mode-alist
1630 (cons '(mh-showing-mode " Show") minor-mode-alist))) 1459 (cons '(mh-showing-mode " Show") minor-mode-alist)))
1631 (easy-menu-add mh-folder-sequence-menu) 1460 (easy-menu-add mh-folder-sequence-menu)
1632 (easy-menu-add mh-folder-message-menu) 1461 (easy-menu-add mh-folder-message-menu)
1633 (easy-menu-add mh-folder-folder-menu) 1462 (easy-menu-add mh-folder-folder-menu)
1634 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 1463 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1635 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) 1464 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
1636 (if (and mh-xemacs-flag 1465 (if (and mh-xemacs-flag
1637 font-lock-auto-fontify) 1466 font-lock-auto-fontify)
1638 (turn-on-font-lock))) ; Force font-lock in XEmacs. 1467 (turn-on-font-lock))) ; Force font-lock in XEmacs.
1639 1468
1640(defun mh-make-local-vars (&rest pairs) 1469(defun mh-make-local-vars (&rest pairs)
1641 "Initialize local variables according to the variable-value PAIRS." 1470 "Initialize local variables according to the variable-value PAIRS."
@@ -1650,15 +1479,15 @@ If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1650refiles aren't carried out. 1479refiles aren't carried out.
1651Return in the folder's buffer." 1480Return in the folder's buffer."
1652 (cond ((null (get-buffer folder)) 1481 (cond ((null (get-buffer folder))
1653 (mh-make-folder folder)) 1482 (mh-make-folder folder))
1654 (t 1483 (t
1655 (or dont-exec-pending (mh-process-or-undo-commands folder)) 1484 (or dont-exec-pending (mh-process-or-undo-commands folder))
1656 (switch-to-buffer folder))) 1485 (switch-to-buffer folder)))
1657 (mh-regenerate-headers range) 1486 (mh-regenerate-headers range)
1658 (if (zerop (buffer-size)) 1487 (if (zerop (buffer-size))
1659 (if (equal range "all") 1488 (if (equal range "all")
1660 (message "Folder %s is empty" folder) 1489 (message "Folder %s is empty" folder)
1661 (message "No messages in %s, range %s" folder range)) 1490 (message "No messages in %s, range %s" folder range))
1662 (mh-goto-cur-msg)) 1491 (mh-goto-cur-msg))
1663 (save-excursion 1492 (save-excursion
1664 (when dont-exec-pending 1493 (when dont-exec-pending
@@ -1670,19 +1499,31 @@ Return in the folder's buffer."
1670 (dolist (msg mh-delete-list) 1499 (dolist (msg mh-delete-list)
1671 (mh-notate msg mh-note-deleted mh-cmd-note))))) 1500 (mh-notate msg mh-note-deleted mh-cmd-note)))))
1672 1501
1502(defun mh-set-cmd-note (width)
1503 "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
1504
1505If `mh-scan-format-file' specifies nil or a filename, then this function
1506will NOT update `mh-cmd-note'."
1507 ;; Add one to the width to always have whitespace in column zero.
1508 (setq width (max (1+ width) 2))
1509 (if (and (equal mh-scan-format-file t)
1510 (not (eq mh-cmd-note width)))
1511 (setq mh-cmd-note width))
1512 mh-cmd-note)
1513
1673(defun mh-regenerate-headers (range &optional update) 1514(defun mh-regenerate-headers (range &optional update)
1674 "Scan folder over range RANGE. 1515 "Scan folder over range RANGE.
1675If UPDATE, append the scan lines, otherwise replace." 1516If UPDATE, append the scan lines, otherwise replace."
1676 (let ((folder mh-current-folder) 1517 (let ((folder mh-current-folder)
1677 (range (if (and range (atom range)) (list range) range)) 1518 (range (if (and range (atom range)) (list range) range))
1678 scan-start) 1519 scan-start)
1679 (message "Scanning %s..." folder) 1520 (message "Scanning %s..." folder)
1680 (with-mh-folder-updating (nil) 1521 (with-mh-folder-updating (nil)
1681 (if update 1522 (if update
1682 (goto-char (point-max)) 1523 (goto-char (point-max))
1683 (delete-region (point-min) (point-max)) 1524 (delete-region (point-min) (point-max))
1684 (if mh-adaptive-cmd-note-flag 1525 (if mh-adaptive-cmd-note-flag
1685 (mh-set-cmd-note (mh-message-number-width folder)))) 1526 (mh-set-cmd-note (mh-message-number-width folder))))
1686 (setq scan-start (point)) 1527 (setq scan-start (point))
1687 (apply #'mh-exec-cmd-output 1528 (apply #'mh-exec-cmd-output
1688 mh-scan-prog nil 1529 mh-scan-prog nil
@@ -1692,19 +1533,19 @@ If UPDATE, append the scan lines, otherwise replace."
1692 folder range) 1533 folder range)
1693 (goto-char scan-start) 1534 (goto-char scan-start)
1694 (cond ((looking-at "scan: no messages in") 1535 (cond ((looking-at "scan: no messages in")
1695 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines 1536 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
1696 ((looking-at "scan: bad message list ") 1537 ((looking-at "scan: bad message list ")
1697 (keep-lines mh-scan-valid-regexp)) 1538 (keep-lines mh-scan-valid-regexp))
1698 ((looking-at "scan: ")) ; Keep error messages 1539 ((looking-at "scan: ")) ; Keep error messages
1699 (t 1540 (t
1700 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines 1541 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
1701 (setq mh-seq-list (mh-read-folder-sequences folder nil)) 1542 (setq mh-seq-list (mh-read-folder-sequences folder nil))
1702 (mh-notate-user-sequences) 1543 (mh-notate-user-sequences)
1703 (or update 1544 (or update
1704 (setq mh-mode-line-annotation 1545 (setq mh-mode-line-annotation
1705 (if (equal range '("all")) 1546 (if (equal range '("all"))
1706 nil 1547 nil
1707 mh-partial-folder-mode-line-annotation))) 1548 mh-partial-folder-mode-line-annotation)))
1708 (mh-make-folder-mode-line)) 1549 (mh-make-folder-mode-line))
1709 (message "Scanning %s...done" folder))) 1550 (message "Scanning %s...done" folder)))
1710 1551
@@ -1727,8 +1568,8 @@ line now with no message truncation."
1727 (save-excursion 1568 (save-excursion
1728 (let ((maxcol (1- (window-width))) 1569 (let ((maxcol (1- (window-width)))
1729 (old-cmd-note mh-cmd-note) 1570 (old-cmd-note mh-cmd-note)
1730 mh-cmd-note-fmt 1571 mh-cmd-note-fmt
1731 msgnum) 1572 msgnum)
1732 ;; Nuke all of the lines just added by the last inc 1573 ;; Nuke all of the lines just added by the last inc
1733 (delete-char (- (point-max) (point))) 1574 (delete-char (- (point-max) (point)))
1734 ;; Update the current buffer to reflect the new mh-cmd-note 1575 ;; Update the current buffer to reflect the new mh-cmd-note
@@ -1750,7 +1591,7 @@ line now with no message truncation."
1750 (let ((eol (point))) 1591 (let ((eol (point)))
1751 (move-to-column maxcol) 1592 (move-to-column maxcol)
1752 (if (<= (point) eol) 1593 (if (<= (point) eol)
1753 (delete-char (- eol (point)))))))) 1594 (delete-char (- eol (point))))))))
1754 ;; now re-read the lost messages 1595 ;; now re-read the lost messages
1755 (goto-char (point-max)) 1596 (goto-char (point-max))
1756 (prog1 (point) 1597 (prog1 (point)
@@ -1760,36 +1601,36 @@ line now with no message truncation."
1760 "Read new mail from MAILDROP-NAME into the current buffer. 1601 "Read new mail from MAILDROP-NAME into the current buffer.
1761Return in the current buffer." 1602Return in the current buffer."
1762 (let ((point-before-inc (point)) 1603 (let ((point-before-inc (point))
1763 (folder mh-current-folder) 1604 (folder mh-current-folder)
1764 (new-mail-flag nil)) 1605 (new-mail-flag nil))
1765 (with-mh-folder-updating (t) 1606 (with-mh-folder-updating (t)
1766 (if maildrop-name 1607 (if maildrop-name
1767 (message "inc %s -file %s..." folder maildrop-name) 1608 (message "inc %s -file %s..." folder maildrop-name)
1768 (message "inc %s..." folder)) 1609 (message "inc %s..." folder))
1769 (setq mh-next-direction 'forward) 1610 (setq mh-next-direction 'forward)
1770 (goto-char (point-max)) 1611 (goto-char (point-max))
1771 (let ((start-of-inc (point))) 1612 (let ((start-of-inc (point)))
1772 (mh-remove-cur-notation) 1613 (mh-remove-cur-notation)
1773 (if maildrop-name 1614 (if maildrop-name
1774 ;; I think MH 5 used "-ms-file" instead of "-file", 1615 ;; I think MH 5 used "-ms-file" instead of "-file",
1775 ;; which would make inc'ing from maildrops fail. 1616 ;; which would make inc'ing from maildrops fail.
1776 (mh-exec-cmd-output mh-inc-prog nil folder 1617 (mh-exec-cmd-output mh-inc-prog nil folder
1777 (mh-scan-format) 1618 (mh-scan-format)
1778 "-file" (expand-file-name maildrop-name) 1619 "-file" (expand-file-name maildrop-name)
1779 "-width" (window-width) 1620 "-width" (window-width)
1780 "-truncate") 1621 "-truncate")
1781 (mh-exec-cmd-output mh-inc-prog nil 1622 (mh-exec-cmd-output mh-inc-prog nil
1782 (mh-scan-format) 1623 (mh-scan-format)
1783 "-width" (window-width))) 1624 "-width" (window-width)))
1784 (if maildrop-name 1625 (if maildrop-name
1785 (message "inc %s -file %s...done" folder maildrop-name) 1626 (message "inc %s -file %s...done" folder maildrop-name)
1786 (message "inc %s...done" folder)) 1627 (message "inc %s...done" folder))
1787 (goto-char start-of-inc) 1628 (goto-char start-of-inc)
1788 (cond ((save-excursion 1629 (cond ((save-excursion
1789 (re-search-forward "^inc: no mail" nil t)) 1630 (re-search-forward "^inc: no mail" nil t))
1790 (message "No new mail%s%s" (if maildrop-name " in " "") 1631 (message "No new mail%s%s" (if maildrop-name " in " "")
1791 (if maildrop-name maildrop-name ""))) 1632 (if maildrop-name maildrop-name "")))
1792 ((and (when mh-narrowed-to-seq 1633 ((and (when mh-narrowed-to-seq
1793 (let ((saved-text (buffer-substring-no-properties 1634 (let ((saved-text (buffer-substring-no-properties
1794 start-of-inc (point-max)))) 1635 start-of-inc (point-max))))
1795 (delete-region start-of-inc (point-max)) 1636 (delete-region start-of-inc (point-max))
@@ -1800,27 +1641,29 @@ Return in the current buffer."
1800 (goto-char start-of-inc)))) 1641 (goto-char start-of-inc))))
1801 nil)) 1642 nil))
1802 ((re-search-forward "^inc:" nil t) ; Error messages 1643 ((re-search-forward "^inc:" nil t) ; Error messages
1803 (error "Error incorporating mail")) 1644 (error "Error incorporating mail"))
1804 ((and 1645 ((and
1805 (equal mh-scan-format-file t) 1646 (equal mh-scan-format-file t)
1806 mh-adaptive-cmd-note-flag 1647 mh-adaptive-cmd-note-flag
1807 ;; Have we reached an edge condition? 1648 ;; Have we reached an edge condition?
1808 (save-excursion 1649 (save-excursion
1809 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1)) 1650 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
1810 (setq start-of-inc (mh-generate-new-cmd-note folder)) 1651 (setq start-of-inc (mh-generate-new-cmd-note folder))
1811 nil)) 1652 nil))
1812 (t 1653 (t
1813 (setq new-mail-flag t))) 1654 (setq new-mail-flag t)))
1814 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines 1655 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1815 (setq mh-seq-list (mh-read-folder-sequences folder t)) 1656 (setq mh-seq-list (mh-read-folder-sequences folder t))
1816 (mh-notate-user-sequences) 1657 (when (equal (point-max) start-of-inc)
1817 (if new-mail-flag 1658 (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
1818 (progn 1659 (mh-notate-user-sequences)
1819 (mh-make-folder-mode-line) 1660 (if new-mail-flag
1661 (progn
1662 (mh-make-folder-mode-line)
1820 (when (memq 'unthread mh-view-ops) 1663 (when (memq 'unthread mh-view-ops)
1821 (mh-thread-inc folder start-of-inc)) 1664 (mh-thread-inc folder start-of-inc))
1822 (mh-goto-cur-msg)) 1665 (mh-goto-cur-msg))
1823 (goto-char point-before-inc)))))) 1666 (goto-char point-before-inc))))))
1824 1667
1825(defun mh-make-folder-mode-line (&optional ignored) 1668(defun mh-make-folder-mode-line (&optional ignored)
1826 "Set the fields of the mode line for a folder buffer. 1669 "Set the fields of the mode line for a folder buffer.
@@ -1830,37 +1673,37 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1830 (save-window-excursion 1673 (save-window-excursion
1831 (mh-first-msg) 1674 (mh-first-msg)
1832 (let ((new-first-msg-num (mh-get-msg-num nil))) 1675 (let ((new-first-msg-num (mh-get-msg-num nil)))
1833 (when (or (not (memq 'unthread mh-view-ops)) 1676 (when (or (not (memq 'unthread mh-view-ops))
1834 (null mh-first-msg-num) 1677 (null mh-first-msg-num)
1835 (null new-first-msg-num) 1678 (null new-first-msg-num)
1836 (< new-first-msg-num mh-first-msg-num)) 1679 (< new-first-msg-num mh-first-msg-num))
1837 (setq mh-first-msg-num new-first-msg-num))) 1680 (setq mh-first-msg-num new-first-msg-num)))
1838 (mh-last-msg) 1681 (mh-last-msg)
1839 (let ((new-last-msg-num (mh-get-msg-num nil))) 1682 (let ((new-last-msg-num (mh-get-msg-num nil)))
1840 (when (or (not (memq 'unthread mh-view-ops)) 1683 (when (or (not (memq 'unthread mh-view-ops))
1841 (null mh-last-msg-num) 1684 (null mh-last-msg-num)
1842 (null new-last-msg-num) 1685 (null new-last-msg-num)
1843 (> new-last-msg-num mh-last-msg-num)) 1686 (> new-last-msg-num mh-last-msg-num))
1844 (setq mh-last-msg-num new-last-msg-num))) 1687 (setq mh-last-msg-num new-last-msg-num)))
1845 (setq mh-msg-count (if mh-first-msg-num 1688 (setq mh-msg-count (if mh-first-msg-num
1846 (count-lines (point-min) (point-max)) 1689 (count-lines (point-min) (point-max))
1847 0)) 1690 0))
1848 (setq mode-line-buffer-identification 1691 (setq mode-line-buffer-identification
1849 (list (format "{%%b%s} %s msg%s" 1692 (list (format "{%%b%s} %s msg%s"
1850 (if mh-mode-line-annotation 1693 (if mh-mode-line-annotation
1851 (format "/%s" mh-mode-line-annotation) 1694 (format "/%s" mh-mode-line-annotation)
1852 "") 1695 "")
1853 (if (zerop mh-msg-count) 1696 (if (zerop mh-msg-count)
1854 "no" 1697 "no"
1855 (format "%d" mh-msg-count)) 1698 (format "%d" mh-msg-count))
1856 (if (zerop mh-msg-count) 1699 (if (zerop mh-msg-count)
1857 "s" 1700 "s"
1858 (cond ((> mh-msg-count 1) 1701 (cond ((> mh-msg-count 1)
1859 (format "s (%d-%d)" mh-first-msg-num 1702 (format "s (%d-%d)" mh-first-msg-num
1860 mh-last-msg-num)) 1703 mh-last-msg-num))
1861 (mh-first-msg-num 1704 (mh-first-msg-num
1862 (format " (%d)" mh-first-msg-num)) 1705 (format " (%d)" mh-first-msg-num))
1863 (""))))))))) 1706 ("")))))))))
1864 1707
1865(defun mh-unmark-all-headers (remove-all-flags) 1708(defun mh-unmark-all-headers (remove-all-flags)
1866 "Remove all '+' flags from the folder listing. 1709 "Remove all '+' flags from the folder listing.
@@ -1868,60 +1711,62 @@ With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1868Optimized for speed (i.e., no regular expressions)." 1711Optimized for speed (i.e., no regular expressions)."
1869 (save-excursion 1712 (save-excursion
1870 (let ((case-fold-search nil) 1713 (let ((case-fold-search nil)
1871 (last-line (1- (point-max))) 1714 (last-line (1- (point-max)))
1872 char) 1715 char)
1873 (mh-first-msg) 1716 (mh-first-msg)
1874 (while (<= (point) last-line) 1717 (while (<= (point) last-line)
1875 (forward-char mh-cmd-note) 1718 (forward-char mh-cmd-note)
1876 (setq char (following-char)) 1719 (setq char (following-char))
1877 (if (or (and remove-all-flags 1720 (if (or (and remove-all-flags
1878 (or (= char (aref mh-note-deleted 0)) 1721 (or (= char (aref mh-note-deleted 0))
1879 (= char (aref mh-note-refiled 0)))) 1722 (= char (aref mh-note-refiled 0))))
1880 (= char (aref mh-note-cur 0))) 1723 (= char (aref mh-note-cur 0)))
1881 (progn 1724 (progn
1882 (delete-char 1) 1725 (delete-char 1)
1883 (insert " "))) 1726 (insert " ")))
1884 (if remove-all-flags 1727 (if remove-all-flags
1885 (progn 1728 (progn
1886 (forward-char 1) 1729 (forward-char 1)
1887 (if (= (following-char) (aref mh-note-seq 0)) 1730 (if (= (following-char) (aref mh-note-seq 0))
1888 (progn 1731 (progn
1889 (delete-char 1) 1732 (delete-char 1)
1890 (insert " "))))) 1733 (insert " ")))))
1891 (forward-line))))) 1734 (forward-line)))))
1892 1735
1893(defun mh-remove-cur-notation () 1736(defun mh-remove-cur-notation ()
1894 "Remove old cur notation." 1737 "Remove old cur notation."
1895 (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) 1738 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1896 (save-excursion 1739 (save-excursion
1897 (and cur-msg 1740 (and cur-msg
1898 (mh-goto-msg cur-msg t t) 1741 (mh-goto-msg cur-msg t t)
1899 (looking-at mh-scan-cur-msg-number-regexp) 1742 (looking-at mh-scan-cur-msg-number-regexp)
1900 (mh-notate nil ? mh-cmd-note))))) 1743 (mh-notate nil ? mh-cmd-note)))))
1901 1744
1902(defun mh-remove-all-notation () 1745(defun mh-remove-all-notation ()
1903 "Remove all notations on all scan lines that MH-E introduces." 1746 "Remove all notations on all scan lines that MH-E introduces."
1904 (save-excursion 1747 (save-excursion
1905 (goto-char (point-min)) 1748 (goto-char (point-min))
1906 (while (not (eobp)) 1749 (while (not (eobp))
1907 (mh-notate nil ? mh-cmd-note) 1750 (unless (or (equal (char-after) ?+) (eolp))
1908 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) 1751 (mh-notate nil ? mh-cmd-note)
1909 (mh-notate nil ? (1+ mh-cmd-note))) 1752 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
1753 (mh-notate nil ? (1+ mh-cmd-note))))
1910 (forward-line)))) 1754 (forward-line))))
1911 1755
1756;;;###mh-autoload
1912(defun mh-goto-cur-msg (&optional minimal-changes-flag) 1757(defun mh-goto-cur-msg (&optional minimal-changes-flag)
1913 "Position the cursor at the current message. 1758 "Position the cursor at the current message.
1914When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't 1759When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
1915recenter the folder buffer." 1760recenter the folder buffer."
1916 (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) 1761 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1917 (cond ((and cur-msg 1762 (cond ((and cur-msg
1918 (mh-goto-msg cur-msg t t)) 1763 (mh-goto-msg cur-msg t t))
1919 (unless minimal-changes-flag 1764 (unless minimal-changes-flag
1920 (mh-notate nil mh-note-cur mh-cmd-note) 1765 (mh-notate nil mh-note-cur mh-cmd-note)
1921 (mh-recenter 0) 1766 (mh-recenter 0)
1922 (mh-maybe-show cur-msg))) 1767 (mh-maybe-show cur-msg)))
1923 (t 1768 (t
1924 (message "No current message"))))) 1769 (message "No current message")))))
1925 1770
1926(defun mh-process-or-undo-commands (folder) 1771(defun mh-process-or-undo-commands (folder)
1927 "If FOLDER has outstanding commands, then either process or discard them. 1772 "If FOLDER has outstanding commands, then either process or discard them.
@@ -1929,10 +1774,10 @@ Called by functions like `mh-sort-folder', so also invalidate show buffer."
1929 (set-buffer folder) 1774 (set-buffer folder)
1930 (if (mh-outstanding-commands-p) 1775 (if (mh-outstanding-commands-p)
1931 (if (or mh-do-not-confirm-flag 1776 (if (or mh-do-not-confirm-flag
1932 (y-or-n-p 1777 (y-or-n-p
1933 "Process outstanding deletes and refiles (or lose them)? ")) 1778 "Process outstanding deletes and refiles (or lose them)? "))
1934 (mh-process-commands folder) 1779 (mh-process-commands folder)
1935 (mh-undo-folder))) 1780 (mh-undo-folder)))
1936 (mh-update-unseen) 1781 (mh-update-unseen)
1937 (mh-invalidate-show-buffer)) 1782 (mh-invalidate-show-buffer))
1938 1783
@@ -1949,7 +1794,13 @@ with no arguments, before the commands are processed."
1949 ;; Update the unseen sequence if it exists 1794 ;; Update the unseen sequence if it exists
1950 (mh-update-unseen) 1795 (mh-update-unseen)
1951 1796
1952 (let ((redraw-needed-flag nil)) 1797 (let ((redraw-needed-flag mh-index-data))
1798 ;; Remove invalid scan lines if we are in an index folder and then remove
1799 ;; the real messages
1800 (when mh-index-data
1801 (mh-index-delete-folder-headers)
1802 (mh-index-execute-commands))
1803
1953 ;; Then refile messages 1804 ;; Then refile messages
1954 (mh-mapc #'(lambda (folder-msg-list) 1805 (mh-mapc #'(lambda (folder-msg-list)
1955 (let ((dest-folder (symbol-name (car folder-msg-list))) 1806 (let ((dest-folder (symbol-name (car folder-msg-list)))
@@ -1973,17 +1824,18 @@ with no arguments, before the commands are processed."
1973 ;; Don't need to remove sequences since delete and refile do so. 1824 ;; Don't need to remove sequences since delete and refile do so.
1974 ;; Mark cur message 1825 ;; Mark cur message
1975 (if (> (buffer-size) 0) 1826 (if (> (buffer-size) 0)
1976 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) 1827 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1977 1828
1978 ;; Redraw folder window if needed 1829 ;; Redraw folder buffer if needed
1979 (when (and (memq 'unthread mh-view-ops) redraw-needed-flag) 1830 (when (and redraw-needed-flag)
1980 (mh-thread-inc folder (point-max)))) 1831 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
1832 (mh-index-data (mh-index-insert-folder-headers)))))
1981 1833
1982 (and (buffer-file-name (get-buffer mh-show-buffer)) 1834 (and (buffer-file-name (get-buffer mh-show-buffer))
1983 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) 1835 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1984 ;; If "inc" were to put a new msg in this file, 1836 ;; If "inc" were to put a new msg in this file,
1985 ;; we would not notice, so mark it invalid now. 1837 ;; we would not notice, so mark it invalid now.
1986 (mh-invalidate-show-buffer)) 1838 (mh-invalidate-show-buffer))
1987 1839
1988 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) 1840 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1989 (mh-unmark-all-headers t) 1841 (mh-unmark-all-headers t)
@@ -1997,17 +1849,17 @@ The value of `mh-unseen-updated-hook' is a list of functions to be called,
1997with no arguments, after the unseen sequence is updated." 1849with no arguments, after the unseen sequence is updated."
1998 (if mh-seen-list 1850 (if mh-seen-list
1999 (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) 1851 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
2000 (unseen-msgs (mh-seq-msgs unseen-seq))) 1852 (unseen-msgs (mh-seq-msgs unseen-seq)))
2001 (if unseen-msgs 1853 (if unseen-msgs
2002 (progn 1854 (progn
2003 (mh-undefine-sequence mh-unseen-seq mh-seen-list) 1855 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
2004 (run-hooks 'mh-unseen-updated-hook) 1856 (run-hooks 'mh-unseen-updated-hook)
2005 (while mh-seen-list 1857 (while mh-seen-list
2006 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) 1858 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
2007 (setq mh-seen-list (cdr mh-seen-list))) 1859 (setq mh-seen-list (cdr mh-seen-list)))
2008 (setcdr unseen-seq unseen-msgs) 1860 (setcdr unseen-seq unseen-msgs)
2009 t) ;since we set the folder 1861 t) ;since we set the folder
2010 (setq mh-seen-list nil))))) 1862 (setq mh-seen-list nil)))))
2011 1863
2012(defun mh-delete-scan-msgs (msgs) 1864(defun mh-delete-scan-msgs (msgs)
2013 "Delete the scan listing lines for MSGS." 1865 "Delete the scan listing lines for MSGS."
@@ -2029,20 +1881,20 @@ Sort of the opposite of `mh-read-msg-list', which expands ranges.
2029Message lists passed to MH programs go through this so 1881Message lists passed to MH programs go through this so
2030command line arguments won't exceed system limits." 1882command line arguments won't exceed system limits."
2031 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) 1883 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
2032 (range-high nil) 1884 (range-high nil)
2033 (prev -1) 1885 (prev -1)
2034 (ranges nil)) 1886 (ranges nil))
2035 (while prev 1887 (while prev
2036 (if range-high 1888 (if range-high
2037 (if (or (not (numberp prev)) 1889 (if (or (not (numberp prev))
2038 (not (equal (car msgs) (1- prev)))) 1890 (not (equal (car msgs) (1- prev))))
2039 (progn ;non-sequential, flush old range 1891 (progn ;non-sequential, flush old range
2040 (if (eq prev range-high) 1892 (if (eq prev range-high)
2041 (setq ranges (cons range-high ranges)) 1893 (setq ranges (cons range-high ranges))
2042 (setq ranges (cons (format "%s-%s" prev range-high) ranges))) 1894 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
2043 (setq range-high nil)))) 1895 (setq range-high nil))))
2044 (or range-high 1896 (or range-high
2045 (setq range-high (car msgs))) ;start new or first range 1897 (setq range-high (car msgs))) ;start new or first range
2046 (setq prev (car msgs)) 1898 (setq prev (car msgs))
2047 (setq msgs (cdr msgs))) 1899 (setq msgs (cdr msgs)))
2048 ranges)) 1900 ranges))
@@ -2052,11 +1904,11 @@ command line arguments won't exceed system limits."
2052Strings are \"smaller\" than numbers. 1904Strings are \"smaller\" than numbers.
2053Legal values are things like \"cur\", \"last\", 1, and 1820." 1905Legal values are things like \"cur\", \"last\", 1, and 1820."
2054 (if (numberp msg1) 1906 (if (numberp msg1)
2055 (if (numberp msg2) 1907 (if (numberp msg2)
2056 (> msg1 msg2) 1908 (> msg1 msg2)
2057 t) 1909 t)
2058 (if (numberp msg2) 1910 (if (numberp msg2)
2059 nil 1911 nil
2060 (string-lessp msg2 msg1)))) 1912 (string-lessp msg2 msg1))))
2061 1913
2062(defun mh-lessp (msg1 msg2) 1914(defun mh-lessp (msg1 msg2)
@@ -2080,55 +1932,55 @@ If SAVE-REFILES is non-nil, then keep the sequences
2080that note messages to be refiled." 1932that note messages to be refiled."
2081 (let ((seqs ())) 1933 (let ((seqs ()))
2082 (cond (save-refiles 1934 (cond (save-refiles
2083 (mh-mapc (function (lambda (seq) ; Save the refiling sequences 1935 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
2084 (if (mh-folder-name-p (mh-seq-name seq)) 1936 (if (mh-folder-name-p (mh-seq-name seq))
2085 (setq seqs (cons seq seqs))))) 1937 (setq seqs (cons seq seqs)))))
2086 mh-seq-list))) 1938 mh-seq-list)))
2087 (save-excursion 1939 (save-excursion
2088 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) 1940 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
2089 (progn 1941 (progn
2090 ;; look for name in line of form "cur: 4" or "myseq (private): 23" 1942 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
2091 (while (re-search-forward "^[^: ]+" nil t) 1943 (while (re-search-forward "^[^: ]+" nil t)
2092 (setq seqs (cons (mh-make-seq (intern (buffer-substring 1944 (setq seqs (cons (mh-make-seq (intern (buffer-substring
2093 (match-beginning 0) 1945 (match-beginning 0)
2094 (match-end 0))) 1946 (match-end 0)))
2095 (mh-read-msg-list)) 1947 (mh-read-msg-list))
2096 seqs))) 1948 seqs)))
2097 (delete-region (point-min) (point))))) ; avoid race with 1949 (delete-region (point-min) (point))))) ; avoid race with
2098 ; mh-process-daemon 1950 ; mh-process-daemon
2099 seqs)) 1951 seqs))
2100 1952
2101(defun mh-read-msg-list () 1953(defun mh-read-msg-list ()
2102 "Return a list of message numbers from point to the end of the line. 1954 "Return a list of message numbers from point to the end of the line.
2103Expands ranges into set of individual numbers." 1955Expands ranges into set of individual numbers."
2104 (let ((msgs ()) 1956 (let ((msgs ())
2105 (end-of-line (save-excursion (end-of-line) (point))) 1957 (end-of-line (save-excursion (end-of-line) (point)))
2106 num) 1958 num)
2107 (while (re-search-forward "[0-9]+" end-of-line t) 1959 (while (re-search-forward "[0-9]+" end-of-line t)
2108 (setq num (string-to-int (buffer-substring (match-beginning 0) 1960 (setq num (string-to-int (buffer-substring (match-beginning 0)
2109 (match-end 0)))) 1961 (match-end 0))))
2110 (cond ((looking-at "-") ; Message range 1962 (cond ((looking-at "-") ; Message range
2111 (forward-char 1) 1963 (forward-char 1)
2112 (re-search-forward "[0-9]+" end-of-line t) 1964 (re-search-forward "[0-9]+" end-of-line t)
2113 (let ((num2 (string-to-int (buffer-substring (match-beginning 0) 1965 (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
2114 (match-end 0))))) 1966 (match-end 0)))))
2115 (if (< num2 num) 1967 (if (< num2 num)
2116 (error "Bad message range: %d-%d" num num2)) 1968 (error "Bad message range: %d-%d" num num2))
2117 (while (<= num num2) 1969 (while (<= num num2)
2118 (setq msgs (cons num msgs)) 1970 (setq msgs (cons num msgs))
2119 (setq num (1+ num))))) 1971 (setq num (1+ num)))))
2120 ((not (zerop num)) ;"pick" outputs "0" to mean no match 1972 ((not (zerop num)) ;"pick" outputs "0" to mean no match
2121 (setq msgs (cons num msgs))))) 1973 (setq msgs (cons num msgs)))))
2122 msgs)) 1974 msgs))
2123 1975
2124(defun mh-notate-user-sequences () 1976(defun mh-notate-user-sequences ()
2125 "Mark the scan listing of all messages in user-defined sequences." 1977 "Mark the scan listing of all messages in user-defined sequences."
2126 (let ((seqs mh-seq-list) 1978 (let ((seqs mh-seq-list)
2127 name) 1979 name)
2128 (while seqs 1980 (while seqs
2129 (setq name (mh-seq-name (car seqs))) 1981 (setq name (mh-seq-name (car seqs)))
2130 (if (not (mh-internal-seq name)) 1982 (if (not (mh-internal-seq name))
2131 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) 1983 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
2132 (setq seqs (cdr seqs))))) 1984 (setq seqs (cdr seqs)))))
2133 1985
2134(defun mh-internal-seq (name) 1986(defun mh-internal-seq (name)
@@ -2143,39 +1995,39 @@ Expands ranges into set of individual numbers."
2143MESSAGE defaults to displayed message. From Lisp, optional third arg 1995MESSAGE defaults to displayed message. From Lisp, optional third arg
2144INTERNAL-FLAG non-nil means do not inform MH of the change." 1996INTERNAL-FLAG non-nil means do not inform MH of the change."
2145 (interactive (list (mh-get-msg-num t) 1997 (interactive (list (mh-get-msg-num t)
2146 (mh-read-seq-default "Delete from" t) 1998 (mh-read-seq-default "Delete from" t)
2147 nil)) 1999 nil))
2148 (let ((entry (mh-find-seq sequence))) 2000 (let ((entry (mh-find-seq sequence)))
2149 (cond (entry 2001 (cond (entry
2150 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) 2002 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
2151 (if (not internal-flag) 2003 (if (not internal-flag)
2152 (mh-undefine-sequence sequence (list message))) 2004 (mh-undefine-sequence sequence (list message)))
2153 (setcdr entry (delq message (mh-seq-msgs entry))))))) 2005 (setcdr entry (delq message (mh-seq-msgs entry)))))))
2154 2006
2155(defun mh-undefine-sequence (seq msgs) 2007(defun mh-undefine-sequence (seq msgs)
2156 "Remove from the SEQ the list of MSGS." 2008 "Remove from the SEQ the list of MSGS."
2157 (mh-exec-cmd "mark" mh-current-folder "-delete" 2009 (mh-exec-cmd "mark" mh-current-folder "-delete"
2158 "-sequence" (symbol-name seq) 2010 "-sequence" (symbol-name seq)
2159 (mh-coalesce-msg-list msgs))) 2011 (mh-coalesce-msg-list msgs)))
2160 2012
2161(defun mh-define-sequence (seq msgs) 2013(defun mh-define-sequence (seq msgs)
2162 "Define the SEQ to contain the list of MSGS. 2014 "Define the SEQ to contain the list of MSGS.
2163Do not mark pseudo-sequences or empty sequences. 2015Do not mark pseudo-sequences or empty sequences.
2164Signals an error if SEQ is an illegal name." 2016Signals an error if SEQ is an illegal name."
2165 (if (and msgs 2017 (if (and msgs
2166 (not (mh-folder-name-p seq))) 2018 (not (mh-folder-name-p seq)))
2167 (save-excursion 2019 (save-excursion
2168 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" 2020 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2169 "-sequence" (symbol-name seq) 2021 "-sequence" (symbol-name seq)
2170 (mh-coalesce-msg-list msgs))))) 2022 (mh-coalesce-msg-list msgs)))))
2171 2023
2172(defun mh-map-over-seqs (function seq-list) 2024(defun mh-map-over-seqs (function seq-list)
2173 "Apply FUNCTION to each sequence in SEQ-LIST. 2025 "Apply FUNCTION to each sequence in SEQ-LIST.
2174The sequence name and the list of messages are passed as arguments." 2026The sequence name and the list of messages are passed as arguments."
2175 (while seq-list 2027 (while seq-list
2176 (funcall function 2028 (funcall function
2177 (mh-seq-name (car seq-list)) 2029 (mh-seq-name (car seq-list))
2178 (mh-seq-msgs (car seq-list))) 2030 (mh-seq-msgs (car seq-list)))
2179 (setq seq-list (cdr seq-list)))) 2031 (setq seq-list (cdr seq-list))))
2180 2032
2181(defun mh-notate-if-in-one-seq (msg character offset seq) 2033(defun mh-notate-if-in-one-seq (msg character offset seq)
@@ -2184,18 +2036,18 @@ The CHARACTER is placed at the given OFFSET from the beginning of the listing.
2184The notation is performed if the MSG is only in SEQ." 2036The notation is performed if the MSG is only in SEQ."
2185 (let ((in-seqs (mh-seq-containing-msg msg nil))) 2037 (let ((in-seqs (mh-seq-containing-msg msg nil)))
2186 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) 2038 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2187 (mh-notate msg character offset)))) 2039 (mh-notate msg character offset))))
2188 2040
2189(defun mh-seq-containing-msg (msg &optional include-internal-flag) 2041(defun mh-seq-containing-msg (msg &optional include-internal-flag)
2190 "Return a list of the sequences containing MSG. 2042 "Return a list of the sequences containing MSG.
2191If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." 2043If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2192 (let ((l mh-seq-list) 2044 (let ((l mh-seq-list)
2193 (seqs ())) 2045 (seqs ()))
2194 (while l 2046 (while l
2195 (and (memq msg (mh-seq-msgs (car l))) 2047 (and (memq msg (mh-seq-msgs (car l)))
2196 (or include-internal-flag 2048 (or include-internal-flag
2197 (not (mh-internal-seq (mh-seq-name (car l))))) 2049 (not (mh-internal-seq (mh-seq-name (car l)))))
2198 (setq seqs (cons (mh-seq-name (car l)) seqs))) 2050 (setq seqs (cons (mh-seq-name (car l)) seqs)))
2199 (setq l (cdr l))) 2051 (setq l (cdr l)))
2200 seqs)) 2052 seqs))
2201 2053
@@ -2203,17 +2055,26 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2203 2055
2204;;; User prompting commands. 2056;;; User prompting commands.
2205 2057
2206(defun mh-read-msg-range (prompt) 2058(defun mh-read-msg-range (folder &optional always-prompt-flag)
2207 "Read a list of blank-separated messages using the given PROMPT." 2059 "Prompt for message range from FOLDER.
2208 (let* ((buf (read-string prompt)) 2060If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
2209 (buf-size (length buf)) 2061range."
2210 (start 0) 2062 (multiple-value-bind (total unseen) (mh-folder-size folder)
2211 (input ())) 2063 (cond
2212 (while (< start buf-size) 2064 ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
2213 (let ((next (read-from-string buf start buf-size))) 2065 (list (symbol-name mh-unseen-seq)))
2214 (setq input (cons (car next) input)) 2066 ((or (null mh-large-folder) (not (numberp total)))
2215 (setq start (cdr next)))) 2067 (list "all"))
2216 (nreverse input))) 2068 ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
2069 (let* ((prompt
2070 (format "Range or number of messages to read (default: %s): "
2071 total))
2072 (in (read-string prompt nil nil (number-to-string total))))
2073 (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
2074 (list (format "last:%s" (car (read-from-string in)))))
2075 ((equal in "") (list "all"))
2076 (t (split-string in)))))
2077 (t (list "all")))))
2217 2078
2218 2079
2219 2080
@@ -2230,91 +2091,99 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2230 2091
2231;; Save the `b' binding for a future `back'. Maybe? 2092;; Save the `b' binding for a future `back'. Maybe?
2232(gnus-define-keys mh-folder-mode-map 2093(gnus-define-keys mh-folder-mode-map
2233 " " mh-page-msg 2094 " " mh-page-msg
2234 "!" mh-refile-or-write-again 2095 "!" mh-refile-or-write-again
2235 "," mh-header-display 2096 "," mh-header-display
2236 "." mh-alt-show 2097 "." mh-alt-show
2237 ">" mh-write-msg-to-file 2098 ">" mh-write-msg-to-file
2238 "?" mh-help 2099 "?" mh-help
2239 "E" mh-extract-rejected-mail 2100 "E" mh-extract-rejected-mail
2240 "M" mh-modify 2101 "M" mh-modify
2241 "\177" mh-previous-page 2102 "\177" mh-previous-page
2242 "\C-d" mh-delete-msg-no-motion 2103 "\C-d" mh-delete-msg-no-motion
2243 "\t" mh-next-button 2104 "\t" mh-index-next-folder
2244 [backtab] mh-prev-button 2105 [backtab] mh-index-previous-folder
2245 "\M-\t" mh-prev-button 2106 "\M-\t" mh-index-previous-folder
2246 "\e<" mh-first-msg 2107 "\e<" mh-first-msg
2247 "\e>" mh-last-msg 2108 "\e>" mh-last-msg
2248 "\ed" mh-redistribute 2109 "\ed" mh-redistribute
2249 "\r" mh-show 2110 "\r" mh-show
2250 "^" mh-alt-refile-msg 2111 "^" mh-alt-refile-msg
2251 "c" mh-copy-msg 2112 "c" mh-copy-msg
2252 "d" mh-delete-msg 2113 "d" mh-delete-msg
2253 "e" mh-edit-again 2114 "e" mh-edit-again
2254 "f" mh-forward 2115 "f" mh-forward
2255 "g" mh-goto-msg 2116 "g" mh-goto-msg
2256 "i" mh-inc-folder 2117 "i" mh-inc-folder
2257 "k" mh-delete-subject 2118 "k" mh-delete-subject-or-thread
2258 "l" mh-print-msg 2119 "l" mh-print-msg
2259 "m" mh-alt-send 2120 "m" mh-alt-send
2260 "n" mh-next-undeleted-msg 2121 "n" mh-next-undeleted-msg
2261 "o" mh-refile-msg 2122 "\M-n" mh-next-unread-msg
2262 "p" mh-previous-undeleted-msg 2123 "o" mh-refile-msg
2263 "q" mh-quit 2124 "p" mh-previous-undeleted-msg
2264 "r" mh-reply 2125 "\M-p" mh-previous-unread-msg
2265 "s" mh-send 2126 "q" mh-quit
2266 "t" mh-toggle-showing 2127 "r" mh-reply
2267 "u" mh-undo 2128 "s" mh-send
2268 "x" mh-execute-commands 2129 "t" mh-toggle-showing
2269 "|" mh-pipe-msg) 2130 "u" mh-undo
2131 "v" mh-index-visit-folder
2132 "x" mh-execute-commands
2133 "|" mh-pipe-msg)
2270 2134
2271(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) 2135(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2272 "?" mh-prefix-help 2136 "?" mh-prefix-help
2273 "S" mh-sort-folder 2137 "S" mh-sort-folder
2274 "f" mh-alt-visit-folder 2138 "f" mh-alt-visit-folder
2275 "i" mh-index-search 2139 "i" mh-index-search
2276 "k" mh-kill-folder 2140 "k" mh-kill-folder
2277 "l" mh-list-folders 2141 "l" mh-list-folders
2278 "o" mh-alt-visit-folder 2142 "o" mh-alt-visit-folder
2279 "p" mh-pack-folder 2143 "p" mh-pack-folder
2280 "r" mh-rescan-folder 2144 "r" mh-rescan-folder
2281 "s" mh-search-folder 2145 "s" mh-search-folder
2282 "u" mh-undo-folder 2146 "u" mh-undo-folder
2283 "v" mh-visit-folder) 2147 "v" mh-visit-folder)
2284 2148
2285(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) 2149(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2286 "?" mh-prefix-help 2150 "?" mh-prefix-help
2287 "d" mh-delete-msg-from-seq 2151 "d" mh-delete-msg-from-seq
2288 "k" mh-delete-seq 2152 "k" mh-delete-seq
2289 "l" mh-list-sequences 2153 "l" mh-list-sequences
2290 "n" mh-narrow-to-seq 2154 "n" mh-narrow-to-seq
2291 "p" mh-put-msg-in-seq 2155 "p" mh-put-msg-in-seq
2292 "s" mh-msg-is-in-seq 2156 "s" mh-msg-is-in-seq
2293 "w" mh-widen) 2157 "w" mh-widen)
2294 2158
2295(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) 2159(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
2296 "?" mh-prefix-help 2160 "?" mh-prefix-help
2297 "t" mh-toggle-threads) 2161 "u" mh-thread-ancestor
2162 "p" mh-thread-previous-sibling
2163 "n" mh-thread-next-sibling
2164 "t" mh-toggle-threads
2165 "d" mh-thread-delete
2166 "o" mh-thread-refile)
2298 2167
2299(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) 2168(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2300 "?" mh-prefix-help 2169 "?" mh-prefix-help
2301 "s" mh-narrow-to-subject 2170 "s" mh-narrow-to-subject
2302 "w" mh-widen) 2171 "w" mh-widen)
2303 2172
2304(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) 2173(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
2305 "?" mh-prefix-help 2174 "?" mh-prefix-help
2306 "s" mh-store-msg ;shar 2175 "s" mh-store-msg ;shar
2307 "u" mh-store-msg) ;uuencode 2176 "u" mh-store-msg) ;uuencode
2308 2177
2309(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) 2178(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
2310 " " mh-page-digest 2179 " " mh-page-digest
2311 "?" mh-prefix-help 2180 "?" mh-prefix-help
2312 "\177" mh-page-digest-backwards 2181 "\177" mh-page-digest-backwards
2313 "b" mh-burst-digest) 2182 "b" mh-burst-digest)
2314 2183
2315(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) 2184(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
2316 "?" mh-prefix-help 2185 "?" mh-prefix-help
2317 "a" mh-mime-save-parts 2186 "a" mh-mime-save-parts
2318 "i" mh-folder-inline-mime-part 2187 "i" mh-folder-inline-mime-part
2319 "o" mh-folder-save-mime-part 2188 "o" mh-folder-save-mime-part
2320 "v" mh-folder-toggle-mime-part 2189 "v" mh-folder-toggle-mime-part
@@ -2345,23 +2214,23 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2345;;; `F' entry, it would not be clear what these commands operated upon. 2214;;; `F' entry, it would not be clear what these commands operated upon.
2346(defvar mh-help-messages 2215(defvar mh-help-messages
2347 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" 2216 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
2348 "[d]elete, [o]refile, e[x]ecute,\n" 2217 "[d]elete, [o]refile, e[x]ecute,\n"
2349 "[s]end, [r]eply.\n" 2218 "[s]end, [r]eply.\n"
2350 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, " 2219 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
2351 "[T]hread, / Limit, e[X]tract, [D]igest.") 2220 "[T]hread, / Limit, e[X]tract, [D]igest.")
2352 2221
2353 (?F "[l]ist, [v]isit folder;\n" 2222 (?F "[l]ist, [v]isit folder;\n"
2354 "[t]hread; [s]earch; [i]ndexed search;\n" 2223 "[t]hread; [s]earch; [i]ndexed search;\n"
2355 "[p]ack; [S]ort; [r]escan; [k]ill") 2224 "[p]ack; [S]ort; [r]escan; [k]ill")
2356 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" 2225 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
2357 "[s]equences, [l]ist,\n" 2226 "[s]equences, [l]ist,\n"
2358 "[d]elete message from sequence, [k]ill sequence") 2227 "[d]elete message from sequence, [k]ill sequence")
2359 (?T "[t]oggle thread") 2228 (?T "[t]oggle, [d]elete, [o]refile thread")
2360 (?/ "Limit to [s]ubject; [w]iden") 2229 (?/ "Limit to [s]ubject; [w]iden")
2361 (?X "un[s]har, [u]udecode message") 2230 (?X "un[s]har, [u]udecode message")
2362 (?D "[b]urst digest") 2231 (?D "[b]urst digest")
2363 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" 2232 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
2364 "[TAB] next; [SHIFT-TAB] previous")) 2233 "[TAB] next; [SHIFT-TAB] previous"))
2365 "Key binding cheat sheet. 2234 "Key binding cheat sheet.
2366 2235
2367This is an associative array which is used to show the most common commands. 2236This is an associative array which is used to show the most common commands.
@@ -2375,175 +2244,14 @@ well.")
2375 2244
2376 2245
2377 2246
2378;;; autoload the other MH-E parts
2379
2380;;; mh-comp
2381
2382(autoload 'mh-smail "mh-comp"
2383 "Compose and send mail with the MH mail system.
2384This function is an entry point to MH-E, the Emacs front end
2385to the MH mail system.
2386See documentation of `\\[mh-send]' for more details on composing mail." t)
2387
2388(autoload 'mh-smail-other-window "mh-comp"
2389 "Compose and send mail in other window with the MH mail system.
2390This function is an entry point to MH-E, the Emacs front end
2391to the MH mail system.
2392See documentation of `\\[mh-send]' for more details on composing mail." t)
2393
2394(autoload 'mh-edit-again "mh-comp"
2395 "Clean-up a draft or a message previously sent and make it resendable.
2396Default is the current message.
2397The variable mh-new-draft-cleaned-headers specifies the headers to remove.
2398See also documentation for `\\[mh-send]' function." t)
2399
2400(autoload 'mh-extract-rejected-mail "mh-comp"
2401 "Extract a letter returned by the mail system and make it resendable.
2402Default is the current message. The variable mh-new-draft-cleaned-headers
2403gives the headers to clean out of the original message.
2404See also documentation for `\\[mh-send]' function." t)
2405
2406(autoload 'mh-forward "mh-comp"
2407 "Forward a message or message sequence. Defaults to displayed message.
2408If optional prefix argument provided, then prompt for the message sequence.
2409See also documentation for `\\[mh-send]' function." t)
2410
2411(autoload 'mh-redistribute "mh-comp"
2412 "Redistribute a letter.
2413Depending on how your copy of MH was compiled, you may need to change the
2414setting of the variable mh-redist-full-contents. See its documentation." t)
2415
2416(autoload 'mh-send "mh-comp"
2417 "Compose and send a letter.
2418The file named by `mh-comp-formfile' will be used as the form.
2419Do not call this function from outside MH-E; use \\[mh-smail] instead.
2420The letter is composed in mh-letter-mode; see its documentation for more
2421details. If `mh-compose-letter-function' is defined, it is called on the
2422draft and passed three arguments: to, subject, and cc." t)
2423
2424(autoload 'mh-send-other-window "mh-comp"
2425 "Compose and send a letter in another window.
2426Do not call this function from outside MH-E;
2427use \\[mh-smail-other-window] instead.
2428See also documentation for `\\[mh-send]' function." t)
2429
2430(autoload 'mh-letter-mode "mh-comp"
2431 "Mode for composing letters in MH-E.
2432For more details, type \\[describe-mode] while in MH-Letter mode." t)
2433
2434;;; mh-funcs
2435
2436(autoload 'mh-burst-digest "mh-funcs"
2437 "Burst apart the current message, which should be a digest.
2438The message is replaced by its table of contents and the messages from the
2439digest are inserted into the folder after that message." t)
2440
2441(autoload 'mh-copy-msg "mh-funcs"
2442 "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
2443Default is the displayed message. If optional prefix argument is
2444provided, then prompt for the message sequence." t)
2445
2446(autoload 'mh-kill-folder "mh-funcs"
2447 "Remove the current folder." t)
2448
2449(autoload 'mh-list-folders "mh-funcs"
2450 "List mail folders." t)
2451
2452(autoload 'mh-pack-folder "mh-funcs"
2453 "Renumber the messages of a folder to be 1..n.
2454First, offer to execute any outstanding commands for the current folder.
2455If optional prefix argument provided, prompt for the range of messages
2456to display after packing. Otherwise, show the entire folder." t)
2457
2458(autoload 'mh-pipe-msg "mh-funcs"
2459 "Pipe the current message through the given shell COMMAND.
2460If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
2461Otherwise just send the message's body without the headers." t)
2462
2463(autoload 'mh-page-digest "mh-funcs"
2464 "Advance displayed message to next digested message." t)
2465
2466(autoload 'mh-page-digest-backwards "mh-funcs"
2467 "Back up displayed message to previous digested message." t)
2468
2469(autoload 'mh-print-msg "mh-funcs"
2470 "Print MESSAGE(s) (default: displayed message) on printer.
2471If optional prefix argument provided, then prompt for the message sequence.
2472The variable mh-lpr-command-format is used to generate the print command.
2473The messages are formatted by mhl. See the variable mhl-formfile." t)
2474
2475(autoload 'mh-sort-folder "mh-funcs"
2476 "Sort the messages in the current folder by date.
2477Calls the MH program sortm to do the work.
2478The arguments in the list mh-sortm-args are passed to sortm
2479if this function is passed an argument." t)
2480
2481(autoload 'mh-store-msg "mh-funcs"
2482 "Store the file(s) contained in the current message into DIRECTORY.
2483The message can contain a shar file or uuencoded file.
2484Default directory is the last directory used, or initially the value of
2485mh-store-default-directory or the current directory." t)
2486
2487(autoload 'mh-store-buffer "mh-funcs"
2488 "Store the file(s) contained in the current buffer into DIRECTORY.
2489The buffer can contain a shar file or uuencoded file.
2490Default directory is the last directory used, or initially the value of
2491`mh-store-default-directory' or the current directory." t)
2492
2493(autoload 'mh-help "mh-funcs"
2494 "Display cheat sheet for MH-E commands in minibuffer." t)
2495
2496(autoload 'mh-prefix-help "mh-funcs"
2497 "Display cheat sheet for the commands of the current prefix in minibuffer."
2498 t)
2499
2500;;; mh-pick
2501
2502(autoload 'mh-search-folder "mh-pick"
2503 "Search FOLDER for messages matching a pattern.
2504Add the messages found to the sequence named `search'." t)
2505
2506;;; mh-seq
2507
2508(autoload 'mh-region-to-sequence "mh-seq"
2509 "Define sequence 'region as the messages in selected region." t)
2510(autoload 'mh-delete-seq "mh-seq"
2511 "Delete the SEQUENCE." t)
2512(autoload 'mh-list-sequences "mh-seq"
2513 "List the sequences defined in FOLDER." t)
2514(autoload 'mh-msg-is-in-seq "mh-seq"
2515 "Display the sequences that contain MESSAGE (default: displayed message)." t)
2516(autoload 'mh-narrow-to-seq "mh-seq"
2517 "Restrict display of this folder to just messages in SEQUENCE
2518Use \\[mh-widen] to undo this command." t)
2519(autoload 'mh-put-msg-in-seq "mh-seq"
2520 "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
2521If optional prefix argument provided, then prompt for the message sequence." t)
2522(autoload 'mh-rename-seq "mh-seq"
2523 "Rename SEQUENCE to have NEW-NAME." t)
2524(autoload 'mh-narrow-to-subject "mh-seq"
2525 "Narrow to a sequence containing all following messages with same subject."
2526 t)
2527(autoload 'mh-toggle-threads "mh-seq"
2528 "Toggle threaded view of folder." t)
2529(autoload 'mh-delete-subject "mh-seq"
2530 "Mark all following messages with same subject to be deleted." t)
2531
2532;;; mh-speed
2533
2534(autoload 'mh-folder-speedbar-buttons "mh-speed")
2535(autoload 'mh-show-speedbar-buttons "mh-speed")
2536(autoload 'mh-index-folder-speedbar-buttons "mh-speed")
2537(autoload 'mh-index-show-speedbar-buttons "mh-speed")
2538(autoload 'mh-letter-speedbar-buttons "mh-speed")
2539
2540(dolist (mess '("^Cursor not pointing to message$" 2247(dolist (mess '("^Cursor not pointing to message$"
2541 "^There is no other window$")) 2248 "^There is no other window$"))
2542 (add-to-list 'debug-ignored-errors mess)) 2249 (add-to-list 'debug-ignored-errors mess))
2543 2250
2544(provide 'mh-e) 2251(provide 'mh-e)
2545 2252
2546;;; Local Variables: 2253;;; Local Variables:
2254;;; indent-tabs-mode: nil
2547;;; sentence-end-double-space: nil 2255;;; sentence-end-double-space: nil
2548;;; End: 2256;;; End:
2549 2257
diff --git a/lisp/mail/mh-funcs.el b/lisp/mail/mh-funcs.el
index e092b7554f6..b14039170f1 100644
--- a/lisp/mail/mh-funcs.el
+++ b/lisp/mail/mh-funcs.el
@@ -32,17 +32,13 @@
32 32
33;;; Change Log: 33;;; Change Log:
34 34
35;; $Id: mh-funcs.el,v 1.28 2002/11/11 23:01:27 mbaushke Exp $ 35;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $
36 36
37;;; Code: 37;;; Code:
38 38
39(require 'mh-e) 39(require 'mh-e)
40 40
41;;; autoload 41;;; Customization
42(autoload 'mh-notate-seq "mh-seq")
43(autoload 'mh-speed-invalidate-map "mh-speed")
44
45;;; customization
46 42
47(defvar mh-sortm-args nil 43(defvar mh-sortm-args nil
48 "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. 44 "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
@@ -59,6 +55,7 @@ For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
59 55
60;;; Functions 56;;; Functions
61 57
58;;;###mh-autoload
62(defun mh-burst-digest () 59(defun mh-burst-digest ()
63 "Burst apart the current message, which should be a digest. 60 "Burst apart the current message, which should be a digest.
64The message is replaced by its table of contents and the messages from the 61The message is replaced by its table of contents and the messages from the
@@ -66,7 +63,7 @@ digest are inserted into the folder after that message."
66 (interactive) 63 (interactive)
67 (let ((digest (mh-get-msg-num t))) 64 (let ((digest (mh-get-msg-num t)))
68 (mh-process-or-undo-commands mh-current-folder) 65 (mh-process-or-undo-commands mh-current-folder)
69 (mh-set-folder-modified-p t) ; lock folder while bursting 66 (mh-set-folder-modified-p t) ; lock folder while bursting
70 (message "Bursting digest...") 67 (message "Bursting digest...")
71 (mh-exec-cmd "burst" mh-current-folder digest "-inplace") 68 (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
72 (with-mh-folder-updating (t) 69 (with-mh-folder-updating (t)
@@ -76,19 +73,29 @@ digest are inserted into the folder after that message."
76 (mh-goto-cur-msg) 73 (mh-goto-cur-msg)
77 (message "Bursting digest...done"))) 74 (message "Bursting digest...done")))
78 75
76;;;###mh-autoload
79(defun mh-copy-msg (msg-or-seq folder) 77(defun mh-copy-msg (msg-or-seq folder)
80 "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. 78 "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
81Default is the displayed message. If optional prefix argument is provided, 79Default is the displayed message. If optional prefix argument is provided,
82then prompt for the message sequence." 80then prompt for the message sequence."
83 (interactive (list (if current-prefix-arg 81 (interactive (list (cond
84 (mh-read-seq-default "Copy" t) 82 ((mh-mark-active-p t)
85 (mh-get-msg-num t)) 83 (mh-region-to-msg-list (region-beginning) (region-end)))
86 (mh-prompt-for-folder "Copy to" "" t))) 84 (current-prefix-arg
87 (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) 85 (mh-read-seq-default "Copy" t))
86 (t
87 (mh-get-msg-num t)))
88 (mh-prompt-for-folder "Copy to" "" t)))
89 (mh-exec-cmd "refile"
90 (cond ((numberp msg-or-seq) msg-or-seq)
91 ((listp msg-or-seq) msg-or-seq)
92 (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
93 "-link" "-src" mh-current-folder folder)
88 (if (numberp msg-or-seq) 94 (if (numberp msg-or-seq)
89 (mh-notate msg-or-seq mh-note-copied mh-cmd-note) 95 (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
90 (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) 96 (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
91 97
98;;;###mh-autoload
92(defun mh-kill-folder () 99(defun mh-kill-folder ()
93 "Remove the current folder and all included messages. 100 "Remove the current folder and all included messages.
94Removes all of the messages (files) within the specified current folder, 101Removes all of the messages (files) within the specified current folder,
@@ -99,54 +106,60 @@ with no arguments, after the folders has been removed."
99 (if (yes-or-no-p (format "Remove folder %s (and all included messages)?" 106 (if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
100 mh-current-folder)) 107 mh-current-folder))
101 (let ((folder mh-current-folder)) 108 (let ((folder mh-current-folder))
102 (if (null mh-folder-list) 109 (if (null mh-folder-list)
103 (mh-set-folder-list)) 110 (mh-set-folder-list))
104 (mh-set-folder-modified-p t) ; lock folder to kill it 111 (mh-set-folder-modified-p t) ; lock folder to kill it
105 (mh-exec-cmd-daemon "rmf" folder) 112 (mh-exec-cmd-daemon "rmf" folder)
106 (setq mh-folder-list 113 (setq mh-folder-list
107 (delq (assoc folder mh-folder-list) mh-folder-list)) 114 (delq (assoc folder mh-folder-list) mh-folder-list))
108 (when (boundp 'mh-speed-folder-map) 115 (when (boundp 'mh-speed-folder-map)
109 (mh-speed-invalidate-map folder)) 116 (mh-speed-invalidate-map folder))
110 (run-hooks 'mh-folder-list-change-hook) 117 (run-hooks 'mh-folder-list-change-hook)
111 (message "Folder %s removed" folder) 118 (message "Folder %s removed" folder)
112 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain 119 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
113 (if (get-buffer mh-show-buffer) 120 (if (get-buffer mh-show-buffer)
114 (kill-buffer mh-show-buffer)) 121 (kill-buffer mh-show-buffer))
115 (if (get-buffer folder) 122 (if (get-buffer folder)
116 (kill-buffer folder))) 123 (kill-buffer folder)))
117 (message "Folder not removed"))) 124 (message "Folder not removed")))
118 125
119;; Avoid compiler warning... 126;; Avoid compiler warning...
120(defvar view-exit-action) 127(defvar view-exit-action)
121 128
129;;;###mh-autoload
122(defun mh-list-folders () 130(defun mh-list-folders ()
123 "List mail folders." 131 "List mail folders."
124 (interactive) 132 (interactive)
125 (let ((temp-buffer mh-temp-folders-buffer)) 133 (let ((temp-buffer mh-temp-folders-buffer))
126 (with-output-to-temp-buffer temp-buffer 134 (with-output-to-temp-buffer temp-buffer
127 (save-excursion 135 (save-excursion
128 (set-buffer temp-buffer) 136 (set-buffer temp-buffer)
129 (erase-buffer) 137 (erase-buffer)
130 (message "Listing folders...") 138 (message "Listing folders...")
131 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag 139 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
132 "-recurse" 140 "-recurse"
133 "-norecurse")) 141 "-norecurse"))
134 (goto-char (point-min)) 142 (goto-char (point-min))
135 (view-mode 1) 143 (view-mode 1)
136 (setq view-exit-action 'kill-buffer) 144 (setq view-exit-action 'kill-buffer)
137 (message "Listing folders...done"))))) 145 (message "Listing folders...done")))))
138 146
147;;;###mh-autoload
139(defun mh-pack-folder (range) 148(defun mh-pack-folder (range)
140 "Renumber the messages of a folder to be 1..n. 149 "Renumber the messages of a folder to be 1..n.
141First, offer to execute any outstanding commands for the current folder. If 150First, offer to execute any outstanding commands for the current folder. If
142optional prefix argument provided, prompt for the RANGE of messages to display 151optional prefix argument provided, prompt for the RANGE of messages to display
143after packing. Otherwise, show the entire folder." 152after packing. Otherwise, show the entire folder."
144 (interactive (list (if current-prefix-arg 153 (interactive (list (if current-prefix-arg
145 (mh-read-msg-range 154 (mh-read-msg-range mh-current-folder t)
146 "Range to scan after packing [all]? ") 155 '("all"))))
147 "all"))) 156 (let ((threaded-flag (memq 'unthread mh-view-ops)))
148 (mh-pack-folder-1 range) 157 (mh-pack-folder-1 range)
149 (mh-goto-cur-msg) 158 (mh-goto-cur-msg)
159 (when mh-index-data
160 (mh-index-update-maps mh-current-folder))
161 (cond (threaded-flag (mh-toggle-threads))
162 (mh-index-data (mh-index-insert-folder-headers))))
150 (message "Packing folder...done")) 163 (message "Packing folder...done"))
151 164
152(defun mh-pack-folder-1 (range) 165(defun mh-pack-folder-1 (range)
@@ -155,13 +168,14 @@ Display the given RANGE of messages after packing. If RANGE is nil, show the
155entire folder." 168entire folder."
156 (mh-process-or-undo-commands mh-current-folder) 169 (mh-process-or-undo-commands mh-current-folder)
157 (message "Packing folder...") 170 (message "Packing folder...")
158 (mh-set-folder-modified-p t) ; lock folder while packing 171 (mh-set-folder-modified-p t) ; lock folder while packing
159 (save-excursion 172 (save-excursion
160 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" 173 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
161 "-norecurse" "-fast")) 174 "-norecurse" "-fast"))
162 (mh-reset-threads-and-narrowing) 175 (mh-reset-threads-and-narrowing)
163 (mh-regenerate-headers range)) 176 (mh-regenerate-headers range))
164 177
178;;;###mh-autoload
165(defun mh-pipe-msg (command include-headers) 179(defun mh-pipe-msg (command include-headers)
166 "Pipe the current message through the given shell COMMAND. 180 "Pipe the current message through the given shell COMMAND.
167If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. 181If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
@@ -169,7 +183,7 @@ Otherwise just send the message's body without the headers."
169 (interactive 183 (interactive
170 (list (read-string "Shell command on message: ") current-prefix-arg)) 184 (list (read-string "Shell command on message: ") current-prefix-arg))
171 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) 185 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
172 (message-directory default-directory)) 186 (message-directory default-directory))
173 (save-excursion 187 (save-excursion
174 (set-buffer (get-buffer-create mh-temp-buffer)) 188 (set-buffer (get-buffer-create mh-temp-buffer))
175 (erase-buffer) 189 (erase-buffer)
@@ -177,8 +191,9 @@ Otherwise just send the message's body without the headers."
177 (goto-char (point-min)) 191 (goto-char (point-min))
178 (if (not include-headers) (search-forward "\n\n")) 192 (if (not include-headers) (search-forward "\n\n"))
179 (let ((default-directory message-directory)) 193 (let ((default-directory message-directory))
180 (shell-command-on-region (point) (point-max) command nil))))) 194 (shell-command-on-region (point) (point-max) command nil)))))
181 195
196;;;###mh-autoload
182(defun mh-page-digest () 197(defun mh-page-digest ()
183 "Advance displayed message to next digested message." 198 "Advance displayed message to next digested message."
184 (interactive) 199 (interactive)
@@ -188,13 +203,14 @@ Otherwise just send the message's body without the headers."
188 (let ((case-fold-search nil)) 203 (let ((case-fold-search nil))
189 ;; Search for blank line and then for From: 204 ;; Search for blank line and then for From:
190 (or (and (search-forward "\n\n" nil t) 205 (or (and (search-forward "\n\n" nil t)
191 (re-search-forward "^From:" nil t)) 206 (re-search-forward "^From:" nil t))
192 (error "No more messages in digest"))) 207 (error "No more messages in digest")))
193 ;; Go back to previous blank line, then forward to the first non-blank. 208 ;; Go back to previous blank line, then forward to the first non-blank.
194 (search-backward "\n\n" nil t) 209 (search-backward "\n\n" nil t)
195 (forward-line 2) 210 (forward-line 2)
196 (mh-recenter 0))) 211 (mh-recenter 0)))
197 212
213;;;###mh-autoload
198(defun mh-page-digest-backwards () 214(defun mh-page-digest-backwards ()
199 "Back up displayed message to previous digested message." 215 "Back up displayed message to previous digested message."
200 (interactive) 216 (interactive)
@@ -204,66 +220,68 @@ Otherwise just send the message's body without the headers."
204 (let ((case-fold-search nil)) 220 (let ((case-fold-search nil))
205 (beginning-of-line) 221 (beginning-of-line)
206 (or (and (search-backward "\n\n" nil t) 222 (or (and (search-backward "\n\n" nil t)
207 (re-search-backward "^From:" nil t)) 223 (re-search-backward "^From:" nil t))
208 (error "No previous message in digest"))) 224 (error "No previous message in digest")))
209 ;; Go back to previous blank line, then forward to the first non-blank. 225 ;; Go back to previous blank line, then forward to the first non-blank.
210 (if (search-backward "\n\n" nil t) 226 (if (search-backward "\n\n" nil t)
211 (forward-line 2)) 227 (forward-line 2))
212 (mh-recenter 0))) 228 (mh-recenter 0)))
213 229
230;;;###mh-autoload
214(defun mh-print-msg (msg-or-seq) 231(defun mh-print-msg (msg-or-seq)
215 "Print MSG-OR-SEQ (default: displayed message) on printer. 232 "Print MSG-OR-SEQ (default: displayed message) on printer.
216If optional prefix argument provided, then prompt for the message sequence. 233If optional prefix argument provided, then prompt for the message sequence.
217The variable `mh-lpr-command-format' is used to generate the print command. 234The variable `mh-lpr-command-format' is used to generate the print command.
218The messages are formatted by mhl. See the variable `mhl-formfile'." 235The messages are formatted by mhl. See the variable `mhl-formfile'."
219 (interactive (list (if current-prefix-arg 236 (interactive (list (if current-prefix-arg
220 (reverse (mh-seq-to-msgs 237 (reverse (mh-seq-to-msgs
221 (mh-read-seq-default "Print" t))) 238 (mh-read-seq-default "Print" t)))
222 (mh-get-msg-num t)))) 239 (mh-get-msg-num t))))
223 (if (numberp msg-or-seq) 240 (if (numberp msg-or-seq)
224 (message "Printing message...") 241 (message "Printing message...")
225 (message "Printing sequence...")) 242 (message "Printing sequence..."))
226 (let ((print-command 243 (let ((print-command
227 (if (numberp msg-or-seq) 244 (if (numberp msg-or-seq)
228 (format "%s -nobell -clear %s %s | %s" 245 (format "%s -nobell -clear %s %s | %s"
229 (expand-file-name "mhl" mh-lib-progs) 246 (expand-file-name "mhl" mh-lib-progs)
230 (mh-msg-filename msg-or-seq) 247 (mh-msg-filename msg-or-seq)
231 (if (stringp mhl-formfile) 248 (if (stringp mhl-formfile)
232 (format "-form %s" mhl-formfile) 249 (format "-form %s" mhl-formfile)
233 "") 250 "")
234 (format mh-lpr-command-format 251 (format mh-lpr-command-format
235 (if (numberp msg-or-seq) 252 (if (numberp msg-or-seq)
236 (format "%s/%d" mh-current-folder 253 (format "%s/%d" mh-current-folder
237 msg-or-seq) 254 msg-or-seq)
238 (format "Sequence from %s" mh-current-folder)))) 255 (format "Sequence from %s" mh-current-folder))))
239 (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" 256 (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
240 (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") 257 (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
241 (expand-file-name "mhl" mh-lib-progs) 258 (expand-file-name "mhl" mh-lib-progs)
242 (if (stringp mhl-formfile) 259 (if (stringp mhl-formfile)
243 (format "-form %s" mhl-formfile) 260 (format "-form %s" mhl-formfile)
244 "") 261 "")
245 (mh-msg-filenames msg-or-seq) 262 (mh-msg-filenames msg-or-seq)
246 (format mh-lpr-command-format 263 (format mh-lpr-command-format
247 (if (numberp msg-or-seq) 264 (if (numberp msg-or-seq)
248 (format "%s/%d" mh-current-folder 265 (format "%s/%d" mh-current-folder
249 msg-or-seq) 266 msg-or-seq)
250 (format "Sequence from %s" 267 (format "Sequence from %s"
251 mh-current-folder))))))) 268 mh-current-folder)))))))
252 (if mh-print-background-flag 269 (if mh-print-background-flag
253 (mh-exec-cmd-daemon shell-file-name "-c" print-command) 270 (mh-exec-cmd-daemon shell-file-name "-c" print-command)
254 (call-process shell-file-name nil nil nil "-c" print-command)) 271 (call-process shell-file-name nil nil nil "-c" print-command))
255 (if (numberp msg-or-seq) 272 (if (numberp msg-or-seq)
256 (mh-notate msg-or-seq mh-note-printed mh-cmd-note) 273 (mh-notate msg-or-seq mh-note-printed mh-cmd-note)
257 (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) 274 (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
258 (mh-add-msgs-to-seq msg-or-seq 'printed t) 275 (mh-add-msgs-to-seq msg-or-seq 'printed t)
259 (if (numberp msg-or-seq) 276 (if (numberp msg-or-seq)
260 (message "Printing message...done") 277 (message "Printing message...done")
261 (message "Printing sequence...done")))) 278 (message "Printing sequence...done"))))
262 279
263(defun mh-msg-filenames (msgs &optional folder) 280(defun mh-msg-filenames (msgs &optional folder)
264 "Return a list of file names for MSGS in FOLDER (default current folder)." 281 "Return a list of file names for MSGS in FOLDER (default current folder)."
265 (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) 282 (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
266 283
284;;;###mh-autoload
267(defun mh-sort-folder (&optional extra-args) 285(defun mh-sort-folder (&optional extra-args)
268 "Sort the messages in the current folder by date. 286 "Sort the messages in the current folder by date.
269Calls the MH program sortm to do the work. 287Calls the MH program sortm to do the work.
@@ -272,36 +290,45 @@ argument EXTRA-ARGS is given."
272 (interactive "P") 290 (interactive "P")
273 (mh-process-or-undo-commands mh-current-folder) 291 (mh-process-or-undo-commands mh-current-folder)
274 (setq mh-next-direction 'forward) 292 (setq mh-next-direction 'forward)
275 (mh-set-folder-modified-p t) ; lock folder while sorting 293 (mh-set-folder-modified-p t) ; lock folder while sorting
276 (message "Sorting folder...") 294 (message "Sorting folder...")
277 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) 295 (let ((threaded-flag (memq 'unthread mh-view-ops)))
278 (message "Sorting folder...done") 296 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
279 (mh-scan-folder mh-current-folder "all")) 297 (when mh-index-data
280 298 (mh-index-update-maps mh-current-folder))
299 (message "Sorting folder...done")
300 (mh-reset-threads-and-narrowing)
301 (mh-scan-folder mh-current-folder "all")
302 (cond (threaded-flag (mh-toggle-threads))
303 (mh-index-data (mh-index-insert-folder-headers)))))
304
305;;;###mh-autoload
281(defun mh-undo-folder (&rest ignore) 306(defun mh-undo-folder (&rest ignore)
282 "Undo all pending deletes and refiles in current folder. 307 "Undo all pending deletes and refiles in current folder.
283Argument IGNORE is deprecated." 308Argument IGNORE is deprecated."
284 (interactive) 309 (interactive)
285 (cond ((or mh-do-not-confirm-flag 310 (cond ((or mh-do-not-confirm-flag
286 (yes-or-no-p "Undo all commands in folder? ")) 311 (yes-or-no-p "Undo all commands in folder? "))
287 (setq mh-delete-list nil 312 (setq mh-delete-list nil
288 mh-refile-list nil 313 mh-refile-list nil
289 mh-seq-list nil 314 mh-seq-list nil
290 mh-next-direction 'forward) 315 mh-next-direction 'forward)
291 (with-mh-folder-updating (nil) 316 (with-mh-folder-updating (nil)
292 (mh-unmark-all-headers t))) 317 (mh-unmark-all-headers t)))
293 (t 318 (t
294 (message "Commands not undone.") 319 (message "Commands not undone.")
295 (sit-for 2)))) 320 (sit-for 2))))
296 321
322;;;###mh-autoload
297(defun mh-store-msg (directory) 323(defun mh-store-msg (directory)
298 "Store the file(s) contained in the current message into DIRECTORY. 324 "Store the file(s) contained in the current message into DIRECTORY.
299The message can contain a shar file or uuencoded file. 325The message can contain a shar file or uuencoded file.
300Default directory is the last directory used, or initially the value of 326Default directory is the last directory used, or initially the value of
301`mh-store-default-directory' or the current directory." 327`mh-store-default-directory' or the current directory."
302 (interactive (list (let ((udir (or mh-store-default-directory default-directory))) 328 (interactive (list (let ((udir (or mh-store-default-directory
303 (read-file-name "Store message in directory: " 329 default-directory)))
304 udir udir nil)))) 330 (read-file-name "Store message in directory: "
331 udir udir nil))))
305 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) 332 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
306 (save-excursion 333 (save-excursion
307 (set-buffer (get-buffer-create mh-temp-buffer)) 334 (set-buffer (get-buffer-create mh-temp-buffer))
@@ -309,58 +336,59 @@ Default directory is the last directory used, or initially the value of
309 (insert-file-contents msg-file-to-store) 336 (insert-file-contents msg-file-to-store)
310 (mh-store-buffer directory)))) 337 (mh-store-buffer directory))))
311 338
339;;;###mh-autoload
312(defun mh-store-buffer (directory) 340(defun mh-store-buffer (directory)
313 "Store the file(s) contained in the current buffer into DIRECTORY. 341 "Store the file(s) contained in the current buffer into DIRECTORY.
314The buffer can contain a shar file or uuencoded file. 342The buffer can contain a shar file or uuencoded file.
315Default directory is the last directory used, or initially the value of 343Default directory is the last directory used, or initially the value of
316`mh-store-default-directory' or the current directory." 344`mh-store-default-directory' or the current directory."
317 (interactive (list (let ((udir (or mh-store-default-directory 345 (interactive (list (let ((udir (or mh-store-default-directory
318 default-directory))) 346 default-directory)))
319 (read-file-name "Store buffer in directory: " 347 (read-file-name "Store buffer in directory: "
320 udir udir nil)))) 348 udir udir nil))))
321 (let ((store-directory (expand-file-name directory)) 349 (let ((store-directory (expand-file-name directory))
322 (sh-start (save-excursion 350 (sh-start (save-excursion
323 (goto-char (point-min)) 351 (goto-char (point-min))
324 (if (re-search-forward 352 (if (re-search-forward
325 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) 353 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
326 (progn 354 (progn
327 ;; The "cut here" pattern was removed from above 355 ;; The "cut here" pattern was removed from above
328 ;; because it seemed to hurt more than help. 356 ;; because it seemed to hurt more than help.
329 ;; But keep this to make it easier to put it back. 357 ;; But keep this to make it easier to put it back.
330 (if (looking-at "^[^a-z0-9\"]*cut here\\b") 358 (if (looking-at "^[^a-z0-9\"]*cut here\\b")
331 (forward-line 1)) 359 (forward-line 1))
332 (beginning-of-line) 360 (beginning-of-line)
333 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") 361 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
334 nil ;most likely end of a uuencode 362 nil ;most likely end of a uuencode
335 (point)))))) 363 (point))))))
336 (log-buffer (get-buffer-create "*Store Output*")) 364 (log-buffer (get-buffer-create "*Store Output*"))
337 (command "sh") 365 (command "sh")
338 (uudecode-filename "(unknown filename)")) 366 (uudecode-filename "(unknown filename)"))
339 (if (not sh-start) 367 (if (not sh-start)
340 (save-excursion 368 (save-excursion
341 (goto-char (point-min)) 369 (goto-char (point-min))
342 (if (re-search-forward "^begin [0-7]+ " nil t) 370 (if (re-search-forward "^begin [0-7]+ " nil t)
343 (setq uudecode-filename 371 (setq uudecode-filename
344 (buffer-substring (point) 372 (buffer-substring (point)
345 (progn (end-of-line) (point))))))) 373 (progn (end-of-line) (point)))))))
346 (save-excursion 374 (save-excursion
347 (set-buffer log-buffer) 375 (set-buffer log-buffer)
348 (erase-buffer) 376 (erase-buffer)
349 (if (not (file-directory-p store-directory)) 377 (if (not (file-directory-p store-directory))
350 (progn 378 (progn
351 (insert "mkdir " directory "\n") 379 (insert "mkdir " directory "\n")
352 (call-process "mkdir" nil log-buffer t store-directory))) 380 (call-process "mkdir" nil log-buffer t store-directory)))
353 (insert "cd " directory "\n") 381 (insert "cd " directory "\n")
354 (setq mh-store-default-directory directory) 382 (setq mh-store-default-directory directory)
355 (if (not sh-start) 383 (if (not sh-start)
356 (progn 384 (progn
357 (setq command "uudecode") 385 (setq command "uudecode")
358 (insert uudecode-filename " being uudecoded...\n")))) 386 (insert uudecode-filename " being uudecoded...\n"))))
359 (set-window-start (display-buffer log-buffer) 0) ;watch progress 387 (set-window-start (display-buffer log-buffer) 0) ;watch progress
360 (let (value) 388 (let (value)
361 (let ((default-directory (file-name-as-directory store-directory))) 389 (let ((default-directory (file-name-as-directory store-directory)))
362 (setq value (call-process-region sh-start (point-max) command 390 (setq value (call-process-region sh-start (point-max) command
363 nil log-buffer t))) 391 nil log-buffer t)))
364 (set-buffer log-buffer) 392 (set-buffer log-buffer)
365 (mh-handle-process-error command value)) 393 (mh-handle-process-error command value))
366 (insert "\n(mh-store finished)\n"))) 394 (insert "\n(mh-store finished)\n")))
@@ -375,13 +403,15 @@ Default directory is the last directory used, or initially the value of
375 (sit-for 5) 403 (sit-for 5)
376 (message "")) 404 (message ""))
377 405
406;;;###mh-autoload
378(defun mh-help () 407(defun mh-help ()
379 "Display cheat sheet for the MH-Folder commands in minibuffer." 408 "Display cheat sheet for the MH-Folder commands in minibuffer."
380 (interactive) 409 (interactive)
381 (mh-ephem-message 410 (mh-ephem-message
382 (substitute-command-keys 411 (substitute-command-keys
383 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) 412 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
384 413
414;;;###mh-autoload
385(defun mh-prefix-help () 415(defun mh-prefix-help ()
386 "Display cheat sheet for the commands of the current prefix in minibuffer." 416 "Display cheat sheet for the commands of the current prefix in minibuffer."
387 (interactive) 417 (interactive)
@@ -391,7 +421,7 @@ Default directory is the last directory used, or initially the value of
391 ;; length-2. We use that information to obtain a suitable prefix character 421 ;; length-2. We use that information to obtain a suitable prefix character
392 ;; from the recent keys. 422 ;; from the recent keys.
393 (let* ((keys (recent-keys)) 423 (let* ((keys (recent-keys))
394 (prefix-char (elt keys (- (length keys) 2)))) 424 (prefix-char (elt keys (- (length keys) 2))))
395 (mh-ephem-message 425 (mh-ephem-message
396 (substitute-command-keys 426 (substitute-command-keys
397 (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) 427 (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
@@ -399,6 +429,7 @@ Default directory is the last directory used, or initially the value of
399(provide 'mh-funcs) 429(provide 'mh-funcs)
400 430
401;;; Local Variables: 431;;; Local Variables:
432;;; indent-tabs-mode: nil
402;;; sentence-end-double-space: nil 433;;; sentence-end-double-space: nil
403;;; End: 434;;; End:
404 435
diff --git a/lisp/mail/mh-identity.el b/lisp/mail/mh-identity.el
new file mode 100644
index 00000000000..1347225a2ed
--- /dev/null
+++ b/lisp/mail/mh-identity.el
@@ -0,0 +1,219 @@
1;;; mh-identity.el --- Multiple Identify support for MH-E.
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Multiple identity support for MH-E.
30;;
31;; Used to easily set different fields such as From and Organization, as
32;; well as different signature files.
33;;
34;; Customize the variable `mh-identity-list' and an Identity menu will
35;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
36;; from the command line.
37
38;;; Change Log:
39
40;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $
41
42;;; Code:
43
44
45(require 'cl)
46
47(eval-when (compile load eval)
48 (defvar mh-comp-loaded nil)
49 (unless mh-comp-loaded
50 (setq mh-comp-loaded t)
51 (require 'mh-comp))) ;Since we do this on sending
52
53(autoload 'mml-insert-tag "mml")
54
55;;;###mh-autoload
56(defun mh-identity-make-menu ()
57 "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
58 (when (and mh-identity-list (boundp 'mh-letter-mode-map))
59 (easy-menu-define mh-identity-menu mh-letter-mode-map
60 "mh-e identity menu"
61 (append
62 '("Identity")
63 ;; Dynamically render :type corresponding to `mh-identity-list'
64 ;; e.g.:
65 ;; ["home" (mh-insert-identity "home")
66 ;; :style radio :active (not (equal mh-identity-local "home"))
67 ;; :selected (equal mh-identity-local "home")]
68 (mapcar (function
69 (lambda (arg)
70 `[,arg (mh-insert-identity ,arg) :style radio
71 :active (not (equal mh-identity-local ,arg))
72 :selected (equal mh-identity-local ,arg)]))
73 (mapcar 'car mh-identity-list))
74 '("--"
75 ["none" (mh-insert-identity "none") mh-identity-local]
76 ["Set Default for Session"
77 (setq mh-identity-default mh-identity-local) t]
78 ["Save as Default"
79 (customize-save-variable
80 'mh-identity-default mh-identity-local) t]
81 )))))
82
83;;;###mh-autoload
84(defun mh-identity-list-set (symbol value)
85 "Update the `mh-identity-list' variable, and rebuild the menu.
86Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
87customization). This is called after 'customize is used to alter
88`mh-identity-list'."
89 (set-default symbol value)
90 (mh-identity-make-menu))
91
92(defvar mh-identity-local nil
93 "Buffer-local variable holding the identity currently in use.")
94(make-variable-buffer-local 'mh-identity-local)
95
96(defun mh-header-field-delete (field value-only)
97 "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
98Return t if anything is deleted."
99 (when (mh-goto-header-field field)
100 (if (not value-only)
101 (beginning-of-line)
102 (forward-char))
103 (delete-region (point)
104 (progn (mh-header-field-end)
105 (if (not value-only) (forward-char 1))
106 (point)))
107 t))
108
109(defvar mh-identity-signature-start nil
110 "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
111(defvar mh-identity-signature-end nil
112 "Marker for the end of a signature inserted by `mh-insert-identity'.")
113
114;;;###mh-autoload
115(defun mh-insert-identity (identity)
116 "Insert proper fields for given IDENTITY.
117Edit the `mh-identity-list' variable to define identity."
118 (interactive
119 (list (completing-read
120 "Identity: "
121 (if mh-identity-local
122 (cons '("none")
123 (mapcar 'list (mapcar 'car mh-identity-list)))
124 (mapcar 'list (mapcar 'car mh-identity-list)))
125 nil t)))
126 (save-excursion
127 ;;First remove old settings, if any.
128 (when mh-identity-local
129 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
130 (while pers-list
131 (let ((field (concat (caar pers-list) ":")))
132 (cond
133 ((string-equal "signature:" field)
134 (when (and (boundp 'mh-identity-signature-start)
135 (markerp mh-identity-signature-start))
136 (goto-char mh-identity-signature-start)
137 (forward-char -1)
138 (delete-region (point) mh-identity-signature-end)))
139 ((mh-header-field-delete field nil))))
140 (setq pers-list (cdr pers-list)))))
141 ;; Then insert the replacement
142 (when (not (equal "none" identity))
143 (let ((pers-list (cadr (assoc identity mh-identity-list))))
144 (while pers-list
145 (let ((field (concat (caar pers-list) ":"))
146 (value (cdar pers-list)))
147 (cond
148 ;; No value, remove field
149 ((or (not value)
150 (string= value ""))
151 (mh-header-field-delete field nil))
152 ;; Existing field, replace
153 ((mh-header-field-delete field t)
154 (insert value))
155 ;; Handle "signature" special case. Insert file or call function.
156 ((and (string-equal "signature:" field)
157 (or (and (stringp value)
158 (file-readable-p value))
159 (fboundp value)))
160 (goto-char (point-max))
161 (if (not (looking-at "^$"))
162 (insert "\n"))
163 (insert "\n")
164 (save-restriction
165 (narrow-to-region (point) (point))
166 (set (make-local-variable 'mh-identity-signature-start)
167 (make-marker))
168 (set-marker mh-identity-signature-start (point))
169 (cond
170 ;; If MIME composition done, insert signature at the end as
171 ;; an inline MIME part.
172 ((and (boundp 'mh-mhn-compose-insert-flag)
173 mh-mhn-compose-insert-flag)
174 (insert "#\n" "Content-Description: Signature\n"))
175 ((and (boundp 'mh-mml-compose-insert-flag)
176 mh-mml-compose-insert-flag)
177 (mml-insert-tag 'part 'type "text/plain"
178 'disposition "inline"
179 'description "Signature")))
180 (if (stringp value)
181 (insert-file-contents value)
182 (funcall value))
183 (goto-char (point-min))
184 (when (not (re-search-forward "^--" nil t))
185 (if (and (boundp 'mh-mhn-compose-insert-flag)
186 mh-mhn-compose-insert-flag)
187 (forward-line 2))
188 (if (and (boundp 'mh-mml-compose-insert-flag)
189 mh-mml-compose-insert-flag)
190 (forward-line 1))
191 (insert "-- \n"))
192 (set (make-local-variable 'mh-identity-signature-end)
193 (make-marker))
194 (set-marker mh-identity-signature-end (point-max))))
195 ;; Handle "From" field differently, adding it at the beginning.
196 ((string-equal "From:" field)
197 (goto-char (point-min))
198 (insert "From: " value "\n"))
199 ;; Skip empty signature (Can't remove what we don't know)
200 ((string-equal "signature:" field))
201 ;; Other field, add at end
202 (t ;Otherwise, add the end.
203 (goto-char (point-min))
204 (mh-goto-header-end 0)
205 (mh-insert-fields field value))))
206 (setq pers-list (cdr pers-list))))))
207 ;; Remember what is in use in this buffer
208 (if (equal "none" identity)
209 (setq mh-identity-local nil)
210 (setq mh-identity-local identity)))
211
212(provide 'mh-identity)
213
214;;; Local Variables:
215;;; indent-tabs-mode: nil
216;;; sentence-end-double-space: nil
217;;; End:
218
219;;; mh-identity.el ends here
diff --git a/lisp/mail/mh-index.el b/lisp/mail/mh-index.el
index cf4b97f31e8..a04a11b651f 100644
--- a/lisp/mail/mh-index.el
+++ b/lisp/mail/mh-index.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2002 Free Software Foundation, Inc.
4 4
5;; Author: Bill Wohler <wohler@newt.com> 5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail 7;; Keywords: mail
8;; See: mh-e.el 8;; See: mh-e.el
@@ -37,14 +37,10 @@
37;;; the documentation for `mh-index-search' to get started. That 37;;; the documentation for `mh-index-search' to get started. That
38;;; documentation will direct you to the specific instructions for your 38;;; documentation will direct you to the specific instructions for your
39;;; particular indexer. 39;;; particular indexer.
40;;;
41;;; (3) Right now only viewing messages and moving between messages works in
42;;; the index buffer. With a little bit of work more stuff like
43;;; replying or forwarding messages can be done.
44 40
45;;; Change Log: 41;;; Change Log:
46 42
47;; $Id: mh-index.el,v 1.51 2002/11/13 18:43:57 satyaki Exp $ 43;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $
48 44
49;;; Code: 45;;; Code:
50 46
@@ -52,34 +48,11 @@
52(require 'mh-e) 48(require 'mh-e)
53(require 'mh-mime) 49(require 'mh-mime)
54 50
55;; Shush the byte-compiler
56(defvar font-lock-defaults)
57
58(autoload 'gnus-local-map-property "gnus-util") 51(autoload 'gnus-local-map-property "gnus-util")
59(autoload 'gnus-eval-format "gnus-spec") 52(autoload 'gnus-eval-format "gnus-spec")
60(autoload 'widget-convert-button "wid-edit") 53(autoload 'widget-convert-button "wid-edit")
61(autoload 'executable-find "executable") 54(autoload 'executable-find "executable")
62 55
63;;; User customizable
64(defcustom mh-index-program nil
65 "Indexing program that MH-E shall use.
66The possible choices are swish++, swish-e, namazu, glimpse and grep. By
67default this variable is nil which means that the programs are tried in order
68and the first one found is used."
69 :group 'mh
70 :type '(choice (const :tag "auto-detect" nil)
71 (const :tag "swish++" swish++)
72 (const :tag "swish-e" swish)
73 (const :tag "namazu" namazu)
74 (const :tag "glimpse" glimpse)
75 (const :tag "grep" grep)))
76
77;;; Hooks
78(defcustom mh-index-show-hook nil
79 "Invoked after the message has been displayed."
80 :type 'hook
81 :group 'mh-hook)
82
83;; Support different indexing programs 56;; Support different indexing programs
84(defvar mh-indexer-choices 57(defvar mh-indexer-choices
85 '((swish++ 58 '((swish++
@@ -100,118 +73,211 @@ and the first one found is used."
100(defvar mh-index-next-result-function nil 73(defvar mh-index-next-result-function nil
101 "Function to parse the next line of output.") 74 "Function to parse the next line of output.")
102 75
103;; Names for the default mh-index-buffers... 76;; FIXME: This should be a defcustom...
104(defvar mh-index-buffer "*mh-index*") 77(defvar mh-index-folder "+mhe-index"
105(defvar mh-index-show-buffer "*mh-index-show*") 78 "Folder that contains the folders resulting from the index searches.")
106 79
107;; For use with adaptive size setting... 80;; Temporary buffers for search results
108(defvar mh-index-max-msg-index 0)
109
110;; Buffer locals to allow multiple concurrent search folders.
111(defvar mh-index-other-buffer nil
112 "Keeps track of other buffer associated with current buffer.
113The value is the show buffer or the folder-buffer depending on whether we are
114in a folder buffer or show buffer respectively.")
115(defvar mh-index-matches nil
116 "Map of folder to messages which match.")
117(defvar mh-index-previous-window-configuration nil
118 "Keep track of previous window configuration that is restored on exit.")
119(defvar mh-index-current-msg nil
120 "Message index of message being shown.")
121
122;; Make variables buffer local ...
123(make-variable-buffer-local 'mh-index-other-buffer)
124(make-variable-buffer-local 'mh-index-matches)
125(make-variable-buffer-local 'mh-index-previous-window-configuration)
126(make-variable-buffer-local 'mh-current-folder)
127(make-variable-buffer-local 'mh-index-current-msg)
128
129;; ... and arrange for them to not get slaughtered by a call to text-mode
130;; (text-mode is called by mh-show-mode and mh-folder-mode).
131(put 'mh-index-other-buffer 'permanent-local t)
132(put 'mh-index-matches 'permanent-local t)
133(put 'mh-index-previous-window-configuration 'permanent-local t)
134(put 'mh-index-current-msg 'permanent-local t)
135(put 'mh-current-folder 'permanent-local t)
136(put 'mh-cmd-note 'permanent-local t)
137
138;; Temporary buffer where search results are output.
139(defvar mh-index-temp-buffer " *mh-index-temp*") 81(defvar mh-index-temp-buffer " *mh-index-temp*")
82(defvar mh-checksum-buffer " *mh-checksum-buffer*")
83
84
140 85
141;; Keymaps 86;;; A few different checksum programs are supported. The supported programs
142 87;;; are:
143;; N.B. If this map were named mh-index-folder-mode-map, it would inherit the 88;;; 1. md5sum
144;; keymap from mh-folder-mode. Since we want our own keymap, we tweak the name 89;;; 2. md5
145;; to avoid this unwanted inheritance. 90;;; 3. openssl
146(defvar mh-index-folder-mode-keymap (make-sparse-keymap) 91;;;
147 "Keymap for MH index folder.") 92;;; To add support for your favorite checksum program add a clause to the cond
148(suppress-keymap mh-index-folder-mode-keymap) 93;;; statement in mh-checksum-choose. This should set the variable
149(gnus-define-keys mh-index-folder-mode-keymap 94;;; mh-checksum-cmd to the command line needed to run the checsum program and
150 " " mh-index-page-msg 95;;; should set mh-checksum-parser to a function which returns a cons cell
151 "," mh-index-header-display 96;;; containing the message number and checksum string.
152 "." mh-index-show 97
153 [mouse-2] mh-index-show 98(defvar mh-checksum-cmd)
154 "?" mh-help 99(defvar mh-checksum-parser)
155 "\177" mh-index-previous-page 100
156 "\M-\t" mh-index-prev-button 101(defun mh-checksum-choose ()
157 [backtab] mh-index-prev-button 102 "Check if a program to create a checksum is present."
158 "\r" mh-index-show 103 (unless (boundp 'mh-checksum-cmd)
159 "\t" mh-index-next-button 104 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
160 "i" mh-inc-folder 105 (cond ((executable-find "md5sum")
161 "m" mh-send ;alias 106 (setq mh-checksum-cmd (list (executable-find "md5sum")))
162 "n" mh-index-next 107 (setq mh-checksum-parser #'mh-md5sum-parser))
163 "p" mh-index-prev 108 ((executable-find "openssl")
164 "q" mh-index-quit 109 (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
165 "s" mh-send) 110 (setq mh-checksum-parser #'mh-openssl-parser))
166 111 ((executable-find "md5")
167(gnus-define-keys (mh-index-folder-map "F" mh-index-folder-mode-keymap) 112 (setq mh-checksum-cmd (list (executable-find "md5")))
168 "?" mh-prefix-help 113 (setq mh-checksum-parser #'mh-md5-parser))
169 "f" mh-visit-folder ;alias 114 (t (error "No suitable checksum program"))))))
170 "i" mh-index-search-again 115
171 "o" mh-visit-folder ;alias 116(defun mh-md5sum-parser ()
172 "v" mh-visit-folder) 117 "Parse md5sum output."
173 118 (let ((begin (line-beginning-position))
174(defvar mh-index-button-map (make-sparse-keymap)) 119 (end (line-end-position))
175(gnus-define-keys mh-index-button-map 120 first-space last-slash)
176 "\r" mh-index-press-button) 121 (setq first-space (search-forward " " end t))
122 (goto-char end)
123 (setq last-slash (search-backward "/" begin t))
124 (cond ((and first-space last-slash)
125 (cons (car (read-from-string (buffer-substring-no-properties
126 (1+ last-slash) end)))
127 (buffer-substring-no-properties begin (1- first-space))))
128 (t (cons nil nil)))))
129
130(defun mh-openssl-parser ()
131 "Parse openssl output."
132 (let ((begin (line-beginning-position))
133 (end (line-end-position))
134 last-space last-slash)
135 (goto-char end)
136 (setq last-space (search-backward " " begin t))
137 (setq last-slash (search-backward "/" begin t))
138 (cond ((and last-slash last-space)
139 (cons (car (read-from-string (buffer-substring-no-properties
140 (1+ last-slash) (1- last-space))))
141 (buffer-substring-no-properties (1+ last-space) end))))))
142
143(defalias 'mh-md5-parser 'mh-openssl-parser)
177 144
178 145
179 146
180;;; Help Messages 147;;; Make sure that we don't produce too long a command line.
181 148
182;;; If you add a new prefix, add appropriate text to the nil key. 149(defvar mh-index-max-cmdline-args 500
183;;; 150 "Maximum number of command line args.")
184;;; In general, messages are grouped logically. Taking the main commands for 151
185;;; example, the first line is "ways to view messages," the second line is 152(defun mh-index-execute (cmd &rest args)
186;;; "things you can do with messages", and the third is "composing" messages. 153 "Partial imitation of xargs.
187;;; 154The current buffer contains a list of strings, one on each line. The function
188;;; When adding a new prefix, ensure that the help message contains "what" the 155will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
189;;; prefix is for. For example, if the word "folder" were not present in the 156strings to it. This is repeated till all the strings have been used."
190;;; `F' entry, it would not be clear what these commands operated upon. 157 (goto-char (point-min))
191(defvar mh-index-folder-mode-help-messages 158 (let ((out (get-buffer-create " *mh-xargs-output*")))
192 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" 159 (save-excursion
193 "[s]end, [q]uit") 160 (set-buffer out)
194 (?F "[v]isit folder; [i]ndexed search")) 161 (erase-buffer))
195 "Key binding cheat sheet. 162 (while (not (eobp))
196 163 (let ((arg-list (reverse args))
197This is an associative array which is used to show the most common commands. 164 (count 0))
198The key is a prefix char. The value is one or more strings which are 165 (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
199concatenated together and displayed in the minibuffer if ? is pressed after 166 (push (buffer-substring-no-properties (point) (line-end-position))
200the prefix character. The special key nil is used to display the 167 arg-list)
201non-prefixed commands. 168 (incf count)
202 169 (forward-line))
203The substitutions described in `substitute-command-keys' are performed as 170 (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
204well.") 171 (erase-buffer)
172 (insert-buffer-substring out)))
205 173
206 174
207 175
208(defun mh-index-search (folder search-regexp &optional new-buffer-flag) 176(defun mh-index-update-single-msg (msg checksum origin-map)
177 "Update various maps for one message.
178MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
179non-nil, a hashtable containing which maps each message in the index folder to
180the folder and message that it was copied from. The function updates the hash
181tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
182
183This function should only be called in the appropriate index folder buffer."
184 (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
185 (let* ((intermediate (gethash msg origin-map))
186 (ofolder (car intermediate))
187 (omsg (cdr intermediate)))
188 ;; This is most probably a duplicate. So eliminate it.
189 (call-process "rm" nil nil nil
190 (format "%s%s/%s" mh-user-path
191 (substring mh-current-folder 1) msg))
192 (remhash omsg (gethash ofolder mh-index-data))))
193 (t
194 (setf (gethash msg mh-index-msg-checksum-map) checksum)
195 (when origin-map
196 (setf (gethash checksum mh-index-checksum-origin-map)
197 (gethash msg origin-map))))))
198
199;;;###mh-autoload
200(defun mh-index-update-maps (folder &optional origin-map)
201 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
202As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
203is a hashtable which maps each message in the index folder to the original
204folder and message from whence it was copied. If present the
205checksum -> (origin-folder, origin-index) map is updated too."
206 (clrhash mh-index-msg-checksum-map)
207 (save-excursion
208 ;; Clear temp buffer
209 (set-buffer (get-buffer-create mh-checksum-buffer))
210 (erase-buffer)
211 ;; Run scan to check if any messages needs MD5 annotations at all
212 (with-temp-buffer
213 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
214 "-format" "%(msg)\n%{x-mhe-checksum}\n"
215 folder "all")
216 (goto-char (point-min))
217 (let (msg checksum)
218 (while (not (eobp))
219 (setq msg (buffer-substring-no-properties
220 (point) (line-end-position)))
221 (forward-line)
222 (save-excursion
223 (cond ((eolp)
224 ;; need to compute checksum
225 (set-buffer mh-checksum-buffer)
226 (insert mh-user-path (substring folder 1) "/" msg "\n"))
227 (t
228 ;; update maps
229 (setq checksum (buffer-substring-no-properties
230 (point) (line-end-position)))
231 (let ((msg (car (read-from-string msg))))
232 (set-buffer folder)
233 (mh-index-update-single-msg msg checksum origin-map)))))
234 (forward-line))))
235 ;; Run checksum program if needed
236 (unless (and (eobp) (bobp))
237 (apply #'mh-index-execute mh-checksum-cmd)
238 (goto-char (point-min))
239 (while (not (eobp))
240 (let* ((intermediate (funcall mh-checksum-parser))
241 (msg (car intermediate))
242 (checksum (cdr intermediate)))
243 (when msg
244 ;; annotate
245 (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
246 "-nodate" "-text" checksum "-inplace")
247 ;; update maps
248 (save-excursion
249 (set-buffer folder)
250 (mh-index-update-single-msg msg checksum origin-map)))
251 (forward-line))))))
252
253(defun mh-index-generate-pretty-name (string)
254 "Given STRING generate a name which is suitable for use as a folder name.
255White space from the beginning and end are removed. All spaces in the name are
256replaced with underscores and all / are replaced with $. If STRING is longer
257than 20 it is truncated too."
258 (with-temp-buffer
259 (insert string)
260 (goto-char (point-min))
261 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
262 (delete-char 1))
263 (goto-char (point-max))
264 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
265 (delete-backward-char 1))
266 (subst-char-in-region (point-min) (point-max) ? ?_ t)
267 (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
268 (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
269 (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
270 (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
271 (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
272
273;;;###mh-autoload
274(defun mh-index-search (redo-search-flag folder search-regexp)
209 "Perform an indexed search in an MH mail folder. 275 "Perform an indexed search in an MH mail folder.
210 276
211FOLDER is searched with SEARCH-REGEXP and the results are presented in an MH-E 277If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
212folder. If FOLDER is \"+\" then mail in all folders are searched. Optional 278index search, then the search is repeated. Otherwise, FOLDER is searched with
213prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a 279SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
214new buffer. This allows multiple search results to coexist. 280\"+\" then mail in all folders are searched.
215 281
216Four indexing programs are supported; if none of these are present, then grep 282Four indexing programs are supported; if none of these are present, then grep
217is used. This function picks the first program that is available on your 283is used. This function picks the first program that is available on your
@@ -224,544 +290,249 @@ index for each program:
224 - `mh-swish++-execute-search' 290 - `mh-swish++-execute-search'
225 - `mh-swish-execute-search' 291 - `mh-swish-execute-search'
226 - `mh-namazu-execute-search' 292 - `mh-namazu-execute-search'
227 - `mh-glimpse-execute-search'" 293 - `mh-glimpse-execute-search'
294
295This and related functions use an X-MHE-Checksum header to cache the MD5
296checksum of a message. This means that already present X-MHE-Checksum headers
297in the incoming email could result in messages not being found. The following
298procmail recipe should avoid this:
299
300 :0 wf
301 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
302
303This has the effect of renaming already present X-MHE-Checksum headers."
228 (interactive 304 (interactive
229 (list (progn 305 (list current-prefix-arg
306 (progn
230 (unless mh-find-path-run (mh-find-path)) 307 (unless mh-find-path-run (mh-find-path))
231 (mh-prompt-for-folder "Search" "+" nil "all")) 308 (or (and current-prefix-arg (car mh-index-previous-search))
309 (mh-prompt-for-folder "Search" "+" nil "all")))
232 (progn 310 (progn
233 ;; Yes, we do want to call mh-index-choose every time in case the 311 ;; Yes, we do want to call mh-index-choose every time in case the
234 ;; user has switched the indexer manually. 312 ;; user has switched the indexer manually.
235 (unless (mh-index-choose) (error "No indexing program found")) 313 (unless (mh-index-choose) (error "No indexing program found"))
236 (read-string (format "%s regexp: " 314 (or (and current-prefix-arg (cadr mh-index-previous-search))
237 (upcase-initials (symbol-name mh-indexer))))) 315 (read-string (format "%s regexp: "
238 current-prefix-arg)) 316 (upcase-initials
239 (setq mh-index-max-msg-index 0) 317 (symbol-name mh-indexer))))))))
240 (let ((config (current-window-configuration)) 318 (mh-checksum-choose)
241 (mh-index-buffer 319 (let ((result-count 0)
242 (cond (new-buffer-flag 320 (old-window-config mh-previous-window-config)
243 (buffer-name (generate-new-buffer mh-index-buffer))) 321 (previous-search mh-index-previous-search)
244 ((and (eq major-mode 'mh-index-folder-mode)) 322 (index-folder (format "%s/%s" mh-index-folder
245 (buffer-name (current-buffer))) 323 (mh-index-generate-pretty-name search-regexp))))
246 (t mh-index-buffer))) 324 ;; Create a new folder for the search results or recreate the old one...
247 (mh-index-show-buffer 325 (if (and redo-search-flag mh-index-previous-search)
248 (cond (new-buffer-flag 326 (let ((buffer-name (buffer-name (current-buffer))))
249 (buffer-name (generate-new-buffer mh-index-show-buffer))) 327 (mh-process-or-undo-commands buffer-name)
250 ((eq major-mode 'mh-index-folder-mode) 328 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
251 mh-index-other-buffer) 329 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
252 (t mh-index-show-buffer)))) 330 (setq index-folder buffer-name))
253 (when (buffer-live-p (get-buffer mh-index-show-buffer)) 331 (setq index-folder (mh-index-new-folder index-folder)))
254 (kill-buffer (get-buffer mh-index-show-buffer))) 332
255 (get-buffer-create mh-index-buffer) 333 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
256 (get-buffer-create mh-index-show-buffer) 334 (folder-results-map (make-hash-table :test #'equal))
257 (save-excursion 335 (origin-map (make-hash-table :test #'equal)))
258 (set-buffer mh-index-buffer)
259 (setq mh-index-other-buffer mh-index-show-buffer))
260 (save-excursion
261 (set-buffer mh-index-show-buffer)
262 (setq mh-index-other-buffer mh-index-buffer))
263 (set-buffer mh-index-buffer)
264 (setq buffer-read-only nil)
265 (erase-buffer)
266 (let* ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
267 (count 0)
268 (folder-count 0)
269 cur-folder last-folder cur-index last-index
270 parse-results button-start button-end)
271 (setq mh-index-matches (make-hash-table :test #'equal))
272
273 ;; Run search program... 336 ;; Run search program...
274 (message "%s searching... " (upcase-initials (symbol-name mh-indexer))) 337 (message "Executing %s... " mh-indexer)
275 (funcall mh-index-execute-search-function folder-path search-regexp) 338 (funcall mh-index-execute-search-function folder-path search-regexp)
276 339
277 ;; Parse output and generate folder view 340 ;; Parse indexer output
278 (message "Processing %s output... " mh-indexer) 341 (message "Processing %s output... " mh-indexer)
279 (goto-char (point-min)) 342 (goto-char (point-min))
280 (while (setq parse-results (funcall mh-index-next-result-function)) 343 (loop for next-result = (funcall mh-index-next-result-function)
281 (unless (eq parse-results 'error) 344 when (null next-result) return nil
282 (setq cur-folder (car parse-results) 345 do (unless (eq next-result 'error)
283 cur-index (cadr parse-results)) 346 (unless (gethash (car next-result) folder-results-map)
284 (setq mh-index-max-msg-index (max mh-index-max-msg-index cur-index)) 347 (setf (gethash (car next-result) folder-results-map)
285 (cond ((and (equal cur-folder last-folder) 348 (make-hash-table :test #'equal)))
286 (= cur-index last-index)) 349 (setf (gethash (cadr next-result)
287 nil) 350 (gethash (car next-result) folder-results-map))
288 ((equal cur-folder last-folder) 351 t)))
289 (save-excursion 352
290 (set-buffer mh-index-buffer) 353 ;; Copy the search results over
291 (push cur-index (gethash cur-folder mh-index-matches)))) 354 (maphash #'(lambda (folder msgs)
292 (t 355 (let ((msgs (sort (loop for msg being the hash-keys of msgs
293 (save-excursion 356 collect msg)
294 (set-buffer mh-index-buffer) 357 #'<)))
295 (unless (gethash cur-folder mh-index-matches) 358 (mh-exec-cmd "refile" msgs "-src" folder
296 (setq button-start (point)) 359 "-link" index-folder)
297 (gnus-eval-format "%T\n" '((?T cur-folder ?s)) 360 (loop for msg in msgs
298 `(,@(gnus-local-map-property 361 do (incf result-count)
299 mh-index-button-map) 362 (setf (gethash result-count origin-map)
300 mh-callback mh-index-callback 363 (cons folder msg)))))
301 mh-data ,cur-folder)) 364 folder-results-map)
302 (setq button-end (point))
303 (widget-convert-button
304 'link button-start button-end
305 :button-keymap mh-index-button-map
306 :action 'mh-index-callback)
307 (insert "\n"))
308 (push cur-index (gethash cur-folder mh-index-matches)))))
309 (setq last-folder cur-folder)
310 (setq last-index cur-index)))
311
312 ;; Get rid of extra line at end of the buffer if there were any hits.
313 (set-buffer mh-index-buffer)
314 (goto-char (point-max))
315 (when (and (= (forward-line -1) 0) (bolp) (eolp))
316 (delete-char 1))
317
318 ;; Set mh-cmd-note to a large enough value...
319 (when mh-adaptive-cmd-note-flag
320 (mh-set-cmd-note (mh-index-find-max-width mh-index-max-msg-index)))
321 365
322 ;; Generate scan lines for the hits. 366 ;; Generate scan lines for the hits.
323 (message "Generating scan lines... ") 367 (let ((mh-show-threads-flag nil))
324 (goto-char (point-min)) 368 (mh-visit-folder index-folder () (list folder-results-map origin-map)))
325 (while (not (eobp)) 369
326 (let ((folder (get-text-property (point) 'mh-data)))
327 (when folder
328 (incf folder-count)
329 (forward-line)
330 (incf count (mh-index-insert-scan folder))))
331 (forward-line))
332
333 ;; Go to the first hit (if any).
334 (goto-char (point-min)) 370 (goto-char (point-min))
335 (forward-line) 371 (forward-line)
372 (mh-update-sequences)
373 (mh-recenter nil)
374
375 ;; Maintain history
376 (when (and redo-search-flag previous-search)
377 (setq mh-previous-window-config old-window-config))
378 (setq mh-index-previous-search (list folder search-regexp))
336 379
337 ;; Remember old window configuration
338 (setq mh-index-previous-window-configuration config)
339
340 ;; Setup folder buffer mode
341 (when mh-decode-mime-flag
342 (add-hook 'kill-buffer-hook 'mh-mime-cleanup))
343 (mh-index-folder-mode)
344 (setq mh-show-buffer mh-index-show-buffer)
345 (setq buffer-read-only t)
346 (set-buffer-modified-p nil)
347 (mh-index-configure-one-window)
348 (setq mh-current-folder nil mh-index-current-msg nil)
349 (message "%s found %s matches in %s folders" 380 (message "%s found %s matches in %s folders"
350 (upcase-initials (symbol-name mh-indexer)) 381 (upcase-initials (symbol-name mh-indexer))
351 count folder-count)))) 382 (loop for msg-hash being hash-values of mh-index-data
352 383 sum (hash-table-count msg-hash))
353(defun mh-index-find-max-width (max-index) 384 (loop for msg-hash being hash-values of mh-index-data
354 "Given MAX-INDEX find the number of digits necessary to print it." 385 count (> (hash-table-count msg-hash) 0))))))
355 (let ((result 1) 386
356 (max-int 9)) 387;;;###mh-autoload
357 (while (< max-int max-index) 388(defun mh-index-next-folder (&optional backward-flag)
358 (incf result) 389 "Jump to the next folder marker.
359 (setq max-int (+ (* 10 max-int) 9))) 390The function is only applicable to folders displaying index search results.
360 result)) 391With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
361 392results."
362(defun mh-index-search-again () 393 (interactive "P")
363 "Call `mh-index-search' from index search buffer." 394 (if (or (null mh-index-data)
395 (memq 'unthread mh-view-ops))
396 (message "Only applicable in an unthreaded MH-E index search buffer")
397 (let ((point (point)))
398 (forward-line (if backward-flag -1 1))
399 (cond ((if backward-flag
400 (re-search-backward "^+" (point-min) t)
401 (re-search-forward "^+" (point-max) t))
402 (beginning-of-line))
403 ((and (if backward-flag
404 (goto-char (point-max))
405 (goto-char (point-min)))
406 nil))
407 ((if backward-flag
408 (re-search-backward "^+" (point-min) t)
409 (re-search-forward "^+" (point-max) t))
410 (beginning-of-line))
411 (t (goto-char point))))))
412
413;;;###mh-autoload
414(defun mh-index-previous-folder ()
415 "Jump to the previous folder marker."
364 (interactive) 416 (interactive)
365 (cond ((eq major-mode 'mh-index-show-mode) 417 (mh-index-next-folder t))
366 (set-buffer mh-index-other-buffer)) 418
367 ((not (eq major-mode 'mh-index-folder-mode)) 419(defun mh-folder-exists-p (folder)
368 (error "Should be called from one of the index buffers"))) 420 "Check if FOLDER exists."
369 (let ((old-buffer (current-buffer)) 421 (and (mh-folder-name-p folder)
370 (window-config mh-index-previous-window-configuration)) 422 (save-excursion
371 (unwind-protect (call-interactively 'mh-index-search) 423 (with-temp-buffer
372 (when (eq old-buffer (current-buffer)) 424 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
373 (setq mh-index-previous-window-configuration window-config))))) 425 (goto-char (point-min))
374 426 (not (eobp))))))
375(defun mh-index-insert-scan (folder) 427
376 "Insert scan lines for hits in FOLDER that the indexing program found. 428(defun mh-msg-exists-p (msg folder)
377The only twist is to replace the subject/body field with the match (if 429 "Check if MSG exists in FOLDER."
378possible)." 430 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
379 (save-excursion 431
380 (apply #'mh-exec-cmd-output 432(defun mh-index-new-folder (name)
381 mh-scan-prog nil (mh-scan-format) 433 "Create and return an MH folder name based on NAME.
382 "-noclear" "-noheader" "-width" (window-width) 434If the folder NAME already exists then check if NAME<2> exists. If it doesn't
383 folder (mh-coalesce-msg-list (gethash folder mh-index-matches)))) 435then it is created and returned. Otherwise try NAME<3>. This is repeated till
384 (save-excursion 436we find a new folder name."
385 (let ((window-width (window-width)) 437 (unless (mh-folder-name-p name)
386 (count 0)) 438 (error "The argument should be a valid MH folder name"))
387 (while (not (or (get-text-property (point) 'mh-data) (eobp))) 439 (let ((chosen-name name))
388 (beginning-of-line) 440 (block unique-name
389 (unless (and (eolp) (bolp)) 441 (unless (mh-folder-exists-p name)
390 (incf count) 442 (return-from unique-name))
391 (forward-char mh-cmd-note) 443 (loop for index from 2
392 (delete-char 1) 444 do (let ((new-name (format "%s<%s>" name index)))
393 (insert " ")) 445 (unless (mh-folder-exists-p new-name)
394 (forward-line 1)) 446 (setq chosen-name new-name)
395 count))) 447 (return-from unique-name)))))
396 448 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
397(defun mh-index-callback () 449 (when (boundp 'mh-speed-folder-map)
398 "Callback function for buttons in the index buffer." 450 (mh-speed-add-folder chosen-name))
399 (let* ((folder (save-excursion 451 (push (list chosen-name) mh-folder-list)
400 (buffer-substring-no-properties 452 chosen-name))
401 (progn (beginning-of-line) (point)) 453
402 (progn (end-of-line) (point))))) 454;;;###mh-autoload
403 (data (get-text-property (point) 'mh-data)) 455(defun mh-index-insert-folder-headers ()
404 (msg-list (gethash data mh-index-matches))) 456 "Annotate the search results with original folder names."
405 (when msg-list 457 (let ((cur-msg (mh-get-msg-num nil))
406 (mh-visit-folder folder msg-list)))) 458 (old-buffer-modified-flag (buffer-modified-p))
407 459 (buffer-read-only nil)
408(defmacro mh-defun-index (func args &rest body) 460 current-folder last-folder)
409 "Macro to generate a function callable both from index and show buffer.
410FUNC is the function name, ARGS the argument list and BODY the function
411body."
412 (let ((cur (gensym))
413 interactive-spec doc-string)
414 (when (stringp (car body))
415 (setq doc-string (car body))
416 (setq body (cdr body)))
417 (when (and (listp (car body)) (eq (caar body) 'interactive))
418 (setq interactive-spec (car body))
419 (setq body (cdr body)))
420 `(defun ,func ,args
421 ,@(if doc-string (list doc-string) ())
422 ,interactive-spec
423 (let* ((mh-index-buffer (if (eq major-mode 'mh-index-folder-mode)
424 (buffer-name (current-buffer))
425 mh-index-other-buffer))
426 (mh-index-show-buffer (if (eq major-mode 'mh-index-show-mode)
427 (buffer-name (current-buffer))
428 mh-index-other-buffer))
429 (,cur (cond ((eq (get-buffer mh-index-buffer)
430 (current-buffer))
431 mh-index-buffer)
432 ((eq (get-buffer mh-index-show-buffer)
433 (current-buffer))
434 mh-index-show-buffer)
435 (t (error "Not called from mh-index buffer")))))
436 (flet ((mh-msg-folder (folder) mh-index-buffer)
437 (mh-msg-filename (msg-num folder)
438 (format "%s%s/%s" mh-user-path (subseq folder 1) msg-num)))
439 (cond ((eq ,cur mh-index-buffer)
440 (mh-index-goto-nearest-msg)
441 (when (and mh-current-folder mh-index-current-msg)
442 (mh-index-notate mh-current-folder
443 mh-index-current-msg " " mh-cmd-note))
444 (setq mh-current-folder (mh-index-parse-folder))
445 (setq mh-index-current-msg (mh-index-parse-msg-number)))
446 ((eq ,cur mh-index-show-buffer)
447 (set-buffer mh-index-buffer)
448 (mh-index-goto-msg mh-current-folder
449 mh-index-current-msg)
450 (mh-index-notate nil nil " " mh-cmd-note))
451 (t (error "This can't happen!")))
452 (unwind-protect
453 (progn ,@body)
454 (save-excursion
455 (set-buffer mh-index-buffer)
456 (mh-index-goto-msg mh-current-folder mh-index-current-msg)
457 (mh-recenter nil))
458 (mh-index-configure-windows)
459 (pop-to-buffer ,cur)))))))
460
461(defun mh-index-advance (steps)
462 "Advance STEPS messages in the folder buffer.
463If there are less than STEPS messages left then an error message is printed."
464 (let* ((backward-flag (< steps 0))
465 (steps (if backward-flag (- steps) steps))
466 point)
467 (block body
468 (save-excursion
469 (while (> steps 0)
470 (unless (= (forward-line (if backward-flag -1 1)) 0)
471 (return-from body))
472 (cond ((and (eolp) (bolp) (not backward-flag))
473 (unless (= (forward-line 2) 0) (return-from body)))
474 ((and (get-text-property (point) 'mh-data) backward-flag)
475 (unless (= (forward-line -2) 0) (return-from body)))
476 ((or (and (eolp) (bolp))
477 (get-text-property (point) 'mh-data))
478 (error "Mh-index-buffer is inconsistent")))
479 (decf steps))
480 (setq point (point))))
481 (cond (point (goto-char point) t)
482 (t nil))))
483
484;; Details about message at point. These functions assume that we are on a
485;; line which contains a message scan line and not on a blank line or a line
486;; with a folder name.
487(defun mh-index-parse-msg-number ()
488 "Parse message number of message at point."
489 (save-excursion
490 (beginning-of-line)
491 (let* ((b (point))
492 (e (progn (forward-char mh-cmd-note) (point)))
493 (data (ignore-errors
494 (read-from-string (buffer-substring-no-properties b e)))))
495 (unless (and (consp data) (integerp (car data)))
496 (error "Didn't find message number"))
497 (car data))))
498
499(defun mh-index-parse-folder ()
500 "Parse folder of message at point."
501 (save-excursion
502 (while (not (get-text-property (point) 'mh-data))
503 (unless (eql (forward-line -1) 0)
504 (error "Reached beginning of buffer without seeing a folder")))
505 (buffer-substring-no-properties (progn (beginning-of-line) (point))
506 (progn (end-of-line) (point)))))
507
508(defun mh-index-goto-nearest-msg ()
509 "If point is not at a message go to the closest line with a message on it."
510 (beginning-of-line)
511 (cond ((and (eolp) (bolp)) (forward-line -1))
512 ((get-text-property (point) 'mh-data) (forward-line 1))))
513
514;; Window configuration for mh-index... There should be similar functions
515;; in MH-E but I couldn't find them. I got the idea of using next-window,
516;; previous-window and minibuffer-window from MH-E code.
517(defun mh-index-configure-windows ()
518 "Configure windows."
519 (cond ((and (buffer-live-p (get-buffer mh-index-show-buffer))
520 (buffer-live-p (get-buffer mh-index-buffer))
521 (eq (save-excursion (set-buffer mh-index-show-buffer) major-mode)
522 'mh-index-show-mode))
523 (mh-index-configure-two-windows))
524 ((buffer-live-p (get-buffer mh-index-buffer))
525 (mh-index-configure-one-window))))
526
527(defun mh-count-windows ()
528 "Count the number of windows in the current frame.
529The minibuffer window is excluded from the count."
530 (let* ((start-window (next-window nil t))
531 (current-window (next-window start-window t))
532 (count 0))
533 (while (not (eq current-window start-window))
534 (incf count)
535 (setq current-window (next-window current-window t)))
536 count))
537
538(defun mh-index-configure-two-windows ()
539 "Force a split view like that of MH-E."
540 (save-excursion
541 (unless (and (get-buffer mh-index-show-buffer)
542 (get-buffer mh-index-buffer))
543 (error "We don't have both index buffers"))
544 (let ((window-count (mh-count-windows)))
545 (unless (and (= window-count 2)
546 (eq (window-buffer (next-window (minibuffer-window)))
547 (get-buffer mh-index-buffer))
548 (eq (window-buffer (previous-window (minibuffer-window)))
549 (get-buffer mh-index-show-buffer)))
550 (unless (= window-count 2)
551 (delete-other-windows)
552 (split-window-vertically))
553 (set-window-buffer (next-window (minibuffer-window))
554 mh-index-buffer)
555 (set-window-buffer (previous-window (minibuffer-window))
556 mh-index-show-buffer))
557 (unless (and (get-buffer-window mh-index-buffer)
558 (= (window-height (get-buffer-window mh-index-buffer))
559 mh-summary-height))
560 (pop-to-buffer mh-index-buffer)
561 (shrink-window (- (window-height) mh-summary-height))))
562 (set-window-point (previous-window (minibuffer-window))
563 (progn (set-buffer mh-index-show-buffer) (point)))
564 (set-window-point (next-window (minibuffer-window))
565 (progn (set-buffer mh-index-buffer) (point)))))
566
567(defun mh-index-configure-one-window ()
568 "Single window view."
569 (save-excursion
570 (unless (buffer-live-p (get-buffer mh-index-buffer))
571 (error "Should have mh-index-buffer"))
572 (switch-to-buffer mh-index-buffer)
573 (delete-other-windows)
574 (set-window-point (next-window (minibuffer-window))
575 (progn (set-buffer mh-index-buffer) (point)))))
576
577;; This is slightly more involved than normal MH-E since we may have multiple
578;; folders in the same buffer.
579(defun mh-index-goto-msg (folder msg)
580 "Move the cursor to the message specified by FOLDER and MSG."
581 (block body
582 (unless (buffer-live-p (get-buffer mh-index-buffer))
583 (error "No index buffer to go to"))
584 (set-buffer mh-index-buffer)
585 (goto-char (point-min)) 461 (goto-char (point-min))
586 (while (re-search-forward (format "^%s$" folder) nil t) 462 (while (not (eobp))
587 (forward-line) 463 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
588 (while (not (eolp)) 464 mh-index-msg-checksum-map)
589 (when (= (mh-index-parse-msg-number) msg) 465 mh-index-checksum-origin-map)))
590 (return-from body)) 466 (when (and current-folder (not (eq current-folder last-folder)))
467 (insert (if last-folder "\n" "") current-folder "\n")
468 (setq last-folder current-folder))
469 (forward-line))
470 (when cur-msg (mh-goto-msg cur-msg t))
471 (set-buffer-modified-p old-buffer-modified-flag)))
472
473;;;###mh-autoload
474(defun mh-index-delete-folder-headers ()
475 "Delete the folder headers."
476 (let ((cur-msg (mh-get-msg-num nil))
477 (old-buffer-modified-flag (buffer-modified-p))
478 (buffer-read-only nil))
479 (goto-char (point-min))
480 (while (not (eobp))
481 (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
482 (delete-region (point) (progn (forward-line) (point)))
591 (forward-line))) 483 (forward-line)))
592 (error "Folder: %s, msg: %s doesn't exist" folder msg))) 484 (when cur-msg (mh-goto-msg cur-msg t t))
593 485 (set-buffer-modified-p old-buffer-modified-flag)))
594;; Can't use mh-notate directly since we could have more than one folder in
595;; the same buffer
596(defun mh-index-notate (folder msg notation offset)
597 "Add notation to scan line.
598FOLDER is the message folder and MSG the message index. These arguments
599specify the message to be notated. NOTATION is the character to be used to
600notate and OFFSET is the number of chars from start of the line where
601notation is to be placed."
602 (save-excursion
603 (set-buffer mh-index-buffer)
604 (let ((buffer-read-only nil)
605 (modified-p (buffer-modified-p))
606 (found t))
607 (setq found nil)
608 (when (and (stringp folder) (numberp msg))
609 (block nil
610 (goto-char (point-min))
611 (re-search-forward (format "^%s$" folder))
612 (forward-line)
613 (while (not (eolp))
614 (when (= (mh-index-parse-msg-number) msg)
615 (setq found t)
616 (return))
617 (forward-line))))
618 (when found
619 (beginning-of-line)
620 (forward-char offset)
621 (delete-char 1)
622 (insert notation)
623 (unless modified-p (set-buffer-modified-p nil))))))
624 486
625 487;;;###mh-autoload
626 488(defun mh-index-visit-folder ()
627;;; User functions 489 "Visit original folder from where the message at point was found."
628
629(mh-defun-index mh-index-show (display-headers-flag)
630 "Display message at point.
631If there are no messages at point then display the closest message.
632The value of `mh-index-show-hook' is a list of functions to be called,
633with no arguments, after the message has been displayed.
634If DISPLAY-HEADERS-FLAG is non-nil then the raw message is shown."
635 (interactive (list nil))
636 (when (or (and (bolp) (eolp)) (get-text-property (point) 'mh-data))
637 (error "No message at point"))
638 (setq mh-current-folder (mh-index-parse-folder))
639 (setq mh-index-current-msg (mh-index-parse-msg-number))
640 ;; Do new notation
641 (when (and mh-current-folder mh-index-current-msg)
642 (mh-index-notate mh-current-folder mh-index-current-msg
643 mh-note-cur mh-cmd-note))
644 (let ((mh-decode-mime-flag (and (not display-headers-flag) mh-decode-mime-flag))
645 (mh-clean-message-header-flag
646 (and (not display-headers-flag) mh-clean-message-header-flag))
647 (mhl-formfile (if display-headers-flag nil mhl-formfile))
648 (msg mh-index-current-msg)
649 (folder mh-current-folder))
650 (when (not (eq display-headers-flag mh-showing-with-headers))
651 (mh-invalidate-show-buffer))
652 (mh-in-show-buffer (mh-index-show-buffer)
653 (mh-display-msg msg folder))
654 ;; Search for match in shown message
655 (select-window (get-buffer-window mh-index-show-buffer))
656 (set-buffer mh-index-show-buffer)
657 (mh-index-show-mode))
658 (run-hooks 'mh-index-show-hook))
659
660(defun mh-index-header-display ()
661 "Show the message with full headers."
662 (interactive)
663 (mh-index-show t)
664 (setq mh-showing-with-headers t))
665
666(mh-defun-index mh-index-next (steps)
667 "Display next message.
668Prefix argument STEPS specifies the number of messages to skip ahead."
669 (interactive "p")
670 (mh-index-goto-nearest-msg)
671 (if (mh-index-advance steps)
672 (mh-index-show nil)
673 (mh-index-show nil)
674 (message "Not enough messages")))
675
676(mh-defun-index mh-index-prev (steps)
677 "Display previous message.
678Prefix argument STEPS specifies the number of messages to skip backward."
679 (interactive "p")
680 (mh-index-goto-nearest-msg)
681 (if (mh-index-advance (- steps))
682 (mh-index-show nil)
683 (mh-index-show nil)
684 (message "Not enough messages")))
685
686(defun mh-index-page-msg (arg)
687 "Scroll the displayed message upward ARG lines."
688 (interactive "P")
689 (save-excursion
690 (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode)
691 mh-index-other-buffer)
692 ((eq major-mode 'mh-index-show-mode)
693 (buffer-name (current-buffer)))
694 (t (error "Don't use mh-index-page-msg"))))
695 (window (get-buffer-window show-buffer))
696 (current-window (selected-window)))
697 (when (window-live-p window)
698 (select-window window)
699 (unwind-protect (scroll-up arg)
700 (select-window current-window))))))
701
702(defun mh-index-previous-page (arg)
703 "Scroll the displayed message downward ARG lines."
704 (interactive "P")
705 (save-excursion
706 (let* ((show-buffer (cond ((eq major-mode 'mh-index-folder-mode)
707 mh-index-other-buffer)
708 ((eq major-mode 'mh-index-show-mode)
709 (buffer-name (current-buffer)))
710 (t (error "Don't use mh-index-previous-page"))))
711 (window (get-buffer-window show-buffer))
712 (current-window (selected-window)))
713 (when (window-live-p window)
714 (select-window window)
715 (unwind-protect (scroll-down arg)
716 (select-window current-window))))))
717
718(defun mh-index-press-button ()
719 "Press index button."
720 (interactive)
721 (let ((function (get-text-property (point) 'mh-callback)))
722 (when function
723 (funcall function))))
724
725(defun mh-index-quit ()
726 "Quit the index folder.
727Restore the previous window configuration, if one exists.
728The value of `mh-before-quit-hook' is a list of functions to be called, with
729no arguments, immediately upon entry to this function.
730The value of `mh-quit-hook' is a list of functions to be called, with no
731arguments, upon exit of this function."
732 (interactive) 490 (interactive)
733 (cond ((eq major-mode 'mh-index-show-mode) 491 (unless mh-index-data
734 (set-buffer mh-index-other-buffer)) 492 (error "Not in an index folder"))
735 ((not (eq major-mode 'mh-index-folder-mode)) 493 (let (folder msg)
736 (error "The function mh-index-quit shouldn't be called"))) 494 (save-excursion
737 (run-hooks 'mh-before-quit-hook) 495 (cond ((and (bolp) (eolp))
738 (let ((mh-index-buffer (buffer-name (current-buffer))) 496 (ignore-errors (forward-line -1))
739 (mh-index-show-buffer mh-index-other-buffer) 497 (setq msg (mh-get-msg-num t)))
740 (window-config mh-index-previous-window-configuration)) 498 ((equal (char-after (line-beginning-position)) ?+)
741 (when (buffer-live-p (get-buffer mh-index-buffer)) 499 (setq folder (buffer-substring-no-properties
742 (bury-buffer (get-buffer mh-index-buffer))) 500 (line-beginning-position) (line-end-position))))
743 (when (buffer-live-p (get-buffer mh-index-show-buffer)) 501 (t (setq msg (mh-get-msg-num t)))))
744 (bury-buffer (get-buffer mh-index-show-buffer))) 502 (when (not folder)
745 (when window-config 503 (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
746 (set-window-configuration window-config))) 504 mh-index-checksum-origin-map))))
747 (run-hooks 'mh-quit-hook)) 505 (mh-visit-folder
748 506 folder (loop for x being the hash-keys of (gethash folder mh-index-data)
749;; Can't quite use mh-next-button... This buffer has no concept of 507 when (mh-msg-exists-p x folder) collect x))))
750;; folder-buffer or show-buffer. Maybe refactor mh-next-button? 508
751(defun mh-index-next-button (&optional backward-flag) 509(defun mh-index-match-checksum (msg folder checksum)
752 "Go to the next button. 510 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
753Advance point to the next button in the show buffer. If the end of buffer is 511 (with-temp-buffer
754reached then the search wraps over to the start of the buffer. With optional 512 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
755argument BACKWARD-FLAG the point will move to the previous button." 513 "-format" "%{x-mhe-checksum}\n" folder msg)
756 (interactive current-prefix-arg) 514 (goto-char (point-min))
757 (mh-goto-next-button backward-flag)) 515 (string-equal (buffer-substring-no-properties (point) (line-end-position))
758 516 checksum)))
759(defun mh-index-prev-button () 517
760 "Go to the next button. 518;;;###mh-autoload
761Move point to the previous button in the show buffer. If the beginning of 519(defun mh-index-execute-commands ()
762the buffer is reached then the search wraps over to the end." 520 "Delete/refile the actual messages.
763 (interactive) 521The copies in the searched folder are then deleted/refiled to get the desired
764 (mh-index-next-button t)) 522result. Before deleting the messages we make sure that the message being
523deleted is identical to the one that the user has marked in the index buffer."
524 (let ((message-table (make-hash-table :test #'equal)))
525 (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
526 (dolist (msg msg-list)
527 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
528 (pair (gethash checksum mh-index-checksum-origin-map)))
529 (when (and checksum (car pair) (cdr pair)
530 (mh-index-match-checksum (cdr pair) (car pair) checksum))
531 (push (cdr pair) (gethash (car pair) message-table))
532 (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
533 (maphash (lambda (folder msgs)
534 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
535 message-table)))
765 536
766 537
767 538
@@ -770,6 +541,7 @@ the buffer is reached then the search wraps over to the end."
770(defvar mh-glimpse-binary (executable-find "glimpse")) 541(defvar mh-glimpse-binary (executable-find "glimpse"))
771(defvar mh-glimpse-directory ".glimpse") 542(defvar mh-glimpse-directory ".glimpse")
772 543
544;;;###mh-autoload
773(defun mh-glimpse-execute-search (folder-path search-regexp) 545(defun mh-glimpse-execute-search (folder-path search-regexp)
774 "Execute glimpse and read the results. 546 "Execute glimpse and read the results.
775 547
@@ -784,12 +556,18 @@ First create the directory /home/user/Mail/.glimpse. Then create the file
784 */,* 556 */,*
785 */*~ 557 */*~
786 ^/home/user/Mail/.glimpse 558 ^/home/user/Mail/.glimpse
559 ^/home/user/Mail/mhe-index
787 560
788If there are any directories you would like to ignore, append lines like the 561If there are any directories you would like to ignore, append lines like the
789following to .glimpse_exclude: 562following to .glimpse_exclude:
790 563
791 ^/home/user/Mail/scripts 564 ^/home/user/Mail/scripts
792 565
566You do not want to index the folders that hold the results of your searches
567since they tend to be ephemeral and the original messages are indexed anyway.
568The configuration file above assumes that the results are found in sub-folders
569of `mh-index-folder' which is +mhe-index by default.
570
793Use the following command line to generate the glimpse index. Run this 571Use the following command line to generate the glimpse index. Run this
794daily from cron: 572daily from cron:
795 573
@@ -799,9 +577,9 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
799 (set-buffer (get-buffer-create mh-index-temp-buffer)) 577 (set-buffer (get-buffer-create mh-index-temp-buffer))
800 (erase-buffer) 578 (erase-buffer)
801 (call-process mh-glimpse-binary nil '(t nil) nil 579 (call-process mh-glimpse-binary nil '(t nil) nil
802 ;(format "-%s" fuzz) 580 ;(format "-%s" fuzz)
803 "-i" "-y" 581 "-i" "-y"
804 "-H" (format "%s%s" mh-user-path mh-glimpse-directory) 582 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
805 "-F" (format "^%s" folder-path) 583 "-F" (format "^%s" folder-path)
806 search-regexp) 584 search-regexp)
807 (goto-char (point-min))) 585 (goto-char (point-min)))
@@ -812,32 +590,32 @@ Parse it and return the message folder, message index and the match. If no
812other matches left then return nil. If the current record is invalid return 590other matches left then return nil. If the current record is invalid return
813'error." 591'error."
814 (prog1 592 (prog1
815 (block nil 593 (block nil
816 (when (eobp) 594 (when (eobp)
817 (return nil)) 595 (return nil))
818 (let ((eol-pos (line-end-position)) 596 (let ((eol-pos (line-end-position))
819 (bol-pos (line-beginning-position)) 597 (bol-pos (line-beginning-position))
820 folder-start msg-end) 598 folder-start msg-end)
821 (goto-char bol-pos) 599 (goto-char bol-pos)
822 (unless (search-forward mh-user-path eol-pos t) 600 (unless (search-forward mh-user-path eol-pos t)
823 (return 'error))
824 (setq folder-start (point))
825 (unless (search-forward ": " eol-pos t)
826 (return 'error))
827 (let ((match (buffer-substring-no-properties (point) eol-pos)))
828 (forward-char -2)
829 (setq msg-end (point))
830 (unless (search-backward "/" folder-start t)
831 (return 'error)) 601 (return 'error))
832 (list (format "+%s" (buffer-substring-no-properties 602 (setq folder-start (point))
833 folder-start (point))) 603 (unless (search-forward ": " eol-pos t)
834 (let ((val (ignore-errors (read-from-string 604 (return 'error))
835 (buffer-substring-no-properties 605 (let ((match (buffer-substring-no-properties (point) eol-pos)))
836 (1+ (point)) msg-end))))) 606 (forward-char -2)
837 (if (and (consp val) (integerp (car val))) 607 (setq msg-end (point))
838 (car val) 608 (unless (search-backward "/" folder-start t)
839 (return 'error))) 609 (return 'error))
840 match)))) 610 (list (format "+%s" (buffer-substring-no-properties
611 folder-start (point)))
612 (let ((val (ignore-errors (read-from-string
613 (buffer-substring-no-properties
614 (1+ (point)) msg-end)))))
615 (if (and (consp val) (integerp (car val)))
616 (car val)
617 (return 'error)))
618 match))))
841 (forward-line))) 619 (forward-line)))
842 620
843 621
@@ -861,32 +639,32 @@ Parse it and return the message folder, message index and the match. If no
861other matches left then return nil. If the current record is invalid return 639other matches left then return nil. If the current record is invalid return
862'error." 640'error."
863 (prog1 641 (prog1
864 (block nil 642 (block nil
865 (when (eobp) 643 (when (eobp)
866 (return nil)) 644 (return nil))
867 (let ((eol-pos (line-end-position)) 645 (let ((eol-pos (line-end-position))
868 (bol-pos (line-beginning-position)) 646 (bol-pos (line-beginning-position))
869 folder-start msg-end) 647 folder-start msg-end)
870 (goto-char bol-pos) 648 (goto-char bol-pos)
871 (unless (search-forward mh-user-path eol-pos t) 649 (unless (search-forward mh-user-path eol-pos t)
872 (return 'error))
873 (setq folder-start (point))
874 (unless (search-forward ":" eol-pos t)
875 (return 'error))
876 (let ((match (buffer-substring-no-properties (point) eol-pos)))
877 (forward-char -1)
878 (setq msg-end (point))
879 (unless (search-backward "/" folder-start t)
880 (return 'error)) 650 (return 'error))
881 (list (format "+%s" (buffer-substring-no-properties 651 (setq folder-start (point))
882 folder-start (point))) 652 (unless (search-forward ":" eol-pos t)
883 (let ((val (ignore-errors (read-from-string 653 (return 'error))
884 (buffer-substring-no-properties 654 (let ((match (buffer-substring-no-properties (point) eol-pos)))
885 (1+ (point)) msg-end))))) 655 (forward-char -1)
886 (if (and (consp val) (integerp (car val))) 656 (setq msg-end (point))
887 (car val) 657 (unless (search-backward "/" folder-start t)
888 (return 'error))) 658 (return 'error))
889 match)))) 659 (list (format "+%s" (buffer-substring-no-properties
660 folder-start (point)))
661 (let ((val (ignore-errors (read-from-string
662 (buffer-substring-no-properties
663 (1+ (point)) msg-end)))))
664 (if (and (consp val) (integerp (car val)))
665 (car val)
666 (return 'error)))
667 match))))
890 (forward-line))) 668 (forward-line)))
891 669
892 670
@@ -897,6 +675,7 @@ other matches left then return nil. If the current record is invalid return
897(defvar mh-swish-directory ".swish") 675(defvar mh-swish-directory ".swish")
898(defvar mh-swish-folder nil) 676(defvar mh-swish-folder nil)
899 677
678;;;###mh-autoload
900(defun mh-swish-execute-search (folder-path search-regexp) 679(defun mh-swish-execute-search (folder-path search-regexp)
901 "Execute swish-e and read the results. 680 "Execute swish-e and read the results.
902 681
@@ -923,6 +702,7 @@ First create the directory /home/user/Mail/.swish. Then create the file
923 IgnoreLimit 50 1000 702 IgnoreLimit 50 1000
924 IndexComments 0 703 IndexComments 0
925 FileRules pathname contains /home/user/Mail/.swish 704 FileRules pathname contains /home/user/Mail/.swish
705 FileRules pathname contains /home/user/Mail/mhe-index
926 FileRules filename is index 706 FileRules filename is index
927 FileRules filename is \..* 707 FileRules filename is \..*
928 FileRules filename is #.* 708 FileRules filename is #.*
@@ -934,6 +714,11 @@ following to config:
934 714
935 FileRules pathname contains /home/user/Mail/scripts 715 FileRules pathname contains /home/user/Mail/scripts
936 716
717You do not want to index the folders that hold the results of your searches
718since they tend to be ephemeral and the original messages are indexed anyway.
719The configuration file above assumes that the results are found in sub-folders
720of `mh-index-folder' which is +mhe-index by default.
721
937Use the following command line to generate the swish index. Run this 722Use the following command line to generate the swish index. Run this
938daily from cron: 723daily from cron:
939 724
@@ -991,9 +776,10 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
991;; Swish++ interface 776;; Swish++ interface
992 777
993(defvar mh-swish++-binary (or (executable-find "search++") 778(defvar mh-swish++-binary (or (executable-find "search++")
994 (executable-find "search"))) 779 (executable-find "search")))
995(defvar mh-swish++-directory ".swish++") 780(defvar mh-swish++-directory ".swish++")
996 781
782;;;###mh-autoload
997(defun mh-swish++-execute-search (folder-path search-regexp) 783(defun mh-swish++-execute-search (folder-path search-regexp)
998 "Execute swish++ and read the results. 784 "Execute swish++ and read the results.
999 785
@@ -1003,15 +789,24 @@ directory.
1003First create the directory /home/user/Mail/.swish++. Then create the file 789First create the directory /home/user/Mail/.swish++. Then create the file
1004/home/user/Mail/.swish++/swish++.conf with the following contents: 790/home/user/Mail/.swish++/swish++.conf with the following contents:
1005 791
1006 IncludeMeta Bcc Cc Comments Content-Description From Keywords 792 IncludeMeta Bcc Cc Comments Content-Description From Keywords
1007 IncludeMeta Newsgroups Resent-To Subject To 793 IncludeMeta Newsgroups Resent-To Subject To
1008 IncludeFile Mail [0-9]* 794 IncludeMeta Message-Id References In-Reply-To
1009 IndexFile /home/user/Mail/.swish++/swish++.index 795 IncludeFile Mail *
796 IndexFile /home/user/Mail/.swish++/swish++.index
1010 797
1011Use the following command line to generate the swish index. Run this 798Use the following command line to generate the swish index. Run this
1012daily from cron: 799daily from cron:
1013 800
1014 index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail 801 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
802 -o -path /home/user/Mail/.swish++ -prune \\
803 -o -name \"[0-9]*\" -print \\
804 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
805
806You do not want to index the folders that hold the results of your searches
807since they tend to be ephemeral and the original messages are indexed anyway.
808The command above assumes that the results are found in sub-folders of
809`mh-index-folder' which is +mhe-index by default.
1015 810
1016On some systems (Debian GNU/Linux, for example), use index++ instead of index. 811On some systems (Debian GNU/Linux, for example), use index++ instead of index.
1017 812
@@ -1042,6 +837,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1042(defvar mh-namazu-directory ".namazu") 837(defvar mh-namazu-directory ".namazu")
1043(defvar mh-namazu-folder nil) 838(defvar mh-namazu-folder nil)
1044 839
840;;;###mh-autoload
1045(defun mh-namazu-execute-search (folder-path search-regexp) 841(defun mh-namazu-execute-search (folder-path search-regexp)
1046 "Execute namazu and read the results. 842 "Execute namazu and read the results.
1047 843
@@ -1054,6 +850,15 @@ First create the directory /home/user/Mail/.namazu. Then create the file
1054 package conf; # Don't remove this line! 850 package conf; # Don't remove this line!
1055 $ADDRESS = 'user@localhost'; 851 $ADDRESS = 'user@localhost';
1056 $ALLOW_FILE = \"[0-9]*\"; 852 $ALLOW_FILE = \"[0-9]*\";
853 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
854
855In the above example configuration, none of the mail files contained in the
856directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
857
858You do not want to index the folders that hold the results of your searches
859since they tend to be ephemeral and the original messages are indexed anyway.
860The configuration file above assumes that the results are found in sub-folders
861of `mh-index-folder' which is +mhe-index by default.
1057 862
1058Use the following command line to generate the namazu index. Run this 863Use the following command line to generate the namazu index. Run this
1059daily from cron: 864daily from cron:
@@ -1063,7 +868,7 @@ daily from cron:
1063 868
1064FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." 869FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1065 (let ((namazu-index-directory 870 (let ((namazu-index-directory
1066 (format "%s%s" mh-user-path mh-namazu-directory))) 871 (format "%s%s" mh-user-path mh-namazu-directory)))
1067 (unless (file-exists-p namazu-index-directory) 872 (unless (file-exists-p namazu-index-directory)
1068 (error "Namazu directory %s not present" namazu-index-directory)) 873 (error "Namazu directory %s not present" namazu-index-directory))
1069 (unless (executable-find mh-namazu-binary) 874 (unless (executable-find mh-namazu-binary)
@@ -1092,7 +897,7 @@ FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1092 (return 'error)) 897 (return 'error))
1093 (string-match mh-user-path file-name) 898 (string-match mh-user-path file-name)
1094 (let* ((folder/msg (substring file-name (match-end 0))) 899 (let* ((folder/msg (substring file-name (match-end 0)))
1095 (mark (search "/" folder/msg :from-end t))) 900 (mark (mh-search-from-end ?/ folder/msg)))
1096 (unless mark (return 'error)) 901 (unless mark (return 'error))
1097 (list (format "+%s" (substring folder/msg 0 mark)) 902 (list (format "+%s" (substring folder/msg 0 mark))
1098 (let ((n (ignore-errors (read-from-string 903 (let ((n (ignore-errors (read-from-string
@@ -1117,7 +922,7 @@ system."
1117 ;; through the list. 922 ;; through the list.
1118 (let ((program-alist (cond (mh-index-program 923 (let ((program-alist (cond (mh-index-program
1119 (list 924 (list
1120 (assoc mh-index-program mh-indexer-choices))) 925 (assoc mh-index-program mh-indexer-choices)))
1121 (mh-indexer 926 (mh-indexer
1122 (list (assoc mh-indexer mh-indexer-choices))) 927 (list (assoc mh-indexer mh-indexer-choices)))
1123 (t mh-indexer-choices)))) 928 (t mh-indexer-choices))))
@@ -1133,157 +938,10 @@ system."
1133 938
1134 939
1135 940
1136;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1137;;; Menus for folder mode: folder, message (in that order)
1138;;; folder-mode "Message" menu
1139(easy-menu-define
1140 mh-index-folder-message-menu mh-index-folder-mode-keymap
1141 "Menu for MH-E folder-message."
1142 '("Message"
1143 ["Show Message" mh-index-show (mh-get-msg-num nil)]
1144 ["Show Message with Header" mh-index-header-display (mh-get-msg-num nil)]
1145 ["Next Message" mh-index-next t]
1146 ["Previous Message" mh-index-prev t]
1147 "--"
1148 ["Compose a New Message" mh-send t]))
1149
1150;;; folder-mode "Folder" menu
1151(easy-menu-define
1152 mh-index-folder-folder-menu mh-index-folder-mode-keymap
1153 "Menu for MH-E folder."
1154 '("Folder"
1155 ["Incorporate New Mail" mh-inc-folder t]
1156 "--"
1157 ["Visit a Folder..." mh-visit-folder t]
1158 ["Indexed Search..." mh-index-search-again t]
1159 "--"
1160 ["Quit Indexed Search" mh-index-quit t]))
1161
1162
1163
1164;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1165(eval-when-compile (defvar tool-bar-map))
1166(defvar mh-index-folder-tool-bar-map nil)
1167(when (fboundp 'tool-bar-add-item)
1168 (setq mh-index-folder-tool-bar-map
1169 (let ((tool-bar-map (make-sparse-keymap)))
1170 (tool-bar-add-item "mail" 'mh-inc-folder
1171 'mh-indexfoldertoolbar-inc-folder
1172 :help "Incorporate new mail in Inbox")
1173 (tool-bar-add-item "left_arrow" 'mh-index-prev
1174 'mh-indexfoldertoolbar-prev :help "Previous message")
1175 (tool-bar-add-item "page-down" 'mh-index-page-msg
1176 'mh-indexfoldertoolbar-page
1177 :help "Page this message")
1178 (tool-bar-add-item "right_arrow" 'mh-index-next
1179 'mh-indexfoldertoolbar-next :help "Next message")
1180
1181 (tool-bar-add-item "mail_compose" 'mh-send 'mh-indexfoldertoolbar-compose
1182 :help "Compose new message")
1183
1184 (tool-bar-add-item "search"
1185 (lambda (&optional arg)
1186 (interactive "P")
1187 (call-interactively mh-tool-bar-search-function))
1188 'mh-indexfoldertoolbar-search :help "Search")
1189 (tool-bar-add-item "fld_open" 'mh-visit-folder
1190 'mh-indexfoldertoolbar-visit
1191 :help "Visit other folder")
1192
1193 (tool-bar-add-item "preferences" (lambda ()
1194 (interactive)
1195 (customize-group "mh"))
1196 'mh-indexfoldertoolbar-customize
1197 :help "MH-E preferences")
1198 (tool-bar-add-item "help" (lambda ()
1199 (interactive)
1200 (Info-goto-node "(mh-e)Top"))
1201 'mh-indexfoldertoolbar-help :help "Help")
1202 tool-bar-map)))
1203
1204;; Modes for mh-index
1205(define-derived-mode mh-index-folder-mode mh-folder-mode "MH-Index-Folder"
1206 "Major MH-E mode for displaying the results of searching.\\<mh-index-folder-mode-keymap>
1207
1208You can display the message the cursor is pointing to and step through the
1209messages.
1210
1211You can also jump to the folders narrowed to the search results by pressing
1212RET on the folder name. Many operations, such as replying to a message,
1213require that you do this first.
1214
1215\\{mh-index-folder-mode-keymap}"
1216 (make-local-variable 'font-lock-defaults)
1217 (setq font-lock-defaults '(mh-index-font-lock-keywords t))
1218 (use-local-map mh-index-folder-mode-keymap)
1219 (make-local-variable 'mh-help-messages)
1220 (easy-menu-add mh-index-folder-message-menu)
1221 (easy-menu-add mh-index-folder-folder-menu)
1222 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1223 (set (make-local-variable 'tool-bar-map) mh-index-folder-tool-bar-map))
1224 (setq mh-help-messages mh-index-folder-mode-help-messages))
1225
1226(define-derived-mode mh-index-show-mode mh-show-mode "MH-Index-Show"
1227 "Major mode for showing messages in MH-E index.\\<mh-index-folder-mode-keymap>
1228\\{mh-index-folder-mode-keymap}"
1229 (use-local-map mh-index-folder-mode-keymap)
1230 (setq mh-help-messages mh-index-folder-mode-help-messages))
1231
1232;; Font lock support for mh-index-folder. This is the same as mh-folder
1233;; except that the folder line needs to be recognized and highlighted.
1234(defvar mh-index-folder-face 'mh-index-folder-face
1235 "Face for highlighting folders in MH-Index buffers.")
1236(defface mh-index-folder-face
1237 '((((class color) (background light))
1238 (:foreground "dark green"))
1239 (((class color) (background dark))
1240 (:foreground "indian red"))
1241 (t
1242 (:bold t)))
1243 "Face for highlighting folders in MH-Index buffers."
1244 :group 'mh)
1245
1246(eval-after-load "font-lock"
1247 '(progn
1248 (defvar mh-index-folder-face 'mh-index-folder-face
1249 "Face for highlighting folders in MH-Index buffers.")
1250
1251 (defvar mh-index-font-lock-keywords
1252 (list
1253 ;; Folder name
1254 (list "^\\+.*" '(0 mh-index-folder-face))
1255 ;; Marked for deletion
1256 (list (concat mh-scan-deleted-msg-regexp ".*")
1257 '(0 mh-folder-deleted-face))
1258 ;; Marked for refile
1259 (list (concat mh-scan-refiled-msg-regexp ".*")
1260 '(0 mh-folder-refiled-face))
1261 ;;after subj
1262 (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
1263 '(mh-folder-font-lock-subject
1264 (1 mh-folder-followup-face append t)
1265 (2 mh-folder-subject-face append t))
1266 ;;current msg
1267 (list mh-scan-cur-msg-number-regexp
1268 '(1 mh-folder-cur-msg-number-face))
1269 (list mh-scan-good-msg-regexp
1270 '(1 mh-folder-msg-number-face)) ;; Msg number
1271 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
1272 (list mh-scan-rcpt-regexp
1273 '(1 mh-folder-to-face) ;; To:
1274 '(2 mh-folder-address-face)) ;; address
1275 ;; scan font-lock name
1276 (list mh-scan-format-regexp
1277 '(1 mh-folder-date-face)
1278 '(3 mh-folder-scan-format-face))
1279 ;; Current message line
1280 (list mh-scan-cur-msg-regexp
1281 '(1 mh-folder-cur-msg-face prepend t)))
1282 "Regexp keywords used to fontify the MH-Index-Folder buffer.")))
1283
1284(provide 'mh-index) 941(provide 'mh-index)
1285 942
1286;;; Local Variables: 943;;; Local Variables:
944;;; indent-tabs-mode: nil
1287;;; sentence-end-double-space: nil 945;;; sentence-end-double-space: nil
1288;;; End: 946;;; End:
1289 947
diff --git a/lisp/mail/mh-loaddefs.el b/lisp/mail/mh-loaddefs.el
new file mode 100644
index 00000000000..20cfb8571bd
--- /dev/null
+++ b/lisp/mail/mh-loaddefs.el
@@ -0,0 +1,880 @@
1;;; mh-loaddefs.el --- automatically extracted autoloads
2;;
3;;; Commentary:
4;;; Code:
5
6;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
7;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
8;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
9;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
10;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
11;;;;;; (15899 19356))
12;;; Generated autoloads from mh-comp.el
13
14(autoload (quote mh-edit-again) "mh-comp" "\
15Clean up a draft or a message MSG previously sent and make it resendable.
16Default is the current message.
17The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
18See also documentation for `\\[mh-send]' function." t nil)
19
20(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
21Extract message MSG returned by the mail system and make it resendable.
22Default is the current message. The variable `mh-new-draft-cleaned-headers'
23gives the headers to clean out of the original message.
24See also documentation for `\\[mh-send]' function." t nil)
25
26(autoload (quote mh-forward) "mh-comp" "\
27Forward one or more messages to the recipients TO and CC.
28
29Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
30
31Default is the displayed message. If optional prefix argument is given then
32prompt for the message sequence. If variable `transient-mark-mode' is non-nil
33and the mark is active, then the selected region is forwarded.
34See also documentation for `\\[mh-send]' function." t nil)
35
36(autoload (quote mh-redistribute) "mh-comp" "\
37Redistribute displayed message to recipients TO and CC.
38Use optional argument MSG to redistribute another message.
39Depending on how your copy of MH was compiled, you may need to change the
40setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
41
42(autoload (quote mh-reply) "mh-comp" "\
43Reply to MESSAGE (default: current message).
44If the optional argument REPLY-TO is not given, prompts for type of addresses
45to reply to:
46 from sender only,
47 to sender and primary recipients,
48 cc/all sender and all recipients.
49If optional prefix argument INCLUDEP provided, then include the message
50in the reply using filter `mhl.reply' in your MH directory.
51If the file named by `mh-repl-formfile' exists, it is used as a skeleton
52for the reply. See also documentation for `\\[mh-send]' function." t nil)
53
54(autoload (quote mh-send) "mh-comp" "\
55Compose and send a letter.
56
57Do not call this function from outside MH-E; use \\[mh-smail] instead.
58
59The file named by `mh-comp-formfile' will be used as the form.
60The letter is composed in `mh-letter-mode'; see its documentation for more
61details.
62If `mh-compose-letter-function' is defined, it is called on the draft and
63passed three arguments: TO, CC, and SUBJECT." t nil)
64
65(autoload (quote mh-send-other-window) "mh-comp" "\
66Compose and send a letter in another window.
67
68Do not call this function from outside MH-E; use \\[mh-smail-other-window]
69instead.
70
71The file named by `mh-comp-formfile' will be used as the form.
72The letter is composed in `mh-letter-mode'; see its documentation for more
73details.
74If `mh-compose-letter-function' is defined, it is called on the draft and
75passed three arguments: TO, CC, and SUBJECT." t nil)
76
77(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
78Fill paragraph at or after point.
79Prefix ARG means justify as well. This function enables `fill-paragraph' to
80work better in MH-Letter mode." t nil)
81
82(autoload (quote mh-to-field) "mh-comp" "\
83Move point to the end of a specified header field.
84The field is indicated by the previous keystroke (the last keystroke
85of the command) according to the list in the variable `mh-to-field-choices'.
86Create the field if it does not exist. Set the mark to point before moving." t nil)
87
88(autoload (quote mh-to-fcc) "mh-comp" "\
89Insert an Fcc: FOLDER field in the current message.
90Prompt for the field name with a completion list of the current folders." t nil)
91
92(autoload (quote mh-insert-signature) "mh-comp" "\
93Insert the file named by `mh-signature-file-name' at point.
94The value of `mh-letter-insert-signature-hook' is a list of functions to be
95called, with no arguments, before the signature is actually inserted." t nil)
96
97(autoload (quote mh-check-whom) "mh-comp" "\
98Verify recipients of the current letter, showing expansion of any aliases." t nil)
99
100(autoload (quote mh-send-letter) "mh-comp" "\
101Send the draft letter in the current buffer.
102If optional prefix argument ARG is provided, monitor delivery.
103The value of `mh-before-send-letter-hook' is a list of functions to be called,
104with no arguments, before doing anything.
105Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
106Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
107Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
108Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
109
110(autoload (quote mh-insert-letter) "mh-comp" "\
111Insert a message into the current letter.
112Removes the header fields according to the variable `mh-invisible-headers'.
113Prefixes each non-blank line with `mh-ins-buf-prefix', unless
114`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
115used to format the message.
116Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
117not indent and do not delete headers. Leaves the mark before the letter
118and point after it." t nil)
119
120(autoload (quote mh-yank-cur-msg) "mh-comp" "\
121Insert the current message into the draft buffer.
122Prefix each non-blank line in the message with the string in
123`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
124only the region will be inserted. Otherwise, the entire message will
125be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
126is nil, the portion of the message following the point will be yanked.
127If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
128yanked message will be deleted." t nil)
129
130(autoload (quote mh-fully-kill-draft) "mh-comp" "\
131Kill the draft message file and the draft message buffer.
132Use \\[kill-buffer] if you don't want to delete the draft message file." t nil)
133
134(autoload (quote mh-open-line) "mh-comp" "\
135Insert a newline and leave point after it.
136In addition, insert newline and quoting characters before text after point.
137This is useful in breaking up paragraphs in replies." t nil)
138
139(autoload (quote mh-letter-complete) "mh-comp" "\
140Perform completion on header field or word preceding point.
141Alias completion is done within the mail header on selected fields and
142by the function designated by `mh-letter-complete-function' elsewhere,
143passing the prefix ARG if any." t nil)
144
145;;;***
146
147;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
148;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
149;;; Generated autoloads from mh-customize.el
150
151(autoload (quote mh-customize) "mh-customize" "\
152Customize MH-E variables." t nil)
153
154(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
155Construct toolbar for `mh-letter-mode'." nil nil)
156
157(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
158Construct toolbar for `mh-folder-mode'." nil nil)
159
160;;;***
161
162;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
163;;;;;; "mh-e" "mh-e.el" (15899 29921))
164;;; Generated autoloads from mh-e.el
165
166(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
167Return t if the message under point in folder-mode is in the show buffer.
168Return nil in any other circumstance (no message under point, no show buffer,
169the message in the show buffer doesn't match." nil nil)
170
171(autoload (quote mh-update-sequences) "mh-e" "\
172Update MH's Unseen-Sequence and current folder and message.
173Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
174
175(autoload (quote mh-goto-cur-msg) "mh-e" "\
176Position the cursor at the current message.
177When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
178recenter the folder buffer." nil nil)
179
180;;;***
181
182;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
183;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
184;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
185;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
186;;;;;; (15886 19303))
187;;; Generated autoloads from mh-funcs.el
188
189(autoload (quote mh-burst-digest) "mh-funcs" "\
190Burst apart the current message, which should be a digest.
191The message is replaced by its table of contents and the messages from the
192digest are inserted into the folder after that message." t nil)
193
194(autoload (quote mh-copy-msg) "mh-funcs" "\
195Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
196Default is the displayed message. If optional prefix argument is provided,
197then prompt for the message sequence." t nil)
198
199(autoload (quote mh-kill-folder) "mh-funcs" "\
200Remove the current folder and all included messages.
201Removes all of the messages (files) within the specified current folder,
202and then removes the folder (directory) itself.
203The value of `mh-folder-list-change-hook' is a list of functions to be called,
204with no arguments, after the folders has been removed." t nil)
205
206(autoload (quote mh-list-folders) "mh-funcs" "\
207List mail folders." t nil)
208
209(autoload (quote mh-pack-folder) "mh-funcs" "\
210Renumber the messages of a folder to be 1..n.
211First, offer to execute any outstanding commands for the current folder. If
212optional prefix argument provided, prompt for the RANGE of messages to display
213after packing. Otherwise, show the entire folder." t nil)
214
215(autoload (quote mh-pipe-msg) "mh-funcs" "\
216Pipe the current message through the given shell COMMAND.
217If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
218Otherwise just send the message's body without the headers." t nil)
219
220(autoload (quote mh-page-digest) "mh-funcs" "\
221Advance displayed message to next digested message." t nil)
222
223(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
224Back up displayed message to previous digested message." t nil)
225
226(autoload (quote mh-print-msg) "mh-funcs" "\
227Print MSG-OR-SEQ (default: displayed message) on printer.
228If optional prefix argument provided, then prompt for the message sequence.
229The variable `mh-lpr-command-format' is used to generate the print command.
230The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
231
232(autoload (quote mh-sort-folder) "mh-funcs" "\
233Sort the messages in the current folder by date.
234Calls the MH program sortm to do the work.
235The arguments in the list `mh-sortm-args' are passed to sortm if the optional
236argument EXTRA-ARGS is given." t nil)
237
238(autoload (quote mh-undo-folder) "mh-funcs" "\
239Undo all pending deletes and refiles in current folder.
240Argument IGNORE is deprecated." t nil)
241
242(autoload (quote mh-store-msg) "mh-funcs" "\
243Store the file(s) contained in the current message into DIRECTORY.
244The message can contain a shar file or uuencoded file.
245Default directory is the last directory used, or initially the value of
246`mh-store-default-directory' or the current directory." t nil)
247
248(autoload (quote mh-store-buffer) "mh-funcs" "\
249Store the file(s) contained in the current buffer into DIRECTORY.
250The buffer can contain a shar file or uuencoded file.
251Default directory is the last directory used, or initially the value of
252`mh-store-default-directory' or the current directory." t nil)
253
254(autoload (quote mh-help) "mh-funcs" "\
255Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
256
257(autoload (quote mh-prefix-help) "mh-funcs" "\
258Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
259
260;;;***
261
262;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
263;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
264;;; Generated autoloads from mh-identity.el
265
266(autoload (quote mh-identity-make-menu) "mh-identity" "\
267Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
268
269(autoload (quote mh-identity-list-set) "mh-identity" "\
270Update the `mh-identity-list' variable, and rebuild the menu.
271Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
272customization). This is called after 'customize is used to alter
273`mh-identity-list'." nil nil)
274
275(autoload (quote mh-insert-identity) "mh-identity" "\
276Insert proper fields for given IDENTITY.
277Edit the `mh-identity-list' variable to define identity." t nil)
278
279;;;***
280
281;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
282;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
283;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
284;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
285;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
286;;; Generated autoloads from mh-index.el
287
288(autoload (quote mh-index-update-maps) "mh-index" "\
289Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
290As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
291is a hashtable which maps each message in the index folder to the original
292folder and message from whence it was copied. If present the
293checksum -> (origin-folder, origin-index) map is updated too." nil nil)
294
295(autoload (quote mh-index-search) "mh-index" "\
296Perform an indexed search in an MH mail folder.
297
298If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
299index search, then the search is repeated. Otherwise, FOLDER is searched with
300SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
301\"+\" then mail in all folders are searched.
302
303Four indexing programs are supported; if none of these are present, then grep
304is used. This function picks the first program that is available on your
305system. If you would prefer to use a different program, set the customization
306variable `mh-index-program' accordingly.
307
308The documentation for the following functions describes how to generate the
309index for each program:
310
311 - `mh-swish++-execute-search'
312 - `mh-swish-execute-search'
313 - `mh-namazu-execute-search'
314 - `mh-glimpse-execute-search'
315
316This and related functions use an X-MHE-Checksum header to cache the MD5
317checksum of a message. This means that already present X-MHE-Checksum headers
318in the incoming email could result in messages not being found. The following
319procmail recipe should avoid this:
320
321 :0 wf
322 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
323
324This has the effect of renaming already present X-MHE-Checksum headers." t nil)
325
326(autoload (quote mh-index-next-folder) "mh-index" "\
327Jump to the next folder marker.
328The function is only applicable to folders displaying index search results.
329With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
330results." t nil)
331
332(autoload (quote mh-index-previous-folder) "mh-index" "\
333Jump to the previous folder marker." t nil)
334
335(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
336Annotate the search results with original folder names." nil nil)
337
338(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
339Delete the folder headers." nil nil)
340
341(autoload (quote mh-index-visit-folder) "mh-index" "\
342Visit original folder from where the message at point was found." t nil)
343
344(autoload (quote mh-index-execute-commands) "mh-index" "\
345Delete/refile the actual messages.
346The copies in the searched folder are then deleted/refiled to get the desired
347result. Before deleting the messages we make sure that the message being
348deleted is identical to the one that the user has marked in the index buffer." nil nil)
349
350(autoload (quote mh-glimpse-execute-search) "mh-index" "\
351Execute glimpse and read the results.
352
353In the examples below, replace /home/user/Mail with the path to your MH
354directory.
355
356First create the directory /home/user/Mail/.glimpse. Then create the file
357/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
358
359 */.*
360 */#*
361 */,*
362 */*~
363 ^/home/user/Mail/.glimpse
364 ^/home/user/Mail/mhe-index
365
366If there are any directories you would like to ignore, append lines like the
367following to .glimpse_exclude:
368
369 ^/home/user/Mail/scripts
370
371You do not want to index the folders that hold the results of your searches
372since they tend to be ephemeral and the original messages are indexed anyway.
373The configuration file above assumes that the results are found in sub-folders
374of `mh-index-folder' which is +mhe-index by default.
375
376Use the following command line to generate the glimpse index. Run this
377daily from cron:
378
379 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
380
381FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
382
383(autoload (quote mh-swish-execute-search) "mh-index" "\
384Execute swish-e and read the results.
385
386In the examples below, replace /home/user/Mail with the path to your MH
387directory.
388
389First create the directory /home/user/Mail/.swish. Then create the file
390/home/user/Mail/.swish/config with the following contents:
391
392 IndexDir /home/user/Mail
393 IndexFile /home/user/Mail/.swish/index
394 IndexName \"Mail Index\"
395 IndexDescription \"Mail Index\"
396 IndexPointer \"http://nowhere\"
397 IndexAdmin \"nobody\"
398 #MetaNames automatic
399 IndexReport 3
400 FollowSymLinks no
401 UseStemming no
402 IgnoreTotalWordCountWhenRanking yes
403 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
404 BeginCharacters abcdefghijklmnopqrstuvwxyz
405 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
406 IgnoreLimit 50 1000
407 IndexComments 0
408 FileRules pathname contains /home/user/Mail/.swish
409 FileRules pathname contains /home/user/Mail/mhe-index
410 FileRules filename is index
411 FileRules filename is ..*
412 FileRules filename is #.*
413 FileRules filename is ,.*
414 FileRules filename is .*~
415
416If there are any directories you would like to ignore, append lines like the
417following to config:
418
419 FileRules pathname contains /home/user/Mail/scripts
420
421You do not want to index the folders that hold the results of your searches
422since they tend to be ephemeral and the original messages are indexed anyway.
423The configuration file above assumes that the results are found in sub-folders
424of `mh-index-folder' which is +mhe-index by default.
425
426Use the following command line to generate the swish index. Run this
427daily from cron:
428
429 swish-e -c /home/user/Mail/.swish/config
430
431FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
432
433(autoload (quote mh-swish++-execute-search) "mh-index" "\
434Execute swish++ and read the results.
435
436In the examples below, replace /home/user/Mail with the path to your MH
437directory.
438
439First create the directory /home/user/Mail/.swish++. Then create the file
440/home/user/Mail/.swish++/swish++.conf with the following contents:
441
442 IncludeMeta Bcc Cc Comments Content-Description From Keywords
443 IncludeMeta Newsgroups Resent-To Subject To
444 IncludeMeta Message-Id References In-Reply-To
445 IncludeFile Mail *
446 IndexFile /home/user/Mail/.swish++/swish++.index
447
448Use the following command line to generate the swish index. Run this
449daily from cron:
450
451 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
452 -o -path /home/user/Mail/.swish++ -prune \\
453 -o -name \"[0-9]*\" -print \\
454 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
455
456You do not want to index the folders that hold the results of your searches
457since they tend to be ephemeral and the original messages are indexed anyway.
458The command above assumes that the results are found in sub-folders of
459`mh-index-folder' which is +mhe-index by default.
460
461On some systems (Debian GNU/Linux, for example), use index++ instead of index.
462
463FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
464
465(autoload (quote mh-namazu-execute-search) "mh-index" "\
466Execute namazu and read the results.
467
468In the examples below, replace /home/user/Mail with the path to your MH
469directory.
470
471First create the directory /home/user/Mail/.namazu. Then create the file
472/home/user/Mail/.namazu/mknmzrc with the following contents:
473
474 package conf; # Don't remove this line!
475 $ADDRESS = 'user@localhost';
476 $ALLOW_FILE = \"[0-9]*\";
477 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
478
479In the above example configuration, none of the mail files contained in the
480directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
481
482You do not want to index the folders that hold the results of your searches
483since they tend to be ephemeral and the original messages are indexed anyway.
484The configuration file above assumes that the results are found in sub-folders
485of `mh-index-folder' which is +mhe-index by default.
486
487Use the following command line to generate the namazu index. Run this
488daily from cron:
489
490 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
491 /home/user/Mail
492
493FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
494
495;;;***
496
497;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
498;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis
499;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
500;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
501;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
502;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
503;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
504;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
505;;; Generated autoloads from mh-mime.el
506
507(autoload (quote mh-compose-insertion) "mh-mime" "\
508Add a directive to insert a MIME part from a file, using mhn or gnus.
509If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
510If it is set to 'gnus, then that will be used instead.
511Optional argument INLINE means make it an inline attachment." t nil)
512
513(autoload (quote mh-compose-forward) "mh-mime" "\
514Add a MIME directive to forward a message, using mhn or gnus.
515If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
516If it is set to 'gnus, then that will be used instead.
517Optional argument DESCRIPTION is a description of the attachment.
518Optional argument FOLDER is the folder from which the forwarded message should
519come.
520Optional argument MESSAGE is the message to forward.
521If any of the optional arguments are absent, they are prompted for." t nil)
522
523(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
524Add a directive to insert a MIME message part from a file.
525This is the typical way to insert non-text parts in a message.
526
527Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
528content type, DESCRIPTION, a line of text for the Content-Description field.
529ATTRIBUTES is a comma separated list of name=value pairs that is appended to
530the Content-Type field of the attachment.
531
532See also \\[mh-edit-mhn]." t nil)
533
534(autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\
535Add a directive for a MIME anonymous ftp external body part.
536This directive tells MH to include a reference to a message/external-body part
537retrievable by anonymous FTP.
538
539Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
540MIME content type, and DESCRIPTION, a line of text for the Content-description
541header.
542
543See also \\[mh-edit-mhn]." t nil)
544
545(autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\
546Add a directive to include a MIME reference to a compressed tar file.
547The file should be available via anonymous ftp. This directive tells MH to
548include a reference to a message/external-body part.
549
550Arguments are HOST and FILENAME, which tell where to find the file, and
551DESCRIPTION, a line of text for the Content-description header.
552
553See also \\[mh-edit-mhn]." t nil)
554
555(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
556Add a forw directive to this message, to forward a message with MIME.
557This directive tells MH to include the named messages in this one.
558
559Arguments are DESCRIPTION, a line of text for the Content-description header,
560and FOLDER and MESSAGES, which name the message(s) to be forwarded.
561
562See also \\[mh-edit-mhn]." t nil)
563
564(autoload (quote mh-edit-mhn) "mh-mime" "\
565Format the current draft for MIME, expanding any mhn directives.
566
567Process the current draft with the mhn program, which, using directives
568already inserted in the draft, fills in all the MIME components and header
569fields.
570
571This step should be done last just before sending the message.
572
573The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
574list `mh-mhn-args' are passed to mhn if this function is passed an optional
575prefix argument EXTRA-ARGS.
576
577For assistance with creating mhn directives to insert various types of
578components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
579from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
580anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
581compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
582message). If these helper functions are used, `mh-edit-mhn' is run
583automatically when the draft is sent.
584
585The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
586arguments, after performing the conversion.
587
588The mhn program is part of MH version 6.8 or later." t nil)
589
590(autoload (quote mh-revert-mhn-edit) "mh-mime" "\
591Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
592Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
593
594(autoload (quote mh-mml-to-mime) "mh-mime" "\
595Compose MIME message from mml directives." t nil)
596
597(autoload (quote mh-mml-forward-message) "mh-mime" "\
598Forward a message as attachment.
599The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
600number." nil nil)
601
602(autoload (quote mh-mml-attach-file) "mh-mime" "\
603Attach a file to the outgoing MIME message.
604The file is not inserted or encoded until you send the message with
605`\\[mh-send-letter]'.
606Message disposition is \"inline\" or \"attachment\" and is prompted for if
607DISPOSITION is nil.
608
609This is basically `mml-attach-file' from gnus, modified such that a prefix
610argument yields an `inline' disposition and Content-Type is determined
611automatically." nil nil)
612
613(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
614Add directive to encrypt/sign the entire message." t nil)
615
616(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
617Add directive to encrypt and sign the entire message.
618If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
619
620(autoload (quote mh-mime-cleanup) "mh-mime" "\
621Free the decoded MIME parts." nil nil)
622
623(autoload (quote mh-destroy-postponed-handles) "mh-mime" "\
624Free MIME data for externally displayed mime parts." nil nil)
625
626(autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\
627Some mail programs don't put a MIME-Version header.
628I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil)
629
630(autoload (quote mh-display-smileys) "mh-mime" "\
631Function to display smileys." nil nil)
632
633(autoload (quote mh-display-emphasis) "mh-mime" "\
634Function to display graphical emphasis." nil nil)
635
636(autoload (quote mh-mime-save-parts) "mh-mime" "\
637Store the MIME parts of the current message.
638If ARG, prompt for directory, else use that specified by the variable
639`mh-mime-save-parts-default-directory'. These directories may be superseded by
640mh_profile directives, since this function calls on mhstore or mhn to do the
641actual storing." t nil)
642
643(autoload (quote mh-mime-display) "mh-mime" "\
644Display (and possibly decode) MIME handles.
645Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
646present they are displayed otherwise the buffer is parsed and then
647displayed." nil nil)
648
649(autoload (quote mh-press-button) "mh-mime" "\
650Press MIME button.
651If the MIME part is visible then it is removed. Otherwise the part is
652displayed." t nil)
653
654(autoload (quote mh-push-button) "mh-mime" "\
655Click MIME button for EVENT.
656If the MIME part is visible then it is removed. Otherwise the part is
657displayed. This function is called when the mouse is used to click the MIME
658button." t nil)
659
660(autoload (quote mh-mime-save-part) "mh-mime" "\
661Save MIME part at point." t nil)
662
663(autoload (quote mh-mime-inline-part) "mh-mime" "\
664Toggle display of the raw MIME part." t nil)
665
666;;;***
667
668;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
669;;;;;; "mh-pick.el" (15854 20166))
670;;; Generated autoloads from mh-pick.el
671
672(autoload (quote mh-search-folder) "mh-pick" "\
673Search FOLDER for messages matching a pattern.
674This function uses the MH command `pick' to do the work.
675Add the messages found to the sequence named `search'." t nil)
676
677(autoload (quote mh-do-pick-search) "mh-pick" "\
678Find messages that match the qualifications in the current pattern buffer.
679Messages are searched for in the folder named in `mh-searching-folder'.
680Add the messages found to the sequence named `search'." t nil)
681
682;;;***
683
684;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
685;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
686;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
687;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
688;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
689;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
690;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
691;;;;;; 19358))
692;;; Generated autoloads from mh-seq.el
693
694(autoload (quote mh-delete-seq) "mh-seq" "\
695Delete the SEQUENCE." t nil)
696
697(autoload (quote mh-list-sequences) "mh-seq" "\
698List the sequences defined in the folder being visited." t nil)
699
700(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
701Display the sequences that contain MESSAGE (default: current message)." t nil)
702
703(autoload (quote mh-narrow-to-seq) "mh-seq" "\
704Restrict display of this folder to just messages in SEQUENCE.
705Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
706
707(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
708Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
709If optional prefix argument provided, then prompt for the message sequence.
710If variable `transient-mark-mode' is non-nil and the mark is active, then
711the selected region is added to the sequence." t nil)
712
713(autoload (quote mh-widen) "mh-seq" "\
714Remove restrictions from current folder, thereby showing all messages." t nil)
715
716(autoload (quote mh-rename-seq) "mh-seq" "\
717Rename SEQUENCE to have NEW-NAME." t nil)
718
719(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
720Invoke the FUNC at each message in the SEQ.
721SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
722passed as arguments to FUNC." nil nil)
723
724(autoload (quote mh-notate-seq) "mh-seq" "\
725Mark the scan listing.
726All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
727the line." nil nil)
728
729(autoload (quote mh-add-to-sequence) "mh-seq" "\
730The sequence SEQ is augmented with the messages in MSGS." nil nil)
731
732(autoload (quote mh-region-to-msg-list) "mh-seq" "\
733Return a list of messages within the region between BEGIN and END." nil nil)
734
735(autoload (quote mh-narrow-to-subject) "mh-seq" "\
736Narrow to a sequence containing all following messages with same subject." t nil)
737
738(autoload (quote mh-delete-subject) "mh-seq" "\
739Mark all following messages with same subject to be deleted.
740This puts the messages in a sequence named subject. You can undo the last
741deletion marks using `mh-undo' with a prefix argument and then specifying the
742subject sequence." t nil)
743
744(autoload (quote mh-delete-subject-or-thread) "mh-seq" "\
745Mark messages for deletion intelligently.
746If the folder is threaded then `mh-thread-delete' is used to mark the current
747message and all its descendants for deletion. Otherwise `mh-delete-subject' is
748used to mark the current message and all messages following it with the same
749subject for deletion." t nil)
750
751(autoload (quote mh-thread-inc) "mh-seq" "\
752Update thread tree for FOLDER.
753All messages after START-POINT are added to the thread tree." nil nil)
754
755(autoload (quote mh-thread-add-spaces) "mh-seq" "\
756Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
757
758(autoload (quote mh-toggle-threads) "mh-seq" "\
759Toggle threaded view of folder.
760The conversion of normal view to threaded view is exact, that is the same
761messages are displayed in the folder buffer before and after threading. However
762the conversion from threaded view to normal view is inexact. So more messages
763than were originally present may be shown as a result." t nil)
764
765(autoload (quote mh-thread-forget-message) "mh-seq" "\
766Forget the message INDEX from the threading tables." nil nil)
767
768(autoload (quote mh-thread-next-sibling) "mh-seq" "\
769Jump to next sibling.
770With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil)
771
772(autoload (quote mh-thread-previous-sibling) "mh-seq" "\
773Jump to previous sibling." t nil)
774
775(autoload (quote mh-thread-ancestor) "mh-seq" "\
776Jump to the ancestor of current message.
777If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
778thread tree the message belongs to." t nil)
779
780(autoload (quote mh-thread-delete) "mh-seq" "\
781Mark current message and all its children for subsequent deletion." t nil)
782
783(autoload (quote mh-thread-refile) "mh-seq" "\
784Mark current message and all its children for refiling to FOLDER." t nil)
785
786;;;***
787
788;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
789;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
790;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
791;;; Generated autoloads from mh-speed.el
792
793(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
794Interface function to create MH-E speedbar buffer.
795BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil)
796
797(defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons))
798
799(defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons))
800
801(autoload (quote mh-speed-toggle) "mh-speed" "\
802Toggle the display of child folders.
803The otional ARGS are ignored and there for compatibilty with speedbar." t nil)
804
805(autoload (quote mh-speed-view) "mh-speed" "\
806View folder on current line.
807Optional ARGS are ignored." t nil)
808
809(autoload (quote mh-speed-flists) "mh-speed" "\
810Execute flists -recurse and update message counts.
811If FORCE is non-nil the timer is reset." t nil)
812
813(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
814Remove FOLDER from various optimization caches." t nil)
815
816(autoload (quote mh-speed-add-folder) "mh-speed" "\
817Add FOLDER since it is being created.
818The function invalidates the latest ancestor that is present." nil nil)
819
820;;;***
821
822;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
823;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
824;;; Generated autoloads from mh-utils.el
825
826(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
827Find e-mail address around or before point.
828Then search backwards to beginning of line for the start of an e-mail
829address. If no e-mail address found, return nil." nil nil)
830
831(autoload (quote mh-get-msg-num) "mh-utils" "\
832Return the message number of the displayed message.
833If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
834not pointing to a message." nil nil)
835
836;;;***
837
838;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
839;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
840;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
841;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
842;;; Generated autoloads from mh-alias.el
843
844(autoload (quote mh-alias-reload) "mh-alias" "\
845Load MH aliases into `mh-alias-alist'." t nil)
846
847(autoload (quote mh-read-address) "mh-alias" "\
848Read an address from the minibuffer with PROMPT." nil nil)
849
850(autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\
851Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
852
853(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
854Expand mail alias before point." nil nil)
855
856(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
857Return t is From has no current alias set." nil nil)
858
859(autoload (quote mh-alias-add-alias) "mh-alias" "\
860*Add ALIAS for ADDRESS in personal alias file.
861Prompts for confirmation if the address already has an alias.
862If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
863
864(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
865*Add ALIAS for ADDRESS in personal alias file.
866Prompts for confirmation if the alias is already in use or if the address
867already has an alias." t nil)
868
869(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
870Insert an alias for email address under point." t nil)
871
872;;;***
873
874(provide 'mh-loaddefs)
875;;; Local Variables:
876;;; version-control: never
877;;; no-byte-compile: t
878;;; no-update-autoloads: t
879;;; End:
880;;; mh-loaddefs.el ends here
diff --git a/lisp/mail/mh-mime.el b/lisp/mail/mh-mime.el
index bd70c371549..594b63eee9b 100644
--- a/lisp/mail/mh-mime.el
+++ b/lisp/mail/mh-mime.el
@@ -32,17 +32,17 @@
32 32
33;;; Change Log: 33;;; Change Log:
34 34
35;; $Id: mh-mime.el,v 1.90 2002/11/22 20:00:48 satyaki Exp $ 35;; $Id: mh-mime.el,v 1.98 2002/12/06 03:33:47 satyaki Exp $
36 36
37;;; Code: 37;;; Code:
38 38
39(require 'cl) 39(require 'cl)
40(require 'mh-comp) 40(require 'mh-comp)
41(require 'mh-utils) 41(require 'mh-utils)
42(load "mm-decode" t t) ; Non-fatal dependency 42(load "mm-decode" t t) ; Non-fatal dependency
43(load "mm-uu" t t) ; Non-fatal dependency 43(load "mm-uu" t t) ; Non-fatal dependency
44(load "mailcap" t t) ; Non-fatal dependency 44(load "mailcap" t t) ; Non-fatal dependency
45(load "smiley" t t) ; Non-fatal dependency 45(load "smiley" t t) ; Non-fatal dependency
46(require 'gnus-util) 46(require 'gnus-util)
47 47
48(autoload 'gnus-article-goto-header "gnus-art") 48(autoload 'gnus-article-goto-header "gnus-art")
@@ -59,29 +59,7 @@
59(autoload 'mml-to-mime "mml") 59(autoload 'mml-to-mime "mml")
60(autoload 'mml-attach-file "mml") 60(autoload 'mml-attach-file "mml")
61 61
62;;; Hooks 62;;;###mh-autoload
63(defcustom mh-edit-mhn-hook nil
64 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
65 :type 'hook
66 :group 'mh-hook)
67
68;; Keeps assorted MIME data
69(defstruct (mh-buffer-data (:conc-name mh-mime-)
70 (:constructor mh-make-buffer-data))
71 ;; Structure to keep track of MIME handles on a per buffer basis.
72 (handles ()) ; List of MIME handles
73 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
74 ; nested messages
75 (parts-count 0) ; The button number is generated from
76 ; this number
77 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number
78 ; for nested messages
79
80;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
81(defmacro mh-buffer-data ()
82 "Convenience macro to get the MIME data structures of the current buffer."
83 `(gethash (current-buffer) mh-globals-hash))
84
85(defun mh-compose-insertion (&optional inline) 63(defun mh-compose-insertion (&optional inline)
86 "Add a directive to insert a MIME part from a file, using mhn or gnus. 64 "Add a directive to insert a MIME part from a file, using mhn or gnus.
87If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. 65If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
@@ -94,6 +72,7 @@ Optional argument INLINE means make it an inline attachment."
94 (mh-mml-attach-file)) 72 (mh-mml-attach-file))
95 (call-interactively 'mh-mhn-compose-insertion))) 73 (call-interactively 'mh-mhn-compose-insertion)))
96 74
75;;;###mh-autoload
97(defun mh-compose-forward (&optional description folder message) 76(defun mh-compose-forward (&optional description folder message)
98 "Add a MIME directive to forward a message, using mhn or gnus. 77 "Add a MIME directive to forward a message, using mhn or gnus.
99If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. 78If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
@@ -104,12 +83,12 @@ come.
104Optional argument MESSAGE is the message to forward. 83Optional argument MESSAGE is the message to forward.
105If any of the optional arguments are absent, they are prompted for." 84If any of the optional arguments are absent, they are prompted for."
106 (interactive (list 85 (interactive (list
107 (read-string "Forw Content-description: ") 86 (read-string "Forw Content-description: ")
108 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) 87 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
109 (read-string (format "Messages%s: " 88 (read-string (format "Messages%s: "
110 (if mh-sent-from-msg 89 (if mh-sent-from-msg
111 (format " [%d]" mh-sent-from-msg) 90 (format " [%d]" mh-sent-from-msg)
112 ""))))) 91 "")))))
113 (if (equal mh-compose-insertion 'gnus) 92 (if (equal mh-compose-insertion 'gnus)
114 (mh-mml-forward-message description folder message) 93 (mh-mml-forward-message description folder message)
115 (mh-mhn-compose-forw description folder message))) 94 (mh-mhn-compose-forw description folder message)))
@@ -117,7 +96,7 @@ If any of the optional arguments are absent, they are prompted for."
117;; To do: 96;; To do:
118;; paragraph code should not fill # lines if MIME enabled. 97;; paragraph code should not fill # lines if MIME enabled.
119;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] 98;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
120;; invokes mh-edit-mhn automatically before sending.) 99;; invokes mh-edit-mhn automatically before sending.)
121;; actually, instead of mh-auto-edit-mhn, 100;; actually, instead of mh-auto-edit-mhn,
122;; should read automhnproc from profile 101;; should read automhnproc from profile
123;; MIME option to mh-forward 102;; MIME option to mh-forward
@@ -143,7 +122,7 @@ MH profile.")
143 "Return t if 'file' command is on the system. 122 "Return t if 'file' command is on the system.
144'file -i' is used to get MIME type of composition insertion." 123'file -i' is used to get MIME type of composition insertion."
145 (when (not (boundp 'mh-have-file-command)) 124 (when (not (boundp 'mh-have-file-command))
146 (load "executable" t t) ; executable-find not autoloaded in emacs20 125 (load "executable" t t) ; executable-find not autoloaded in emacs20
147 (setq mh-have-file-command 126 (setq mh-have-file-command
148 (and (fboundp 'executable-find) 127 (and (fboundp 'executable-find)
149 (executable-find "file") ; file command exists 128 (executable-find "file") ; file command exists
@@ -223,6 +202,7 @@ Returns nil if file command not on system."
223 "Legal MIME content types. 202 "Legal MIME content types.
224See documentation for \\[mh-edit-mhn].") 203See documentation for \\[mh-edit-mhn].")
225 204
205;;;###mh-autoload
226(defun mh-mhn-compose-insertion (filename type description attributes) 206(defun mh-mhn-compose-insertion (filename type description attributes)
227 "Add a directive to insert a MIME message part from a file. 207 "Add a directive to insert a MIME message part from a file.
228This is the typical way to insert non-text parts in a message. 208This is the typical way to insert non-text parts in a message.
@@ -234,22 +214,22 @@ the Content-Type field of the attachment.
234 214
235See also \\[mh-edit-mhn]." 215See also \\[mh-edit-mhn]."
236 (interactive (let ((filename (read-file-name "Insert contents of: "))) 216 (interactive (let ((filename (read-file-name "Insert contents of: ")))
237 (list 217 (list
238 filename 218 filename
239 (or (mh-file-mime-type filename) 219 (or (mh-file-mime-type filename)
240 (completing-read "Content-Type: " 220 (completing-read "Content-Type: "
241 (if (fboundp 'mailcap-mime-types) 221 (if (fboundp 'mailcap-mime-types)
242 (mapcar 'list (mailcap-mime-types)) 222 (mapcar 'list (mailcap-mime-types))
243 mh-mime-content-types))) 223 mh-mime-content-types)))
244 (read-string "Content-Description: ") 224 (read-string "Content-Description: ")
245 (read-string "Content-Attributes: " 225 (read-string "Content-Attributes: "
246 (concat "name=\"" 226 (concat "name=\""
247 (file-name-nondirectory filename) 227 (file-name-nondirectory filename)
248 "\""))))) 228 "\"")))))
249 (mh-mhn-compose-type filename type description attributes )) 229 (mh-mhn-compose-type filename type description attributes ))
250 230
251(defun mh-mhn-compose-type (filename type 231(defun mh-mhn-compose-type (filename type
252 &optional description attributes comment) 232 &optional description attributes comment)
253 "Insert a mhn directive to insert a file. 233 "Insert a mhn directive to insert a file.
254 234
255The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is 235The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
@@ -269,6 +249,7 @@ optional COMMENT can also be included."
269 (insert "\n")) 249 (insert "\n"))
270 250
271 251
252;;;###mh-autoload
272(defun mh-mhn-compose-anon-ftp (host filename type description) 253(defun mh-mhn-compose-anon-ftp (host filename type description)
273 "Add a directive for a MIME anonymous ftp external body part. 254 "Add a directive for a MIME anonymous ftp external body part.
274This directive tells MH to include a reference to a message/external-body part 255This directive tells MH to include a reference to a message/external-body part
@@ -280,16 +261,17 @@ header.
280 261
281See also \\[mh-edit-mhn]." 262See also \\[mh-edit-mhn]."
282 (interactive (list 263 (interactive (list
283 (read-string "Remote host: ") 264 (read-string "Remote host: ")
284 (read-string "Remote filename: ") 265 (read-string "Remote filename: ")
285 (completing-read "External Content-Type: " 266 (completing-read "External Content-Type: "
286 (if (fboundp 'mailcap-mime-types) 267 (if (fboundp 'mailcap-mime-types)
287 (mapcar 'list (mailcap-mime-types)) 268 (mapcar 'list (mailcap-mime-types))
288 mh-mime-content-types)) 269 mh-mime-content-types))
289 (read-string "External Content-Description: "))) 270 (read-string "External Content-Description: ")))
290 (mh-mhn-compose-external-type "anon-ftp" host filename 271 (mh-mhn-compose-external-type "anon-ftp" host filename
291 type description)) 272 type description))
292 273
274;;;###mh-autoload
293(defun mh-mhn-compose-external-compressed-tar (host filename description) 275(defun mh-mhn-compose-external-compressed-tar (host filename description)
294 "Add a directive to include a MIME reference to a compressed tar file. 276 "Add a directive to include a MIME reference to a compressed tar file.
295The file should be available via anonymous ftp. This directive tells MH to 277The file should be available via anonymous ftp. This directive tells MH to
@@ -300,19 +282,20 @@ DESCRIPTION, a line of text for the Content-description header.
300 282
301See also \\[mh-edit-mhn]." 283See also \\[mh-edit-mhn]."
302 (interactive (list 284 (interactive (list
303 (read-string "Remote host: ") 285 (read-string "Remote host: ")
304 (read-string "Remote filename: ") 286 (read-string "Remote filename: ")
305 (read-string "Tar file Content-description: "))) 287 (read-string "Tar file Content-description: ")))
306 (mh-mhn-compose-external-type "anon-ftp" host filename 288 (mh-mhn-compose-external-type "anon-ftp" host filename
307 "application/octet-stream" 289 "application/octet-stream"
308 description 290 description
309 "type=tar; conversions=x-compress" 291 "type=tar; conversions=x-compress"
310 "mode=image")) 292 "mode=image"))
311 293
312 294
313(defun mh-mhn-compose-external-type (access-type host filename type 295(defun mh-mhn-compose-external-type (access-type host filename type
314 &optional description 296 &optional description
315 attributes extra-params comment) 297 attributes extra-params
298 comment)
316 "Add a directive to include a MIME reference to a remote file. 299 "Add a directive to include a MIME reference to a remote file.
317The file should be available via anonymous ftp. This directive tells MH to 300The file should be available via anonymous ftp. This directive tells MH to
318include a reference to a message/external-body part. 301include a reference to a message/external-body part.
@@ -342,6 +325,7 @@ See also \\[mh-edit-mhn]."
342 (insert "; " extra-params)) 325 (insert "; " extra-params))
343 (insert "\n")) 326 (insert "\n"))
344 327
328;;;###mh-autoload
345(defun mh-mhn-compose-forw (&optional description folder messages) 329(defun mh-mhn-compose-forw (&optional description folder messages)
346 "Add a forw directive to this message, to forward a message with MIME. 330 "Add a forw directive to this message, to forward a message with MIME.
347This directive tells MH to include the named messages in this one. 331This directive tells MH to include the named messages in this one.
@@ -351,12 +335,12 @@ and FOLDER and MESSAGES, which name the message(s) to be forwarded.
351 335
352See also \\[mh-edit-mhn]." 336See also \\[mh-edit-mhn]."
353 (interactive (list 337 (interactive (list
354 (read-string "Forw Content-description: ") 338 (read-string "Forw Content-description: ")
355 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) 339 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
356 (read-string (format "Messages%s: " 340 (read-string (format "Messages%s: "
357 (if mh-sent-from-msg 341 (if mh-sent-from-msg
358 (format " [%d]" mh-sent-from-msg) 342 (format " [%d]" mh-sent-from-msg)
359 ""))))) 343 "")))))
360 (setq mh-mhn-compose-insert-flag t) 344 (setq mh-mhn-compose-insert-flag t)
361 (beginning-of-line) 345 (beginning-of-line)
362 (insert "#forw [") 346 (insert "#forw [")
@@ -368,14 +352,15 @@ See also \\[mh-edit-mhn]."
368 (not (string= folder "")) 352 (not (string= folder ""))
369 (insert " " folder)) 353 (insert " " folder))
370 (if (and messages 354 (if (and messages
371 (not (string= messages ""))) 355 (not (string= messages "")))
372 (let ((start (point))) 356 (let ((start (point)))
373 (insert " " messages) 357 (insert " " messages)
374 (subst-char-in-region start (point) ?, ? )) 358 (subst-char-in-region start (point) ?, ? ))
375 (if mh-sent-from-msg 359 (if mh-sent-from-msg
376 (insert " " (int-to-string mh-sent-from-msg)))) 360 (insert " " (int-to-string mh-sent-from-msg))))
377 (insert "\n")) 361 (insert "\n"))
378 362
363;;;###mh-autoload
379(defun mh-edit-mhn (&optional extra-args) 364(defun mh-edit-mhn (&optional extra-args)
380 "Format the current draft for MIME, expanding any mhn directives. 365 "Format the current draft for MIME, expanding any mhn directives.
381 366
@@ -416,6 +401,7 @@ The mhn program is part of MH version 6.8 or later."
416 (message "mhn editing...done") 401 (message "mhn editing...done")
417 (run-hooks 'mh-edit-mhn-hook)) 402 (run-hooks 'mh-edit-mhn-hook))
418 403
404;;;###mh-autoload
419(defun mh-revert-mhn-edit (noconfirm) 405(defun mh-revert-mhn-edit (noconfirm)
420 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. 406 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
421Optional non-nil argument NOCONFIRM means don't ask for confirmation." 407Optional non-nil argument NOCONFIRM means don't ask for confirmation."
@@ -423,21 +409,21 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
423 (if (null buffer-file-name) 409 (if (null buffer-file-name)
424 (error "Buffer does not seem to be associated with any file")) 410 (error "Buffer does not seem to be associated with any file"))
425 (let ((backup-strings '("," "#")) 411 (let ((backup-strings '("," "#"))
426 backup-file) 412 backup-file)
427 (while (and backup-strings 413 (while (and backup-strings
428 (not (file-exists-p 414 (not (file-exists-p
429 (setq backup-file 415 (setq backup-file
430 (concat (file-name-directory buffer-file-name) 416 (concat (file-name-directory buffer-file-name)
431 (car backup-strings) 417 (car backup-strings)
432 (file-name-nondirectory buffer-file-name) 418 (file-name-nondirectory buffer-file-name)
433 ".orig"))))) 419 ".orig")))))
434 (setq backup-strings (cdr backup-strings))) 420 (setq backup-strings (cdr backup-strings)))
435 (or backup-strings 421 (or backup-strings
436 (error "Backup file for %s no longer exists!" buffer-file-name)) 422 (error "Backup file for %s no longer exists!" buffer-file-name))
437 (or noconfirm 423 (or noconfirm
438 (yes-or-no-p (format "Revert buffer from file %s? " 424 (yes-or-no-p (format "Revert buffer from file %s? "
439 backup-file)) 425 backup-file))
440 (error "Revert not confirmed")) 426 (error "Revert not confirmed"))
441 (let ((buffer-read-only nil)) 427 (let ((buffer-read-only nil))
442 (erase-buffer) 428 (erase-buffer)
443 (insert-file-contents backup-file)) 429 (insert-file-contents backup-file))
@@ -447,6 +433,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
447 433
448;;; MIME composition functions 434;;; MIME composition functions
449 435
436;;;###mh-autoload
450(defun mh-mml-to-mime () 437(defun mh-mml-to-mime ()
451 "Compose MIME message from mml directives." 438 "Compose MIME message from mml directives."
452 (interactive) 439 (interactive)
@@ -455,6 +442,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
455 (mml-to-mime) 442 (mml-to-mime)
456 (setq mh-mml-compose-insert-flag nil)) 443 (setq mh-mml-compose-insert-flag nil))
457 444
445;;;###mh-autoload
458(defun mh-mml-forward-message (description folder message) 446(defun mh-mml-forward-message (description folder message)
459 "Forward a message as attachment. 447 "Forward a message as attachment.
460The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE 448The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
@@ -476,6 +464,7 @@ number."
476 (setq mh-mml-compose-insert-flag t)) 464 (setq mh-mml-compose-insert-flag t))
477 (t (error "The message number, %s is not a integer!" msg))))) 465 (t (error "The message number, %s is not a integer!" msg)))))
478 466
467;;;###mh-autoload
479(defun mh-mml-attach-file (&optional disposition) 468(defun mh-mml-attach-file (&optional disposition)
480 "Attach a file to the outgoing MIME message. 469 "Attach a file to the outgoing MIME message.
481The file is not inserted or encoded until you send the message with 470The file is not inserted or encoded until you send the message with
@@ -502,6 +491,7 @@ automatically."
502 'disposition dispos 'description description) 491 'disposition dispos 'description description)
503 (setq mh-mml-compose-insert-flag t))) 492 (setq mh-mml-compose-insert-flag t)))
504 493
494;;;###mh-autoload
505(defun mh-mml-secure-message-sign-pgpmime () 495(defun mh-mml-secure-message-sign-pgpmime ()
506 "Add directive to encrypt/sign the entire message." 496 "Add directive to encrypt/sign the entire message."
507 (interactive) 497 (interactive)
@@ -510,6 +500,7 @@ automatically."
510 (mml-secure-message-sign-pgpmime) 500 (mml-secure-message-sign-pgpmime)
511 (setq mh-mml-compose-insert-flag t))) 501 (setq mh-mml-compose-insert-flag t)))
512 502
503;;;###mh-autoload
513(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) 504(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
514 "Add directive to encrypt and sign the entire message. 505 "Add directive to encrypt and sign the entire message.
515If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." 506If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
@@ -523,54 +514,6 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
523 514
524;;; MIME decoding 515;;; MIME decoding
525 516
526(defcustom mh-graphical-smileys-flag t
527 "*Non-nil means graphical smileys are displayed.
528Non-nil means that small graphics will be used in the show buffer instead of
529patterns like :-), ;-) etc. The setting only has effect if
530`mh-decode-mime-flag' is non-nil."
531 :type 'boolean
532 :group 'mh-buffer)
533
534(defcustom mh-graphical-emphasis-flag t
535 "*Non-nil means graphical emphasis is displayed.
536Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
537/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
538list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
539 :type 'boolean
540 :group 'mh-buffer)
541
542;; Small image definition
543(defcustom mh-max-inline-image-width nil
544 "*Maximum inline image width if Content-Disposition is not present.
545If nil, image will be displayed if its width is smaller than the width of the
546window."
547 :type '(choice (const nil) integer)
548 :group 'mh-buffer)
549
550(defcustom mh-max-inline-image-height nil
551 "*Maximum inline image height if Content-Disposition is not present.
552If nil, image will be displayed if its height is smaller than the height of
553the window."
554 :type '(choice (const nil) integer)
555 :group 'mh-buffer)
556
557(defcustom mh-display-buttons-for-inline-parts-flag nil
558 "*Non-nil means display buttons for all inline MIME parts.
559If non-nil, buttons are displayed for all MIME parts. Inline parts start off
560in displayed state but they can be hidden by clicking the button. If nil no
561buttons are shown for inline parts."
562 :type 'boolean
563 :group 'mh-buffer)
564
565(defcustom mh-mime-save-parts-default-directory t
566 "Default directory to use for `mh-mime-save-parts'.
567If nil, prompt and set for next time the command is used during same session.
568If t, prompt always"
569 :type '(choice (const :tag "Prompt the first time" nil)
570 (const :tag "Prompt always" t)
571 directory)
572 :group 'mh)
573
574(defmacro mh-defun-compat (function arg-list &rest body) 517(defmacro mh-defun-compat (function arg-list &rest body)
575 "This is a macro to define functions which are not defined. 518 "This is a macro to define functions which are not defined.
576It is used for Gnus utility functions which were added recently. If FUNCTION 519It is used for Gnus utility functions which were added recently. If FUNCTION
@@ -579,6 +522,7 @@ BODY."
579 (let ((defined-p (fboundp function))) 522 (let ((defined-p (fboundp function)))
580 (unless defined-p 523 (unless defined-p
581 `(defun ,function ,arg-list ,@body)))) 524 `(defun ,function ,arg-list ,@body))))
525(put 'mh-defun-compat 'lisp-indent-function 'defun)
582 526
583;; Copy of original function from gnus-util.el 527;; Copy of original function from gnus-util.el
584(mh-defun-compat gnus-local-map-property (map) 528(mh-defun-compat gnus-local-map-property (map)
@@ -597,7 +541,7 @@ BODY."
597 ;; HANDLE could be a CTL. 541 ;; HANDLE could be a CTL.
598 (if handle 542 (if handle
599 (put-text-property 0 (length (car handle)) parameter value 543 (put-text-property 0 (length (car handle)) parameter value
600 (car handle)))) 544 (car handle))))
601 545
602;; Copy of original macro is in mm-decode.el 546;; Copy of original macro is in mm-decode.el
603(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) 547(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
@@ -607,11 +551,11 @@ BODY."
607(mh-defun-compat mm-readable-p (handle) 551(mh-defun-compat mm-readable-p (handle)
608 "Say whether the content of HANDLE is readable." 552 "Say whether the content of HANDLE is readable."
609 (and (< (with-current-buffer (mm-handle-buffer handle) 553 (and (< (with-current-buffer (mm-handle-buffer handle)
610 (buffer-size)) 10000) 554 (buffer-size)) 10000)
611 (mm-with-unibyte-buffer 555 (mm-with-unibyte-buffer
612 (mm-insert-part handle) 556 (mm-insert-part handle)
613 (and (eq (mm-body-7-or-8) '7bit) 557 (and (eq (mm-body-7-or-8) '7bit)
614 (not (mm-long-lines-p 76)))))) 558 (not (mm-long-lines-p 76))))))
615 559
616;; Copy of original function in mm-bodies.el 560;; Copy of original function in mm-bodies.el
617(mh-defun-compat mm-long-lines-p (length) 561(mh-defun-compat mm-long-lines-p (length)
@@ -620,11 +564,11 @@ BODY."
620 (goto-char (point-min)) 564 (goto-char (point-min))
621 (end-of-line) 565 (end-of-line)
622 (while (and (not (eobp)) 566 (while (and (not (eobp))
623 (not (> (current-column) length))) 567 (not (> (current-column) length)))
624 (forward-line 1) 568 (forward-line 1)
625 (end-of-line)) 569 (end-of-line))
626 (and (> (current-column) length) 570 (and (> (current-column) length)
627 (current-column)))) 571 (current-column))))
628 572
629(mh-defun-compat mm-keep-viewer-alive-p (handle) 573(mh-defun-compat mm-keep-viewer-alive-p (handle)
630 ;; Released Gnus doesn't keep handles associated with externally displayed 574 ;; Released Gnus doesn't keep handles associated with externally displayed
@@ -642,25 +586,26 @@ BODY."
642(defun mh-mm-save-part (handle) 586(defun mh-mm-save-part (handle)
643 "Write HANDLE to a file." 587 "Write HANDLE to a file."
644 (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) 588 (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
645 (filename (mail-content-type-get 589 (filename (mail-content-type-get
646 (mm-handle-disposition handle) 'filename)) 590 (mm-handle-disposition handle) 'filename))
647 file) 591 file)
648 (when filename 592 (when filename
649 (setq filename (file-name-nondirectory filename))) 593 (setq filename (file-name-nondirectory filename)))
650 (setq file (read-file-name "Save MIME part to: " 594 (setq file (read-file-name "Save MIME part to: "
651 (or mm-default-directory 595 (or mm-default-directory
652 default-directory) 596 default-directory)
653 nil nil (or filename name ""))) 597 nil nil (or filename name "")))
654 (setq mm-default-directory (file-name-directory file)) 598 (setq mm-default-directory (file-name-directory file))
655 (and (or (not (file-exists-p file)) 599 (and (or (not (file-exists-p file))
656 (yes-or-no-p (format "File %s already exists; overwrite? " 600 (yes-or-no-p (format "File %s already exists; overwrite? "
657 file))) 601 file)))
658 (mm-save-part-to-file handle file)))) 602 (mm-save-part-to-file handle file))))
659 603
660 604
661 605
662;;; MIME cleanup 606;;; MIME cleanup
663 607
608;;;###mh-autoload
664(defun mh-mime-cleanup () 609(defun mh-mime-cleanup ()
665 "Free the decoded MIME parts." 610 "Free the decoded MIME parts."
666 (let ((mime-data (gethash (current-buffer) mh-globals-hash))) 611 (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
@@ -671,6 +616,7 @@ BODY."
671 (mm-destroy-parts (mh-mime-handles mime-data)) 616 (mm-destroy-parts (mh-mime-handles mime-data))
672 (remhash (current-buffer) mh-globals-hash)))) 617 (remhash (current-buffer) mh-globals-hash))))
673 618
619;;;###mh-autoload
674(defun mh-destroy-postponed-handles () 620(defun mh-destroy-postponed-handles ()
675 "Free MIME data for externally displayed mime parts." 621 "Free MIME data for externally displayed mime parts."
676 (let ((mime-data (mh-buffer-data))) 622 (let ((mime-data (mh-buffer-data)))
@@ -686,8 +632,8 @@ Gnus (as in the original). The MIME part, HANDLE is associated with the
686undisplayer FUNCTION." 632undisplayer FUNCTION."
687 (if (mm-keep-viewer-alive-p handle) 633 (if (mm-keep-viewer-alive-p handle)
688 (let ((new-handle (copy-sequence handle))) 634 (let ((new-handle (copy-sequence handle)))
689 (mm-handle-set-undisplayer new-handle function) 635 (mm-handle-set-undisplayer new-handle function)
690 (mm-handle-set-undisplayer handle nil) 636 (mm-handle-set-undisplayer handle nil)
691 (save-excursion 637 (save-excursion
692 (set-buffer folder) 638 (set-buffer folder)
693 (push new-handle (mh-mime-handles (mh-buffer-data))))) 639 (push new-handle (mh-mime-handles (mh-buffer-data)))))
@@ -696,7 +642,9 @@ undisplayer FUNCTION."
696 642
697 643
698;;; MIME transformations 644;;; MIME transformations
645(eval-when-compile (require 'font-lock))
699 646
647;;;###mh-autoload
700(defun mh-add-missing-mime-version-header () 648(defun mh-add-missing-mime-version-header ()
701 "Some mail programs don't put a MIME-Version header. 649 "Some mail programs don't put a MIME-Version header.
702I have seen this only in spam, so maybe we shouldn't fix this ;-)" 650I have seen this only in spam, so maybe we shouldn't fix this ;-)"
@@ -708,15 +656,22 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
708 (forward-line -1) 656 (forward-line -1)
709 (insert "MIME-Version: 1.0\n"))))) 657 (insert "MIME-Version: 1.0\n")))))
710 658
659;;;###mh-autoload
711(defun mh-display-smileys () 660(defun mh-display-smileys ()
712 "Function to display smileys." 661 "Function to display smileys."
713 (when (and mh-graphical-smileys-flag (fboundp 'smiley-region)) 662 (when (and mh-graphical-smileys-flag
663 (fboundp 'smiley-region)
664 (boundp 'font-lock-maximum-size)
665 (>= (/ font-lock-maximum-size 8) (buffer-size)))
714 (smiley-region (point-min) (point-max)))) 666 (smiley-region (point-min) (point-max))))
715 667
668;;;###mh-autoload
716(defun mh-display-emphasis () 669(defun mh-display-emphasis ()
717 "Function to display graphical emphasis." 670 "Function to display graphical emphasis."
718 (when mh-graphical-emphasis-flag 671 (when (and mh-graphical-emphasis-flag
719 (flet ((article-goto-body ())) ; shadow this function to do nothing 672 (boundp 'font-lock-maximum-size)
673 (>= (/ font-lock-maximum-size 8) (buffer-size)))
674 (flet ((article-goto-body ())) ; shadow this function to do nothing
720 (save-excursion 675 (save-excursion
721 (goto-char (point-min)) 676 (goto-char (point-min))
722 (article-emphasize))))) 677 (article-emphasize)))))
@@ -760,6 +715,7 @@ I have seen this only in spam, so maybe we shouldn't fix this ;-)"
760 "Default to use for `mh-mime-save-parts-default-directory'. 715 "Default to use for `mh-mime-save-parts-default-directory'.
761Set from last use.") 716Set from last use.")
762 717
718;;;###mh-autoload
763(defun mh-mime-save-parts (arg) 719(defun mh-mime-save-parts (arg)
764 "Store the MIME parts of the current message. 720 "Store the MIME parts of the current message.
765If ARG, prompt for directory, else use that specified by the variable 721If ARG, prompt for directory, else use that specified by the variable
@@ -815,6 +771,7 @@ actual storing."
815(defvar gnus-newsgroup-charset nil) 771(defvar gnus-newsgroup-charset nil)
816(defvar gnus-newsgroup-name nil) 772(defvar gnus-newsgroup-name nil)
817 773
774;;;###mh-autoload
818(defun mh-mime-display (&optional pre-dissected-handles) 775(defun mh-mime-display (&optional pre-dissected-handles)
819 "Display (and possibly decode) MIME handles. 776 "Display (and possibly decode) MIME handles.
820Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If 777Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
@@ -822,11 +779,12 @@ present they are displayed otherwise the buffer is parsed and then
822displayed." 779displayed."
823 (let ((handles ()) 780 (let ((handles ())
824 (folder mh-show-folder-buffer)) 781 (folder mh-show-folder-buffer))
825 (flet ((mm-handle-set-external-undisplayer (handle function) 782 (flet ((mm-handle-set-external-undisplayer
826 (mh-handle-set-external-undisplayer folder handle function))) 783 (handle function)
784 (mh-handle-set-external-undisplayer folder handle function)))
827 ;; If needed dissect the current buffer 785 ;; If needed dissect the current buffer
828 (if pre-dissected-handles 786 (if pre-dissected-handles
829 (setq handles pre-dissected-handles) 787 (setq handles pre-dissected-handles)
830 (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect))) 788 (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
831 (setf (mh-mime-handles (mh-buffer-data)) 789 (setf (mh-mime-handles (mh-buffer-data))
832 (mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))) 790 (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
@@ -864,7 +822,7 @@ If no part is preferred then all the parts are displayed."
864 (preferred 822 (preferred
865 (save-restriction 823 (save-restriction
866 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) 824 (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
867 (or (mm-display-part preferred) (mm-display-part preferred)) 825 (mh-mime-display-single preferred)
868 (goto-char (point-max)))) 826 (goto-char (point-max))))
869 (t (mh-mime-display-mixed handles))))) 827 (t (mh-mime-display-mixed handles)))))
870 828
@@ -883,9 +841,9 @@ opened)."
883 841
884;;; Avoid compiler warnings for XEmacs functions... 842;;; Avoid compiler warnings for XEmacs functions...
885(eval-when (compile) 843(eval-when (compile)
886 (loop for function in '(glyph-width window-pixel-width 844 (loop for function in '(glyph-width window-pixel-width
887 glyph-height window-pixel-height) 845 glyph-height window-pixel-height)
888 do (or (fboundp function) (defalias function 'ignore)))) 846 do (or (fboundp function) (defalias function 'ignore))))
889 847
890(defun mh-small-image-p (handle) 848(defun mh-small-image-p (handle)
891 "Decide whether HANDLE is a \"small\" image that can be displayed inline. 849 "Decide whether HANDLE is a \"small\" image that can be displayed inline.
@@ -895,9 +853,9 @@ This is only useful if a Content-Disposition header is not present."
895 (mm-inline-large-images t)) 853 (mm-inline-large-images t))
896 (and media-test 854 (and media-test
897 (equal (mm-handle-media-supertype handle) "image") 855 (equal (mm-handle-media-supertype handle) "image")
898 (funcall media-test handle) ; Since mm-inline-large-images is T, 856 (funcall media-test handle) ; Since mm-inline-large-images is T,
899 ; this only tells us if the image is 857 ; this only tells us if the image is
900 ; something that emacs can display 858 ; something that emacs can display
901 (let* ((image (mm-get-image handle))) 859 (let* ((image (mm-get-image handle)))
902 (cond ((fboundp 'glyph-width) 860 (cond ((fboundp 'glyph-width)
903 ;; XEmacs -- totally untested, copied from gnus 861 ;; XEmacs -- totally untested, copied from gnus
@@ -919,6 +877,17 @@ This is only useful if a Content-Disposition header is not present."
919 ;; Can't show image inline 877 ;; Can't show image inline
920 nil)))))) 878 nil))))))
921 879
880(defun mh-inline-vcard-p (handle)
881 "Decide if HANDLE is a vcard that must be displayed inline."
882 (let ((type (mm-handle-type handle)))
883 (and (consp type)
884 (equal (car type) "text/x-vcard")
885 (save-excursion
886 (save-restriction
887 (widen)
888 (goto-char (point-min))
889 (not (re-search-forward "^-- $" nil t)))))))
890
922(defun mh-mime-display-single (handle) 891(defun mh-mime-display-single (handle)
923 "Display a leaf node, HANDLE in the MIME tree." 892 "Display a leaf node, HANDLE in the MIME tree."
924 (let* ((type (mm-handle-media-type handle)) 893 (let* ((type (mm-handle-media-type handle))
@@ -928,10 +897,11 @@ This is only useful if a Content-Disposition header is not present."
928 (inlinep (and (equal (car (mm-handle-disposition handle)) "inline") 897 (inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
929 (mm-inlinable-p handle) 898 (mm-inlinable-p handle)
930 (mm-inlined-p handle))) 899 (mm-inlined-p handle)))
931 (displayp (or inlinep ; display if inline 900 (displayp (or inlinep ; show if inline OR
932 (and (not attachmentp) ; if it is not an attachment 901 (mh-inline-vcard-p handle); inline vcard OR
933 (or small-image-flag ; display if small image 902 (and (not attachmentp) ; if not an attachment
934 ; or if user wants inline. 903 (or small-image-flag ; and small image
904 ; and user wants inline
935 (and (not (equal 905 (and (not (equal
936 (mm-handle-media-supertype handle) 906 (mm-handle-media-supertype handle)
937 "image")) 907 "image"))
@@ -941,7 +911,7 @@ This is only useful if a Content-Disposition header is not present."
941 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) 911 (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
942 (cond ((and mh-gnus-pgp-support-flag 912 (cond ((and mh-gnus-pgp-support-flag
943 (equal type "application/pgp-signature")) 913 (equal type "application/pgp-signature"))
944 nil) ; skip signatures as they are already handled... 914 nil) ; skip signatures as they are already handled...
945 ((not displayp) 915 ((not displayp)
946 (insert "\n") 916 (insert "\n")
947 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) 917 (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
@@ -982,9 +952,9 @@ like \"K v\" which operate on individual MIME parts."
982 (gnus-eval-format 952 (gnus-eval-format
983 mh-mime-button-line-format mh-mime-button-line-format-alist 953 mh-mime-button-line-format mh-mime-button-line-format-alist
984 `(,@(gnus-local-map-property mh-mime-button-map) 954 `(,@(gnus-local-map-property mh-mime-button-map)
985 mh-callback mh-mm-display-part 955 mh-callback mh-mm-display-part
986 mh-part ,index 956 mh-part ,index
987 mh-data ,handle)) 957 mh-data ,handle))
988 (setq end (point)) 958 (setq end (point))
989 (widget-convert-button 959 (widget-convert-button
990 'link begin end 960 'link begin end
@@ -1062,6 +1032,7 @@ like \"K v\" which operate on individual MIME parts."
1062 (add-text-properties (line-beginning-position) (line-end-position) 1032 (add-text-properties (line-beginning-position) (line-end-position)
1063 `(mh-region ,region))))))) 1033 `(mh-region ,region)))))))
1064 1034
1035;;;###mh-autoload
1065(defun mh-press-button () 1036(defun mh-press-button ()
1066 "Press MIME button. 1037 "Press MIME button.
1067If the MIME part is visible then it is removed. Otherwise the part is 1038If the MIME part is visible then it is removed. Otherwise the part is
@@ -1072,13 +1043,15 @@ displayed."
1072 (function (get-text-property (point) 'mh-callback)) 1043 (function (get-text-property (point) 'mh-callback))
1073 (buffer-read-only nil) 1044 (buffer-read-only nil)
1074 (folder mh-show-folder-buffer)) 1045 (folder mh-show-folder-buffer))
1075 (flet ((mm-handle-set-external-undisplayer (handle function) 1046 (flet ((mm-handle-set-external-undisplayer
1076 (mh-handle-set-external-undisplayer folder handle function))) 1047 (handle function)
1048 (mh-handle-set-external-undisplayer folder handle function)))
1077 (when (and function (eolp)) 1049 (when (and function (eolp))
1078 (backward-char)) 1050 (backward-char))
1079 (unwind-protect (and function (funcall function data)) 1051 (unwind-protect (and function (funcall function data))
1080 (set-buffer-modified-p nil))))) 1052 (set-buffer-modified-p nil)))))
1081 1053
1054;;;###mh-autoload
1082(defun mh-push-button (event) 1055(defun mh-push-button (event)
1083 "Click MIME button for EVENT. 1056 "Click MIME button for EVENT.
1084If the MIME part is visible then it is removed. Otherwise the part is 1057If the MIME part is visible then it is removed. Otherwise the part is
@@ -1093,21 +1066,24 @@ button."
1093 (data (get-text-property pos 'mh-data)) 1066 (data (get-text-property pos 'mh-data))
1094 (function (get-text-property pos 'mh-callback)) 1067 (function (get-text-property pos 'mh-callback))
1095 (buffer-read-only nil)) 1068 (buffer-read-only nil))
1096 (flet ((mm-handle-set-external-undisplayer (handle function) 1069 (flet ((mm-handle-set-external-undisplayer
1097 (mh-handle-set-external-undisplayer folder handle function))) 1070 (handle function)
1071 (mh-handle-set-external-undisplayer folder handle function)))
1098 (goto-char pos) 1072 (goto-char pos)
1099 (unwind-protect (and function (funcall function data)) 1073 (unwind-protect (and function (funcall function data))
1100 (set-buffer-modified-p nil))))) 1074 (set-buffer-modified-p nil)))))
1101 1075
1076;;;###mh-autoload
1102(defun mh-mime-save-part () 1077(defun mh-mime-save-part ()
1103 "Save MIME part at point." 1078 "Save MIME part at point."
1104 (interactive) 1079 (interactive)
1105 (let ((data (get-text-property (point) 'mh-data))) 1080 (let ((data (get-text-property (point) 'mh-data)))
1106 (when data 1081 (when data
1107 (let ((mm-default-directory mh-mime-save-parts-directory)) 1082 (let ((mm-default-directory mh-mime-save-parts-directory))
1108 (mh-mm-save-part data) 1083 (mh-mm-save-part data)
1109 (setq mh-mime-save-parts-directory mm-default-directory))))) 1084 (setq mh-mime-save-parts-directory mm-default-directory)))))
1110 1085
1086;;;###mh-autoload
1111(defun mh-mime-inline-part () 1087(defun mh-mime-inline-part ()
1112 "Toggle display of the raw MIME part." 1088 "Toggle display of the raw MIME part."
1113 (interactive) 1089 (interactive)
@@ -1149,7 +1125,7 @@ Parameter EL is unused."
1149 (mh-mime-display-mixed (cdr handle)) 1125 (mh-mime-display-mixed (cdr handle))
1150 (insert "\n") 1126 (insert "\n")
1151 (let ((mh-mime-security-button-line-format 1127 (let ((mh-mime-security-button-line-format
1152 mh-mime-security-button-end-line-format)) 1128 mh-mime-security-button-end-line-format))
1153 (mh-insert-mime-security-button handle)) 1129 (mh-insert-mime-security-button handle))
1154 (mm-set-handle-multipart-parameter 1130 (mm-set-handle-multipart-parameter
1155 handle 'mh-region 1131 handle 'mh-region
@@ -1164,9 +1140,9 @@ Parameter EL is unused."
1164 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) 1140 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
1165 (when details 1141 (when details
1166 (let ((mh-mime-security-button-pressed 1142 (let ((mh-mime-security-button-pressed
1167 (not (get-text-property (point) 'mh-button-pressed))) 1143 (not (get-text-property (point) 'mh-button-pressed)))
1168 (mh-mime-security-button-line-format 1144 (mh-mime-security-button-line-format
1169 (get-text-property (point) 'mh-line-format))) 1145 (get-text-property (point) 'mh-line-format)))
1170 (forward-char -1) 1146 (forward-char -1)
1171 (while (eq (get-text-property (point) 'mh-line-format) 1147 (while (eq (get-text-property (point) 'mh-line-format)
1172 mh-mime-security-button-line-format) 1148 mh-mime-security-button-line-format)
@@ -1217,10 +1193,10 @@ Parameter EL is unused."
1217 mh-mime-security-button-line-format 1193 mh-mime-security-button-line-format
1218 mh-mime-security-button-line-format-alist 1194 mh-mime-security-button-line-format-alist
1219 `(,@(gnus-local-map-property mh-mime-security-button-map) 1195 `(,@(gnus-local-map-property mh-mime-security-button-map)
1220 mh-button-pressed ,mh-mime-security-button-pressed 1196 mh-button-pressed ,mh-mime-security-button-pressed
1221 mh-callback mh-mime-security-press-button 1197 mh-callback mh-mime-security-press-button
1222 mh-line-format ,mh-mime-security-button-line-format 1198 mh-line-format ,mh-mime-security-button-line-format
1223 mh-data ,handle)) 1199 mh-data ,handle))
1224 (setq end (point)) 1200 (setq end (point))
1225 (widget-convert-button 'link begin end 1201 (widget-convert-button 'link begin end
1226 :mime-handle handle 1202 :mime-handle handle
@@ -1293,6 +1269,7 @@ message multiple times."
1293(provide 'mh-mime) 1269(provide 'mh-mime)
1294 1270
1295;;; Local Variables: 1271;;; Local Variables:
1272;;; indent-tabs-mode: nil
1296;;; sentence-end-double-space: nil 1273;;; sentence-end-double-space: nil
1297;;; End: 1274;;; End:
1298 1275
diff --git a/lisp/mail/mh-pick.el b/lisp/mail/mh-pick.el
index d724cdbbfbc..a2a50f80565 100644
--- a/lisp/mail/mh-pick.el
+++ b/lisp/mail/mh-pick.el
@@ -30,7 +30,7 @@
30 30
31;;; Change Log: 31;;; Change Log:
32 32
33;; $Id: mh-pick.el,v 1.21 2002/11/05 21:43:16 wohler Exp $ 33;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $
34 34
35;;; Code: 35;;; Code:
36 36
@@ -38,46 +38,40 @@
38(require 'easymenu) 38(require 'easymenu)
39(require 'gnus-util) 39(require 'gnus-util)
40 40
41;;; Hooks
42
43(defcustom mh-pick-mode-hook nil
44 "Invoked upon entry to `mh-pick-mode'."
45 :type 'hook
46 :group 'mh-hook)
47
48;;; Internal variables: 41;;; Internal variables:
49 42
50(defvar mh-pick-mode-map (make-sparse-keymap) 43(defvar mh-pick-mode-map (make-sparse-keymap)
51 "Keymap for searching folder.") 44 "Keymap for searching folder.")
52 45
53(defvar mh-searching-folder nil) ;Folder this pick is searching. 46(defvar mh-searching-folder nil) ;Folder this pick is searching.
54 47
48;;;###mh-autoload
55(defun mh-search-folder (folder) 49(defun mh-search-folder (folder)
56 "Search FOLDER for messages matching a pattern. 50 "Search FOLDER for messages matching a pattern.
57This function uses the MH command `pick' to do the work. 51This function uses the MH command `pick' to do the work.
58Add the messages found to the sequence named `search'." 52Add the messages found to the sequence named `search'."
59 (interactive (list (mh-prompt-for-folder "Search" 53 (interactive (list (mh-prompt-for-folder "Search"
60 mh-current-folder 54 mh-current-folder
61 t))) 55 t)))
62 (switch-to-buffer-other-window "pick-pattern") 56 (switch-to-buffer-other-window "pick-pattern")
63 (if (or (zerop (buffer-size)) 57 (if (or (zerop (buffer-size))
64 (not (y-or-n-p "Reuse pattern? "))) 58 (not (y-or-n-p "Reuse pattern? ")))
65 (mh-make-pick-template) 59 (mh-make-pick-template)
66 (message "")) 60 (message ""))
67 (setq mh-searching-folder folder) 61 (setq mh-searching-folder folder)
68 (message "%s" (substitute-command-keys 62 (message "%s" (substitute-command-keys
69 (concat "Type \\[mh-do-pick-search] to search messages, " 63 (concat "Type \\[mh-do-pick-search] to search messages, "
70 "\\[mh-help] for help.")))) 64 "\\[mh-help] for help."))))
71 65
72(defun mh-make-pick-template () 66(defun mh-make-pick-template ()
73 "Initialize the current buffer with a template for a pick pattern." 67 "Initialize the current buffer with a template for a pick pattern."
74 (erase-buffer) 68 (erase-buffer)
75 (insert "From: \n" 69 (insert "From: \n"
76 "To: \n" 70 "To: \n"
77 "Cc: \n" 71 "Cc: \n"
78 "Date: \n" 72 "Date: \n"
79 "Subject: \n" 73 "Subject: \n"
80 "---------\n") 74 "---------\n")
81 (mh-pick-mode) 75 (mh-pick-mode)
82 (goto-char (point-min)) 76 (goto-char (point-min))
83 (end-of-line)) 77 (end-of-line))
@@ -130,41 +124,42 @@ with no arguments, upon entry to this mode.
130 (setq mh-help-messages mh-pick-mode-help-messages) 124 (setq mh-help-messages mh-pick-mode-help-messages)
131 (run-hooks 'mh-pick-mode-hook)) 125 (run-hooks 'mh-pick-mode-hook))
132 126
127;;;###mh-autoload
133(defun mh-do-pick-search () 128(defun mh-do-pick-search ()
134 "Find messages that match the qualifications in the current pattern buffer. 129 "Find messages that match the qualifications in the current pattern buffer.
135Messages are searched for in the folder named in `mh-searching-folder'. 130Messages are searched for in the folder named in `mh-searching-folder'.
136Add the messages found to the sequence named `search'." 131Add the messages found to the sequence named `search'."
137 (interactive) 132 (interactive)
138 (let ((pattern-buffer (buffer-name)) 133 (let ((pattern-buffer (buffer-name))
139 (searching-buffer mh-searching-folder) 134 (searching-buffer mh-searching-folder)
140 range 135 range
141 msgs 136 msgs
142 (pattern nil) 137 (pattern nil)
143 (new-buffer nil)) 138 (new-buffer nil))
144 (save-excursion 139 (save-excursion
145 (cond ((get-buffer searching-buffer) 140 (cond ((get-buffer searching-buffer)
146 (set-buffer searching-buffer) 141 (set-buffer searching-buffer)
147 (setq range (list (format "%d-%d" 142 (setq range (list (format "%d-%d"
148 mh-first-msg-num mh-last-msg-num)))) 143 mh-first-msg-num mh-last-msg-num))))
149 (t 144 (t
150 (mh-make-folder searching-buffer) 145 (mh-make-folder searching-buffer)
151 (setq range '("all")) 146 (setq range '("all"))
152 (setq new-buffer t)))) 147 (setq new-buffer t))))
153 (message "Searching...") 148 (message "Searching...")
154 (goto-char (point-min)) 149 (goto-char (point-min))
155 (while (and range 150 (while (and range
156 (setq pattern (mh-next-pick-field pattern-buffer))) 151 (setq pattern (mh-next-pick-field pattern-buffer)))
157 (setq msgs (mh-seq-from-command searching-buffer 152 (setq msgs (mh-seq-from-command searching-buffer
158 'search 153 'search
159 (mh-list-to-string 154 (mh-list-to-string
160 (list "pick" pattern searching-buffer 155 (list "pick" pattern searching-buffer
161 "-list" 156 "-list"
162 (mh-coalesce-msg-list range))))) 157 (mh-coalesce-msg-list range)))))
163 (setq range msgs)) ;restrict the pick range for next pass 158 (setq range msgs)) ;restrict the pick range for next pass
164 (message "Searching...done") 159 (message "Searching...done")
165 (if new-buffer 160 (if new-buffer
166 (mh-scan-folder searching-buffer msgs) 161 (mh-scan-folder searching-buffer msgs)
167 (switch-to-buffer searching-buffer)) 162 (switch-to-buffer searching-buffer))
168 (mh-add-msgs-to-seq msgs 'search) 163 (mh-add-msgs-to-seq msgs 'search)
169 (delete-other-windows))) 164 (delete-other-windows)))
170 165
@@ -173,17 +168,17 @@ Add the messages found to the sequence named `search'."
173COMMAND is a list. The first element is a program name 168COMMAND is a list. The first element is a program name
174and the subsequent elements are its arguments, all strings." 169and the subsequent elements are its arguments, all strings."
175 (let ((msg) 170 (let ((msg)
176 (msgs ()) 171 (msgs ())
177 (case-fold-search t)) 172 (case-fold-search t))
178 (save-excursion 173 (save-excursion
179 (save-window-excursion 174 (save-window-excursion
180 (if (eq 0 (apply 'mh-exec-cmd-quiet nil command)) 175 (if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
181 ;; "pick" outputs one number per line 176 ;; "pick" outputs one number per line
182 (while (setq msg (car (mh-read-msg-list))) 177 (while (setq msg (car (mh-read-msg-list)))
183 (setq msgs (cons msg msgs)) 178 (setq msgs (cons msg msgs))
184 (forward-line 1)))) 179 (forward-line 1))))
185 (set-buffer folder) 180 (set-buffer folder)
186 (setq msgs (nreverse msgs)) ;put in ascending order 181 (setq msgs (nreverse msgs)) ;put in ascending order
187 msgs))) 182 msgs)))
188 183
189(defun mh-next-pick-field (buffer) 184(defun mh-next-pick-field (buffer)
@@ -193,50 +188,51 @@ or nil if no pieces remain."
193 (set-buffer buffer) 188 (set-buffer buffer)
194 (let ((case-fold-search t)) 189 (let ((case-fold-search t))
195 (cond ((eobp) 190 (cond ((eobp)
196 nil) 191 nil)
197 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" 192 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
198 nil t) 193 nil t)
199 (let* ((component 194 (let* ((component
200 (format "--%s" 195 (format "--%s"
201 (downcase (buffer-substring (match-beginning 1) 196 (downcase (buffer-substring (match-beginning 1)
202 (match-end 1))))) 197 (match-end 1)))))
203 (pat (buffer-substring (match-beginning 2) (match-end 2)))) 198 (pat (buffer-substring (match-beginning 2) (match-end 2))))
204 (forward-line 1) 199 (forward-line 1)
205 (list component pat))) 200 (list component pat)))
206 ((re-search-forward "^-*$" nil t) 201 ((re-search-forward "^-*$" nil t)
207 (forward-char 1) 202 (forward-char 1)
208 (let ((body (buffer-substring (point) (point-max)))) 203 (let ((body (buffer-substring (point) (point-max))))
209 (if (and (> (length body) 0) (not (equal body "\n"))) 204 (if (and (> (length body) 0) (not (equal body "\n")))
210 (list "-search" body) 205 (list "-search" body)
211 nil))) 206 nil)))
212 (t 207 (t
213 nil)))) 208 nil))))
214 209
215 210
216 211
217;;; Build the pick-mode keymap: 212;;; Build the pick-mode keymap:
218;;; If this changes, modify mh-pick-mode-help-messages accordingly, above. 213;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
219(gnus-define-keys mh-pick-mode-map 214(gnus-define-keys mh-pick-mode-map
220 "\C-c?" mh-help 215 "\C-c?" mh-help
221 "\C-c\C-c" mh-do-pick-search 216 "\C-c\C-c" mh-do-pick-search
222 "\C-c\C-f\C-b" mh-to-field 217 "\C-c\C-f\C-b" mh-to-field
223 "\C-c\C-f\C-c" mh-to-field 218 "\C-c\C-f\C-c" mh-to-field
224 "\C-c\C-f\C-d" mh-to-field 219 "\C-c\C-f\C-d" mh-to-field
225 "\C-c\C-f\C-f" mh-to-field 220 "\C-c\C-f\C-f" mh-to-field
226 "\C-c\C-f\C-r" mh-to-field 221 "\C-c\C-f\C-r" mh-to-field
227 "\C-c\C-f\C-s" mh-to-field 222 "\C-c\C-f\C-s" mh-to-field
228 "\C-c\C-f\C-t" mh-to-field 223 "\C-c\C-f\C-t" mh-to-field
229 "\C-c\C-fb" mh-to-field 224 "\C-c\C-fb" mh-to-field
230 "\C-c\C-fc" mh-to-field 225 "\C-c\C-fc" mh-to-field
231 "\C-c\C-fd" mh-to-field 226 "\C-c\C-fd" mh-to-field
232 "\C-c\C-ff" mh-to-field 227 "\C-c\C-ff" mh-to-field
233 "\C-c\C-fr" mh-to-field 228 "\C-c\C-fr" mh-to-field
234 "\C-c\C-fs" mh-to-field 229 "\C-c\C-fs" mh-to-field
235 "\C-c\C-ft" mh-to-field) 230 "\C-c\C-ft" mh-to-field)
236 231
237(provide 'mh-pick) 232(provide 'mh-pick)
238 233
239;;; Local Variables: 234;;; Local Variables:
235;;; indent-tabs-mode: nil
240;;; sentence-end-double-space: nil 236;;; sentence-end-double-space: nil
241;;; End: 237;;; End:
242 238
diff --git a/lisp/mail/mh-seq.el b/lisp/mail/mh-seq.el
index b6c1d4fd612..1175e420281 100644
--- a/lisp/mail/mh-seq.el
+++ b/lisp/mail/mh-seq.el
@@ -67,7 +67,7 @@
67 67
68;;; Change Log: 68;;; Change Log:
69 69
70;; $Id: mh-seq.el,v 1.71 2002/11/14 20:41:12 wohler Exp $ 70;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $
71 71
72;;; Code: 72;;; Code:
73 73
@@ -137,56 +137,65 @@ redone to get the new thread tree. This makes incremental threading easier.")
137(make-variable-buffer-local 'mh-thread-duplicates) 137(make-variable-buffer-local 'mh-thread-duplicates)
138(make-variable-buffer-local 'mh-thread-history) 138(make-variable-buffer-local 'mh-thread-history)
139 139
140;;;###mh-autoload
140(defun mh-delete-seq (sequence) 141(defun mh-delete-seq (sequence)
141 "Delete the SEQUENCE." 142 "Delete the SEQUENCE."
142 (interactive (list (mh-read-seq-default "Delete" t))) 143 (interactive (list (mh-read-seq-default "Delete" t)))
143 (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) 144 (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
144 sequence) 145 sequence)
145 (mh-undefine-sequence sequence '("all")) 146 (mh-undefine-sequence sequence '("all"))
146 (mh-delete-seq-locally sequence)) 147 (mh-delete-seq-locally sequence))
147 148
148;; Avoid compiler warnings 149;; Avoid compiler warnings
149(defvar view-exit-action) 150(defvar view-exit-action)
150 151
151(defun mh-list-sequences (folder) 152;;;###mh-autoload
152 "List the sequences defined in FOLDER." 153(defun mh-list-sequences ()
153 (interactive (list (mh-prompt-for-folder "List sequences in" 154 "List the sequences defined in the folder being visited."
154 mh-current-folder t))) 155 (interactive)
155 (let ((temp-buffer mh-temp-sequences-buffer) 156 (let ((folder mh-current-folder)
156 (seq-list mh-seq-list)) 157 (temp-buffer mh-temp-sequences-buffer)
158 (seq-list mh-seq-list)
159 (max-len 0))
157 (with-output-to-temp-buffer temp-buffer 160 (with-output-to-temp-buffer temp-buffer
158 (save-excursion 161 (save-excursion
159 (set-buffer temp-buffer) 162 (set-buffer temp-buffer)
160 (erase-buffer) 163 (erase-buffer)
161 (message "Listing sequences ...") 164 (message "Listing sequences ...")
162 (insert "Sequences in folder " folder ":\n") 165 (insert "Sequences in folder " folder ":\n")
163 (while seq-list 166 (let ((seq-list seq-list))
164 (let ((name (mh-seq-name (car seq-list))) 167 (while seq-list
165 (sorted-seq-msgs 168 (setq max-len
166 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)) 169 (max (length (symbol-name (mh-seq-name (pop seq-list))))
167 (last-col (- (window-width) 4)) 170 max-len)))
168 name-spec) 171 (setq max-len (+ 2 max-len)))
169 (insert (setq name-spec (format "%20s:" name))) 172 (while seq-list
170 (while sorted-seq-msgs 173 (let ((name (mh-seq-name (car seq-list)))
171 (if (> (current-column) last-col) 174 (sorted-seq-msgs
172 (progn 175 (mh-coalesce-msg-list
173 (insert "\n") 176 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
174 (move-to-column (length name-spec)))) 177 name-spec)
175 (insert (format " %s" (car sorted-seq-msgs))) 178 (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
176 (setq sorted-seq-msgs (cdr sorted-seq-msgs))) 179 (while sorted-seq-msgs
177 (insert "\n")) 180 (let ((next-element (format " %s" (pop sorted-seq-msgs))))
178 (setq seq-list (cdr seq-list))) 181 (when (>= (+ (current-column) (length next-element))
179 (goto-char (point-min)) 182 (window-width))
180 (view-mode 1) 183 (insert "\n")
181 (setq view-exit-action 'kill-buffer) 184 (insert (format (format "%%%ss" (length name-spec)) "")))
182 (message "Listing sequences...done"))))) 185 (insert next-element)))
183 186 (insert "\n"))
187 (setq seq-list (cdr seq-list)))
188 (goto-char (point-min))
189 (view-mode 1)
190 (setq view-exit-action 'kill-buffer)
191 (message "Listing sequences...done")))))
192
193;;;###mh-autoload
184(defun mh-msg-is-in-seq (message) 194(defun mh-msg-is-in-seq (message)
185 "Display the sequences that contain MESSAGE (default: current message)." 195 "Display the sequences that contain MESSAGE (default: current message)."
186 (interactive (list (mh-get-msg-num t))) 196 (interactive (list (mh-get-msg-num t)))
187 (let* ((dest-folder (loop for seq in mh-refile-list 197 (let* ((dest-folder (loop for seq in mh-refile-list
188 when (member message (cdr seq)) 198 when (member message (cdr seq)) return (car seq)))
189 return (car seq)))
190 (deleted-flag (unless dest-folder (member message mh-delete-list)))) 199 (deleted-flag (unless dest-folder (member message mh-delete-list))))
191 (message "Message %d%s is in sequences: %s" 200 (message "Message %d%s is in sequences: %s"
192 message 201 message
@@ -197,37 +206,39 @@ redone to get the new thread tree. This makes incremental threading easier.")
197 (mh-list-to-string (mh-seq-containing-msg message t)) 206 (mh-list-to-string (mh-seq-containing-msg message t))
198 " ")))) 207 " "))))
199 208
209;;;###mh-autoload
200(defun mh-narrow-to-seq (sequence) 210(defun mh-narrow-to-seq (sequence)
201 "Restrict display of this folder to just messages in SEQUENCE. 211 "Restrict display of this folder to just messages in SEQUENCE.
202Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." 212Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
203 (interactive (list (mh-read-seq "Narrow to" t))) 213 (interactive (list (mh-read-seq "Narrow to" t)))
204 (with-mh-folder-updating (t) 214 (with-mh-folder-updating (t)
205 (cond ((mh-seq-to-msgs sequence) 215 (cond ((mh-seq-to-msgs sequence)
206 (mh-widen) 216 (mh-widen)
207 (mh-remove-all-notation) 217 (mh-remove-all-notation)
208 (let ((eob (point-max)) 218 (let ((eob (point-max))
209 (msg-at-cursor (mh-get-msg-num nil))) 219 (msg-at-cursor (mh-get-msg-num nil)))
210 (setq mh-thread-old-scan-line-map mh-thread-scan-line-map) 220 (setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
211 (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) 221 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
212 (mh-copy-seq-to-eob sequence) 222 (mh-copy-seq-to-eob sequence)
213 (narrow-to-region eob (point-max)) 223 (narrow-to-region eob (point-max))
214 (mh-notate-user-sequences) 224 (mh-notate-user-sequences)
215 (mh-notate-deleted-and-refiled) 225 (mh-notate-deleted-and-refiled)
216 (mh-notate-seq 'cur mh-note-cur mh-cmd-note) 226 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
217 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t)) 227 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
218 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) 228 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
219 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) 229 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
220 (setq mh-mode-line-annotation (symbol-name sequence)) 230 (setq mh-mode-line-annotation (symbol-name sequence))
221 (mh-make-folder-mode-line) 231 (mh-make-folder-mode-line)
222 (mh-recenter nil) 232 (mh-recenter nil)
223 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 233 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
224 (set (make-local-variable 'tool-bar-map) 234 (set (make-local-variable 'tool-bar-map)
225 mh-folder-seq-tool-bar-map)) 235 mh-folder-seq-tool-bar-map))
226 (setq mh-narrowed-to-seq sequence) 236 (setq mh-narrowed-to-seq sequence)
227 (push 'widen mh-view-ops))) 237 (push 'widen mh-view-ops)))
228 (t 238 (t
229 (error "No messages in sequence `%s'" (symbol-name sequence)))))) 239 (error "No messages in sequence `%s'" (symbol-name sequence))))))
230 240
241;;;###mh-autoload
231(defun mh-put-msg-in-seq (msg-or-seq sequence) 242(defun mh-put-msg-in-seq (msg-or-seq sequence)
232 "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE. 243 "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
233If optional prefix argument provided, then prompt for the message sequence. 244If optional prefix argument provided, then prompt for the message sequence.
@@ -235,19 +246,18 @@ If variable `transient-mark-mode' is non-nil and the mark is active, then
235the selected region is added to the sequence." 246the selected region is added to the sequence."
236 (interactive (list (cond 247 (interactive (list (cond
237 ((mh-mark-active-p t) 248 ((mh-mark-active-p t)
238 (mh-region-to-sequence (region-beginning) (region-end)) 249 (mh-region-to-msg-list (region-beginning) (region-end)))
239 'region)
240 (current-prefix-arg 250 (current-prefix-arg
241 (mh-read-seq-default "Add messages from" t)) 251 (mh-read-seq-default "Add messages from" t))
242 (t 252 (t
243 (mh-get-msg-num t))) 253 (mh-get-msg-num t)))
244 (mh-read-seq-default "Add to" nil))) 254 (mh-read-seq-default "Add to" nil)))
245 (if (not (mh-internal-seq sequence)) 255 (if (not (mh-internal-seq sequence))
246 (setq mh-last-seq-used sequence)) 256 (setq mh-last-seq-used sequence))
247 (mh-add-msgs-to-seq (if (numberp msg-or-seq) 257 (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
248 msg-or-seq 258 ((listp msg-or-seq) msg-or-seq)
249 (mh-seq-to-msgs msg-or-seq)) 259 (t (mh-seq-to-msgs msg-or-seq)))
250 sequence)) 260 sequence))
251 261
252(defun mh-valid-view-change-operation-p (op) 262(defun mh-valid-view-change-operation-p (op)
253 "Check if the view change operation can be performed. 263 "Check if the view change operation can be performed.
@@ -256,6 +266,7 @@ OP is one of 'widen and 'unthread."
256 (pop mh-view-ops)) 266 (pop mh-view-ops))
257 (t nil))) 267 (t nil)))
258 268
269;;;###mh-autoload
259(defun mh-widen () 270(defun mh-widen ()
260 "Remove restrictions from current folder, thereby showing all messages." 271 "Remove restrictions from current folder, thereby showing all messages."
261 (interactive) 272 (interactive)
@@ -304,16 +315,16 @@ refiled are present in `mh-refile-list'."
304 315
305;;; Commands to manipulate sequences. Sequences are stored in an alist 316;;; Commands to manipulate sequences. Sequences are stored in an alist
306;;; of the form: 317;;; of the form:
307;;; ((seq-name msgs ...) (seq-name msgs ...) ...) 318;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
308 319
309(defun mh-read-seq-default (prompt not-empty) 320(defun mh-read-seq-default (prompt not-empty)
310 "Read and return sequence name with default narrowed or previous sequence. 321 "Read and return sequence name with default narrowed or previous sequence.
311PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a 322PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
312non-empty sequence is read." 323non-empty sequence is read."
313 (mh-read-seq prompt not-empty 324 (mh-read-seq prompt not-empty
314 (or mh-narrowed-to-seq 325 (or mh-narrowed-to-seq
315 mh-last-seq-used 326 mh-last-seq-used
316 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) 327 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
317 328
318(defun mh-read-seq (prompt not-empty &optional default) 329(defun mh-read-seq (prompt not-empty &optional default)
319 "Read and return a sequence name. 330 "Read and return a sequence name.
@@ -321,60 +332,65 @@ Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY
321flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%' 332flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%'
322defaults to the first sequence containing the current message." 333defaults to the first sequence containing the current message."
323 (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" 334 (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
324 (if default 335 (if default
325 (format "[%s] " default) 336 (format "[%s] " default)
326 "")) 337 ""))
327 (mh-seq-names mh-seq-list))) 338 (mh-seq-names mh-seq-list)))
328 (seq (cond ((equal input "%") 339 (seq (cond ((equal input "%")
329 (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) 340 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
330 ((equal input "") default) 341 ((equal input "") default)
331 (t (intern input)))) 342 (t (intern input))))
332 (msgs (mh-seq-to-msgs seq))) 343 (msgs (mh-seq-to-msgs seq)))
333 (if (and (null msgs) not-empty) 344 (if (and (null msgs) not-empty)
334 (error "No messages in sequence `%s'" seq)) 345 (error "No messages in sequence `%s'" seq))
335 seq)) 346 seq))
336 347
337(defun mh-seq-names (seq-list) 348(defun mh-seq-names (seq-list)
338 "Return an alist containing the names of the SEQ-LIST." 349 "Return an alist containing the names of the SEQ-LIST."
339 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry)))) 350 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
340 seq-list)) 351 seq-list))
341 352
353;;;###mh-autoload
342(defun mh-rename-seq (sequence new-name) 354(defun mh-rename-seq (sequence new-name)
343 "Rename SEQUENCE to have NEW-NAME." 355 "Rename SEQUENCE to have NEW-NAME."
344 (interactive (list (mh-read-seq "Old" t) 356 (interactive (list (mh-read-seq "Old" t)
345 (intern (read-string "New sequence name: ")))) 357 (intern (read-string "New sequence name: "))))
346 (let ((old-seq (mh-find-seq sequence))) 358 (let ((old-seq (mh-find-seq sequence)))
347 (or old-seq 359 (or old-seq
348 (error "Sequence %s does not exist" sequence)) 360 (error "Sequence %s does not exist" sequence))
349 ;; create new sequence first, since it might raise an error. 361 ;; create new sequence first, since it might raise an error.
350 (mh-define-sequence new-name (mh-seq-msgs old-seq)) 362 (mh-define-sequence new-name (mh-seq-msgs old-seq))
351 (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) 363 (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
352 (rplaca old-seq new-name))) 364 (rplaca old-seq new-name)))
353 365
366;;;###mh-autoload
354(defun mh-map-to-seq-msgs (func seq &rest args) 367(defun mh-map-to-seq-msgs (func seq &rest args)
355"Invoke the FUNC at each message in the SEQ. 368 "Invoke the FUNC at each message in the SEQ.
356The remaining ARGS are passed as arguments to FUNC." 369SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
370passed as arguments to FUNC."
357 (save-excursion 371 (save-excursion
358 (let ((msgs (mh-seq-to-msgs seq))) 372 (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
359 (while msgs 373 (while msgs
360 (if (mh-goto-msg (car msgs) t t) 374 (if (mh-goto-msg (car msgs) t t)
361 (apply func (car msgs) args)) 375 (apply func (car msgs) args))
362 (setq msgs (cdr msgs)))))) 376 (setq msgs (cdr msgs))))))
363 377
378;;;###mh-autoload
364(defun mh-notate-seq (seq notation offset) 379(defun mh-notate-seq (seq notation offset)
365 "Mark the scan listing. 380 "Mark the scan listing.
366All messages in SEQ are marked with NOTATION at OFFSET from the beginning of 381All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
367the line." 382the line."
368 (mh-map-to-seq-msgs 'mh-notate seq notation offset)) 383 (mh-map-to-seq-msgs 'mh-notate seq notation offset))
369 384
385;;;###mh-autoload
370(defun mh-add-to-sequence (seq msgs) 386(defun mh-add-to-sequence (seq msgs)
371 "The sequence SEQ is augmented with the messages in MSGS." 387 "The sequence SEQ is augmented with the messages in MSGS."
372 ;; Add to a SEQUENCE each message the list of MSGS. 388 ;; Add to a SEQUENCE each message the list of MSGS.
373 (if (not (mh-folder-name-p seq)) 389 (if (not (mh-folder-name-p seq))
374 (if msgs 390 (if msgs
375 (apply 'mh-exec-cmd "mark" mh-current-folder "-add" 391 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
376 "-sequence" (symbol-name seq) 392 "-sequence" (symbol-name seq)
377 (mh-coalesce-msg-list msgs))))) 393 (mh-coalesce-msg-list msgs)))))
378 394
379;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes 395;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
380;; that the folder buffer is sorted. However in this case that assumption 396;; that the folder buffer is sorted. However in this case that assumption
@@ -397,20 +413,25 @@ the line."
397 (save-restriction 413 (save-restriction
398 (narrow-to-region (point) (point)) 414 (narrow-to-region (point) (point))
399 (mh-regenerate-headers coalesced-msgs t) 415 (mh-regenerate-headers coalesced-msgs t)
400 (when (memq 'unthread mh-view-ops) 416 (cond ((memq 'unthread mh-view-ops)
401 ;; Populate restricted scan-line map 417 ;; Populate restricted scan-line map
402 (goto-char (point-min)) 418 (goto-char (point-min))
403 (while (not (eobp)) 419 (while (not (eobp))
404 (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) 420 (let ((msg (mh-get-msg-num nil)))
405 (mh-thread-parse-scan-line)) 421 (when (numberp msg)
406 (forward-line)) 422 (setf (gethash msg mh-thread-scan-line-map)
407 ;; Remove scan lines and read results from pre-computed thread tree 423 (mh-thread-parse-scan-line))))
408 (delete-region (point-min) (point-max)) 424 (forward-line))
409 (let ((thread-tree (mh-thread-generate mh-current-folder ())) 425 ;; Remove scan lines and read results from pre-computed tree
410 (mh-thread-body-width 426 (delete-region (point-min) (point-max))
411 (- (window-width) mh-cmd-note 427 (let ((thread-tree (mh-thread-generate mh-current-folder ()))
412 (1- mh-scan-field-subject-start-offset)))) 428 (mh-thread-body-width
413 (mh-thread-generate-scan-lines thread-tree -2))))))) 429 (- (window-width) mh-cmd-note
430 (1- mh-scan-field-subject-start-offset)))
431 (mh-thread-last-ancestor nil))
432 (mh-thread-generate-scan-lines thread-tree -2)))
433 (mh-index-data
434 (mh-index-insert-folder-headers)))))))
414 435
415(defun mh-copy-line-to-point (msg location) 436(defun mh-copy-line-to-point (msg location)
416 "Copy current message line to a specific location. 437 "Copy current message line to a specific location.
@@ -421,24 +442,25 @@ LOCATION."
421 (beginning-of-line) 442 (beginning-of-line)
422 (save-excursion 443 (save-excursion
423 (let ((beginning-of-line (point)) 444 (let ((beginning-of-line (point))
424 end) 445 end)
425 (forward-line 1) 446 (forward-line 1)
426 (setq end (point)) 447 (setq end (point))
427 (goto-char location) 448 (goto-char location)
428 (insert-buffer-substring (current-buffer) beginning-of-line end)))) 449 (insert-buffer-substring (current-buffer) beginning-of-line end))))
429 450
430(defun mh-region-to-sequence (begin end) 451;;;###mh-autoload
431 "Define sequence 'region as the messages between point and mark. 452(defun mh-region-to-msg-list (begin end)
432When called programmatically, use arguments BEGIN and END to define region." 453 "Return a list of messages within the region between BEGIN and END."
433 (interactive "r")
434 (mh-delete-seq-locally 'region)
435 (save-excursion 454 (save-excursion
436 ;; If end is end of buffer back up one position 455 ;; If end is end of buffer back up one position
437 (setq end (if (equal end (point-max)) (1- end) end)) 456 (setq end (if (equal end (point-max)) (1- end) end))
438 (goto-char begin) 457 (goto-char begin)
439 (while (<= (point) end) 458 (let ((result ()))
440 (mh-add-msgs-to-seq (mh-get-msg-num t) 'region t) 459 (while (<= (point) end)
441 (forward-line 1)))) 460 (let ((index (mh-get-msg-num nil)))
461 (when (numberp index) (push index result)))
462 (forward-line 1))
463 result)))
442 464
443 465
444 466
@@ -493,6 +515,7 @@ Return number of messages put in the sequence:
493 (t 515 (t
494 0)))))) 516 0))))))
495 517
518;;;###mh-autoload
496(defun mh-narrow-to-subject () 519(defun mh-narrow-to-subject ()
497 "Narrow to a sequence containing all following messages with same subject." 520 "Narrow to a sequence containing all following messages with same subject."
498 (interactive) 521 (interactive)
@@ -510,6 +533,7 @@ Return number of messages put in the sequence:
510 (if (numberp num) 533 (if (numberp num)
511 (mh-goto-msg num t t)))))) 534 (mh-goto-msg num t t))))))
512 535
536;;;###mh-autoload
513(defun mh-delete-subject () 537(defun mh-delete-subject ()
514 "Mark all following messages with same subject to be deleted. 538 "Mark all following messages with same subject to be deleted.
515This puts the messages in a sequence named subject. You can undo the last 539This puts the messages in a sequence named subject. You can undo the last
@@ -527,30 +551,42 @@ subject sequence."
527 (message "Marked %d messages for deletion" count) 551 (message "Marked %d messages for deletion" count)
528 (mh-delete-msg 'subject))))) 552 (mh-delete-msg 'subject)))))
529 553
554;;;###mh-autoload
555(defun mh-delete-subject-or-thread ()
556 "Mark messages for deletion intelligently.
557If the folder is threaded then `mh-thread-delete' is used to mark the current
558message and all its descendants for deletion. Otherwise `mh-delete-subject' is
559used to mark the current message and all messages following it with the same
560subject for deletion."
561 (interactive)
562 (if (memq 'unthread mh-view-ops)
563 (mh-thread-delete)
564 (mh-delete-subject)))
565
530;;; Message threading: 566;;; Message threading:
531 567
532(defun mh-thread-initialize () 568(defun mh-thread-initialize ()
533 "Make hash tables, otherwise clear them." 569 "Make hash tables, otherwise clear them."
534 (cond 570 (cond
535 (mh-thread-id-hash 571 (mh-thread-id-hash
536 (clrhash mh-thread-id-hash) 572 (clrhash mh-thread-id-hash)
537 (clrhash mh-thread-subject-hash) 573 (clrhash mh-thread-subject-hash)
538 (clrhash mh-thread-id-table) 574 (clrhash mh-thread-id-table)
539 (clrhash mh-thread-id-index-map) 575 (clrhash mh-thread-id-index-map)
540 (clrhash mh-thread-index-id-map) 576 (clrhash mh-thread-index-id-map)
541 (clrhash mh-thread-scan-line-map) 577 (clrhash mh-thread-scan-line-map)
542 (clrhash mh-thread-subject-container-hash) 578 (clrhash mh-thread-subject-container-hash)
543 (clrhash mh-thread-duplicates) 579 (clrhash mh-thread-duplicates)
544 (setq mh-thread-history ())) 580 (setq mh-thread-history ()))
545 (t (setq mh-thread-id-hash (make-hash-table :test #'equal)) 581 (t (setq mh-thread-id-hash (make-hash-table :test #'equal))
546 (setq mh-thread-subject-hash (make-hash-table :test #'equal)) 582 (setq mh-thread-subject-hash (make-hash-table :test #'equal))
547 (setq mh-thread-id-table (make-hash-table :test #'eq)) 583 (setq mh-thread-id-table (make-hash-table :test #'eq))
548 (setq mh-thread-id-index-map (make-hash-table :test #'eq)) 584 (setq mh-thread-id-index-map (make-hash-table :test #'eq))
549 (setq mh-thread-index-id-map (make-hash-table :test #'eql)) 585 (setq mh-thread-index-id-map (make-hash-table :test #'eql))
550 (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) 586 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
551 (setq mh-thread-subject-container-hash (make-hash-table :test #'eq)) 587 (setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
552 (setq mh-thread-duplicates (make-hash-table :test #'eq)) 588 (setq mh-thread-duplicates (make-hash-table :test #'eq))
553 (setq mh-thread-history ())))) 589 (setq mh-thread-history ()))))
554 590
555(defsubst mh-thread-id-container (id) 591(defsubst mh-thread-id-container (id)
556 "Given ID, return the corresponding container in `mh-thread-id-table'. 592 "Given ID, return the corresponding container in `mh-thread-id-table'.
@@ -570,8 +606,8 @@ is updated."
570 (parent-container (mh-container-parent child-container))) 606 (parent-container (mh-container-parent child-container)))
571 (when parent-container 607 (when parent-container
572 (setf (mh-container-children parent-container) 608 (setf (mh-container-children parent-container)
573 (remove* child-container (mh-container-children parent-container) 609 (loop for elem in (mh-container-children parent-container)
574 :test #'eq)) 610 unless (eq child-container elem) collect elem))
575 (setf (mh-container-parent child-container) nil)))) 611 (setf (mh-container-parent child-container) nil))))
576 612
577(defsubst mh-thread-add-link (parent child &optional at-end-p) 613(defsubst mh-thread-add-link (parent child &optional at-end-p)
@@ -711,7 +747,7 @@ If CONTAINER is empty return the subject info of one of its children."
711 (setf (mh-container-real-child-p node) t))))))) 747 (setf (mh-container-real-child-p node) t)))))))
712 748
713(defun mh-thread-prune-containers (roots) 749(defun mh-thread-prune-containers (roots)
714"Prune empty containers in the containers ROOTS." 750 "Prune empty containers in the containers ROOTS."
715 (let ((dfs-ordered-nodes ()) 751 (let ((dfs-ordered-nodes ())
716 (work-list roots)) 752 (work-list roots))
717 (while work-list 753 (while work-list
@@ -804,16 +840,18 @@ preference to something that has it."
804Ideally this should have some regexp which will try to guess if a string 840Ideally this should have some regexp which will try to guess if a string
805between < and > is a message id and not an email address. For now it will 841between < and > is a message id and not an email address. For now it will
806take the last string inside angles." 842take the last string inside angles."
807 (let ((end (search ">" reply-to-header :from-end t))) 843 (let ((end (mh-search-from-end ?> reply-to-header)))
808 (when (numberp end) 844 (when (numberp end)
809 (let ((begin (search "<" reply-to-header :from-end t :end2 end))) 845 (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
810 (when (numberp begin) 846 (when (numberp begin)
811 (list (substring reply-to-header begin (1+ end)))))))) 847 (list (substring reply-to-header begin (1+ end))))))))
812 848
813(defun mh-thread-set-tables (folder) 849(defun mh-thread-set-tables (folder)
814 "Use the tables of FOLDER in current buffer." 850 "Use the tables of FOLDER in current buffer."
815 (flet ((mh-get-table (symbol) 851 (flet ((mh-get-table (symbol)
816 (save-excursion (set-buffer folder) (symbol-value symbol)))) 852 (save-excursion
853 (set-buffer folder)
854 (symbol-value symbol))))
817 (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash)) 855 (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
818 (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash)) 856 (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
819 (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table)) 857 (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
@@ -851,7 +889,7 @@ Only information about messages in MSG-LIST are added to the tree."
851 #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil 889 #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
852 "-width" "10000" "-format" 890 "-width" "10000" "-format"
853 "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" 891 "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
854 (mapcar #'(lambda (x) (format "%s" x)) msg-list))) 892 folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
855 (goto-char (point-min)) 893 (goto-char (point-min))
856 (let ((roots ()) 894 (let ((roots ())
857 (case-fold-search t)) 895 (case-fold-search t))
@@ -859,8 +897,8 @@ Only information about messages in MSG-LIST are added to the tree."
859 (while (not (eobp)) 897 (while (not (eobp))
860 (block process-message 898 (block process-message
861 (let* ((index-line 899 (let* ((index-line
862 (prog1 (buffer-substring (point) (line-end-position)) 900 (prog1 (buffer-substring (point) (line-end-position))
863 (forward-line))) 901 (forward-line)))
864 (index (car (read-from-string index-line))) 902 (index (car (read-from-string index-line)))
865 (id (prog1 (buffer-substring (point) (line-end-position)) 903 (id (prog1 (buffer-substring (point) (line-end-position))
866 (forward-line))) 904 (forward-line)))
@@ -901,6 +939,7 @@ Only information about messages in MSG-LIST are added to the tree."
901 (set-buffer folder) 939 (set-buffer folder)
902 (setq mh-thread-history history)))))) 940 (setq mh-thread-history history))))))
903 941
942;;;###mh-autoload
904(defun mh-thread-inc (folder start-point) 943(defun mh-thread-inc (folder start-point)
905 "Update thread tree for FOLDER. 944 "Update thread tree for FOLDER.
906All messages after START-POINT are added to the thread tree." 945All messages after START-POINT are added to the thread tree."
@@ -909,22 +948,26 @@ All messages after START-POINT are added to the thread tree."
909 (let ((msg-list ())) 948 (let ((msg-list ()))
910 (while (not (eobp)) 949 (while (not (eobp))
911 (let ((index (mh-get-msg-num nil))) 950 (let ((index (mh-get-msg-num nil)))
912 (push index msg-list) 951 (when (numberp index)
913 (setf (gethash index mh-thread-scan-line-map) 952 (push index msg-list)
914 (mh-thread-parse-scan-line)) 953 (setf (gethash index mh-thread-scan-line-map)
954 (mh-thread-parse-scan-line)))
915 (forward-line))) 955 (forward-line)))
916 (let ((thread-tree (mh-thread-generate folder msg-list)) 956 (let ((thread-tree (mh-thread-generate folder msg-list))
917 (buffer-read-only nil) 957 (buffer-read-only nil)
918 (old-buffer-modified-flag (buffer-modified-p))) 958 (old-buffer-modified-flag (buffer-modified-p)))
919 (delete-region (point-min) (point-max)) 959 (delete-region (point-min) (point-max))
920 (let ((mh-thread-body-width (- (window-width) mh-cmd-note 960 (let ((mh-thread-body-width (- (window-width) mh-cmd-note
921 (1- mh-scan-field-subject-start-offset)))) 961 (1- mh-scan-field-subject-start-offset)))
962 (mh-thread-last-ancestor nil))
922 (mh-thread-generate-scan-lines thread-tree -2)) 963 (mh-thread-generate-scan-lines thread-tree -2))
923 (mh-notate-user-sequences) 964 (mh-notate-user-sequences)
924 (mh-notate-deleted-and-refiled) 965 (mh-notate-deleted-and-refiled)
925 (mh-notate-seq 'cur mh-note-cur mh-cmd-note) 966 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
926 (set-buffer-modified-p old-buffer-modified-flag)))) 967 (set-buffer-modified-p old-buffer-modified-flag))))
927 968
969(defvar mh-thread-last-ancestor)
970
928(defun mh-thread-generate-scan-lines (tree level) 971(defun mh-thread-generate-scan-lines (tree level)
929 "Generate scan lines. 972 "Generate scan lines.
930TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices 973TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
@@ -938,18 +981,31 @@ the message."
938 (duplicates (gethash id mh-thread-duplicates)) 981 (duplicates (gethash id mh-thread-duplicates))
939 (new-level (+ level 2)) 982 (new-level (+ level 2))
940 (dupl-flag t) 983 (dupl-flag t)
984 (force-angle-flag nil)
941 (increment-level-flag nil)) 985 (increment-level-flag nil))
942 (dolist (scan-line (mapcar (lambda (x) 986 (dolist (scan-line (mapcar (lambda (x)
943 (gethash x mh-thread-scan-line-map)) 987 (gethash x mh-thread-scan-line-map))
944 (reverse (cons index duplicates)))) 988 (reverse (cons index duplicates))))
945 (when scan-line 989 (when scan-line
990 (when (and dupl-flag (equal level 0)
991 (mh-thread-ancestor-p mh-thread-last-ancestor tree))
992 (setq level (+ level 2)
993 new-level (+ new-level 2)
994 force-angle-flag t))
995 (when (equal level 0)
996 (setq mh-thread-last-ancestor tree)
997 (while (mh-container-parent mh-thread-last-ancestor)
998 (setq mh-thread-last-ancestor
999 (mh-container-parent mh-thread-last-ancestor))))
946 (insert (car scan-line) 1000 (insert (car scan-line)
947 (format (format "%%%ss" 1001 (format (format "%%%ss"
948 (if dupl-flag level new-level)) "") 1002 (if dupl-flag level new-level)) "")
949 (if (and (mh-container-real-child-p tree) dupl-flag) 1003 (if (and (mh-container-real-child-p tree) dupl-flag
1004 (not force-angle-flag))
950 "[" "<") 1005 "[" "<")
951 (cadr scan-line) 1006 (cadr scan-line)
952 (if (and (mh-container-real-child-p tree) dupl-flag) 1007 (if (and (mh-container-real-child-p tree) dupl-flag
1008 (not force-angle-flag))
953 "]" ">") 1009 "]" ">")
954 (truncate-string-to-width 1010 (truncate-string-to-width
955 (caddr scan-line) (- mh-thread-body-width 1011 (caddr scan-line) (- mh-thread-body-width
@@ -984,14 +1040,16 @@ Otherwise uses the line at point as the scan line to parse."
984 (substring string (+ mh-cmd-note mh-scan-field-from-end-offset)) 1040 (substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
985 string))) 1041 string)))
986 1042
1043;;;###mh-autoload
987(defun mh-thread-add-spaces (count) 1044(defun mh-thread-add-spaces (count)
988 "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." 1045 "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
989 (let ((spaces (format (format "%%%ss" count) ""))) 1046 (let ((spaces (format (format "%%%ss" count) "")))
990 (while (not (eobp)) 1047 (while (not (eobp))
991 (let* ((msg-num (mh-get-msg-num nil)) 1048 (let* ((msg-num (mh-get-msg-num nil))
992 (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map)))) 1049 (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
993 (setf (gethash msg-num mh-thread-scan-line-map) 1050 (when (numberp msg-num)
994 (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))) 1051 (setf (gethash msg-num mh-thread-scan-line-map)
1052 (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
995 (forward-line 1)))) 1053 (forward-line 1))))
996 1054
997(defun mh-thread-folder () 1055(defun mh-thread-folder ()
@@ -1000,23 +1058,24 @@ Otherwise uses the line at point as the scan line to parse."
1000 (mh-thread-initialize) 1058 (mh-thread-initialize)
1001 (goto-char (point-min)) 1059 (goto-char (point-min))
1002 (while (not (eobp)) 1060 (while (not (eobp))
1003 (setf (gethash (mh-get-msg-num nil) mh-thread-scan-line-map) 1061 (let ((index (mh-get-msg-num nil)))
1004 (mh-thread-parse-scan-line)) 1062 (when (numberp index)
1063 (setf (gethash index mh-thread-scan-line-map)
1064 (mh-thread-parse-scan-line))))
1005 (forward-line)) 1065 (forward-line))
1006 (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num)) 1066 (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
1007 (thread-tree (mh-thread-generate (buffer-name) (list range))) 1067 (thread-tree (mh-thread-generate (buffer-name) (list range))))
1008 (buffer-read-only nil)
1009 (old-buffer-modified-p (buffer-modified-p)))
1010 (delete-region (point-min) (point-max)) 1068 (delete-region (point-min) (point-max))
1011 (let ((mh-thread-body-width (- (window-width) mh-cmd-note 1069 (let ((mh-thread-body-width (- (window-width) mh-cmd-note
1012 (1- mh-scan-field-subject-start-offset)))) 1070 (1- mh-scan-field-subject-start-offset)))
1071 (mh-thread-last-ancestor nil))
1013 (mh-thread-generate-scan-lines thread-tree -2)) 1072 (mh-thread-generate-scan-lines thread-tree -2))
1014 (mh-notate-user-sequences) 1073 (mh-notate-user-sequences)
1015 (mh-notate-deleted-and-refiled) 1074 (mh-notate-deleted-and-refiled)
1016 (mh-notate-seq 'cur mh-note-cur mh-cmd-note) 1075 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
1017 (set-buffer-modified-p old-buffer-modified-p)
1018 (message "Threading %s...done" (buffer-name)))) 1076 (message "Threading %s...done" (buffer-name))))
1019 1077
1078;;;###mh-autoload
1020(defun mh-toggle-threads () 1079(defun mh-toggle-threads ()
1021 "Toggle threaded view of folder. 1080 "Toggle threaded view of folder.
1022The conversion of normal view to threaded view is exact, that is the same 1081The conversion of normal view to threaded view is exact, that is the same
@@ -1024,24 +1083,32 @@ messages are displayed in the folder buffer before and after threading. However
1024the conversion from threaded view to normal view is inexact. So more messages 1083the conversion from threaded view to normal view is inexact. So more messages
1025than were originally present may be shown as a result." 1084than were originally present may be shown as a result."
1026 (interactive) 1085 (interactive)
1027 (let ((msg-at-point (mh-get-msg-num nil))) 1086 (let ((msg-at-point (mh-get-msg-num nil))
1087 (old-buffer-modified-flag (buffer-modified-p))
1088 (buffer-read-only nil))
1028 (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq) 1089 (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
1029 (unless (mh-valid-view-change-operation-p 'unthread) 1090 (unless (mh-valid-view-change-operation-p 'unthread)
1030 (error "Can't unthread folder")) 1091 (error "Can't unthread folder"))
1031 (mh-scan-folder mh-current-folder 1092 (mh-scan-folder mh-current-folder
1032 (format "%s" mh-narrowed-to-seq) 1093 (format "%s" mh-narrowed-to-seq)
1033 t)) 1094 t)
1095 (when mh-index-data
1096 (mh-index-insert-folder-headers)))
1034 ((memq 'unthread mh-view-ops) 1097 ((memq 'unthread mh-view-ops)
1035 (unless (mh-valid-view-change-operation-p 'unthread) 1098 (unless (mh-valid-view-change-operation-p 'unthread)
1036 (error "Can't unthread folder")) 1099 (error "Can't unthread folder"))
1037 (mh-scan-folder mh-current-folder 1100 (mh-scan-folder mh-current-folder
1038 (format "%s-%s" mh-first-msg-num mh-last-msg-num) 1101 (format "%s-%s" mh-first-msg-num mh-last-msg-num)
1039 t)) 1102 t)
1103 (when mh-index-data
1104 (mh-index-insert-folder-headers)))
1040 (t (mh-thread-folder) 1105 (t (mh-thread-folder)
1041 (push 'unthread mh-view-ops))) 1106 (push 'unthread mh-view-ops)))
1042 (when msg-at-point (mh-goto-msg msg-at-point t t)) 1107 (when msg-at-point (mh-goto-msg msg-at-point t t))
1108 (set-buffer-modified-p old-buffer-modified-flag)
1043 (mh-recenter nil))) 1109 (mh-recenter nil)))
1044 1110
1111;;;###mh-autoload
1045(defun mh-thread-forget-message (index) 1112(defun mh-thread-forget-message (index)
1046 "Forget the message INDEX from the threading tables." 1113 "Forget the message INDEX from the threading tables."
1047 (let* ((id (gethash index mh-thread-index-id-map)) 1114 (let* ((id (gethash index mh-thread-index-id-map))
@@ -1058,9 +1125,152 @@ than were originally present may be shown as a result."
1058 (setf (gethash id mh-thread-duplicates) 1125 (setf (gethash id mh-thread-duplicates)
1059 (remove index duplicates)))))) 1126 (remove index duplicates))))))
1060 1127
1128
1129
1130;;; Operations on threads
1131
1132(defun mh-thread-current-indentation-level ()
1133 "Find the number of spaces by which current message is indented."
1134 (save-excursion
1135 (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
1136 mh-scan-date-width 1))
1137 (level 0))
1138 (beginning-of-line)
1139 (forward-char address-start-offset)
1140 (while (char-equal (char-after) ? )
1141 (incf level)
1142 (forward-char))
1143 level)))
1144
1145;;;###mh-autoload
1146(defun mh-thread-next-sibling (&optional previous-flag)
1147 "Jump to next sibling.
1148With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling."
1149 (interactive)
1150 (cond ((not (memq 'unthread mh-view-ops))
1151 (error "Folder isn't threaded"))
1152 ((eobp)
1153 (error "No message at point")))
1154 (beginning-of-line)
1155 (let ((point (point))
1156 (done nil)
1157 (my-level (mh-thread-current-indentation-level)))
1158 (while (and (not done)
1159 (equal (forward-line (if previous-flag -1 1)) 0)
1160 (not (eobp)))
1161 (let ((level (mh-thread-current-indentation-level)))
1162 (cond ((equal level my-level)
1163 (setq done 'success))
1164 ((< level my-level)
1165 (message "No %s sibling" (if previous-flag "previous" "next"))
1166 (setq done 'failure)))))
1167 (cond ((eq done 'success) (mh-maybe-show))
1168 ((eq done 'failure) (goto-char point))
1169 (t (message "No %s sibling" (if previous-flag "previous" "next"))
1170 (goto-char point)))))
1171
1172;;;###mh-autoload
1173(defun mh-thread-previous-sibling ()
1174 "Jump to previous sibling."
1175 (interactive)
1176 (mh-thread-next-sibling t))
1177
1178(defun mh-thread-immediate-ancestor ()
1179 "Jump to immediate ancestor in thread tree."
1180 (beginning-of-line)
1181 (let ((point (point))
1182 (ancestor-level (- (mh-thread-current-indentation-level) 2))
1183 (done nil))
1184 (if (< ancestor-level 0)
1185 nil
1186 (while (and (not done) (equal (forward-line -1) 0))
1187 (when (equal ancestor-level (mh-thread-current-indentation-level))
1188 (setq done t)))
1189 (unless done
1190 (goto-char point))
1191 done)))
1192
1193;;;###mh-autoload
1194(defun mh-thread-ancestor (&optional thread-root-flag)
1195 "Jump to the ancestor of current message.
1196If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
1197thread tree the message belongs to."
1198 (interactive "P")
1199 (beginning-of-line)
1200 (cond ((not (memq 'unthread mh-view-ops))
1201 (error "Folder isn't threaded"))
1202 ((eobp)
1203 (error "No message at point")))
1204 (let ((current-level (mh-thread-current-indentation-level)))
1205 (cond (thread-root-flag
1206 (while (mh-thread-immediate-ancestor))
1207 (mh-maybe-show))
1208 ((equal current-level 1)
1209 (message "Message has no ancestor"))
1210 (t (mh-thread-immediate-ancestor)
1211 (mh-maybe-show)))))
1212
1213(defun mh-thread-find-children ()
1214 "Return a region containing the current message and its children.
1215The result is returned as a list of two elements. The first is the point at the
1216start of the region and the second is the point at the end."
1217 (beginning-of-line)
1218 (if (eobp)
1219 nil
1220 (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
1221 mh-scan-date-width 1))
1222 (level (mh-thread-current-indentation-level))
1223 spaces begin)
1224 (setq begin (point))
1225 (setq spaces (format (format "%%%ss" (1+ level)) ""))
1226 (forward-line)
1227 (block nil
1228 (while (not (eobp))
1229 (forward-char address-start-offset)
1230 (unless (equal (string-match spaces (buffer-substring-no-properties
1231 (point) (line-end-position)))
1232 0)
1233 (beginning-of-line)
1234 (backward-char)
1235 (return))
1236 (forward-line)))
1237 (list begin (point)))))
1238
1239;;;###mh-autoload
1240(defun mh-thread-delete ()
1241 "Mark current message and all its children for subsequent deletion."
1242 (interactive)
1243 (cond ((not (memq 'unthread mh-view-ops))
1244 (error "Folder isn't threaded"))
1245 ((eobp)
1246 (error "No message at point"))
1247 (t (mh-delete-msg
1248 (apply #'mh-region-to-msg-list (mh-thread-find-children))))))
1249
1250;; This doesn't handle mh-default-folder-for-message-function. We should
1251;; refactor that code so that we don't copy it.
1252;;;###mh-autoload
1253(defun mh-thread-refile (folder)
1254 "Mark current message and all its children for refiling to FOLDER."
1255 (interactive (list
1256 (intern (mh-prompt-for-folder
1257 "Destination"
1258 (cond ((eq 'refile (car mh-last-destination-folder))
1259 (symbol-name (cdr mh-last-destination-folder)))
1260 (t ""))
1261 t))))
1262 (cond ((not (memq 'unthread mh-view-ops))
1263 (error "Folder isn't threaded"))
1264 ((eobp)
1265 (error "No message at point"))
1266 (t (mh-refile-msg
1267 (apply #'mh-region-to-msg-list (mh-thread-find-children))
1268 folder))))
1269
1061(provide 'mh-seq) 1270(provide 'mh-seq)
1062 1271
1063;;; Local Variables: 1272;;; Local Variables:
1273;;; indent-tabs-mode: nil
1064;;; sentence-end-double-space: nil 1274;;; sentence-end-double-space: nil
1065;;; End: 1275;;; End:
1066 1276
diff --git a/lisp/mail/mh-speed.el b/lisp/mail/mh-speed.el
index 3e511d1d40e..beda52778e4 100644
--- a/lisp/mail/mh-speed.el
+++ b/lisp/mail/mh-speed.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2002 Free Software Foundation, Inc.
4 4
5;; Author: Bill Wohler <wohler@newt.com> 5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail 7;; Keywords: mail
8;; See: mh-e.el 8;; See: mh-e.el
@@ -31,71 +31,15 @@
31 31
32;;; Change Log: 32;;; Change Log:
33 33
34;; $Id: mh-speed.el,v 1.26 2002/11/13 19:36:00 wohler Exp $ 34;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $
35 35
36;;; Code: 36;;; Code:
37 37
38;; Requires 38;; Requires
39(require 'cl) 39(require 'cl)
40(require 'mh-utils)
41(require 'mh-e) 40(require 'mh-e)
42(require 'speedbar) 41(require 'speedbar)
43 42
44;; Autoloads
45(autoload 'mh-index-goto-nearest-msg "mh-index")
46(autoload 'mh-index-parse-folder "mh-index")
47(autoload 'mh-visit-folder "mh-e")
48
49;; User customizable
50(defcustom mh-large-folder 200
51 "The number of messages that indicates a large folder.
52If the number of messages in a folder exceeds this value, confirmation is
53required when the folder is visited from the speedbar."
54 :type 'integer
55 :group 'mh)
56
57(defcustom mh-speed-flists-interval 60
58 "Time between calls to flists in seconds.
59If 0, flists is not called repeatedly."
60 :type 'integer
61 :group 'mh)
62
63(defcustom mh-speed-run-flists-flag t
64 "Non-nil means flists is used.
65If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
66update the display of the number of unseen and total messages in each folder.
67If resources are limited, this can be set to nil and the speedbar display can
68be updated manually with the \\[mh-speed-flists] command."
69 :type 'boolean
70 :group 'mh)
71
72(defface mh-speedbar-folder-face
73 '((((class color) (background light))
74 (:foreground "blue4"))
75 (((class color) (background dark))
76 (:foreground "light blue")))
77 "Face used for folders in the speedbar buffer."
78 :group 'mh)
79
80(defface mh-speedbar-selected-folder-face
81 '((((class color) (background light))
82 (:foreground "red" :underline t))
83 (((class color) (background dark))
84 (:foreground "red" :underline t))
85 (t (:underline t)))
86 "Face used for the current folder."
87 :group 'mh)
88
89(defface mh-speedbar-folder-with-unseen-messages-face
90 '((t (:inherit mh-speedbar-folder-face :bold t)))
91 "Face used for folders in the speedbar buffer which have unread messages."
92 :group 'mh)
93
94(defface mh-speedbar-selected-folder-with-unseen-messages-face
95 '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
96 "Face used for the current folder when it has unread messages."
97 :group 'mh)
98
99;; Global variables 43;; Global variables
100(defvar mh-speed-refresh-flag nil) 44(defvar mh-speed-refresh-flag nil)
101(defvar mh-speed-last-selected-folder nil) 45(defvar mh-speed-last-selected-folder nil)
@@ -116,6 +60,7 @@ be updated manually with the \\[mh-speed-flists] command."
116 (cdr (assoc "files" speedbar-stealthy-function-list)))) 60 (cdr (assoc "files" speedbar-stealthy-function-list))))
117 61
118;; Functions called by speedbar to initialize display... 62;; Functions called by speedbar to initialize display...
63;;;###mh-autoload
119(defun mh-folder-speedbar-buttons (buffer) 64(defun mh-folder-speedbar-buttons (buffer)
120 "Interface function to create MH-E speedbar buffer. 65 "Interface function to create MH-E speedbar buffer.
121BUFFER is the MH-E buffer for which the speedbar buffer is to be created." 66BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
@@ -134,24 +79,22 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
134 (when mh-speed-run-flists-flag 79 (when mh-speed-run-flists-flag
135 (mh-speed-flists nil)))) 80 (mh-speed-flists nil))))
136 81
82;;;###mh-autoload
137(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) 83(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
138(defalias 'mh-index-folder-speedbar-buttons 'mh-folder-speedbar-buttons) 84;;;###mh-autoload
139(defalias 'mh-index-show-speedbar-buttons 'mh-folder-speedbar-buttons)
140(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons) 85(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
141 86
142;; Keymaps for speedbar... 87;; Keymaps for speedbar...
143(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap) 88(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
144 "Specialized speedbar keymap for MH-E buffers.") 89 "Specialized speedbar keymap for MH-E buffers.")
145(gnus-define-keys mh-folder-speedbar-key-map 90(gnus-define-keys mh-folder-speedbar-key-map
146 "+" mh-speed-expand-folder 91 "+" mh-speed-expand-folder
147 "-" mh-speed-contract-folder 92 "-" mh-speed-contract-folder
148 "\r" mh-speed-view 93 "\r" mh-speed-view
149 "f" mh-speed-flists 94 "f" mh-speed-flists
150 "i" mh-speed-invalidate-map) 95 "i" mh-speed-invalidate-map)
151 96
152(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) 97(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
153(defvar mh-index-folder-speedbar-key-map mh-folder-speedbar-key-map)
154(defvar mh-index-show-speedbar-key-map mh-folder-speedbar-key-map)
155(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) 98(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
156 99
157;; Menus for speedbar... 100;; Menus for speedbar...
@@ -171,8 +114,6 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
171 "Extra menu items for speedbar.") 114 "Extra menu items for speedbar.")
172 115
173(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) 116(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
174(defvar mh-index-folder-speedbar-menu-items mh-folder-speedbar-menu-items)
175(defvar mh-index-show-speedbar-menu-items mh-folder-speedbar-menu-items)
176(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items) 117(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
177 118
178(defmacro mh-speed-select-attached-frame () 119(defmacro mh-speed-select-attached-frame ()
@@ -193,12 +134,12 @@ own when you are trying to navigate around in the speedbar buffer.
193 134
194The update is always carried out if FORCE is non-nil." 135The update is always carried out if FORCE is non-nil."
195 (let* ((lastf (selected-frame)) 136 (let* ((lastf (selected-frame))
196 (newcf (save-excursion 137 (newcf (save-excursion
197 (mh-speed-select-attached-frame) 138 (mh-speed-select-attached-frame)
198 (prog1 (mh-speed-extract-folder-name (buffer-name)) 139 (prog1 (mh-speed-extract-folder-name (buffer-name))
199 (select-frame lastf)))) 140 (select-frame lastf))))
200 (lastb (current-buffer)) 141 (lastb (current-buffer))
201 (case-fold-search t)) 142 (case-fold-search t))
202 (when (or force 143 (when (or force
203 (and mh-speed-refresh-flag (not (eq lastf speedbar-frame))) 144 (and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
204 (and (stringp newcf) 145 (and (stringp newcf)
@@ -271,7 +212,7 @@ The function will expand out parent folders of FOLDER if needed."
271 (suffix-list ()) 212 (suffix-list ())
272 (last-slash t)) 213 (last-slash t))
273 (while (and (not (gethash prefix mh-speed-folder-map)) last-slash) 214 (while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
274 (setq last-slash (search "/" prefix :from-end t)) 215 (setq last-slash (mh-search-from-end ?/ prefix))
275 (when (integerp last-slash) 216 (when (integerp last-slash)
276 (push (substring prefix (1+ last-slash)) suffix-list) 217 (push (substring prefix (1+ last-slash)) suffix-list)
277 (setq prefix (substring prefix 0 last-slash)))) 218 (setq prefix (substring prefix 0 last-slash))))
@@ -306,15 +247,10 @@ Do the right thing for the different kinds of buffers that MH-E uses."
306 ((eq major-mode 'mh-show-mode) 247 ((eq major-mode 'mh-show-mode)
307 (set-buffer mh-show-folder-buffer) 248 (set-buffer mh-show-folder-buffer)
308 mh-current-folder) 249 mh-current-folder)
309 ((eq major-mode 'mh-index-folder-mode) 250 ((eq major-mode 'mh-letter-mode)
310 (save-excursion
311 (mh-index-goto-nearest-msg)
312 (mh-index-parse-folder)))
313 ((or (eq major-mode 'mh-index-show-mode)
314 (eq major-mode 'mh-letter-mode))
315 (when (string-match mh-user-path buffer-file-name) 251 (when (string-match mh-user-path buffer-file-name)
316 (let* ((rel-path (substring buffer-file-name (match-end 0))) 252 (let* ((rel-path (substring buffer-file-name (match-end 0)))
317 (directory-end (search "/" rel-path :from-end t))) 253 (directory-end (mh-search-from-end ?/ rel-path)))
318 (when directory-end 254 (when directory-end
319 (format "+%s" (substring rel-path 0 directory-end))))))))) 255 (format "+%s" (substring rel-path 0 directory-end)))))))))
320 256
@@ -347,12 +283,14 @@ Do the right thing for the different kinds of buffers that MH-E uses."
347 (add-text-properties 283 (add-text-properties
348 (line-beginning-position) (1+ (line-beginning-position)) 284 (line-beginning-position) (1+ (line-beginning-position))
349 `(mh-folder ,folder-name 285 `(mh-folder ,folder-name
350 mh-expanded nil 286 mh-expanded nil
351 mh-children-p ,(not (not (cdr f))) 287 mh-children-p ,(not (not (cdr f)))
352 ,@(if counts `(mh-count (,(car counts) . ,(cdr counts))) ()) 288 ,@(if counts `(mh-count
353 mh-level ,level)))))) 289 (,(car counts) . ,(cdr counts))) ())
290 mh-level ,level))))))
354 folder-list))) 291 folder-list)))
355 292
293;;;###mh-autoload
356(defun mh-speed-toggle (&rest args) 294(defun mh-speed-toggle (&rest args)
357 "Toggle the display of child folders. 295 "Toggle the display of child folders.
358The otional ARGS are ignored and there for compatibilty with speedbar." 296The otional ARGS are ignored and there for compatibilty with speedbar."
@@ -393,45 +331,14 @@ The otional ARGS are ignored and there for compatibilty with speedbar."
393(defalias 'mh-speed-expand-folder 'mh-speed-toggle) 331(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
394(defalias 'mh-speed-contract-folder 'mh-speed-toggle) 332(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
395 333
396(defun mh-speed-folder-size () 334;;;###mh-autoload
397 "Find folder size if folder on current line."
398 (let ((folder (get-text-property (line-beginning-position) 'mh-folder)))
399 (or (cdr (get-text-property (line-beginning-position) 'mh-count))
400 (and (null folder) 0)
401 (with-temp-buffer
402 (call-process (expand-file-name "flist" mh-progs) nil t nil
403 "-norecurse" folder)
404 (goto-char (point-min))
405 (unless (re-search-forward "out of " (line-end-position) t)
406 (error "Call to flist failed on folder %s" folder))
407 (car (read-from-string
408 (buffer-substring-no-properties (point)
409 (line-end-position))))))))
410
411(defun mh-speed-view (&rest args) 335(defun mh-speed-view (&rest args)
412 "View folder on current line. 336 "View folder on current line.
413Optional ARGS are ignored." 337Optional ARGS are ignored."
414 (interactive) 338 (interactive)
415 (declare (ignore args)) 339 (declare (ignore args))
416 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) 340 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
417 (range 341 (range (and (stringp folder) (mh-read-msg-range folder))))
418 (cond ((save-excursion
419 (beginning-of-line)
420 (re-search-forward "([1-9][0-9]*/[0-9]+)"
421 (line-end-position) t))
422 mh-unseen-seq)
423 ((> (mh-speed-folder-size) mh-large-folder)
424 (let* ((size (mh-speed-folder-size))
425 (prompt
426 (format "How many messages from %s (default: %s): "
427 folder size))
428 (in (read-string prompt nil nil
429 (number-to-string size)))
430 (result (car (ignore-errors (read-from-string in)))))
431 (cond ((null result) (format "last:%s" size))
432 ((numberp result) (format "last:%s" result))
433 (t (format "%s" result)))))
434 (t nil))))
435 (when (stringp folder) 342 (when (stringp folder)
436 (speedbar-with-attached-buffer 343 (speedbar-with-attached-buffer
437 (mh-visit-folder folder range) 344 (mh-visit-folder folder range)
@@ -463,19 +370,22 @@ aren't usually mail folders are hidden."
463 (apply #'call-process arg-list) 370 (apply #'call-process arg-list)
464 (goto-char (point-min)) 371 (goto-char (point-min))
465 (while (not (and (eolp) (bolp))) 372 (while (not (and (eolp) (bolp)))
466 (let ((folder-end (or (search-forward "+ " (line-end-position) t) 373 (goto-char (line-end-position))
467 (search-forward " " (line-end-position) t)))) 374 (let ((has-pos (search-backward " has " (line-beginning-position) t)))
468 (when (integerp folder-end) 375 (when (integerp has-pos)
469 (let ((name (buffer-substring (line-beginning-position) 376 (while (or (equal (char-after has-pos) ? )
470 (match-beginning 0)))) 377 (equal (char-after has-pos) ?+))
378 (decf has-pos))
379 (incf has-pos)
380 (let ((name (buffer-substring (line-beginning-position) has-pos)))
471 (let ((first-char (substring name 0 1))) 381 (let ((first-char (substring name 0 1)))
472 (unless (or (string-equal first-char ".") 382 (unless (or (string-equal first-char ".")
473 (string-equal first-char "#") 383 (string-equal first-char "#")
474 (string-equal first-char ",")) 384 (string-equal first-char ","))
475 (push 385 (push
476 (cons name 386 (cons name
477 (search-forward "(others)" (line-end-position) t)) 387 (search-forward "(others)" (line-end-position) t))
478 results))))) 388 results)))))
479 (forward-line 1)))) 389 (forward-line 1))))
480 (setq results (nreverse results)) 390 (setq results (nreverse results))
481 (when (stringp folder) 391 (when (stringp folder)
@@ -487,6 +397,7 @@ aren't usually mail folders are hidden."
487 results)))) 397 results))))
488 results)) 398 results))
489 399
400;;;###mh-autoload
490(defun mh-speed-flists (force) 401(defun mh-speed-flists (force)
491 "Execute flists -recurse and update message counts. 402 "Execute flists -recurse and update message counts.
492If FORCE is non-nil the timer is reset." 403If FORCE is non-nil the timer is reset."
@@ -509,7 +420,8 @@ If FORCE is non-nil the timer is reset."
509 'exit))) 420 'exit)))
510 (setq mh-speed-flists-process 421 (setq mh-speed-flists-process
511 (start-process (expand-file-name "flists" mh-progs) nil 422 (start-process (expand-file-name "flists" mh-progs) nil
512 "flists" "-recurse")) 423 "flists" "-recurse"
424 "-sequence" (symbol-name mh-unseen-seq)))
513 (set-process-filter mh-speed-flists-process 425 (set-process-filter mh-speed-flists-process
514 'mh-speed-parse-flists-output))))))) 426 'mh-speed-parse-flists-output)))))))
515 427
@@ -527,61 +439,53 @@ next."
527 mh-speed-partial-line 439 mh-speed-partial-line
528 (substring output position line-end)) 440 (substring output position line-end))
529 mh-speed-partial-line "") 441 mh-speed-partial-line "")
530 (when (string-match "+? " line) 442 (multiple-value-setq (folder unseen total)
531 (setq folder (format "+%s" (subseq line 0 (match-beginning 0)))) 443 (mh-parse-flist-output-line line))
532 (when (string-match " has " line) 444 (when (and folder unseen total)
533 (setq unseen (car (read-from-string line (match-end 0)))) 445 (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
534 (when (string-match "; out of " line) 446 (save-excursion
535 (setq total (car (read-from-string line (match-end 0)))) 447 (when (buffer-live-p (get-buffer speedbar-buffer))
536 (setf (gethash folder mh-speed-flists-cache) 448 (set-buffer speedbar-buffer)
537 (cons unseen total)) 449 (speedbar-with-writable
538 (save-excursion 450 (when (get-text-property (point-min) 'mh-level)
539 (when (buffer-live-p (get-buffer speedbar-buffer)) 451 (let ((pos (gethash folder mh-speed-folder-map))
540 (set-buffer speedbar-buffer) 452 face)
541 (speedbar-with-writable 453 (when pos
542 (when (get-text-property (point-min) 'mh-level) 454 (goto-char pos)
543 (let ((pos (gethash folder mh-speed-folder-map)) 455 (goto-char (line-beginning-position))
544 face) 456 (cond
545 (when pos 457 ((null (get-text-property (point) 'mh-count))
546 (goto-char pos) 458 (goto-char (line-end-position))
547 (goto-char (line-beginning-position)) 459 (setq face (get-text-property (1- (point)) 'face))
548 (cond 460 (insert (format " (%s/%s)" unseen total))
549 ((null (get-text-property (point) 'mh-count)) 461 (mh-speed-highlight 'unknown face)
550 (goto-char (line-end-position)) 462 (goto-char (line-beginning-position))
551 (setq face (get-text-property (1- (point)) 463 (add-text-properties (point) (1+ (point))
552 'face)) 464 `(mh-count (,unseen . ,total))))
553 (insert (format " (%s/%s)" unseen total)) 465 ((not (equal (get-text-property (point) 'mh-count)
554 (mh-speed-highlight 'unknown face) 466 (cons unseen total)))
555 (goto-char (line-beginning-position)) 467 (goto-char (line-end-position))
556 (add-text-properties 468 (setq face (get-text-property (1- (point)) 'face))
557 (point) (1+ (point)) 469 (re-search-backward " " (line-beginning-position) t)
558 `(mh-count (,unseen . ,total)))) 470 (delete-region (point) (line-end-position))
559 ((not 471 (insert (format " (%s/%s)" unseen total))
560 (equal (get-text-property (point) 'mh-count) 472 (mh-speed-highlight 'unknown face)
561 (cons unseen total))) 473 (goto-char (line-beginning-position))
562 (goto-char (line-end-position)) 474 (add-text-properties
563 (setq face (get-text-property (1- (point)) 475 (point) (1+ (point))
564 'face)) 476 `(mh-count (,unseen . ,total))))))))))))
565 (re-search-backward
566 " " (line-beginning-position) t)
567 (delete-region (point) (line-end-position))
568 (insert (format " (%s/%s)" unseen total))
569 (mh-speed-highlight 'unknown face)
570 (goto-char (line-beginning-position))
571 (add-text-properties
572 (point) (1+ (point))
573 `(mh-count (,unseen . ,total))))))))))))))
574 (setq position (1+ line-end))) 477 (setq position (1+ line-end)))
575 (set-match-data prevailing-match-data)) 478 (set-match-data prevailing-match-data))
576 (setq mh-speed-partial-line (subseq output position)))) 479 (setq mh-speed-partial-line (substring output position))))
577 480
481;;;###mh-autoload
578(defun mh-speed-invalidate-map (folder) 482(defun mh-speed-invalidate-map (folder)
579 "Remove FOLDER from various optimization caches." 483 "Remove FOLDER from various optimization caches."
580 (interactive (list "")) 484 (interactive (list ""))
581 (save-excursion 485 (save-excursion
582 (set-buffer speedbar-buffer) 486 (set-buffer speedbar-buffer)
583 (let* ((speedbar-update-flag nil) 487 (let* ((speedbar-update-flag nil)
584 (last-slash (search "/" folder :from-end t)) 488 (last-slash (mh-search-from-end ?/ folder))
585 (parent (if last-slash (substring folder 0 last-slash) nil)) 489 (parent (if last-slash (substring folder 0 last-slash) nil))
586 (parent-position (gethash parent mh-speed-folder-map)) 490 (parent-position (gethash parent mh-speed-folder-map))
587 (parent-change nil)) 491 (parent-change nil))
@@ -615,13 +519,14 @@ next."
615 (when (equal folder "") 519 (when (equal folder "")
616 (clrhash mh-speed-folders-cache))))) 520 (clrhash mh-speed-folders-cache)))))
617 521
522;;;###mh-autoload
618(defun mh-speed-add-folder (folder) 523(defun mh-speed-add-folder (folder)
619 "Add FOLDER since it is being created. 524 "Add FOLDER since it is being created.
620The function invalidates the latest ancestor that is present." 525The function invalidates the latest ancestor that is present."
621 (save-excursion 526 (save-excursion
622 (set-buffer speedbar-buffer) 527 (set-buffer speedbar-buffer)
623 (let ((speedbar-update-flag nil) 528 (let ((speedbar-update-flag nil)
624 (last-slash (search "/" folder :from-end t)) 529 (last-slash (mh-search-from-end ?/ folder))
625 (ancestor folder) 530 (ancestor folder)
626 (ancestor-pos nil)) 531 (ancestor-pos nil))
627 (block while-loop 532 (block while-loop
@@ -630,7 +535,7 @@ The function invalidates the latest ancestor that is present."
630 (setq ancestor-pos (gethash ancestor mh-speed-folder-map)) 535 (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
631 (when ancestor-pos 536 (when ancestor-pos
632 (return-from while-loop)) 537 (return-from while-loop))
633 (setq last-slash (search "/" ancestor :from-end t)))) 538 (setq last-slash (mh-search-from-end ?/ ancestor))))
634 (unless ancestor-pos (setq ancestor nil)) 539 (unless ancestor-pos (setq ancestor nil))
635 (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map))) 540 (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
636 (speedbar-with-writable 541 (speedbar-with-writable
@@ -650,17 +555,18 @@ The function invalidates the latest ancestor that is present."
650 (save-excursion 555 (save-excursion
651 (beginning-of-line) 556 (beginning-of-line)
652 (if (re-search-forward "\\[.\\]" (line-end-position) t) 557 (if (re-search-forward "\\[.\\]" (line-end-position) t)
653 (speedbar-with-writable 558 (speedbar-with-writable
654 (backward-char 2) 559 (backward-char 2)
655 (delete-char 1) 560 (delete-char 1)
656 (insert-char char 1 t) 561 (insert-char char 1 t)
657 (put-text-property (point) (1- (point)) 'invisible nil) 562 (put-text-property (point) (1- (point)) 'invisible nil)
658 ;; make sure we fix the image on the text here. 563 ;; make sure we fix the image on the text here.
659 (speedbar-insert-image-button-maybe (- (point) 2) 3))))) 564 (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
660 565
661(provide 'mh-speed) 566(provide 'mh-speed)
662 567
663;;; Local Variables: 568;;; Local Variables:
569;;; indent-tabs-mode: nil
664;;; sentence-end-double-space: nil 570;;; sentence-end-double-space: nil
665;;; End: 571;;; End:
666 572
diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el
index 562e7752ff1..320cdf7cbfd 100644
--- a/lisp/mail/mh-utils.el
+++ b/lisp/mail/mh-utils.el
@@ -30,12 +30,24 @@
30 30
31;;; Change Log: 31;;; Change Log:
32 32
33;; $Id: mh-utils.el,v 1.177 2002/11/22 20:00:47 satyaki Exp $ 33;; $Id: mh-utils.el,v 1.193 2003/01/08 00:27:31 satyaki Exp $
34 34
35;;; Code: 35;;; Code:
36 36
37;; Is this XEmacs-land? Located here since needed by mh-customize.el.
38(defvar mh-xemacs-flag (featurep 'xemacs)
39 "Non-nil means the current Emacs is XEmacs.")
40
37(require 'cl) 41(require 'cl)
38(require 'gnus-util) 42(require 'gnus-util)
43(require 'font-lock)
44(require 'mh-loaddefs)
45(require 'mh-customize)
46
47(load "mm-decode" t t) ; Non-fatal dependency
48(load "mm-view" t t) ; Non-fatal dependency
49(load "executable" t t) ; Non-fatal dependency on
50 ; executable-find
39 51
40;; Shush the byte-compiler 52;; Shush the byte-compiler
41(defvar font-lock-auto-fontify) 53(defvar font-lock-auto-fontify)
@@ -43,188 +55,13 @@
43(defvar mark-active) 55(defvar mark-active)
44(defvar tool-bar-mode) 56(defvar tool-bar-mode)
45 57
46(load "mm-decode" t t) ; Non-fatal dependency 58;;; Autoloads
47(load "mm-view" t t) ; Non-fatal dependency
48
49(load "executable" t t) ; Non-fatal dependency on
50 ; executable-find
51
52;;; Autoload mh-seq
53(autoload 'mh-add-to-sequence "mh-seq")
54(autoload 'mh-notate-seq "mh-seq")
55(autoload 'mh-read-seq-default "mh-seq")
56(autoload 'mh-map-to-seq-msgs "mh-seq")
57
58;;; Autoload mh-e
59(autoload 'mh-goto-cur-msg "mh-e")
60(autoload 'mh-update-sequences "mh-e")
61
62;;; Autoload mh-mime
63(autoload 'mh-add-missing-mime-version-header "mh-mime")
64(autoload 'mh-mime-cleanup "mh-mime")
65(autoload 'mh-buffer-data "mh-mime" nil nil t)
66(autoload 'mh-make-buffer-data "mh-mime" nil nil)
67(autoload 'mh-mime-display "mh-mime")
68(autoload 'mh-display-smileys "mh-mime")
69(autoload 'mh-display-emphasis "mh-mime")
70
71;;; Autoload mh-index
72(autoload 'mh-index-search "mh-index"
73 "Perform an indexed search in an MH mail folder.
74
75FOLDER is searched with SEARCH-REGEXP and the results are presented in an MH-E
76folder. If FOLDER is \"+\" then mail in all folders are searched. Optional
77prefix argument NEW-BUFFER-FLAG decides whether the results are presented in a
78new buffer. This allows multiple search results to coexist.
79
80Four indexing programs are supported; if none of these are present, then grep
81is used. This function picks the first program that is available on your
82system. If you would prefer to use a different program, set the customization
83variable `mh-index-program' accordingly.
84
85The documentation for the following functions describes how to generate the
86index for each program:
87
88 - `mh-swish++-execute-search'
89 - `mh-swish-execute-search'
90 - `mh-namazu-execute-search'
91 - `mh-glimpse-execute-search'"
92 t)
93;;; These are here since their docstrings are needed before loading mh-index.
94(autoload 'mh-swish++-execute-search "mh-index"
95 "Execute swish++ and read the results.
96
97In the examples below, replace /home/user/Mail with the path to your MH
98directory.
99
100First create the directory /home/user/Mail/.swish++. Then create the file
101/home/user/Mail/.swish++/swish++.conf with the following contents:
102
103 IncludeMeta Bcc Cc Comments Content-Description From Keywords
104 IncludeMeta Newsgroups Resent-To Subject To
105 IncludeFile Mail [0-9]*
106 IndexFile /home/user/Mail/.swish++/swish++.index
107
108Use the following command line to generate the swish index. Run this
109daily from cron:
110
111 index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
112
113On some systems (Debian GNU/Linux, for example), use index++ instead of index.
114
115FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
116 t)
117(autoload 'mh-swish-execute-search "mh-index"
118 "Execute swish-e and read the results.
119
120In the examples below, replace /home/user/Mail with the path to your MH
121directory.
122
123First create the directory /home/user/Mail/.swish. Then create the file
124/home/user/Mail/.swish/config with the following contents:
125
126 IndexDir /home/user/Mail
127 IndexFile /home/user/Mail/.swish/index
128 IndexName \"Mail Index\"
129 IndexDescription \"Mail Index\"
130 IndexPointer \"http://nowhere\"
131 IndexAdmin \"nobody\"
132 #MetaNames automatic
133 IndexReport 3
134 FollowSymLinks no
135 UseStemming no
136 IgnoreTotalWordCountWhenRanking yes
137 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
138 BeginCharacters abcdefghijklmnopqrstuvwxyz
139 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
140 IgnoreLimit 50 1000
141 IndexComments 0
142 FileRules pathname contains /home/user/Mail/.swish
143 FileRules filename is index
144 FileRules filename is \..*
145 FileRules filename is #.*
146 FileRules filename is ,.*
147 FileRules filename is .*~
148
149If there are any directories you would like to ignore, append lines like the
150following to config:
151
152 FileRules pathname contains /home/user/Mail/scripts
153
154Use the following command line to generate the swish index. Run this
155daily from cron:
156
157 swish-e -c /home/user/Mail/.swish/config
158
159FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
160 t)
161(autoload 'mh-namazu-execute-search "mh-index"
162 "Execute namazu and read the results.
163
164In the examples below, replace /home/user/Mail with the path to your MH
165directory.
166
167First create the directory /home/user/Mail/.namazu. Then create the file
168/home/user/Mail/.namazu/mknmzrc with the following contents:
169
170 package conf; # Don't remove this line!
171 $ADDRESS = 'user@localhost';
172 $ALLOW_FILE = \"[0-9]*\";
173
174Use the following command line to generate the namazu index. Run this
175daily from cron:
176
177 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
178 /home/user/Mail
179
180FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
181 t)
182(autoload 'mh-glimpse-execute-search "mh-index"
183 "Execute glimpse and read the results.
184
185In the examples below, replace /home/user/Mail with the path to your MH
186directory.
187
188First create the directory /home/user/Mail/.glimpse. Then create the file
189/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
190
191 */.*
192 */#*
193 */,*
194 */*~
195 ^/home/user/Mail/.glimpse
196
197If there are any directories you would like to ignore, append lines like the
198following to .glimpse_exclude:
199
200 ^/home/user/Mail/scripts
201
202Use the following command line to generate the glimpse index. Run this
203daily from cron:
204
205 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
206
207FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
208 t)
209
210;;; Autoload mh-speed
211(autoload 'mh-speed-add-folder "mh-speed")
212
213;;; Autoload mh-comp
214(autoload 'mh-reply "mh-comp" nil t)
215
216;;; Other Autoloads
217(autoload 'gnus-article-highlight-citation "gnus-cite") 59(autoload 'gnus-article-highlight-citation "gnus-cite")
218(autoload 'mail-header-end "sendmail") 60(autoload 'mail-header-end "sendmail")
219(autoload 'Info-goto-node "info") 61(autoload 'Info-goto-node "info")
220(autoload 'font-lock-default-fontify-region "font-lock")
221(unless (fboundp 'make-hash-table) 62(unless (fboundp 'make-hash-table)
222 (autoload 'make-hash-table "cl")) 63 (autoload 'make-hash-table "cl"))
223 64
224;; Is this XEmacs-land?
225(defvar mh-xemacs-flag (featurep 'xemacs)
226 "Non-nil means the current Emacs is XEmacs.")
227
228;;; Set for local environment: 65;;; Set for local environment:
229;;; mh-progs and mh-lib used to be set in paths.el, which tried to 66;;; mh-progs and mh-lib used to be set in paths.el, which tried to
230;;; figure out at build time which of several possible directories MH 67;;; figure out at build time which of several possible directories MH
@@ -254,217 +91,32 @@ This directory contains, among other things, the mhl program.")
254;;;###autoload 91;;;###autoload
255(put 'mh-nmh-flag 'risky-local-variable t) 92(put 'mh-nmh-flag 'risky-local-variable t)
256 93
94;;; CL Replacements
95(defun mh-search-from-end (char string)
96 "Return the position of last occurrence of CHAR in STRING.
97If CHAR is not present in STRING then return nil. The function is used in lieu
98of `search' in the CL package."
99 (loop for index from (1- (length string)) downto 0
100 when (equal (aref string index) char) return index
101 finally return nil))
102
257;;; Macro to generate correct code for different emacs variants 103;;; Macro to generate correct code for different emacs variants
258 104
259(defmacro mh-mark-active-p (check-transient-mark-mode-flag) 105(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
260 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. 106 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
261In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if 107In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
262variable `transient-mark-mode' is active." 108variable `transient-mark-mode' is active."
263 (cond (mh-xemacs-flag ;XEmacs 109 (cond (mh-xemacs-flag ;XEmacs
264 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) 110 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
265 ((not check-transient-mark-mode-flag) ;GNU Emacs 111 ((not check-transient-mark-mode-flag) ;GNU Emacs
266 `(and (boundp 'mark-active) mark-active)) 112 `(and (boundp 'mark-active) mark-active))
267 (t ;GNU Emacs 113 (t ;GNU Emacs
268 `(and (boundp 'transient-mark-mode) transient-mark-mode 114 `(and (boundp 'transient-mark-mode) transient-mark-mode
269 (boundp 'mark-active) mark-active)))) 115 (boundp 'mark-active) mark-active))))
270 116
271;;; User preferences:
272
273(defgroup mh-buffer nil
274 "Layout of MH-E buffers"
275 :prefix "mh-"
276 :group 'mh)
277
278(defcustom mh-tool-bar-reply-3-buttons-flag nil
279 "*Non-nil means use three buttons for reply commands in tool-bar.
280If you have room on your tool-bar because you are using a large font, you
281may set this variable to expand the single reply button into three buttons
282that won't lead to minibuffer prompt about who to reply to."
283 :type 'boolean
284 :group 'mh)
285
286(defcustom mh-tool-bar-search-function 'mh-search-folder
287 "*Function called by the tool-bar search button.
288See `mh-search-folder' and `mh-index-search' for details."
289 :type '(choice (const mh-search-folder)
290 (const mh-index-search)
291 (function :tag "Other function"))
292 :group 'mh)
293
294(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
295 "*Non-nil means that Gnus is used to show MIME attachments with Gnus."
296 :type 'boolean
297 :group 'mh-buffer)
298
299(defcustom mh-auto-folder-collect-flag t
300 "*Non-nil means immediate collect folder names in the background.
301If t, MH-E should start a background process to collect the names of all
302folders as soon as MH-E is first used."
303 :type 'boolean
304 :group 'mh)
305
306(defcustom mh-recursive-folders-flag nil
307 "*Non-nil means that commands which operate on folders do so recursively."
308 :type 'boolean
309 :group 'mh)
310
311(defcustom mh-adaptive-cmd-note-flag t
312 "*Non-nil means that the message number width is determined dynamically.
313This is done once when a folder is first opened by running scan on the last
314message of the folder. The message number for the last message is extracted
315and its width calculated. This width is used when calling `mh-set-cmd-note'.
316
317If you prefer fixed-width message numbers, set this variable to nil and call
318`mh-set-cmd-note' with the width specified by the scan format in
319`mh-scan-format-file'. For example, the default width is 4, so you would use
320\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
321 :type 'boolean
322 :group 'mh)
323
324(defcustom mh-clean-message-header-flag t
325 "*Non-nil means clean headers of messages that are displayed or inserted.
326The variables `mh-visible-headers' and `mh-invisible-headers' control what
327is removed."
328 :type 'boolean
329 :group 'mh-buffer)
330
331(defcustom mh-visible-headers nil
332 "*Contains a regexp specifying the headers to keep when cleaning.
333Only used if `mh-clean-message-header-flag' is non-nil. Setting this variable
334overrides `mh-invisible-headers'."
335 :type '(choice (const nil) regexp)
336 :group 'mh-buffer)
337
338(defcustom mh-show-use-xface-flag (and window-system
339 (not (null (cond
340 (mh-xemacs-flag
341 (locate-library "x-face"))
342 ((>= emacs-major-version 21)
343 (locate-library "x-face-e21"))
344 (t ;Emacs20
345 nil))))
346 (not (null (and (fboundp 'executable-find)
347 (executable-find
348 "uncompface")))))
349 "*Non-nil means display faces in `mh-show-mode' with external x-face package.
350It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its
351files in the Emacs `load-path' and MH-E will invoke it automatically for you if
352this variable is non-nil.
353
354The `uncompface' binary is also required to be in the execute PATH. It can
355be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z"
356 :type 'boolean
357 :group 'mh-buffer)
358
359(defcustom mh-show-maximum-size 0
360 "*Maximum size of message (in bytes) to display automatically.
361Provides an opportunity to skip over large messages which may be slow to load.
362Use a value of 0 to display all messages automatically regardless of size."
363 :type 'integer
364 :group 'mh-buffer)
365
366(defvar mh-invisible-headers
367 (concat
368 "^"
369 (let ((max-specpdl-size 1000)) ;workaround for insufficient default
370 (regexp-opt
371 (append
372 (if (not mh-show-use-xface-flag)
373 '("X-Face: "))
374 '( ;; RFC 822
375 "Received: " "Message-Id: " "Return-Path: "
376 ;; RFC 2045
377 "Mime-Version" "Content-"
378 ;; sendmail
379 "X-Authentication-Warning: " "X-MIME-Autoconverted: " "From "
380 "Status: "
381 ;; X400
382 "X400-" "P1-Message-Id: " "Original-Encoded-Information-Types: "
383 "P1-Recipient: " "P1-Content-Type: " "Ua-Content-Id: "
384 ;; MH
385 "Resent" "Prev-Resent" "Forwarded: " "Replied: " "Delivery-Date: "
386 "In-Reply-To: " "Remailed-" "Via: " "Mail-from: "
387 ;; gnus
388 "X-Gnus-Mail-Source: "
389 ;; MS Outlook
390 "X-Priority: " "X-Msmail-" "X-MimeOLE: " "X-Apparently-From: "
391 "Importance: " "Sensitivity: " "X-MS-TNEF-Correlator: "
392 ;; Juno
393 "X-Juno-"
394 ;; Hotmail
395 "X-OriginalArrivalTime: " "X-Originating-IP: "
396 ;; Netscape/Mozilla
397 "X-Accept-Language: " "X-Mozilla-Status: "
398 ;; NTMail
399 "X-Info: " "X-VSMLoop: "
400 ;; News
401 "NNTP-" "X-News: "
402 ;; Mailman mailing list manager
403 "List-" "X-Beenthere: " "X-Mailman-Version: "
404 ;; Egroups/yahoogroups mailing list manager
405 "X-eGroups-" "X-Apparently-To: " "Mailing-List: " "Delivered-To: "
406 ;; SourceForge mailing list manager
407 "X-Original-Date: "
408 ;; Unknown mailing list managers
409 "X-Mailing-List: " "X-Loop: "
410 "List-Subscribe: " "List-Unsubscribe: "
411 "X-List-Subscribe: " "X-List-Unsubscribe: "
412 "X-Listserver: " "List-" "X-List-Host: "
413 ;; Sieve filtering
414 "X-Sieve: "
415 ;; Spam
416 "X-Spam-Status: " "X-Spam-Level: " "X-Spam-Score: "
417 "X-SpamBouncer: " "X-SBClass: " "X-SBRule: " "X-SBNote: "
418 "X-SBPass: " "X-Folder: "
419 "X-Habeas-SWE-1: " "X-Habeas-SWE-2: " "X-Habeas-SWE-3: "
420 "X-Habeas-SWE-4: " "X-Habeas-SWE-5: " "X-Habeas-SWE-6: "
421 "X-Habeas-SWE-7: " "X-Habeas-SWE-8: " "X-Habeas-SWE-9: "
422 ;; Worldtalk gateways
423 "X-Wss-Id: "
424 ;; User added
425 "X-Qotd-"
426 ;; Miscellaneous
427 "X-Sender: " "X-Ack: " "Errors-To: " "Precedence: " "X-Message-Id"
428 "X-From-Line" "X-Cron-Env: " "Delivery: " "X-Delivered"
429 "X-Received: " "X-Vms-To: " "Xref: " "X-Request-" "X-UIDL: "
430 "X-Orcl-Content-Type: " "X-Server-Uuid: " "X-Envelope-Sender: "
431 "X-Envelope-To: " "Encoding: " "Old-Return-Path: " "Path: "
432 "References: " "Lines: " "Autoforwarded: " "Bestservhost: "
433 "X-pgp: " "X-Accept-Language: " "Priority: " "User-Agent: "
434 "X-MIMETrack: " "X-Abuse-Info: " "X-Complaints-To: "
435 "X-No-Archive: " "X-Original-Complaints-To: "
436 "X-Original-Trace: " "X-Received-Date: " "X-Server-Date: "
437 "X-Trace: " "X-UserInfo1: " "X-submission-address: "
438 "X-Scanned-By"))
439 t)))
440 "*Regexp matching lines in a message header that are not to be shown.
441If `mh-visible-headers' is non-nil, it is used instead to specify what
442to keep.")
443
444;;; Additional header fields that might someday be added: 117;;; Additional header fields that might someday be added:
445;;; "Sender: " "Reply-to: " 118;;; "Sender: " "Reply-to: "
446 119
447(defcustom mh-bury-show-buffer-flag t
448 "*Non-nil means that the displayed show buffer for a folder is buried."
449 :type 'boolean
450 :group 'mh-buffer)
451
452(defcustom mh-summary-height (or (and (fboundp 'frame-height)
453 (> (frame-height) 24)
454 (min 10 (/ (frame-height) 6)))
455 4)
456 "*Number of lines in MH-Folder window (including the mode line)."
457 :type 'integer
458 :group 'mh-buffer)
459
460;; Use goto-addr if it was already loaded (which probably sets this
461;; variable to t), or if this variable is otherwise set to t.
462(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
463 goto-address-highlight-p)
464 "*Non-nil means URLs and e-mail addresses are highlighted using goto-addr while in `mh-show-mode'."
465 :type 'boolean
466 :group 'mh-buffer)
467
468(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" 120(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
469 "Regexp to find the number of a message in a scan line. 121 "Regexp to find the number of a message in a scan line.
470The message's number must be surrounded with \\( \\)") 122The message's number must be surrounded with \\( \\)")
@@ -485,58 +137,6 @@ Use `0%d' for zero-filled message numbers.")
485 "Format string containing a regexp matching the scan listing for a message. 137 "Format string containing a regexp matching the scan listing for a message.
486The desired message's number will be an argument to format.") 138The desired message's number will be an argument to format.")
487 139
488(defcustom mhl-formfile nil
489 "*Name of format file to be used by mhl to show and print messages.
490A value of t means use the default format file.
491nil means don't use mhl to format messages when showing; mhl is still used,
492with the default format file, to format messages when printing them.
493The format used should specify a non-zero value for overflowoffset so
494the message continues to conform to RFC 822 and MH-E can parse the headers."
495 :type '(choice (const nil) (const t) string)
496 :group 'mh)
497(put 'mhl-formfile 'info-file "mh-e")
498
499(defvar mh-decode-quoted-printable-have-mimedecode
500 (not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
501 "Whether the mimedecode command is installed on the system.
502This sets the default value of variable `mh-decode-quoted-printable-flag' to
503determine whether quoted-printable MIME parts are decoded by the mimedecode
504command when viewed in `mh-show'. The source code for mimedecode can be
505obtained from http://www.freesoft.org/CIE/FAQ/mimedeco.c")
506
507(defcustom mh-decode-quoted-printable-flag
508 mh-decode-quoted-printable-have-mimedecode
509 "Non-nil means decode quoted-printable MIME part using mimedecode.
510
511Determine whether to decode quoted-printable MIME parts in `mh-show'
512using mimedecode.
513
514Quoted printable content is translated to 8-bit characters in `mh-show' by
515the gnus' mm-decode library if it is available. Otherwise (and for certain
516cases mm-decode can't handle) this can be done using the 'mimedecode'
517command. Setting this variable indicates to use 'mimedecode' when
518mm-decode is not available or as a helper to it. The source code for
519mimedecode can usually be obtained from
520http://www.freesoft.org/CIE/FAQ/mimedeco.c"
521 :type 'boolean
522 :group 'mh-buffer)
523
524(defcustom mh-update-sequences-after-mh-show-flag t
525 "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'.
526If set, `mh-update-sequence' is run every time a message is shown, telling
527MH or nmh that this is your current message. It's useful, for example, to
528display MIME content using \"M-! mhshow RET\""
529 :type 'boolean
530 :group 'mh-buffer)
531
532(defcustom mh-highlight-citation-p 'gnus
533 "How to highlight citations in show buffers.
534The gnus method uses a different color for each indentation."
535 :type '(choice (const :tag "Use gnus" gnus)
536 (const :tag "Use font-lock" font-lock)
537 (const :tag "Don't fontify" nil))
538 :group 'mh-buffer)
539
540(defvar mh-default-folder-for-message-function nil 140(defvar mh-default-folder-for-message-function nil
541 "Function to select a default folder for refiling or Fcc. 141 "Function to select a default folder for refiling or Fcc.
542If set to a function, that function is called with no arguments by 142If set to a function, that function is called with no arguments by
@@ -575,24 +175,23 @@ Do not make this a regexp as it may be the argument to `insert' and it is
575passed through `regexp-quote' before being used by functions like 175passed through `regexp-quote' before being used by functions like
576`re-search-forward'.") 176`re-search-forward'.")
577 177
578;;; Hooks 178;; Variables for MIME display
579
580(defcustom mh-find-path-hook nil
581 "Invoked by `mh-find-path' after reading the user's MH profile."
582 :type 'hook
583 :group 'mh-hook)
584
585(defcustom mh-show-hook nil
586 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
587 :type 'hook
588 :group 'mh-hook)
589 179
590(defcustom mh-show-mode-hook nil 180;; Structure to keep track of MIME handles on a per buffer basis.
591 "Invoked upon entry to `mh-show-mode'." 181(defstruct (mh-buffer-data (:conc-name mh-mime-)
592 :type 'hook 182 (:constructor mh-make-buffer-data))
593 :group 'mh-hook) 183 (handles ()) ; List of MIME handles
184 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
185 ; nested messages
186 (parts-count 0) ; The button number is generated from
187 ; this number
188 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number
189 ; for nested messages
190;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
191(defmacro mh-buffer-data ()
192 "Convenience macro to get the MIME data structures of the current buffer."
193 `(gethash (current-buffer) mh-globals-hash))
594 194
595;; Variables for MIME display
596(defvar mh-globals-hash (make-hash-table) 195(defvar mh-globals-hash (make-hash-table)
597 "Keeps track of MIME data on a per buffer basis.") 196 "Keeps track of MIME data on a per buffer basis.")
598 197
@@ -661,8 +260,8 @@ passed through `regexp-quote' before being used by functions like
661 (locate-library "vcard")))) 260 (locate-library "vcard"))))
662 ("message/delivery-status" mm-inline-text identity) 261 ("message/delivery-status" mm-inline-text identity)
663 ("message/rfc822" mh-mm-inline-message identity) 262 ("message/rfc822" mh-mm-inline-message identity)
664 ;("message/partial" mm-inline-partial identity) 263 ;;("message/partial" mm-inline-partial identity)
665 ;("message/external-body" mm-inline-external-body identity) 264 ;;("message/external-body" mm-inline-external-body identity)
666 ("text/.*" mm-inline-text identity) 265 ("text/.*" mm-inline-text identity)
667 ("audio/wav" mm-inline-audio 266 ("audio/wav" mm-inline-audio
668 (lambda (handle) 267 (lambda (handle)
@@ -701,17 +300,42 @@ This buffer-local variable is used to remember if a MIME insertion was done.
701Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.") 300Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.")
702(make-variable-buffer-local 'mh-mml-compose-insert-flag) 301(make-variable-buffer-local 'mh-mml-compose-insert-flag)
703 302
303;; Copy of `goto-address-mail-regexp'
304(defvar mh-address-mail-regexp
305 "[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+"
306 "A regular expression probably matching an e-mail address.")
307
308;; From goto-addr.el, which we don't want to force-load on users.
309;;;###mh-autoload
310(defun mh-goto-address-find-address-at-point ()
311 "Find e-mail address around or before point.
312Then search backwards to beginning of line for the start of an e-mail
313address. If no e-mail address found, return nil."
314 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
315 (if (or (looking-at mh-address-mail-regexp) ; already at start
316 (and (re-search-forward mh-address-mail-regexp
317 (line-end-position) 'lim)
318 (goto-char (match-beginning 0))))
319 (match-string-no-properties 0)))
320
704(defun mh-in-header-p () 321(defun mh-in-header-p ()
705 "Return non-nil if the point is in the header of a draft message." 322 "Return non-nil if the point is in the header of a draft message."
706 (< (point) (mail-header-end))) 323 (< (point) (mail-header-end)))
707 324
325(defun mh-header-field-beginning ()
326 "Move to the beginning of the current header field.
327Handles RFC 822 continuation lines."
328 (beginning-of-line)
329 (while (looking-at "^[ \t]")
330 (forward-line -1)))
331
708(defun mh-header-field-end () 332(defun mh-header-field-end ()
709 "Move to the end of the current header field. 333 "Move to the end of the current header field.
710Handles RFC 822 continuation lines." 334Handles RFC 822 continuation lines."
711 (forward-line 1) 335 (forward-line 1)
712 (while (looking-at "^[ \t]") 336 (while (looking-at "^[ \t]")
713 (forward-line 1)) 337 (forward-line 1))
714 (backward-char 1)) ;to end of previous line 338 (backward-char 1)) ;to end of previous line
715 339
716(defun mh-letter-header-font-lock (limit) 340(defun mh-letter-header-font-lock (limit)
717 "Return the entire mail header to font-lock. 341 "Return the entire mail header to font-lock.
@@ -733,12 +357,12 @@ Argument LIMIT limits search."
733 (let* ((mail-header-end (mail-header-end)) 357 (let* ((mail-header-end (mail-header-end))
734 (lesser-limit (if (< mail-header-end limit) mail-header-end limit)) 358 (lesser-limit (if (< mail-header-end limit) mail-header-end limit))
735 (case-fold-search t)) 359 (case-fold-search t))
736 (when (and (< (point) mail-header-end) ;Only within header 360 (when (and (< (point) mail-header-end) ;Only within header
737 (re-search-forward (format "^%s" field) lesser-limit t)) 361 (re-search-forward (format "^%s" field) lesser-limit t))
738 (let ((match-one-b (match-beginning 0)) 362 (let ((match-one-b (match-beginning 0))
739 (match-one-e (match-end 0))) 363 (match-one-e (match-end 0)))
740 (mh-header-field-end) 364 (mh-header-field-end)
741 (if (> (point) limit) ;Don't search for end beyond limit 365 (if (> (point) limit) ;Don't search for end beyond limit
742 (goto-char limit)) 366 (goto-char limit))
743 (set-match-data (list match-one-b match-one-e 367 (set-match-data (list match-one-b match-one-e
744 (1+ match-one-e) (point))) 368 (1+ match-one-e) (point)))
@@ -759,88 +383,6 @@ Argument LIMIT limits search."
759Argument LIMIT limits search." 383Argument LIMIT limits search."
760 (mh-header-field-font-lock "Subject:" limit)) 384 (mh-header-field-font-lock "Subject:" limit))
761 385
762(defvar mh-show-to-face 'mh-show-to-face
763 "Face for highlighting the To: header field.")
764(if (boundp 'facemenu-unlisted-faces)
765 (add-to-list 'facemenu-unlisted-faces "^mh-show"))
766(defface mh-show-to-face
767 '((((class grayscale) (background light))
768 (:foreground "DimGray" :underline t))
769 (((class grayscale) (background dark))
770 (:foreground "LightGray" :underline t))
771 (((class color) (background light)) (:foreground "SaddleBrown"))
772 (((class color) (background dark)) (:foreground "burlywood"))
773 (t (:underline t)))
774 "Face for highlighting the To: header field."
775 :group 'mh-buffer)
776
777(defvar mh-show-from-face 'mh-show-from-face
778 "Face for highlighting the From: header field.")
779(defface mh-show-from-face
780 '((((class color) (background light))
781 (:foreground "red3"))
782 (((class color) (background dark))
783 (:foreground "cyan"))
784 (t
785 (:bold t)))
786 "Face for highlighting the From: header field."
787 :group 'mh-buffer)
788
789(defvar mh-folder-subject-face 'mh-folder-subject-face
790 "Face for highlighting subject text in MH-Folder buffers.")
791(if (boundp 'facemenu-unlisted-faces)
792 (add-to-list 'facemenu-unlisted-faces "^mh-folder"))
793(defface mh-folder-subject-face
794 '((((class color) (background light))
795 (:foreground "blue4"))
796 (((class color) (background dark))
797 (:foreground "yellow"))
798 (t
799 (:bold t)))
800 "Face for highlighting subject text in MH-Folder buffers."
801 :group 'mh)
802(defvar mh-show-subject-face 'mh-show-subject-face
803 "Face for highlighting the Subject header field.")
804(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
805
806(defvar mh-show-cc-face 'mh-show-cc-face
807 "Face for highlighting cc header fields.")
808(defface mh-show-cc-face
809 '((((type tty) (class color)) (:foreground "yellow" :weight light))
810 (((class grayscale) (background light))
811 (:foreground "Gray90" :bold t :italic t))
812 (((class grayscale) (background dark))
813 (:foreground "DimGray" :bold t :italic t))
814 (((class color) (background light)) (:foreground "DarkGoldenrod"))
815 (((class color) (background dark)) (:foreground "LightGoldenrod"))
816 (t (:bold t :italic t)))
817 "Face for highlighting cc header fields."
818 :group 'mh-buffer)
819
820(defvar mh-show-date-face 'mh-show-date-face
821 "Face for highlighting the Date header field.")
822(defface mh-show-date-face
823 '((((type tty) (class color)) (:foreground "green"))
824 (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
825 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
826 (((class color) (background light)) (:foreground "ForestGreen"))
827 (((class color) (background dark)) (:foreground "PaleGreen"))
828 (t (:bold t :underline t)))
829 "Face for highlighting the Date header field."
830 :group 'mh-buffer)
831
832(defvar mh-show-header-face 'mh-show-header-face
833 "Face used to deemphasize unspecified header fields.")
834(defface mh-show-header-face
835 '((((type tty) (class color)) (:foreground "green"))
836 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
837 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
838 (((class color) (background light)) (:foreground "RosyBrown"))
839 (((class color) (background dark)) (:foreground "LightSalmon"))
840 (t (:italic t)))
841 "Face used to deemphasize unspecified header fields."
842 :group 'mh-buffer)
843
844(eval-and-compile 386(eval-and-compile
845 ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' 387 ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite'
846 (defvar mh-show-font-lock-keywords 388 (defvar mh-show-font-lock-keywords
@@ -848,12 +390,12 @@ Argument LIMIT limits search."
848 (mh-header-to-font-lock (0 'default) (1 mh-show-to-face)) 390 (mh-header-to-font-lock (0 'default) (1 mh-show-to-face))
849 (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face)) 391 (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face))
850 ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" 392 ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
851 (1 'default) (2 mh-show-from-face)) 393 (1 'default) (2 mh-show-from-face))
852 (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face)) 394 (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face))
853 ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" 395 ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
854 (1 'default) (2 mh-show-cc-face)) 396 (1 'default) (2 mh-show-cc-face))
855 ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" 397 ("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
856 (1 'default) (2 mh-show-date-face)) 398 (1 'default) (2 mh-show-date-face))
857 (mh-letter-header-font-lock (0 mh-show-header-face append t))) 399 (mh-letter-header-font-lock (0 mh-show-header-face append t)))
858 "Additional expressions to highlight in MH-show mode.")) 400 "Additional expressions to highlight in MH-show mode."))
859 401
@@ -895,9 +437,9 @@ message about the fontification operation."
895(if mh-xemacs-flag 437(if mh-xemacs-flag
896 (progn 438 (progn
897 (eval-and-compile 439 (eval-and-compile
898 (require 'gnus) 440 (require 'gnus)
899 (require 'gnus-art) 441 (require 'gnus-art)
900 (require 'gnus-cite)))) 442 (require 'gnus-cite))))
901 443
902(defun mh-gnus-article-highlight-citation () 444(defun mh-gnus-article-highlight-citation ()
903 "Highlight cited text in current buffer using gnus." 445 "Highlight cited text in current buffer using gnus."
@@ -914,9 +456,9 @@ message about the fontification operation."
914 ;; style? 456 ;; style?
915 (flet ((gnus-article-add-button (&rest args) nil)) 457 (flet ((gnus-article-add-button (&rest args) nil))
916 (let* ((modified (buffer-modified-p)) 458 (let* ((modified (buffer-modified-p))
917 (gnus-article-buffer (buffer-name)) 459 (gnus-article-buffer (buffer-name))
918 (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) 460 (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
919 ,(car gnus-cite-face-list)))) 461 ,(car gnus-cite-face-list))))
920 (gnus-article-highlight-citation t) 462 (gnus-article-highlight-citation t)
921 (set-buffer-modified-p modified)))) 463 (set-buffer-modified-p modified))))
922 464
@@ -993,9 +535,9 @@ message about the fontification operation."
993 "Change whether messages should be displayed. 535 "Change whether messages should be displayed.
994With arg, display messages iff ARG is positive." 536With arg, display messages iff ARG is positive."
995 (setq mh-showing-mode 537 (setq mh-showing-mode
996 (if (null arg) 538 (if (null arg)
997 (not mh-showing-mode) 539 (not mh-showing-mode)
998 (> (prefix-numeric-value arg) 0)))) 540 (> (prefix-numeric-value arg) 0))))
999 541
1000;; The sequences of this folder. An alist of (seq . msgs). 542;; The sequences of this folder. An alist of (seq . msgs).
1001(defvar mh-seq-list nil) 543(defvar mh-seq-list nil)
@@ -1020,14 +562,14 @@ flag is unchanged, otherwise it is cleared."
1020 (setq save-modification-flag (car save-modification-flag)) ; CL style 562 (setq save-modification-flag (car save-modification-flag)) ; CL style
1021 `(prog1 563 `(prog1
1022 (let ((mh-folder-updating-mod-flag (buffer-modified-p)) 564 (let ((mh-folder-updating-mod-flag (buffer-modified-p))
1023 (buffer-read-only nil) 565 (buffer-read-only nil)
1024 (buffer-file-name nil)) ;don't let the buffer get locked 566 (buffer-file-name nil)) ;don't let the buffer get locked
1025 (prog1 567 (prog1
1026 (progn 568 (progn
1027 ,@body) 569 ,@body)
1028 (mh-set-folder-modified-p mh-folder-updating-mod-flag))) 570 (mh-set-folder-modified-p mh-folder-updating-mod-flag)))
1029 ,@(if (not save-modification-flag) 571 ,@(if (not save-modification-flag)
1030 '((mh-set-folder-modified-p nil))))) 572 '((mh-set-folder-modified-p nil)))))
1031 573
1032(put 'with-mh-folder-updating 'lisp-indent-hook 1) 574(put 'with-mh-folder-updating 'lisp-indent-hook 1)
1033 575
@@ -1035,12 +577,12 @@ flag is unchanged, otherwise it is cleared."
1035 "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). 577 "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
1036Display buffer SHOW-BUFFER in other window and execute BODY in it. 578Display buffer SHOW-BUFFER in other window and execute BODY in it.
1037Stronger than `save-excursion', weaker than `save-window-excursion'." 579Stronger than `save-excursion', weaker than `save-window-excursion'."
1038 (setq show-buffer (car show-buffer)) ; CL style 580 (setq show-buffer (car show-buffer)) ; CL style
1039 `(let ((mh-in-show-buffer-saved-window (selected-window))) 581 `(let ((mh-in-show-buffer-saved-window (selected-window)))
1040 (switch-to-buffer-other-window ,show-buffer) 582 (switch-to-buffer-other-window ,show-buffer)
1041 (if mh-bury-show-buffer-flag (bury-buffer (current-buffer))) 583 (if mh-bury-show-buffer-flag (bury-buffer (current-buffer)))
1042 (unwind-protect 584 (unwind-protect
1043 (progn 585 (progn
1044 ,@body) 586 ,@body)
1045 (select-window mh-in-show-buffer-saved-window)))) 587 (select-window mh-in-show-buffer-saved-window))))
1046 588
@@ -1089,20 +631,21 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
1089 "Invalidate the show buffer so we must update it to use it." 631 "Invalidate the show buffer so we must update it to use it."
1090 (if (get-buffer mh-show-buffer) 632 (if (get-buffer mh-show-buffer)
1091 (save-excursion 633 (save-excursion
1092 (set-buffer mh-show-buffer) 634 (set-buffer mh-show-buffer)
1093 (mh-unvisit-file)))) 635 (mh-unvisit-file))))
1094 636
1095(defun mh-unvisit-file () 637(defun mh-unvisit-file ()
1096 "Separate current buffer from the message file it was visiting." 638 "Separate current buffer from the message file it was visiting."
1097 (or (not (buffer-modified-p)) 639 (or (not (buffer-modified-p))
1098 (null buffer-file-name) ;we've been here before 640 (null buffer-file-name) ;we've been here before
1099 (yes-or-no-p (format "Message %s modified; flush changes? " 641 (yes-or-no-p (format "Message %s modified; flush changes? "
1100 (file-name-nondirectory buffer-file-name))) 642 (file-name-nondirectory buffer-file-name)))
1101 (error "Flushing changes not confirmed")) 643 (error "Flushing changes not confirmed"))
1102 (clear-visited-file-modtime) 644 (clear-visited-file-modtime)
1103 (unlock-buffer) 645 (unlock-buffer)
1104 (setq buffer-file-name nil)) 646 (setq buffer-file-name nil))
1105 647
648;;;###mh-autoload
1106(defun mh-get-msg-num (error-if-no-message) 649(defun mh-get-msg-num (error-if-no-message)
1107 "Return the message number of the displayed message. 650 "Return the message number of the displayed message.
1108If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is 651If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
@@ -1110,11 +653,11 @@ not pointing to a message."
1110 (save-excursion 653 (save-excursion
1111 (beginning-of-line) 654 (beginning-of-line)
1112 (cond ((looking-at mh-scan-msg-number-regexp) 655 (cond ((looking-at mh-scan-msg-number-regexp)
1113 (string-to-int (buffer-substring (match-beginning 1) 656 (string-to-int (buffer-substring (match-beginning 1)
1114 (match-end 1)))) 657 (match-end 1))))
1115 (error-if-no-message 658 (error-if-no-message
1116 (error "Cursor not pointing to message")) 659 (error "Cursor not pointing to message"))
1117 (t nil)))) 660 (t nil))))
1118 661
1119(defun mh-folder-name-p (name) 662(defun mh-folder-name-p (name)
1120 "Return non-nil if NAME is the name of a folder. 663 "Return non-nil if NAME is the name of a folder.
@@ -1122,31 +665,31 @@ A name (a string or symbol) can be a folder name if it begins with \"+\"."
1122 (if (symbolp name) 665 (if (symbolp name)
1123 (eq (aref (symbol-name name) 0) ?+) 666 (eq (aref (symbol-name name) 0) ?+)
1124 (and (> (length name) 0) 667 (and (> (length name) 0)
1125 (eq (aref name 0) ?+)))) 668 (eq (aref name 0) ?+))))
1126 669
1127 670
1128(defun mh-expand-file-name (filename &optional default) 671(defun mh-expand-file-name (filename &optional default)
1129 "Expand FILENAME like `expand-file-name', but also handle MH folder names. 672 "Expand FILENAME like `expand-file-name', but also handle MH folder names.
1130Any filename that starts with '+' is treated as a folder name. 673Any filename that starts with '+' is treated as a folder name.
1131See `expand-file-name' for description of DEFAULT." 674See `expand-file-name' for description of DEFAULT."
1132 (if (mh-folder-name-p filename) 675 (if (mh-folder-name-p filename)
1133 (expand-file-name (substring filename 1) mh-user-path) 676 (expand-file-name (substring filename 1) mh-user-path)
1134 (expand-file-name filename default))) 677 (expand-file-name filename default)))
1135 678
1136 679
1137(defun mh-msg-filename (msg &optional folder) 680(defun mh-msg-filename (msg &optional folder)
1138 "Return the file name of MSG in FOLDER (default current folder)." 681 "Return the file name of MSG in FOLDER (default current folder)."
1139 (expand-file-name (int-to-string msg) 682 (expand-file-name (int-to-string msg)
1140 (if folder 683 (if folder
1141 (mh-expand-file-name folder) 684 (mh-expand-file-name folder)
1142 mh-folder-filename))) 685 mh-folder-filename)))
1143 686
1144;;; Infrastructure to generate show-buffer functions from folder functions 687;;; Infrastructure to generate show-buffer functions from folder functions
1145;;; XEmacs does not have deactivate-mark? What is the equivalent of 688;;; XEmacs does not have deactivate-mark? What is the equivalent of
1146;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the 689;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
1147;;; folder buffer after the operation has been carried out. 690;;; folder buffer after the operation has been carried out.
1148(defmacro mh-defun-show-buffer (function original-function 691(defmacro mh-defun-show-buffer (function original-function
1149 &optional dont-return) 692 &optional dont-return)
1150 "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. 693 "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
1151If the buffer we start in is still visible and DONT-RETURN is nil then switch 694If the buffer we start in is still visible and DONT-RETURN is nil then switch
1152to it after that." 695to it after that."
@@ -1186,9 +729,9 @@ still visible.\n")
1186;;; Generate interactive functions for the show buffer from the corresponding 729;;; Generate interactive functions for the show buffer from the corresponding
1187;;; folder functions. 730;;; folder functions.
1188(mh-defun-show-buffer mh-show-previous-undeleted-msg 731(mh-defun-show-buffer mh-show-previous-undeleted-msg
1189 mh-previous-undeleted-msg) 732 mh-previous-undeleted-msg)
1190(mh-defun-show-buffer mh-show-next-undeleted-msg 733(mh-defun-show-buffer mh-show-next-undeleted-msg
1191 mh-next-undeleted-msg) 734 mh-next-undeleted-msg)
1192(mh-defun-show-buffer mh-show-quit mh-quit) 735(mh-defun-show-buffer mh-show-quit mh-quit)
1193(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg) 736(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
1194(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg) 737(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
@@ -1199,22 +742,23 @@ still visible.\n")
1199(mh-defun-show-buffer mh-show-forward mh-forward t) 742(mh-defun-show-buffer mh-show-forward mh-forward t)
1200(mh-defun-show-buffer mh-show-header-display mh-header-display) 743(mh-defun-show-buffer mh-show-header-display mh-header-display)
1201(mh-defun-show-buffer mh-show-refile-or-write-again 744(mh-defun-show-buffer mh-show-refile-or-write-again
1202 mh-refile-or-write-again) 745 mh-refile-or-write-again)
1203(mh-defun-show-buffer mh-show-show mh-show) 746(mh-defun-show-buffer mh-show-show mh-show)
1204(mh-defun-show-buffer mh-show-write-message-to-file 747(mh-defun-show-buffer mh-show-write-message-to-file
1205 mh-write-msg-to-file) 748 mh-write-msg-to-file)
1206(mh-defun-show-buffer mh-show-extract-rejected-mail 749(mh-defun-show-buffer mh-show-extract-rejected-mail
1207 mh-extract-rejected-mail t) 750 mh-extract-rejected-mail t)
1208(mh-defun-show-buffer mh-show-delete-msg-no-motion 751(mh-defun-show-buffer mh-show-delete-msg-no-motion
1209 mh-delete-msg-no-motion) 752 mh-delete-msg-no-motion)
1210(mh-defun-show-buffer mh-show-first-msg mh-first-msg) 753(mh-defun-show-buffer mh-show-first-msg mh-first-msg)
1211(mh-defun-show-buffer mh-show-last-msg mh-last-msg) 754(mh-defun-show-buffer mh-show-last-msg mh-last-msg)
1212(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg) 755(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
1213(mh-defun-show-buffer mh-show-edit-again mh-edit-again t) 756(mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
1214(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg) 757(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
1215(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder) 758(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
1216(mh-defun-show-buffer mh-show-delete-subject 759(mh-defun-show-buffer mh-show-delete-subject-or-thread
1217 mh-delete-subject) 760 mh-delete-subject-or-thread)
761(mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
1218(mh-defun-show-buffer mh-show-print-msg mh-print-msg) 762(mh-defun-show-buffer mh-show-print-msg mh-print-msg)
1219(mh-defun-show-buffer mh-show-send mh-send t) 763(mh-defun-show-buffer mh-show-send mh-send t)
1220(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t) 764(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
@@ -1228,7 +772,7 @@ still visible.\n")
1228(mh-defun-show-buffer mh-show-search-folder mh-search-folder t) 772(mh-defun-show-buffer mh-show-search-folder mh-search-folder t)
1229(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder) 773(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
1230(mh-defun-show-buffer mh-show-delete-msg-from-seq 774(mh-defun-show-buffer mh-show-delete-msg-from-seq
1231 mh-delete-msg-from-seq) 775 mh-delete-msg-from-seq)
1232(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq) 776(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
1233(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences) 777(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
1234(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq) 778(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
@@ -1236,11 +780,11 @@ still visible.\n")
1236(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) 780(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
1237(mh-defun-show-buffer mh-show-widen mh-widen) 781(mh-defun-show-buffer mh-show-widen mh-widen)
1238(mh-defun-show-buffer mh-show-narrow-to-subject 782(mh-defun-show-buffer mh-show-narrow-to-subject
1239 mh-narrow-to-subject) 783 mh-narrow-to-subject)
1240(mh-defun-show-buffer mh-show-store-msg mh-store-msg) 784(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
1241(mh-defun-show-buffer mh-show-page-digest mh-page-digest) 785(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
1242(mh-defun-show-buffer mh-show-page-digest-backwards 786(mh-defun-show-buffer mh-show-page-digest-backwards
1243 mh-page-digest-backwards) 787 mh-page-digest-backwards)
1244(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest) 788(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
1245(mh-defun-show-buffer mh-show-page-msg mh-page-msg) 789(mh-defun-show-buffer mh-show-page-msg mh-page-msg)
1246(mh-defun-show-buffer mh-show-previous-page mh-previous-page) 790(mh-defun-show-buffer mh-show-previous-page mh-previous-page)
@@ -1251,7 +795,16 @@ still visible.\n")
1251(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part) 795(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
1252(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part) 796(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
1253(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads) 797(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
798(mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
799(mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
1254(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences) 800(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
801(mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
802(mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
803(mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
804(mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
805(mh-defun-show-buffer mh-show-thread-previous-sibling
806 mh-thread-previous-sibling)
807(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
1255 808
1256;;; Populate mh-show-mode-map 809;;; Populate mh-show-mode-map
1257(gnus-define-keys mh-show-mode-map 810(gnus-define-keys mh-show-mode-map
@@ -1276,18 +829,21 @@ still visible.\n")
1276 "f" mh-show-forward 829 "f" mh-show-forward
1277 "g" mh-show-goto-msg 830 "g" mh-show-goto-msg
1278 "i" mh-show-inc-folder 831 "i" mh-show-inc-folder
1279 "k" mh-show-delete-subject 832 "k" mh-show-delete-subject-or-thread
1280 "l" mh-show-print-msg 833 "l" mh-show-print-msg
1281 "m" mh-show-send 834 "m" mh-show-send
1282 "n" mh-show-next-undeleted-msg 835 "n" mh-show-next-undeleted-msg
836 "\M-n" mh-show-next-unread-msg
1283 "o" mh-show-refile-msg 837 "o" mh-show-refile-msg
1284 "p" mh-show-previous-undeleted-msg 838 "p" mh-show-previous-undeleted-msg
839 "\M-p" mh-show-previous-unread-msg
1285 "q" mh-show-quit 840 "q" mh-show-quit
1286 "r" mh-show-reply 841 "r" mh-show-reply
1287 "s" mh-show-send 842 "s" mh-show-send
1288 "t" mh-show-toggle-showing 843 "t" mh-show-toggle-showing
1289 "u" mh-show-undo 844 "u" mh-show-undo
1290 "x" mh-show-execute-commands 845 "x" mh-show-execute-commands
846 "v" mh-show-index-visit-folder
1291 "|" mh-show-pipe-msg) 847 "|" mh-show-pipe-msg)
1292 848
1293(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) 849(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
@@ -1316,7 +872,12 @@ still visible.\n")
1316 872
1317(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) 873(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
1318 "?" mh-prefix-help 874 "?" mh-prefix-help
1319 "t" mh-show-toggle-threads) 875 "u" mh-show-thread-ancestor
876 "p" mh-show-thread-previous-sibling
877 "n" mh-show-thread-next-sibling
878 "t" mh-show-toggle-threads
879 "d" mh-show-thread-delete
880 "o" mh-show-thread-refile)
1320 881
1321(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) 882(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
1322 "?" mh-prefix-help 883 "?" mh-prefix-help
@@ -1331,13 +892,13 @@ still visible.\n")
1331;; Untested... 892;; Untested...
1332(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) 893(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
1333 "?" mh-prefix-help 894 "?" mh-prefix-help
1334 " " mh-show-page-digest 895 " " mh-show-page-digest
1335 "\177" mh-show-page-digest-backwards 896 "\177" mh-show-page-digest-backwards
1336 "b" mh-show-burst-digest) 897 "b" mh-show-burst-digest)
1337 898
1338(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) 899(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
1339 "?" mh-prefix-help 900 "?" mh-prefix-help
1340 "a" mh-mime-save-parts 901 "a" mh-mime-save-parts
1341 "v" mh-show-toggle-mime-part 902 "v" mh-show-toggle-mime-part
1342 "o" mh-show-save-mime-part 903 "o" mh-show-save-mime-part
1343 "i" mh-show-inline-mime-part 904 "i" mh-show-inline-mime-part
@@ -1409,91 +970,6 @@ still visible.\n")
1409 "--" 970 "--"
1410 ["Quit MH-E" mh-quit t])) 971 ["Quit MH-E" mh-quit t]))
1411 972
1412(eval-when-compile (defvar tool-bar-map))
1413(defvar mh-show-tool-bar-map nil)
1414(when (and (fboundp 'tool-bar-add-item)
1415 tool-bar-mode)
1416 (setq mh-show-tool-bar-map
1417 (let ((tool-bar-map (make-sparse-keymap)))
1418 (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder
1419 :help "Incorporate new mail in Inbox")
1420 (tool-bar-add-item "attach" 'mh-mime-save-parts
1421 'mh-showtoolbar-mime-save-parts
1422 :help "Save MIME parts")
1423
1424 (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg
1425 'mh-showtoolbar-prev :help "Previous message")
1426 (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page
1427 :help "Page this message")
1428 (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg
1429 'mh-showtoolbar-next :help "Next message")
1430
1431 (tool-bar-add-item "close" 'mh-show-delete-msg 'mh-showtoolbar-delete
1432 :help "Mark for deletion")
1433 (tool-bar-add-item "refile" 'mh-show-refile-msg 'mh-showtoolbar-refile
1434 :help "Refile this message")
1435 (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo
1436 :help "Undo this mark")
1437 (tool-bar-add-item "execute" 'mh-show-execute-commands
1438 'mh-showtoolbar-exec
1439 :help "Perform moves and deletes")
1440
1441 (tool-bar-add-item "show" 'mh-show-toggle-showing
1442 'mh-showtoolbar-toggle-show
1443 :help "Toggle showing message")
1444
1445 (cond
1446 (mh-tool-bar-reply-3-buttons-flag
1447 (tool-bar-add-item "reply-from"
1448 (lambda (&optional arg)
1449 (interactive "P")
1450 (set-buffer mh-show-folder-buffer)
1451 (mh-reply (mh-get-msg-num nil) "from" arg))
1452 'mh-showtoolbar-reply-from
1453 :help "Reply to \"from\"")
1454 (tool-bar-add-item "reply-to"
1455 (lambda (&optional arg)
1456 (interactive "P")
1457 (set-buffer mh-show-folder-buffer)
1458 (mh-reply (mh-get-msg-num nil) "to" arg))
1459 'mh-showtoolbar-reply-to
1460 :help "Reply to \"to\"")
1461 (tool-bar-add-item "reply-all"
1462 (lambda (&optional arg)
1463 (interactive "P")
1464 (set-buffer mh-show-folder-buffer)
1465 (mh-reply (mh-get-msg-num nil) "all" arg))
1466 'mh-showtoolbar-reply-all
1467 :help "Reply to \"all\""))
1468 (t
1469 (tool-bar-add-item "mail/reply2" 'mh-show-reply 'mh-showtoolbar-reply
1470 :help "Reply to this message")))
1471 (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose
1472 :help "Compose new message")
1473
1474 (tool-bar-add-item "rescan" 'mh-show-rescan-folder
1475 'mh-showtoolbar-rescan :help "Rescan this folder")
1476 (tool-bar-add-item "repack" 'mh-show-pack-folder 'mh-showtoolbar-pack
1477 :help "Repack this folder")
1478
1479 (tool-bar-add-item "search"
1480 (lambda (&optional arg)
1481 (interactive "P")
1482 (call-interactively mh-tool-bar-search-function))
1483 'mh-showtoolbar-search :help "Search")
1484 (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-showtoolbar-visit
1485 :help "Visit other folder")
1486
1487 (tool-bar-add-item "preferences" (lambda ()
1488 (interactive)
1489 (customize-group "mh"))
1490 'mh-showtoolbar-customize
1491 :help "MH-E preferences")
1492 (tool-bar-add-item "help" (lambda ()
1493 (interactive)
1494 (Info-goto-node "(mh-e)Top"))
1495 'mh-showtoolbar-help :help "Help")
1496 tool-bar-map)))
1497 973
1498;;; Ensure new buffers won't get this mode if default-major-mode is nil. 974;;; Ensure new buffers won't get this mode if default-major-mode is nil.
1499(put 'mh-show-mode 'mode-class 'special) 975(put 'mh-show-mode 'mode-class 'special)
@@ -1508,7 +984,7 @@ be called, with no arguments, upon entry to this mode."
1508 (mh-show-xface) 984 (mh-show-xface)
1509 (mh-show-addr) 985 (mh-show-addr)
1510 (make-local-variable 'font-lock-defaults) 986 (make-local-variable 'font-lock-defaults)
1511 ;(set (make-local-variable 'font-lock-support-mode) nil) 987 ;;(set (make-local-variable 'font-lock-support-mode) nil)
1512 (cond 988 (cond
1513 ((equal mh-highlight-citation-p 'font-lock) 989 ((equal mh-highlight-citation-p 'font-lock)
1514 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) 990 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
@@ -1521,7 +997,7 @@ be called, with no arguments, upon entry to this mode."
1521 (t 997 (t
1522 (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) 998 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
1523 (if (and mh-xemacs-flag 999 (if (and mh-xemacs-flag
1524 font-lock-auto-fontify) 1000 font-lock-auto-fontify)
1525 (turn-on-font-lock)) 1001 (turn-on-font-lock))
1526 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 1002 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1527 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) 1003 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
@@ -1550,7 +1026,7 @@ be called, with no arguments, upon entry to this mode."
1550 (if (fboundp 'x-face-xmas-wl-display-x-face) 1026 (if (fboundp 'x-face-xmas-wl-display-x-face)
1551 #'x-face-xmas-wl-display-x-face 1027 #'x-face-xmas-wl-display-x-face
1552 #'ignore)) 1028 #'ignore))
1553 ((>= emacs-major-version 21) 1029 ((and (not mh-xemacs-flag) (>= emacs-major-version 21))
1554 (load "x-face-e21" t t) 1030 (load "x-face-e21" t t)
1555 (if (fboundp 'x-face-decode-message-header) 1031 (if (fboundp 'x-face-decode-message-header)
1556 #'x-face-decode-message-header 1032 #'x-face-decode-message-header
@@ -1561,7 +1037,8 @@ be called, with no arguments, upon entry to this mode."
1561(defun mh-show-xface () 1037(defun mh-show-xface ()
1562 "Display X-Face." 1038 "Display X-Face."
1563 (when (and mh-show-use-xface-flag 1039 (when (and mh-show-use-xface-flag
1564 (or mh-decode-mime-flag mhl-formfile mh-clean-message-header-flag)) 1040 (or mh-decode-mime-flag mhl-formfile
1041 mh-clean-message-header-flag))
1565 (funcall mh-show-xface-function))) 1042 (funcall mh-show-xface-function)))
1566 1043
1567(defun mh-maybe-show (&optional msg) 1044(defun mh-maybe-show (&optional msg)
@@ -1601,22 +1078,23 @@ arguments, after the message has been displayed."
1601 (mh-showing-mode t) 1078 (mh-showing-mode t)
1602 (setq mh-page-to-next-msg-flag nil) 1079 (setq mh-page-to-next-msg-flag nil)
1603 (let ((folder mh-current-folder) 1080 (let ((folder mh-current-folder)
1604 (clean-message-header mh-clean-message-header-flag) 1081 (clean-message-header mh-clean-message-header-flag)
1605 (show-window (get-buffer-window mh-show-buffer))) 1082 (show-window (get-buffer-window mh-show-buffer)))
1606 (if (not (eq (next-window (minibuffer-window)) (selected-window))) 1083 (if (not (eq (next-window (minibuffer-window)) (selected-window)))
1607 (delete-other-windows)) ; force ourself to the top window 1084 (delete-other-windows)) ; force ourself to the top window
1608 (mh-in-show-buffer (mh-show-buffer) 1085 (mh-in-show-buffer (mh-show-buffer)
1609 (if (and show-window 1086 (if (and show-window
1610 (equal (mh-msg-filename msg folder) buffer-file-name)) 1087 (equal (mh-msg-filename msg folder) buffer-file-name))
1611 (progn ;just back up to start 1088 (progn ;just back up to start
1612 (goto-char (point-min)) 1089 (goto-char (point-min))
1613 (if (not clean-message-header) 1090 (if (not clean-message-header)
1614 (mh-start-of-uncleaned-message))) 1091 (mh-start-of-uncleaned-message)))
1615 (mh-display-msg msg folder)))) 1092 (mh-display-msg msg folder))))
1616 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split 1093 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
1617 (shrink-window (- (window-height) mh-summary-height))) 1094 (shrink-window (- (window-height) mh-summary-height)))
1618 (mh-recenter nil) 1095 (mh-recenter nil)
1619 (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list))) 1096 (if (not (memq msg mh-seen-list))
1097 (setq mh-seen-list (cons msg mh-seen-list)))
1620 (when mh-update-sequences-after-mh-show-flag 1098 (when mh-update-sequences-after-mh-show-flag
1621 (mh-update-sequences)) 1099 (mh-update-sequences))
1622 (run-hooks 'mh-show-hook)) 1100 (run-hooks 'mh-show-hook))
@@ -1706,16 +1184,16 @@ Sets the current buffer to the show buffer."
1706 (show-buffer mh-show-buffer) 1184 (show-buffer mh-show-buffer)
1707 (mm-inline-media-tests mh-mm-inline-media-tests)) 1185 (mm-inline-media-tests mh-mm-inline-media-tests))
1708 (if (not (file-exists-p msg-filename)) 1186 (if (not (file-exists-p msg-filename))
1709 (error "Message %d does not exist" msg-num)) 1187 (error "Message %d does not exist" msg-num))
1710 (if (and (> mh-show-maximum-size 0) 1188 (if (and (> mh-show-maximum-size 0)
1711 (> (elt (file-attributes msg-filename) 7) 1189 (> (elt (file-attributes msg-filename) 7)
1712 mh-show-maximum-size) 1190 mh-show-maximum-size)
1713 (not (y-or-n-p 1191 (not (y-or-n-p
1714 (format 1192 (format
1715 "Message %d (%d bytes) exceeds %d bytes. Display it? " 1193 "Message %d (%d bytes) exceeds %d bytes. Display it? "
1716 msg-num (elt (file-attributes msg-filename) 7) 1194 msg-num (elt (file-attributes msg-filename) 7)
1717 mh-show-maximum-size)))) 1195 mh-show-maximum-size))))
1718 (error "Message %d not displayed" msg-num)) 1196 (error "Message %d not displayed" msg-num))
1719 (set-buffer show-buffer) 1197 (set-buffer show-buffer)
1720 (cond ((not (equal msg-filename buffer-file-name)) 1198 (cond ((not (equal msg-filename buffer-file-name))
1721 (mh-unvisit-file) 1199 (mh-unvisit-file)
@@ -1724,11 +1202,11 @@ Sets the current buffer to the show buffer."
1724 ;; Changing contents, so this hook needs to be reinitialized. 1202 ;; Changing contents, so this hook needs to be reinitialized.
1725 ;; pgp.el uses this. 1203 ;; pgp.el uses this.
1726 (if (boundp 'write-contents-hooks) ;Emacs 19 1204 (if (boundp 'write-contents-hooks) ;Emacs 19
1727 (kill-local-variable 'write-contents-hooks)) 1205 (kill-local-variable 'write-contents-hooks))
1728 (if formfile 1206 (if formfile
1729 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" 1207 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
1730 (if (stringp formfile) 1208 (if (stringp formfile)
1731 (list "-form" formfile)) 1209 (list "-form" formfile))
1732 msg-filename) 1210 msg-filename)
1733 (insert-file-contents msg-filename)) 1211 (insert-file-contents msg-filename))
1734 (if mh-decode-quoted-printable-flag 1212 (if mh-decode-quoted-printable-flag
@@ -1781,27 +1259,27 @@ from the header. VISIBLE-HEADERS contains a regular expression specifying the
1781lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." 1259lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
1782 (let ((case-fold-search t) 1260 (let ((case-fold-search t)
1783 (after-change-functions nil)) ;Work around emacs-20 font-lock bug 1261 (after-change-functions nil)) ;Work around emacs-20 font-lock bug
1784 ;causing an endless loop. 1262 ;causing an endless loop.
1785 (save-restriction 1263 (save-restriction
1786 (goto-char start) 1264 (goto-char start)
1787 (if (search-forward "\n\n" nil 'move) 1265 (if (search-forward "\n\n" nil 'move)
1788 (backward-char 1)) 1266 (backward-char 1))
1789 (narrow-to-region start (point)) 1267 (narrow-to-region start (point))
1790 (goto-char (point-min)) 1268 (goto-char (point-min))
1791 (if visible-headers 1269 (if visible-headers
1792 (while (< (point) (point-max)) 1270 (while (< (point) (point-max))
1793 (cond ((looking-at visible-headers) 1271 (cond ((looking-at visible-headers)
1794 (forward-line 1) 1272 (forward-line 1)
1795 (while (looking-at "[ \t]") (forward-line 1))) 1273 (while (looking-at "[ \t]") (forward-line 1)))
1796 (t 1274 (t
1797 (mh-delete-line 1) 1275 (mh-delete-line 1)
1798 (while (looking-at "[ \t]") 1276 (while (looking-at "[ \t]")
1799 (mh-delete-line 1))))) 1277 (mh-delete-line 1)))))
1800 (while (re-search-forward invisible-headers nil t) 1278 (while (re-search-forward invisible-headers nil t)
1801 (beginning-of-line) 1279 (beginning-of-line)
1802 (mh-delete-line 1) 1280 (mh-delete-line 1)
1803 (while (looking-at "[ \t]") 1281 (while (looking-at "[ \t]")
1804 (mh-delete-line 1)))) 1282 (mh-delete-line 1))))
1805 (unlock-buffer)))) 1283 (unlock-buffer))))
1806 1284
1807(defun mh-delete-line (lines) 1285(defun mh-delete-line (lines)
@@ -1813,12 +1291,12 @@ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
1813Null MSG means the message at cursor." 1291Null MSG means the message at cursor."
1814 (save-excursion 1292 (save-excursion
1815 (if (or (null msg) 1293 (if (or (null msg)
1816 (mh-goto-msg msg t t)) 1294 (mh-goto-msg msg t t))
1817 (with-mh-folder-updating (t) 1295 (with-mh-folder-updating (t)
1818 (beginning-of-line) 1296 (beginning-of-line)
1819 (forward-char offset) 1297 (forward-char offset)
1820 (delete-char 1) 1298 (delete-char 1)
1821 (insert notation))))) 1299 (insert notation)))))
1822 1300
1823(defun mh-find-msg-get-num (step) 1301(defun mh-find-msg-get-num (step)
1824 "Return the message number of the message nearest the cursor. 1302 "Return the message number of the message nearest the cursor.
@@ -1826,18 +1304,18 @@ Jumps over non-message lines, such as inc errors.
1826If we have to search, STEP tells whether to search forward or backward." 1304If we have to search, STEP tells whether to search forward or backward."
1827 (or (mh-get-msg-num nil) 1305 (or (mh-get-msg-num nil)
1828 (let ((msg-num nil) 1306 (let ((msg-num nil)
1829 (nreverses 0)) 1307 (nreverses 0))
1830 (while (and (not msg-num) 1308 (while (and (not msg-num)
1831 (< nreverses 2)) 1309 (< nreverses 2))
1832 (cond ((eobp) 1310 (cond ((eobp)
1833 (setq step -1) 1311 (setq step -1)
1834 (setq nreverses (1+ nreverses))) 1312 (setq nreverses (1+ nreverses)))
1835 ((bobp) 1313 ((bobp)
1836 (setq step 1) 1314 (setq step 1)
1837 (setq nreverses (1+ nreverses)))) 1315 (setq nreverses (1+ nreverses))))
1838 (forward-line step) 1316 (forward-line step)
1839 (setq msg-num (mh-get-msg-num nil))) 1317 (setq msg-num (mh-get-msg-num nil)))
1840 msg-num))) 1318 msg-num)))
1841 1319
1842(defun mh-goto-msg (number &optional no-error-if-no-message dont-show) 1320(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
1843 "Position the cursor at message NUMBER. 1321 "Position the cursor at message NUMBER.
@@ -1869,12 +1347,12 @@ Returns nil if the field is not in the buffer."
1869 (let ((case-fold-search t)) 1347 (let ((case-fold-search t))
1870 (goto-char (point-min)) 1348 (goto-char (point-min))
1871 (cond ((not (re-search-forward (format "^%s" field) nil t)) nil) 1349 (cond ((not (re-search-forward (format "^%s" field) nil t)) nil)
1872 ((looking-at "[\t ]*$") nil) 1350 ((looking-at "[\t ]*$") nil)
1873 (t 1351 (t
1874 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) 1352 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
1875 (let ((start (match-beginning 1))) 1353 (let ((start (match-beginning 1)))
1876 (end-of-line) 1354 (end-of-line)
1877 (buffer-substring start (point))))))) 1355 (buffer-substring start (point)))))))
1878 1356
1879(defvar mail-user-agent) 1357(defvar mail-user-agent)
1880(defvar read-mail-command) 1358(defvar read-mail-command)
@@ -1897,44 +1375,44 @@ arguments, after these variable have been set."
1897 ;; Be sure profile is fully expanded before switching buffers 1375 ;; Be sure profile is fully expanded before switching buffers
1898 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) 1376 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
1899 (set-buffer (get-buffer-create mh-temp-buffer)) 1377 (set-buffer (get-buffer-create mh-temp-buffer))
1900 (setq buffer-offer-save nil) ;for people who set default to t 1378 (setq buffer-offer-save nil) ;for people who set default to t
1901 (erase-buffer) 1379 (erase-buffer)
1902 (condition-case err 1380 (condition-case err
1903 (insert-file-contents profile) 1381 (insert-file-contents profile)
1904 (file-error 1382 (file-error
1905 (mh-install profile err))) 1383 (mh-install profile err)))
1906 (setq mh-user-path (mh-get-profile-field "Path:")) 1384 (setq mh-user-path (mh-get-profile-field "Path:"))
1907 (if (not mh-user-path) 1385 (if (not mh-user-path)
1908 (setq mh-user-path "Mail")) 1386 (setq mh-user-path "Mail"))
1909 (setq mh-user-path 1387 (setq mh-user-path
1910 (file-name-as-directory 1388 (file-name-as-directory
1911 (expand-file-name mh-user-path (expand-file-name "~")))) 1389 (expand-file-name mh-user-path (expand-file-name "~"))))
1912 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) 1390 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
1913 (if mh-draft-folder 1391 (if mh-draft-folder
1914 (progn 1392 (progn
1915 (if (not (mh-folder-name-p mh-draft-folder)) 1393 (if (not (mh-folder-name-p mh-draft-folder))
1916 (setq mh-draft-folder (format "+%s" mh-draft-folder))) 1394 (setq mh-draft-folder (format "+%s" mh-draft-folder)))
1917 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) 1395 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
1918 (error "Draft folder \"%s\" not found. Create it and try again" 1396 (error "Draft folder \"%s\" not found. Create it and try again"
1919 (mh-expand-file-name mh-draft-folder))))) 1397 (mh-expand-file-name mh-draft-folder)))))
1920 (setq mh-inbox (mh-get-profile-field "Inbox:")) 1398 (setq mh-inbox (mh-get-profile-field "Inbox:"))
1921 (cond ((not mh-inbox) 1399 (cond ((not mh-inbox)
1922 (setq mh-inbox "+inbox")) 1400 (setq mh-inbox "+inbox"))
1923 ((not (mh-folder-name-p mh-inbox)) 1401 ((not (mh-folder-name-p mh-inbox))
1924 (setq mh-inbox (format "+%s" mh-inbox)))) 1402 (setq mh-inbox (format "+%s" mh-inbox))))
1925 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) 1403 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
1926 (if mh-unseen-seq 1404 (if mh-unseen-seq
1927 (setq mh-unseen-seq (intern mh-unseen-seq)) 1405 (setq mh-unseen-seq (intern mh-unseen-seq))
1928 (setq mh-unseen-seq 'unseen)) ;old MH default? 1406 (setq mh-unseen-seq 'unseen)) ;old MH default?
1929 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) 1407 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
1930 (if mh-previous-seq 1408 (if mh-previous-seq
1931 (setq mh-previous-seq (intern mh-previous-seq))) 1409 (setq mh-previous-seq (intern mh-previous-seq)))
1932 (run-hooks 'mh-find-path-hook))) 1410 (run-hooks 'mh-find-path-hook)))
1933 (and mh-auto-folder-collect-flag 1411 (and mh-auto-folder-collect-flag
1934 (let ((mh-no-install t)) ;only get folders if MH installed 1412 (let ((mh-no-install t)) ;only get folders if MH installed
1935 (condition-case err 1413 (condition-case err
1936 (mh-make-folder-list-background) 1414 (mh-make-folder-list-background)
1937 (file-error))))) ;so don't complain if not installed 1415 (file-error))))) ;so don't complain if not installed
1938 1416
1939(defun mh-file-command-p (file) 1417(defun mh-file-command-p (file)
1940 "Return t if file FILE is the name of a executable regular file." 1418 "Return t if file FILE is the name of a executable regular file."
@@ -1952,7 +1430,7 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1952 "/usr/bin/mh/" ;Ultrix 4.2, Linux 1430 "/usr/bin/mh/" ;Ultrix 4.2, Linux
1953 "/usr/new/mh/" ;Ultrix <4.2 1431 "/usr/new/mh/" ;Ultrix <4.2
1954 "/usr/contrib/mh/bin/" ;BSDI 1432 "/usr/contrib/mh/bin/" ;BSDI
1955 "/usr/pkg/bin/" ; NetBSD 1433 "/usr/pkg/bin/" ; NetBSD
1956 "/usr/local/bin/" 1434 "/usr/local/bin/"
1957 ) 1435 )
1958 "mhparam")))) 1436 "mhparam"))))
@@ -1978,29 +1456,29 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1978 mh-nmh-flag t))) 1456 mh-nmh-flag t)))
1979 (kill-buffer tmp-buffer)))) 1457 (kill-buffer tmp-buffer))))
1980 (unless (and mh-progs mh-lib mh-lib-progs) 1458 (unless (and mh-progs mh-lib mh-lib-progs)
1981 (error "Unable to determine paths from `mhparam' command"))))) 1459 (error "Unable to determine paths from `mhparam' command")))))
1982 1460
1983(defun mh-path-search (path file) 1461(defun mh-path-search (path file)
1984 "Search PATH, a list of directory names, for FILE. 1462 "Search PATH, a list of directory names, for FILE.
1985Returns the element of PATH that contains FILE, or nil if not found." 1463Returns the element of PATH that contains FILE, or nil if not found."
1986 (while (and path 1464 (while (and path
1987 (not (funcall 'mh-file-command-p 1465 (not (funcall 'mh-file-command-p
1988 (expand-file-name file (car path))))) 1466 (expand-file-name file (car path)))))
1989 (setq path (cdr path))) 1467 (setq path (cdr path)))
1990 (car path)) 1468 (car path))
1991 1469
1992(defvar mh-no-install nil) ;do not run install-mh 1470(defvar mh-no-install nil) ;do not run install-mh
1993 1471
1994(defun mh-install (profile error-val) 1472(defun mh-install (profile error-val)
1995 "Initialize the MH environment. 1473 "Initialize the MH environment.
1996This is called if we fail to read the PROFILE file. ERROR-VAL is the error 1474This is called if we fail to read the PROFILE file. ERROR-VAL is the error
1997that made this call necessary." 1475that made this call necessary."
1998 (if (or (getenv "MH") 1476 (if (or (getenv "MH")
1999 (file-exists-p profile) 1477 (file-exists-p profile)
2000 mh-no-install) 1478 mh-no-install)
2001 (signal (car error-val) 1479 (signal (car error-val)
2002 (list (format "Cannot read MH profile \"%s\"" profile) 1480 (list (format "Cannot read MH profile \"%s\"" profile)
2003 (car (cdr (cdr error-val)))))) 1481 (car (cdr (cdr error-val))))))
2004 ;; The "install-mh" command will output a short note which 1482 ;; The "install-mh" command will output a short note which
2005 ;; mh-exec-cmd will display to the user. 1483 ;; mh-exec-cmd will display to the user.
2006 ;; The MH 5 version of install-mh might try prompt the user 1484 ;; The MH 5 version of install-mh might try prompt the user
@@ -2011,9 +1489,9 @@ that made this call necessary."
2011 (condition-case err 1489 (condition-case err
2012 (insert-file-contents profile) 1490 (insert-file-contents profile)
2013 (file-error 1491 (file-error
2014 (signal (car err) ;re-signal with more specific msg 1492 (signal (car err) ;re-signal with more specific msg
2015 (list (format "Cannot read MH profile \"%s\"" profile) 1493 (list (format "Cannot read MH profile \"%s\"" profile)
2016 (car (cdr (cdr err)))))))) 1494 (car (cdr (cdr err))))))))
2017 1495
2018(defun mh-set-folder-modified-p (flag) 1496(defun mh-set-folder-modified-p (flag)
2019 "Mark current folder as modified or unmodified according to FLAG." 1497 "Mark current folder as modified or unmodified according to FLAG."
@@ -2042,37 +1520,21 @@ The message number width portion of the format is discovered using
2042 (substring fmt end)))) 1520 (substring fmt end))))
2043 fmt)) 1521 fmt))
2044 1522
2045(defun mh-set-cmd-note (width)
2046 "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
2047
2048If `mh-scan-format-file' specifies nil or a filename, then this function
2049will NOT update `mh-cmd-note'."
2050 ;; Add one to the width to always have whitespace in column zero.
2051 (setq width (max (1+ width) 2))
2052 (if (and (equal mh-scan-format-file t)
2053 (not (eq mh-cmd-note width)))
2054 (progn
2055 (setq mh-cmd-note width)
2056 ;; Rachet up the default value
2057 (if (< (default-value 'mh-cmd-note) mh-cmd-note)
2058 (setq-default mh-cmd-note mh-cmd-note))))
2059 mh-cmd-note)
2060
2061(defun mh-message-number-width (folder) 1523(defun mh-message-number-width (folder)
2062 "Return the widest message number in this FOLDER." 1524 "Return the widest message number in this FOLDER."
2063 (or mh-progs (mh-find-path)) 1525 (or mh-progs (mh-find-path))
2064 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)) 1526 (let ((tmp-buffer (get-buffer-create mh-temp-buffer))
2065 (width 0)) 1527 (width 0))
2066 (save-excursion 1528 (save-excursion
2067 (set-buffer tmp-buffer) 1529 (set-buffer tmp-buffer)
2068 (erase-buffer) 1530 (erase-buffer)
2069 (apply 'call-process 1531 (apply 'call-process
2070 (expand-file-name "scan" mh-progs) nil '(t nil) nil 1532 (expand-file-name "scan" mh-progs) nil '(t nil) nil
2071 (list folder "last" "-format" "%(msg)")) 1533 (list folder "last" "-format" "%(msg)"))
2072 (goto-char (point-min)) 1534 (goto-char (point-min))
2073 (if (re-search-forward mh-scan-msg-number-regexp nil 0 1) 1535 (if (re-search-forward mh-scan-msg-number-regexp nil 0 1)
2074 (setq width (length (buffer-substring 1536 (setq width (length (buffer-substring
2075 (match-beginning 1) (match-end 1)))))) 1537 (match-beginning 1) (match-end 1))))))
2076 width)) 1538 width))
2077 1539
2078(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) 1540(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
@@ -2083,14 +1545,14 @@ addition."
2083 (let ((entry (mh-find-seq seq))) 1545 (let ((entry (mh-find-seq seq)))
2084 (if (and msgs (atom msgs)) (setq msgs (list msgs))) 1546 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
2085 (if (null entry) 1547 (if (null entry)
2086 (setq mh-seq-list 1548 (setq mh-seq-list
2087 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) 1549 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
2088 mh-seq-list)) 1550 mh-seq-list))
2089 (if msgs (setcdr entry (mh-canonicalize-sequence 1551 (if msgs (setcdr entry (mh-canonicalize-sequence
2090 (append msgs (mh-seq-msgs entry)))))) 1552 (append msgs (mh-seq-msgs entry))))))
2091 (cond ((not internal-flag) 1553 (cond ((not internal-flag)
2092 (mh-add-to-sequence seq msgs) 1554 (mh-add-to-sequence seq msgs)
2093 (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))) 1555 (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
2094 1556
2095(defun mh-canonicalize-sequence (msgs) 1557(defun mh-canonicalize-sequence (msgs)
2096 "Sort MSGS in decreasing order and remove duplicates." 1558 "Sort MSGS in decreasing order and remove duplicates."
@@ -2122,54 +1584,54 @@ changed."
2122 ((equal "" default) "? ") 1584 ((equal "" default) "? ")
2123 (t (format " [%s]? " default)))) 1585 (t (format " [%s]? " default))))
2124 (prompt (format "%s folder%s" prompt default-string)) 1586 (prompt (format "%s folder%s" prompt default-string))
2125 read-name folder-name) 1587 read-name folder-name)
2126 (if (null mh-folder-list) 1588 (if (null mh-folder-list)
2127 (mh-set-folder-list)) 1589 (mh-set-folder-list))
2128 (while (and (setq read-name (completing-read prompt mh-folder-list nil nil 1590 (while (and (setq read-name (completing-read prompt mh-folder-list nil nil
2129 "+" 'mh-folder-hist)) 1591 "+" 'mh-folder-hist))
2130 (equal read-name "") 1592 (equal read-name "")
2131 (equal default ""))) 1593 (equal default "")))
2132 (cond ((or (equal read-name "") (equal read-name "+")) 1594 (cond ((or (equal read-name "") (equal read-name "+"))
2133 (setq read-name default)) 1595 (setq read-name default))
2134 ((not (mh-folder-name-p read-name)) 1596 ((not (mh-folder-name-p read-name))
2135 (setq read-name (format "+%s" read-name)))) 1597 (setq read-name (format "+%s" read-name))))
2136 (if (or (not read-name) (equal "" read-name)) 1598 (if (or (not read-name) (equal "" read-name))
2137 (error "No folder specified")) 1599 (error "No folder specified"))
2138 (setq folder-name read-name) 1600 (setq folder-name read-name)
2139 (cond ((and (> (length folder-name) 0) 1601 (cond ((and (> (length folder-name) 0)
2140 (eq (aref folder-name (1- (length folder-name))) ?/)) 1602 (eq (aref folder-name (1- (length folder-name))) ?/))
2141 (setq folder-name (substring folder-name 0 -1)))) 1603 (setq folder-name (substring folder-name 0 -1))))
2142 (let ((new-file-flag 1604 (let ((new-file-flag
2143 (not (file-exists-p (mh-expand-file-name folder-name))))) 1605 (not (file-exists-p (mh-expand-file-name folder-name)))))
2144 (cond ((and new-file-flag 1606 (cond ((and new-file-flag
2145 (y-or-n-p 1607 (y-or-n-p
2146 (format "Folder %s does not exist. Create it? " 1608 (format "Folder %s does not exist. Create it? "
2147 folder-name))) 1609 folder-name)))
2148 (message "Creating %s" folder-name) 1610 (message "Creating %s" folder-name)
2149 (mh-exec-cmd-error nil "folder" folder-name) 1611 (mh-exec-cmd-error nil "folder" folder-name)
2150 (when (boundp 'mh-speed-folder-map) 1612 (when (boundp 'mh-speed-folder-map)
2151 (mh-speed-add-folder folder-name)) 1613 (mh-speed-add-folder folder-name))
2152 (message "Creating %s...done" folder-name) 1614 (message "Creating %s...done" folder-name)
2153 (setq mh-folder-list (cons (list read-name) mh-folder-list)) 1615 (setq mh-folder-list (cons (list read-name) mh-folder-list))
2154 (run-hooks 'mh-folder-list-change-hook)) 1616 (run-hooks 'mh-folder-list-change-hook))
2155 (new-file-flag 1617 (new-file-flag
2156 (error "Folder %s is not created" folder-name)) 1618 (error "Folder %s is not created" folder-name))
2157 ((not (file-directory-p (mh-expand-file-name folder-name))) 1619 ((not (file-directory-p (mh-expand-file-name folder-name)))
2158 (error "\"%s\" is not a directory" 1620 (error "\"%s\" is not a directory"
2159 (mh-expand-file-name folder-name))) 1621 (mh-expand-file-name folder-name)))
2160 ((and (null (assoc read-name mh-folder-list)) 1622 ((and (null (assoc read-name mh-folder-list))
2161 (null (assoc (concat read-name "/") mh-folder-list))) 1623 (null (assoc (concat read-name "/") mh-folder-list)))
2162 (setq mh-folder-list (cons (list read-name) mh-folder-list)) 1624 (setq mh-folder-list (cons (list read-name) mh-folder-list))
2163 (run-hooks 'mh-folder-list-change-hook)))) 1625 (run-hooks 'mh-folder-list-change-hook))))
2164 folder-name)) 1626 folder-name))
2165 1627
2166(defvar mh-make-folder-list-process nil) ;The background process collecting 1628(defvar mh-make-folder-list-process nil) ;The background process collecting
2167 ;the folder list. 1629 ;the folder list.
2168 1630
2169(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built. 1631(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built.
2170 1632
2171(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from 1633(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from
2172 ;folder process. 1634 ;folder process.
2173 1635
2174(defun mh-set-folder-list () 1636(defun mh-set-folder-list ()
2175 "Set `mh-folder-list' correctly. 1637 "Set `mh-folder-list' correctly.
@@ -2198,47 +1660,47 @@ Call `mh-set-folder-list' to wait for the result."
2198 (mh-find-path)) 1660 (mh-find-path))
2199 (let ((process-connection-type nil)) 1661 (let ((process-connection-type nil))
2200 (setq mh-make-folder-list-process 1662 (setq mh-make-folder-list-process
2201 (start-process "folders" nil (expand-file-name "folders" mh-progs) 1663 (start-process "folders" nil (expand-file-name "folders" mh-progs)
2202 "-fast" 1664 "-fast"
2203 (if mh-recursive-folders-flag 1665 (if mh-recursive-folders-flag
2204 "-recurse" 1666 "-recurse"
2205 "-norecurse"))) 1667 "-norecurse")))
2206 (set-process-filter mh-make-folder-list-process 1668 (set-process-filter mh-make-folder-list-process
2207 'mh-make-folder-list-filter) 1669 'mh-make-folder-list-filter)
2208 (process-kill-without-query mh-make-folder-list-process))))) 1670 (process-kill-without-query mh-make-folder-list-process)))))
2209 1671
2210(defun mh-make-folder-list-filter (process output) 1672(defun mh-make-folder-list-filter (process output)
2211 "Given the PROCESS \"folders -fast\", parse OUTPUT. 1673 "Given the PROCESS \"folders -fast\", parse OUTPUT.
2212See also `set-process-filter'." 1674See also `set-process-filter'."
2213 (let ((position 0) 1675 (let ((position 0)
2214 line-end 1676 line-end
2215 new-folder 1677 new-folder
2216 (prevailing-match-data (match-data))) 1678 (prevailing-match-data (match-data)))
2217 (unwind-protect 1679 (unwind-protect
2218 ;; make sure got complete line 1680 ;; make sure got complete line
2219 (while (setq line-end (string-match "\n" output position)) 1681 (while (setq line-end (string-match "\n" output position))
2220 (setq new-folder (format "+%s%s" 1682 (setq new-folder (format "+%s%s"
2221 mh-folder-list-partial-line 1683 mh-folder-list-partial-line
2222 (substring output position line-end))) 1684 (substring output position line-end)))
2223 (setq mh-folder-list-partial-line "") 1685 (setq mh-folder-list-partial-line "")
2224 ;; is new folder a subfolder of previous? 1686 ;; is new folder a subfolder of previous?
2225 (if (and mh-folder-list-temp 1687 (if (and mh-folder-list-temp
2226 (string-match 1688 (string-match
2227 (regexp-quote 1689 (regexp-quote
2228 (concat (car (car mh-folder-list-temp)) "/")) 1690 (concat (car (car mh-folder-list-temp)) "/"))
2229 new-folder)) 1691 new-folder))
2230 ;; append slash to parent folder for better completion 1692 ;; append slash to parent folder for better completion
2231 ;; (undone by mh-prompt-for-folder) 1693 ;; (undone by mh-prompt-for-folder)
2232 (setq mh-folder-list-temp 1694 (setq mh-folder-list-temp
2233 (cons 1695 (cons
2234 (list new-folder) 1696 (list new-folder)
2235 (cons 1697 (cons
2236 (list (concat (car (car mh-folder-list-temp)) "/")) 1698 (list (concat (car (car mh-folder-list-temp)) "/"))
2237 (cdr mh-folder-list-temp)))) 1699 (cdr mh-folder-list-temp))))
2238 (setq mh-folder-list-temp 1700 (setq mh-folder-list-temp
2239 (cons (list new-folder) 1701 (cons (list new-folder)
2240 mh-folder-list-temp))) 1702 mh-folder-list-temp)))
2241 (setq position (1+ line-end))) 1703 (setq position (1+ line-end)))
2242 (set-match-data prevailing-match-data)) 1704 (set-match-data prevailing-match-data))
2243 (setq mh-folder-list-partial-line (substring output position)))) 1705 (setq mh-folder-list-partial-line (substring output position))))
2244 1706
@@ -2253,12 +1715,12 @@ The output is not read or parsed by MH-E."
2253 (set-buffer (get-buffer-create mh-temp-buffer)) 1715 (set-buffer (get-buffer-create mh-temp-buffer))
2254 (erase-buffer) 1716 (erase-buffer)
2255 (apply 'call-process 1717 (apply 'call-process
2256 (expand-file-name command mh-progs) nil t nil 1718 (expand-file-name command mh-progs) nil t nil
2257 (mh-list-to-string args)) 1719 (mh-list-to-string args))
2258 (if (> (buffer-size) 0) 1720 (if (> (buffer-size) 0)
2259 (save-window-excursion 1721 (save-window-excursion
2260 (switch-to-buffer-other-window mh-temp-buffer) 1722 (switch-to-buffer-other-window mh-temp-buffer)
2261 (sit-for 5))))) 1723 (sit-for 5)))))
2262 1724
2263(defun mh-exec-cmd-error (env command &rest args) 1725(defun mh-exec-cmd-error (env command &rest args)
2264 "In environment ENV, execute mh-command COMMAND with ARGS. 1726 "In environment ENV, execute mh-command COMMAND with ARGS.
@@ -2268,17 +1730,17 @@ Signals an error if process does not complete successfully."
2268 (set-buffer (get-buffer-create mh-temp-buffer)) 1730 (set-buffer (get-buffer-create mh-temp-buffer))
2269 (erase-buffer) 1731 (erase-buffer)
2270 (let ((status 1732 (let ((status
2271 (if env 1733 (if env
2272 ;; the shell hacks necessary here shows just how broken Unix is 1734 ;; the shell hacks necessary here shows just how broken Unix is
2273 (apply 'call-process "/bin/sh" nil t nil "-c" 1735 (apply 'call-process "/bin/sh" nil t nil "-c"
2274 (format "%s %s ${1+\"$@\"}" 1736 (format "%s %s ${1+\"$@\"}"
2275 env 1737 env
2276 (expand-file-name command mh-progs)) 1738 (expand-file-name command mh-progs))
2277 command 1739 command
2278 (mh-list-to-string args)) 1740 (mh-list-to-string args))
2279 (apply 'call-process 1741 (apply 'call-process
2280 (expand-file-name command mh-progs) nil t nil 1742 (expand-file-name command mh-progs) nil t nil
2281 (mh-list-to-string args))))) 1743 (mh-list-to-string args)))))
2282 (mh-handle-process-error command status)))) 1744 (mh-handle-process-error command status))))
2283 1745
2284(defun mh-exec-cmd-daemon (command &rest args) 1746(defun mh-exec-cmd-daemon (command &rest args)
@@ -2288,10 +1750,10 @@ Any output from command is displayed in an asynchronous pop-up window."
2288 (set-buffer (get-buffer-create mh-temp-buffer)) 1750 (set-buffer (get-buffer-create mh-temp-buffer))
2289 (erase-buffer)) 1751 (erase-buffer))
2290 (let* ((process-connection-type nil) 1752 (let* ((process-connection-type nil)
2291 (process (apply 'start-process 1753 (process (apply 'start-process
2292 command nil 1754 command nil
2293 (expand-file-name command mh-progs) 1755 (expand-file-name command mh-progs)
2294 (mh-list-to-string args)))) 1756 (mh-list-to-string args))))
2295 (set-process-filter process 'mh-process-daemon))) 1757 (set-process-filter process 'mh-process-daemon)))
2296 1758
2297(defun mh-process-daemon (process output) 1759(defun mh-process-daemon (process output)
@@ -2309,14 +1771,20 @@ non-nil, in which case an error is signaled if `call-process' returns non-0."
2309 (set-buffer (get-buffer-create mh-temp-buffer)) 1771 (set-buffer (get-buffer-create mh-temp-buffer))
2310 (erase-buffer) 1772 (erase-buffer)
2311 (let ((value 1773 (let ((value
2312 (apply 'call-process 1774 (apply 'call-process
2313 (expand-file-name command mh-progs) nil t nil 1775 (expand-file-name command mh-progs) nil t nil
2314 args))) 1776 args)))
2315 (goto-char (point-min)) 1777 (goto-char (point-min))
2316 (if raise-error 1778 (if raise-error
2317 (mh-handle-process-error command value) 1779 (mh-handle-process-error command value)
2318 value))) 1780 value)))
2319 1781
1782(defun mh-profile-component (component)
1783 "Return COMPONENT value from mhparam, or nil if unset."
1784 (save-excursion
1785 (mh-exec-cmd-quiet nil "mhparam" "-components" component)
1786 (mh-get-profile-field (concat component ":"))))
1787
2320(defun mh-exchange-point-and-mark-preserving-active-mark () 1788(defun mh-exchange-point-and-mark-preserving-active-mark ()
2321 "Put the mark where point is now, and point where the mark is now. 1789 "Put the mark where point is now, and point where the mark is now.
2322This command works even when the mark is not active, and preserves whether the 1790This command works even when the mark is not active, and preserves whether the
@@ -2338,8 +1806,8 @@ Put the output into buffer after point. Set mark after inserted text.
2338Output is expected to be shown to user, not parsed by MH-E." 1806Output is expected to be shown to user, not parsed by MH-E."
2339 (push-mark (point) t) 1807 (push-mark (point) t)
2340 (apply 'call-process 1808 (apply 'call-process
2341 (expand-file-name command mh-progs) nil t display 1809 (expand-file-name command mh-progs) nil t display
2342 (mh-list-to-string args)) 1810 (mh-list-to-string args))
2343 1811
2344 ;; The following is used instead of 'exchange-point-and-mark because the 1812 ;; The following is used instead of 'exchange-point-and-mark because the
2345 ;; latter activates the current region (between point and mark), which 1813 ;; latter activates the current region (between point and mark), which
@@ -2358,26 +1826,26 @@ Put the output into buffer after point. Set mark after inserted text."
2358STATUS is return value from `call-process'. 1826STATUS is return value from `call-process'.
2359Program output is in current buffer. 1827Program output is in current buffer.
2360If output is too long to include in error message, display the buffer." 1828If output is too long to include in error message, display the buffer."
2361 (cond ((eq status 0) ;success 1829 (cond ((eq status 0) ;success
2362 status) 1830 status)
2363 ((stringp status) ;kill string 1831 ((stringp status) ;kill string
2364 (error "%s: %s" command status)) 1832 (error "%s: %s" command status))
2365 (t ;exit code 1833 (t ;exit code
2366 (cond 1834 (cond
2367 ((= (buffer-size) 0) ;program produced no error message 1835 ((= (buffer-size) 0) ;program produced no error message
2368 (error "%s: exit code %d" command status)) 1836 (error "%s: exit code %d" command status))
2369 (t 1837 (t
2370 ;; will error message fit on one line? 1838 ;; will error message fit on one line?
2371 (goto-line 2) 1839 (goto-line 2)
2372 (if (and (< (buffer-size) (frame-width)) 1840 (if (and (< (buffer-size) (frame-width))
2373 (eobp)) 1841 (eobp))
2374 (error "%s" 1842 (error "%s"
2375 (buffer-substring 1 (progn (goto-char 1) 1843 (buffer-substring 1 (progn (goto-char 1)
2376 (end-of-line) 1844 (end-of-line)
2377 (point)))) 1845 (point))))
2378 (display-buffer (current-buffer)) 1846 (display-buffer (current-buffer))
2379 (error "%s failed with status %d. See error message in other window" 1847 (error "%s failed with status %d. See error message in other window"
2380 command status))))))) 1848 command status)))))))
2381 1849
2382(defun mh-list-to-string (l) 1850(defun mh-list-to-string (l)
2383 "Flatten the list L and make every element of the new list into a string." 1851 "Flatten the list L and make every element of the new list into a string."
@@ -2388,22 +1856,23 @@ If output is too long to include in error message, display the buffer."
2388 (let ((new-list nil)) 1856 (let ((new-list nil))
2389 (while l 1857 (while l
2390 (cond ((null (car l))) 1858 (cond ((null (car l)))
2391 ((symbolp (car l)) 1859 ((symbolp (car l))
2392 (setq new-list (cons (symbol-name (car l)) new-list))) 1860 (setq new-list (cons (symbol-name (car l)) new-list)))
2393 ((numberp (car l)) 1861 ((numberp (car l))
2394 (setq new-list (cons (int-to-string (car l)) new-list))) 1862 (setq new-list (cons (int-to-string (car l)) new-list)))
2395 ((equal (car l) "")) 1863 ((equal (car l) ""))
2396 ((stringp (car l)) (setq new-list (cons (car l) new-list))) 1864 ((stringp (car l)) (setq new-list (cons (car l) new-list)))
2397 ((listp (car l)) 1865 ((listp (car l))
2398 (setq new-list (nconc (mh-list-to-string-1 (car l)) 1866 (setq new-list (nconc (mh-list-to-string-1 (car l))
2399 new-list))) 1867 new-list)))
2400 (t (error "Bad element in mh-list-to-string: %s" (car l)))) 1868 (t (error "Bad element in mh-list-to-string: %s" (car l))))
2401 (setq l (cdr l))) 1869 (setq l (cdr l)))
2402 new-list)) 1870 new-list))
2403 1871
2404(provide 'mh-utils) 1872(provide 'mh-utils)
2405 1873
2406;;; Local Variables: 1874;;; Local Variables:
1875;;; indent-tabs-mode: nil
2407;;; sentence-end-double-space: nil 1876;;; sentence-end-double-space: nil
2408;;; End: 1877;;; End:
2409 1878
diff --git a/lisp/mail/mh-xemacs-compat.el b/lisp/mail/mh-xemacs-compat.el
index f23a77de459..692d792a1bc 100644
--- a/lisp/mail/mh-xemacs-compat.el
+++ b/lisp/mail/mh-xemacs-compat.el
@@ -28,7 +28,7 @@
28 28
29;;; Change Log: 29;;; Change Log:
30 30
31;; $Id: mh-xemacs-compat.el,v 1.12 2002/11/02 19:56:50 wohler Exp $ 31;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
32 32
33;;; Code: 33;;; Code:
34 34
@@ -52,10 +52,10 @@
52(unless (fboundp 'cancel-timer) 52(unless (fboundp 'cancel-timer)
53 (defalias 'cancel-timer 'delete-itimer)) 53 (defalias 'cancel-timer 'delete-itimer))
54 54
55
56(provide 'mh-xemacs-compat) 55(provide 'mh-xemacs-compat)
57 56
58;;; Local Variables: 57;;; Local Variables:
58;;; indent-tabs-mode: nil
59;;; sentence-end-double-space: nil 59;;; sentence-end-double-space: nil
60;;; End: 60;;; End:
61 61
diff --git a/lisp/toolbar/alias.pbm b/lisp/toolbar/alias.pbm
new file mode 100644
index 00000000000..1ebe932c6d4
--- /dev/null
+++ b/lisp/toolbar/alias.pbm
@@ -0,0 +1,3 @@
1P4
224 24
3ÿÿÿÿÿÿÿÿÿýŸÿðÿïûÿÿüïÿÏÿÏïÿÏïÿïÏÿï÷ÿÿãÿçõÿ÷üÿþÿÙÿÿù÷ÿÿ÷ÿÿüÿÿÿÿÿÿÿÿÿ \ No newline at end of file
diff --git a/lisp/toolbar/alias.xpm b/lisp/toolbar/alias.xpm
new file mode 100644
index 00000000000..8bf75063bdc
--- /dev/null
+++ b/lisp/toolbar/alias.xpm
@@ -0,0 +1,33 @@
1/* XPM */
2static char * alias_xpm[] = {
3/* columns rows colors chars-per-pixel */
4"24 24 4 1",
5" c None",
6". c #61b761b7600a",
7"X c #a5d8a5d89550",
8"o c black",
9/* pixels */
10" ",
11" ",
12" ",
13" ...... ",
14" ...XXXX..XX ",
15" o..ooooooo... ",
16" ooo oooo..X ",
17" o.X ooo... ",
18" o.X ooo.XX ",
19" o.X oo.. ",
20" o.X oo. ",
21" o... oo.. ",
22" o.X o.. ",
23" o.XX oX. ",
24" o.... oo. ",
25" o..XX oooo ",
26" o...XXX XXoooo ",
27" ooo........ooooo ",
28" oooooXXooooo.oo ",
29" ooo o..oo",
30" o...",
31" ooo",
32" oo",
33" "};