aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2004-07-13 03:06:25 +0000
committerBill Wohler2004-07-13 03:06:25 +0000
commita66894d8b489dfdfafc2058cd181fefbb894fbf0 (patch)
tree39c692b4da2f58c1f9830381b0befa1ec3d56b87
parent0117451de7e30adf240f369f26b7667dbf3788bf (diff)
downloademacs-a66894d8b489dfdfafc2058cd181fefbb894fbf0.tar.gz
emacs-a66894d8b489dfdfafc2058cd181fefbb894fbf0.zip
Upgraded to MH-E version 7.4.4.
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
-rw-r--r--etc/ChangeLog4
-rw-r--r--etc/MH-E-NEWS235
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/mail/reply2.pbmbin81 -> 81 bytes
-rw-r--r--lisp/mh-e/ChangeLog1274
-rw-r--r--lisp/mh-e/mh-alias.el227
-rw-r--r--lisp/mh-e/mh-comp.el507
-rw-r--r--lisp/mh-e/mh-customize.el345
-rw-r--r--lisp/mh-e/mh-e.el581
-rw-r--r--lisp/mh-e/mh-funcs.el53
-rw-r--r--lisp/mh-e/mh-gnus.el142
-rw-r--r--lisp/mh-e/mh-identity.el7
-rw-r--r--lisp/mh-e/mh-index.el399
-rw-r--r--lisp/mh-e/mh-junk.el36
-rw-r--r--lisp/mh-e/mh-loaddefs.el361
-rw-r--r--lisp/mh-e/mh-mime.el253
-rw-r--r--lisp/mh-e/mh-seq.el616
-rw-r--r--lisp/mh-e/mh-speed.el37
-rw-r--r--lisp/mh-e/mh-utils.el278
-rw-r--r--lisp/mh-e/mh-xemacs-compat.el99
-rw-r--r--lisp/mh-e/mh-xemacs-icons.el1307
-rw-r--r--lisp/toolbar/alias.pbmbin185 -> 81 bytes
-rw-r--r--lisp/toolbar/execute.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/highlight.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/page-down.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/refile.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/repack.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/reply-all.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/reply-from.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/reply-to.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/rescan.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/show.pbmbin81 -> 81 bytes
-rw-r--r--lisp/toolbar/widen.pbmbin81 -> 81 bytes
33 files changed, 4175 insertions, 2588 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index d9c0c2816f0..7546d17fd59 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
12004-07-12 Bill Wohler <wohler@newt.com>
2
3 * NEWS, MH-E-NEWS: Upgraded to MH-E version 7.4.4.
4
12004-07-08 David Kastrup <dak@gnu.org> 52004-07-08 David Kastrup <dak@gnu.org>
2 6
3 * NEWS (Lisp changes in 21.4): document (match-data t) change. 7 * NEWS (Lisp changes in 21.4): document (match-data t) change.
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 8861a10096a..5bea16d91ba 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -1,9 +1,242 @@
1Copyright (C) 2003 Free Software Foundation, Inc. 1* COPYRIGHT
2
3Copyright (C) 2003, 2004 Free Software Foundation, Inc.
2 4
3Copying and distribution of this file, with or without modification, 5Copying and distribution of this file, with or without modification,
4are permitted in any medium without royalty provided the copyright 6are permitted in any medium without royalty provided the copyright
5notice and this notice are preserved. 7notice and this notice are preserved.
6 8
9* Changes in MH-E 7.4.4
10
11Version 7.4.4 addresses programmatic issues from the FSF and prepares
12MH-E for inclusion into an impending GNU Emacs release (21.4). There
13are no user-visible changes (unless you are using XEmacs on DOS or
14don't have the cl package installed). Filenames are now unique in
15their first 8 characters (DOS 8.3 requirement). The runtime dependency
16on the cl package has been removed. Desktop saving and restoration
17code moved here from desktop.el.
18
19* Changes in MH-E 7.4.3
20
21Version 7.4.3 fixes the problem where mh-identity-list was not getting
22set from .emacs.
23
24* Changes in MH-E 7.4.2
25
26Version 7.4.2 fixes the accidental dependence on nmh (closes SF
27#791021).
28
29* Changes in MH-E 7.4.1
30
31Version 7.4.1 fixes the Makefile so it no longer tries to compile
32mh-unit.el.
33
34* Changes in MH-E 7.4
35
36Version 7.4 contains many new useful features including arbitrary MH
37range handling, new draft features such as draft form editing, as well
38as sequence propagation and manipulation. We've also fixed bugs and
39added a handful of new variables.
40
41** New Features in MH-E 7.4
42
43*** Add Arbitrary Ranges to MH-E UI
44
45MH-E now handles any legal MH range (such as last:5 or 4 8 10-12)
46wherever you're prompted for a message number or sequence (closes SF
47#728638).
48
49*** Remove Prompting in mh-send
50
51Brian Reid's original mhe didn't do prompting anywhere but used forms
52instead. While we won't go that far, we eliminated prompting where a
53form is already involved, such as in composing a message.
54
55The new customization variable `mh-compose-prompt-flag' can be set to
56t to get the original behavior (closes SF #745622).
57
58*** Use TAB to Switch Fields in Header
59
60When composing a message, TAB and SHIFT-TAB can be used to move
61quickly between header fields. The new customization variable,
62`mh-compose-skipped-header-fields', contains a list of header fields
63that are skipped and truncated if they are too long (closes SF
64#745627).
65
66*** Alias Completion in Composition Buffer
67
68Aliases can be completed in the draft with "M-TAB
69(mh-letter-complete)". Or, if the customization variable
70`mh-compose-space-does-completion-flag' is set to t, then a "SPC
71(mh-letter-complete-or-space)" with do the same thing. If
72`mh-alias-flash-on-comma' is non-nil, ", (mh-letter-confirm-address)"
73will show the alias expansion in the minibuffer (closes SF #745634).
74
75*** Auto Fields Should be Inserted During Send
76
77Fields that were inserted by the multiple personality code when the
78draft was sent now insert the header fields when the draft is composed
79to give you a chance to edit them (closes SF #747890).
80
81*** mh-index-tick-messages
82
83The command "F ' (mh-index-ticked-messages)" creates a buffer with all
84messages ticked with "' (mh-toggle-tick)" in the folders listed in the
85new customization variable `mh-index-ticked-messages-folders'. Chances
86are that if you set `mh-index-new-messages-folders', you'll want to
87set `mh-index-ticked-messages-folders' accordingly.
88
89In addition, a general function, "F q (mh-index-sequenced-messages)"
90has been provided that displays messages in the `mh-unseen-seq' in the
91folders listed `mh-index-new-messages-folders', unless a prefix
92argument is given, in which case you can provide both a list of
93folders and a sequence (closes SF #718833).
94
95*** Narrow to Region
96
97If there is a region, "/ r (mh-narrow-to-range)" will only consider
98those messages in the region. In addition, there is now a stack of
99folder limits which can be popped with "/ w (mh-widen)". With a prefix
100arg, all the restrictions are popped off of the stack (closes SF
101#732823).
102
103*** Narrow to Ticked Sequence
104
105The buffer can now be narrowed to ticked messages with "S '
106(mh-narrow-to-tick)" (closes SF #732825).
107
108*** Display Multiple Buttons for multipart/alternative
109
110A new customizable variable,
111`mh-display-buttons-for-alternatives-flag', was added to display
112buttons for the alternatives. The default value is nil to retain the
113current behavior (closes SF #741288).
114
115*** Identity Menu Changes
116
117A menu item has been added that inserts custom fields if the To or Cc
118header fields match `mh-auto-fields-list'.
119
120** New Variables in MH-E 7.4
121
122*** mh-alias-local-users-prefix
123
124This string is prepended to the real names of users from the passwd
125file. If nil, use the username string unmodified instead of the real
126name from the gecos field of the passwd file.
127
128*** mh-alias-passwd-gecos-comma-separator-flag
129
130Non-nil means the gecos field in the passwd file uses comma as a
131separator. Used to construct aliases for users in the passwd file."
132
133*** mh-interpret-number-as-range-flag
134
135Non-nil means interpret a number as a range. If the variable is
136non-nil, and you use an integer, N, when asked for a range to scan,
137then MH-E uses the range "last:N".
138
139*** mh-kill-folder-suppress-prompt-hook
140
141This new hook is invoked at the beginning of the `F k
142(mh-kill-folder)' command. It is a list of functions to be called,
143with no arguments, which should return a value of non-nil if you
144should not be asked if you're sure that you want to remove the folder.
145This is useful for folders that are easily regenerated.
146
147The default value of `mh-index-p' suppresses the prompt on folders
148generated by an index search.
149
150WARNING: Use this hook with care. If there is a bug in your hook which
151returns t on +inbox and you hit `F k' by accident in the +inbox
152buffer, you will not be happy.
153
154*** mh-refile-preserves-sequences-flag
155
156Non-nil means that sequences are preserved when messages are refiled.
157If this variable is non-nil and a message belonging to a sequence
158other than cur or Previous-Sequence (see mh-profile 5) is refiled then
159it is put in the same sequence in the destination folder. Additional
160sequences that should not to be preserved can be specified by setting
161`mh-unpropagated-sequences' appropriately.
162
163*** mh-visible-header-fields
164
165Customize this instead of `mh-visible-headers', which is now a defvar.
166This was done to mimic the relationship between
167`mh-invisible-header-fields' and `mh-invisible-fields'.
168
169** Variables Deleted in MH-E 7.4
170
171*** mh-visible-headers
172
173See the paragraph for `mh-visible-header-fields' above.
174
175** Bug Fixes in MH-E 7.4
176
177*** Aliases Constantly Reloaded
178
179The system aliases are not loaded as often as they were, so the
180completion speed has been dramatically improved if your passwd file is
181large (closes SF #693859).
182
183*** Folders in MH-Index View Not Saved
184
185When you perform a search to produce an MH-Index buffer, the folders
186that contain the messages are shown. If the MH-Index buffer was
187deleted, or Emacs was restarted and the corresponding folder
188rescanned, the folder information would be lost. This has been fixed
189by saving the information in a file called ".mhe_index" (closes SF
190#701762).
191
192*** Ticking Messages in +mhe-index/new
193
194If a new message in a buffer created by "F n" was ticked (with "'"),
195the message would not be added to the tick sequence in the source
196folder. This has been fixed so that any sequence changes in any index
197folder (from within MH-E of course) are now reflected back to the
198corresponding source folder (closes SF #709664).
199
200*** Custom Vars Set by a Function
201
202The default setting of customization variable `mh-summary-height' is
203now `nil' which means MH-E will change the size dynamically according
204to the size of the frame (closes SF #723267).
205
206*** Folder Completion Slow
207
208The first folder completion was very slow. This has been fixed (closes
209SF #730426).
210
211*** Tick Sequence Persistent When Refiled
212
213Sequences are now preserved when messages are refiled (closes SF
214#737128).
215
216*** Auto-inserted Header Fields Inconsistent
217
218For consistency, all automatically inserted header fields (such as
219X-Mailer and X-Face) are added when the draft is first presented to
220you. This also gives you a chance to edit or delete them if necessary
221(closes SF #745624). Note that we would be distressed if you deleted
222the X-Mailer field.
223
224*** Toolbar Spec Error
225
226The following message appeared when displaying a message in XEmacs:
227
228 Signaling: (error "Toolbar spec must be list or nil" )
229
230This has been fixed (closes SF #745655).
231
232*** mh-index-search Doesn't Find Short Acronyms
233
234Swish typically ignores words with fewer than four letters, but will
235still look for acronyms. Unfortunately, MH-E was downcasing the input
236words which defeated this feature. This has been fixed (closes SF
237#755718).
238
239
7 240
8* Changes in MH-E 7.3 241* Changes in MH-E 7.3
9 242
diff --git a/etc/NEWS b/etc/NEWS
index de282832241..bc00a408a34 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -649,7 +649,7 @@ You can now put the init files .emacs and .emacs_SHELL under
649 649
650** MH-E changes. 650** MH-E changes.
651 651
652Upgraded to MH-E version 7.3. There have been major changes since 652Upgraded to MH-E version 7.4.4. There have been major changes since
653version 5.0.2; see MH-E-NEWS for details. 653version 5.0.2; see MH-E-NEWS for details.
654 654
655+++ 655+++
diff --git a/lisp/mail/reply2.pbm b/lisp/mail/reply2.pbm
index db7ac527d4d..f48b34be3ae 100644
--- a/lisp/mail/reply2.pbm
+++ b/lisp/mail/reply2.pbm
Binary files differ
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 6eb2c1bc2ec..3d19028b099 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,5 +1,1264 @@
12004-04-26 Lars Hansen <larsh@math.ku.dk> 12004-07-10 Bill Wohler <wohler@newt.com>
2 * mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t. 2
3 * Released MH-E version 7.4.4.
4
5 * MH-E-NEWS, README: Updated for release 7.4.4.
6
7 * mh-e.el (Version, mh-version): Updated for release 7.4.4.
8
9 * This patch release contains the following patches:
10
11 * mh-xemacs.el: New file from concatenation of mh-xemacs-compat.el
12 and mh-xemacs-icons.el which were removed since their names
13 exceeded DOS 8+3 limits.
14
15 * Makefile:
16 (mh-e-autoloads.el): Add target to make `mh-e-autoloads.el', a
17 file containg usual entry commands into MH-E to be used for users
18 installing MH-E separately from Emacs.
19 (XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el
20 in XEmacs.
21 (XEMACS_LOADDEFS_COOKIE): Ditto.
22 (XEMACS_LOADDEFS_PKG_NAME): Ditto.
23 (XEMACS_OPTIONS): Add '-no-autoloads' to give a cleaner build
24 environment.
25 (MH-E-SRC): Moved mh-xemacs.el to new variable MH-E-XEMACS-SRC.
26 (MH-E-XEMACS-SRC): New variable to hold XEmacs source files.
27 (MH-E-XEMACS-OBJ): New variable to hold XEmacs object files.
28 (clean): Moved XEmacs-specific code to clean-xemacs.
29 (xemacs): Added clean-xemacs prerequisite. Moved down to XEmacs
30 section of file. Add target to build mh-loaddefs.el in XEmacs
31 (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs.
32 (clean-xemacs): New target to remove XEmacs-specific files.
33 (compile-xemacs): New. It allows for the '-no-autoloads' option
34 and byte-compiles all the source files with a single instance of
35 XEmacs.
36 (dist): Added $(MH-E-XEMACS-SRC) to tarball.
37 (AUTO_PRELOADS): Removed, in favour of 'AUTOLOAD_PACKAGE_NAME' and
38 'AUTOLOAD_FILE'.
39 (AUTOLOAD_PACKAGE_NAME): New.
40 (AUTOLOAD_FILE): New.
41 (all): Don't set $EMACS_HOME if building with XEmacs.
42 (xemacs): Use 'compile-xemacs' instead of 'compile'.
43 (auto-autoloads.elc): Use new $AUTOLOAD_* vars and allow for
44 '-no-autoloads'.
45 (custom-load.elc): Allow for '-no-autoloads'.
46
47 * mh-e.el: Don't require mh-xemacs-compat which no longer exists.
48 The XEmacs stuff gets required by mh-customize.el which is
49 required by mh-utils.el which is required by mh-e.el. This all
50 happens before mh-xemacs-compat was required, so all should be
51 well.
52 (mh-restore-desktop-buffer): Move from desktop.el. Add Parameters.
53 (mh-restore-desktop-buffer): Delete with-no-warnings.
54 (mh-folder-mode): Bind desktop-save-buffer to t.
55 (Courtesy Lars Hansen).
56
57 * mh-alias.el (mh-assoc-ignore-case): New macro to use
58 assoc-string when available (Emacs 21.4+); assoc-ignore-case
59 otherwise.
60 (mh-alias-reload, mh-alias-expand,
61 mh-alias-minibuffer-confirm-address): Use it.
62
63 * mh-seq.el: Added mh-autoload to mh-read-seq-default.
64
65 * mh-utils.el (mh-require-cl): The Emacs coding conventions
66 require that the cl package not be required at runtime. However,
67 the cl package in versions of Emacs prior to 21.4 left cl routines
68 in their macro expansions. Use mh-require-cl to provide the cl
69 routines in the best way possible.
70 (require 'mouse): To shush compiler.
71
72 * Use new function mh-require-cl throughout.
73
74 * Add arch taglines (courtesy Miles Bader).
75
76 * mh-unit.el (mh-unit-files): Replaced mh-xemacs-compat.el and
77 mh-xemacs-icons.el with mh-xemacs.el.
78
79 * import-emacs: Also grab the ChangeLog.
80
81 * *.pbm: Regenerated using GIMP to be consistent with other Emacs
82 icons.
83 1. Edit .xpm image in GIMP.
84 2. Image > Mode > Indexed. Check Use Black/White Palette and No
85 Color Dithering.
86 3. File > Save As file.xbm.
87 4. Run xbmtopbm < file.xbm > file.pbm.
88 Thanks to jan.h.d@swipnet.se for the help.
89
902003-11-18 Bill Wohler <wohler@newt.com>
91
92 * Released MH-E version 7.4.3.
93
94 * MH-E-NEWS, README: Updated for release 7.4.3.
95
96 * mh-e.el (Version, mh-version): Updated for release 7.4.3.
97
98 * mh-identity.el (mh-identity-make-menu): Removed condition on
99 mh-auto-fields-list. Use it to enable or disable menu item
100 instead.
101
102 * mh-customize.el (mh-identity-list): Removed defvar and moved
103 defcustom before mh-auto-fields-list so that defvar wouldn't
104 clobber user's customization settings.
105
1062003-08-19 Bill Wohler <wohler@newt.com>
107
108 * Released MH-E version 7.4.2.
109
110 * MH-E-NEWS, README: Updated for release 7.4.2.
111
112 * mh-e.el (Version, mh-version): Updated for release 7.4.2.
113
114 * mh-e.el (mh-folder-size, mh-folder-size-folder)
115 (mh-folder-size-flist): If flist is not present use folder to find
116 the number of messages in the folder. Also the .mh_sequences file
117 is read to find the number of unseen messages (patch from 1.349
118 and branched for 7.4.2, closes SF #791021).
119
120 * mh-utils.el (mh-flists-present-flag, mh-find-progs): Introduce a
121 new variable to test for the presence of the flists program and
122 set it in mh-find-progs.
123 (mh-collect-folder-names): Use folders instead of flists. One
124 advantage is that folders is available on MH while flists is not.
125 Another is that if an explicit -sequence argument isn't given and
126 Unseen-Sequence profile is not present then flists croaks while
127 folders doesn't.
128 (mh-collect-folder-names-filter): Don't consider folder names that
129 start with a `.' character. This is needed since the folders
130 command doesn't filter them out like flists does.
131 (patches from 1.307 and 1.309 and branched for 7.4.2, closes SF
132 #791021).
133
1342003-06-25 Bill Wohler <wohler@newt.com>
135
136 * Released MH-E version 7.4.1.
137
138 * MH-E-NEWS, README: Updated for release 7.4.1.
139
140 * mh-e.el (Version, mh-version): Updated for release 7.4.1.
141
1422003-06-25 Bill Wohler <wohler@newt.com>
143
144 * mh-unit.el (require 'cl): Added. Needed when compiling
145 separately.
146
147 * Makefile (clean): Now a double-colon rule. Added a second clean
148 target to remove mh-unit.elc.
149 (compile): Removed mh-unit.elc.
150 (mh-unit.elc): New target used to compile mh-unit.
151
1522003-06-24 Bill Wohler <wohler@newt.com>
153
154 * mh-e.el (Version, mh-version): Set to 7.4+cvs.
155
1562003-06-24 Bill Wohler <wohler@newt.com>
157
158 * Released MH-E version 7.4.
159
160 * MH-E-NEWS, README: Updated for release 7.4.
161
162 * mh-e.el (Version, mh-version): Updated for release 7.4.
163
1642003-06-24 Bill Wohler <wohler@newt.com>
165
166 * mh-alias.el (mh-alias-gecos-name, mh-alias-local-users)
167 (mh-alias-suggest-alias): s/gcos/gecos. The original acronym was
168 GECOS but was later renamed to GCOS (see
169 http://info.astrian.net/jargon/terms/g/GCOS.html). But the term
170 really needs to match the field named pw_gecos in struct passwd in
171 /usr/include/pwd.h
172
173 * mh-customize.el (mh-letter-faces): New group to house
174 mh-letter-header-field-face.
175 (mh-interpret-number-as-range-flag)
176 (mh-kill-folder-suppress-prompt-hook): Use "you" instead of "the
177 user" to make text more friendly.
178 (mh-index-ticked-messages-folders, mh-visible-headers)
179 (mh-visible-header-fields): Alphabetized.
180 (mh-alias-passwd-gcos-comma-separator-flag): Alphabetized and
181 s/gcos/gecos.
182 (mh-alias-local-users-prefix): Fixed docstring. Prefixes are
183 prepended, not appended. Additional checkdoc fix.
184 (mh-letter-header-field-face): Set group to new group
185 mh-letter-faces and moved option into this group.
186
187 * mh-index.el (mh-index-sequenced-messages): Improved wording of
188 docstring and mentioned use of prefix argument.
189
190 * mh-seq.el (mh-widen): Made docstring more accurate (hopefully!).
191
1922003-06-18 Satyaki Das <satyakid@stanford.edu>
193
194 * mh-index.el (mh-replace-string): Modified to preserve case of
195 replacement text.
196 (mh-index-parse-search-regexp): Preserve case of search terms.
197 This is needed to take advantage of the acronym indexing in
198 swish++ (closes SF #755718).
199
2002003-06-13 Satyaki Das <satyakid@stanford.edu>
201
202 * mh-utils.el (mh-show-index-sequenced-messages): Interactive
203 function callable from the show buffer.
204 (mh-show-folder-map): Add key binding for "F q".
205
206 * mh-e.el (mh-folder-map): Same as above.
207
208 * mh-index.el (mh-index-sequenced-messages): Add interactive spec
209 to the function (closes SF #718833).
210
2112003-06-13 Bill Wohler <wohler@newt.com>
212
213 * mh-index.el (mh-flists-execute): Needed to expand mhpath too.
214
2152003-06-12 Satyaki Das <satyakid@stanford.edu>
216
217 * mh-index.el (mh-flists-execute): Modified so that flists
218 present in mh-progs is called.
219
2202003-06-07 Jeffrey C Honig <jch@honig.net>
221
222 * mh-comp.el (mh-forward, mh-forward): Use (mh-mail-header-end) to
223 find the end of headers instead of doing an re-search-forward
224 based on mh-mail-header-separator.
225
2262003-06-06 Satyaki Das <satyakid@stanford.edu>
227
228 * mh-comp.el (mh-letter-toggle-header-field-display): Make the
229 function callable from the show buffer. This means that the
230 buffer is temporarily made writable and the modification status
231 of the buffer restored to the original value.
232
2332003-06-06 Peter S Galbraith <psg@debian.org>
234
235 * mh-utils.el (mh-address-mail-regexp): Bug fix! It wasn't a true
236 copy of the goto-addr variable. My modification only recognized
237 addresses with one dot after the @. Sorry about that.
238
2392003-06-05 Satyaki Das <satyakid@stanford.edu>
240
241 * mh-utils.el (mh-replace-in-string): Move comment into doc
242 string to satisfy checkdoc.
243
244 * mh-alias.el (mh-alias-apropos): Checkdoc fix.
245
2462003-06-05 Bill Wohler <wohler@newt.com>
247
248 * mh-customize.el (mh-identity-list): Fixed typo in docstring.
249
2502003-06-05 Peter S Galbraith <psg@debian.org>
251
252 * mh-comp.el (mh-letter-complete-function-alist): Add bcc an reply-to.
253
2542003-06-04 Peter S Galbraith <psg@debian.org>
255
256 * mh-comp.el (mh-letter-complete-function-alist): Add dcc.
257
2582003-06-03 Peter S Galbraith <psg@debian.org>
259
260 * mh-utils.el (mh-replace-in-string): New function name instead of
261 `dired-replace-in-string'.
262 * mh-alias.el (mh-alias-gcos-name): Use it.
263
264 * mh-alias.el (mh-alias-apropos): New command. Show all aliases
265 that match REGEXP either in name or content.
266
267 * mh-alias.el (mh-alias-suggest-alias): Add no-comma-swap optional
268 arg.
269 (mh-alias-canonicalize-suggestion): Change a comma to a period in
270 created aliases.
271 (mh-alias-local-users): Call `mh-alias-suggest-alias' with
272 `no-comma-swap' arg set to t.
273
274 * mh-alias.el (mh-alias-local-users): Fix case of nil
275 `mh-alias-passwd-gcos-comma-separator-flag'.
276
277 * mh-alias.el (mh-alias-gcos-name): Fix for case of empty gcos
278 name field.
279 (mh-alias-local-users): Fix same.
280
281 * mh-alias.el (mh-alias-canonicalize-suggestion): Replace use by
282 verbose `replace-regexp' by a looped `replace-match'
283
2842003-06-02 Peter S Galbraith <psg@debian.org>
285
286 * mh-utils.el (dired-replace-in-string): Bind if not already
287 defined. Borrowed from dired.el
288
289 * mh-alias.el (mh-alias-gcos-name): switch to using
290 dired-replace-in-string.
291
2922003-06-02 Satyaki Das <satyakid@stanford.edu>
293
294 * mh-utils.el (mh-letter-font-lock-keywords): Fontify header
295 fields in the draft buffer that aren't skipped when navigating
296 with TAB (or S-TAB).
297
298 * mh-customize.el (mh-clean-message-header-flag)
299 (mh-invisible-headers, mh-invisible-header-fields)
300 (mh-alias-passwd-gcos-comma-separator-flag): Checkdoc fix.
301 (mh-letter-header-field-face): New face to fontify the header
302 fields.
303
304 * mh-comp.el (mh-insert-auto-fields-done-local): Checkdoc fix.
305 (mh-letter-mode, mh-letter-mail-header-end-marker): Remember the
306 end of the message header in a marker. This is used to fontify the
307 header fields.
308 (mh-font-lock-field-data, mh-letter-header-end): Functions used
309 to fontify message header fields.
310
311 * mh-alias.el (mh-alias-gcos-name): Checkdoc fix.
312
3132003-06-02 Peter S Galbraith <psg@debian.org>
314
315 * mh-alias.el (mh-alias-gcos-name): New function. Return a usable
316 address string from a GCOS-NAME and USERNAME.
317 (mh-alias-local-users): Use it.
318
319 * mh-customize.el (mh-alias-passwd-gcos-comma-separator-flag): New
320 defcustom. Whether the gcos field in the passwd file uses comma as
321 a separator.
322
323 * mh-customize.el (mh-alias-local-users-prefix): New
324 defcustom. String to append to the real names of users from the
325 passwd file. If nil, use the username string unmodified instead of
326 the real name from the gcos field of the passwd file.
327
328 * mh-alias.el (mh-alias-local-users): Use it to generate aliases
329 which by default are now the real name prefixed by "local."
330
3312003-06-01 Peter S Galbraith <psg@debian.org>
332
333 * mh-comp.el (mh-modify-header-field): Bug fix. Calling with with
334 a value that was already inserted causes it to get inserted a
335 second time. I have wrapped the value around \b word delimiters.
336 Hope there are no side effects for other code.
337
338 * mh-comp.el (mh-insert-auto-fields): Attempt regardless of
339 `mh-insert-auto-fields-done-local' flag in interactive use.
340
341 * mh-comp.el (mh-insert-auto-fields-done-local): Keep track of
342 whether `mh-insert-auto-fields' was called in a buffer.
343 (mh-insert-auto-fields): Set it and use it. Also, don't enter an
344 identity if one was already entered manually.
345 (mh-send-letter): Call `mh-insert-auto-fields' again when sending
346 message.
347 (mh-compose-and-send-mail): Call `mh-insert-auto-fields' _after_
348 `mh-letter-mode' so `mh-identity-local' doesn't get cleared by the
349 mode invocation.
350
3512003-06-01 Satyaki Das <satyakid@stanford.edu>
352
353 * mh-loaddefs.el: Regenerated.
354
355 * mh-seq.el (mh-thread-parse-scan-line): The value of
356 mh-scan-field-from-start-offset was hardcoded in one place. The
357 change fixes that.
358
359 * mh-utils.el (mh-show-mode): Setup mh-show-mode to display
360 elipsis for truncated header fields and to skip over them quickly.
361 (mh-clean-msg-header): Make another pass over the message header
362 fields truncating long headers.
363
364 * mh-comp.el (mh-letter-complete): Remove unnecessary autoload.
365 (mh-letter-toggle-header-field-display): Take into account that
366 an empty line can also end the message header. The function was
367 originally written with the draft buffer in mind.
368
3692003-06-01 Mark D. Baushke <mdb@gnu.org>
370
371 * mh-comp.el (mh-letter-mode-map): Do not steal C-t. Use C-c C-t
372 for the mh-letter-toggle-header-field-display command.
373
3742003-05-31 Peter S Galbraith <psg@debian.org>
375
376 * mh-customize.el (mh-visible-headers): Changed to a defvar that
377 will be set using new `mh-visible-headers' function using
378 `mh-visible-header-fields' as input.
379 (mh-visible-headers): New function, described above.
380 (mh-visible-header-fields): New defcustom. The UI to set
381 `mh-visible-headers'.
382 (mh-invisible-header-fields-set): Deleted. Code merged into
383 defcustom since it's so short.
384
3852003-05-31 Satyaki Das <satyakid@stanford.edu>
386
387 * mh-comp.el (mh-letter-toggle-header-field-display): Extended to
388 truncate headers if they are too long.
389 (mh-letter-truncate-header-field): Make code that would be
390 duplicated into a function.
391 (mh-letter-hide-all-skipped-fields): Modified so that fields that
392 are important are hidden if they are too long.
393
3942003-05-31 Satyaki Das <satyakid@stanford.edu>
395
396 * mh-utils.el ("tool-bar"): Since tool-bar isn't available on
397 XEmacs, requiring it causes problems. So load it instead.
398 (mh-do-at-event-location): New macro to do stuff at location of
399 events. This has been refactored out of mh-push-button.
400
401 * mh-mime.el (mh-push-button): Simplified since it now uses the
402 mh-do-at-event-location macro.
403
404 * mh-comp.el (mh-hidden-header-keymap): Keymap to make mouse
405 clicks on header toggle its display.
406 (mh-letter-toggle-header-field-display-button): Interactive
407 function to toggle header display when mouse button is clicked.
408
4092003-05-31 Peter S Galbraith <psg@debian.org>
410
411 * mh-e.el (mh-folder-mode): Remove conditional on tool-bar-mode.
412
413 * mh-comp.el (mh-letter-mode): Same.
414
415 * mh-utils.el (mh-show-mode): Same.
416
4172003-05-30 Satyaki Das <satyakid@stanford.edu>
418
419 * mh-utils.el (tool-bar): Load tool-bar explicitly. This avoids
420 problems with incorrect initialization of tool-bar-map otherwise.
421
4222003-05-30 Peter S Galbraith <psg@mixed.dyndns.org>
423
424 * mh-comp.el (mh-modify-header-field): Minor fix of spaces for
425 when an entry already existed.
426 (mh-insert-auto-fields): Make interactive. Add optional `quiet'
427 arg for use when called systematically on every buffer. Won't be
428 used interactively for more verbose output.
429 (mh-letter-mode-map): Add \C-c\M-d keybinding for
430 mh-insert-auto-fields.
431
432 * mh-identity.el (mh-identity-make-menu): Add a menu entry in
433 Identity menu for mh-insert-auto-fields.
434
435 * mh-customize.el (mh-invisible-header-fields): Add entries for
436 `Envelope-to' and `X-Original-To'.
437
4382003-05-30 Satyaki Das <satyakid@stanford.edu>
439
440 * mh-comp.el (mh-letter-mode): Skip over invisible text quickly.
441
4422003-05-30 Satyaki Das <satyakid@stanford.edu>
443
444 * mh-comp.el (mh-letter-mode): Use text properties to achieve
445 invisibility. This is more portable and the same code can be used
446 for all Emacs versions.
447 (mh-letter-toggle-header-field-display): Rewritten to use text
448 properties.
449 (mh-dead-overlay-p, mh-letter-hidden-header-fields)): Removed.
450
4512003-05-29 Satyaki Das <satyakid@stanford.edu>
452
453 * mh-comp.el (mh-letter-hidden-header-fields, mh-letter-mode): Add
454 a hash table, initialized it in mh-letter-mode, to remember the
455 overlays introduced to hide long headers fields.
456 (mh-insert-x-mailer): checkdoc fix.
457 (mh-compose-and-send-mail): Hide unimportant message header
458 fields.
459 (mh-letter-header-field-regexp, mh-letter-header-field-at-point)
460 (mh-letter-next-header-field, mh-letter-previous-header-field):
461 Add a variable that contains the header-field name regexp and use
462 it instead of the regexp directly.
463 (mh-letter-toggle-header-field-display, mh-letter-mode-map): Add
464 new key binding in mh-letter-mode that toggles display of long
465 header fields, in mh-letter-mode.
466 (mh-dead-overlay-p): A predicate which checks if a given header
467 field has an active overlay hiding it.
468 (mh-letter-hide-all-skipped-fields): New function that shortens
469 uninteresting headers.
470
4712003-05-29 Eric Ding <ericding@acorn.bethesda.net>
472
473 * mh-comp.el (mh-letter-next-header-field-or-indent): Call
474 indent-relative rather than indent-for-tab-command.
475
4762003-05-29 Satyaki Das <satyakid@stanford.edu>
477
478 * mh-comp.el (mh-letter-complete-or-space): The meaning of the
479 customizable variable was reversed. Also make the doc string more
480 accurate.
481
4822003-05-28 Satyaki Das <satyakid@stanford.edu>
483
484 * mh-customize.el (mh-compose-skipped-header-fields): New
485 customizable variable that lists headers that are skipped.
486 (mh-compose-space-does-completion-flag): Option to do completion
487 with space (closes SF #745634).
488
489 * mh-comp.el (mh-insert-x-mailer): Check the value of
490 mh-insert-x-mailer-flag in this function instead of in its caller.
491 (mh-compose-and-send-mail, mh-send-letter): Insert X-Mailer and
492 X-Face headers when the draft is first presented to the user
493 instead of when the mail is sent (closes SF #745624).
494 (mh-letter-complete-or-space): Allow for this key binding to be
495 overridden.
496 (mh-letter-next-header-field): Fix a problem with multiline header
497 fields.
498 (mh-letter-next-header-field, mh-letter-previous-header-field):
499 Make these functions skip unwanted header fields.
500 (mh-letter-skipped-header-field-p): New predicate that checks if a
501 header field is to be skipped.
502
503 * mh-seq.el (mh-thread-inc): Inc'ing email in threaded mode was
504 causing duplication of the current notation. The change fixes that.
505
5062003-05-28 Satyaki Das <satyakid@stanford.edu>
507
508 * mh-comp.el (mh-beginning-of-word): Generalize it to skip
509 arbitrary number of words.
510 (mh-letter-complete-or-space): New interactive function that
511 allows space character to be used for completion.
512 (mh-letter-mode-map): Add key binding to allow space to be used
513 for completion.
514
5152003-05-27 Satyaki Das <satyakid@stanford.edu>
516
517 * mh-customize.el (mh-compose-prompt-flag): Customizable variable
518 that controls whether the user is prompted when composing a draft.
519 It replaces mh-dont-prompt-for-address-flag (closes SF #745622).
520
521 * mh-comp.el (mh-letter-next-header-field): If the point is in
522 the header field name, then go the start of the header field
523 instead of the next field.
524 (mh-interactive-read-address, mh-interactive-read-string)
525 (mh-letter-adjust-point): Use mh-compose-prompt-flag instead of
526 mh-dont-prompt-for-address-flag.
527
5282003-05-27 Satyaki Das <satyakid@stanford.edu>
529
530 * mh-customize.el (mh-tool-bar-define): Fix incorrect usage of
531 set-specifier (closes SF #745655). Also the button enabling code
532 interacts poorly with font-lock in XEmacs. So disable that.
533
5342003-05-26 Satyaki Das <satyakid@stanford.edu>
535
536 * mh-e.el (mh-folder-from-address): The function
537 message-fetch-field expects that the buffer is narrowed to the
538 mail header. The change makes sure that this is indeed the case.
539
540 * mh-mime.el (mh-add-missing-mime-version-header)
541 (mh-decode-message-body): Same as above.
542
5432003-05-25 Satyaki Das <satyakid@stanford.edu>
544
545 * mh-alias.el (mh-alias-minibuffer-confirm-address): Modified to
546 use mh-beginning-of-word.
547
548 * mh-comp.el (mh-letter-confirm-address): Calling
549 mh-alias-reload-maybe can be expensive. So do it only if we really
550 need to.
551
5522003-05-25 Satyaki Das <satyakid@stanford.edu>
553
554 * mh-loaddefs.el: Regenerated.
555
556 * mh-comp.el (mh-letter-confirm-address): Load aliases if not yet
557 loaded.
558
559 * mh-alias.el (mh-alias-reload-maybe): Autoload it since it is
560 used in mh-comp.el.
561
5622003-05-24 Satyaki Das <satyakid@stanford.edu>
563
564 * mh-comp.el (mh-letter-skip-leading-whitespace-in-header-field):
565 New function to skip leading space and tab characters when placing
566 point in a header field.
567 (mh-letter-next-header-field, mh-letter-previous-header-field):
568 Skip leading whitespace when using TAB to navigate to header
569 fields.
570 (mh-letter-confirm-address): New interactive function that
571 displays the last expansion of the last alias when "," is typed.
572 (mh-letter-mode-map): Add key binding for "," (closes SF #745634).
573
5742003-05-23 Satyaki Das <satyakid@stanford.edu>
575
576 * mh-comp.el (mh-edit-again, mh-forward, mh-send)
577 (mh-send-other-window, mh-send-sub): Modified so that if
578 mh-dont-prompt-for-address-flag is non-nil, then MH-E won't prompt
579 for addresses to send mail to and instead directly jump to the
580 draft (closes SF #745622).
581 (mh-letter-complete-function-alist): An alist that is used to
582 decide which completion function to use in which header. This
583 variable should probably be customizable.
584 (mh-letter-complete): Now uses mh-letter-complete-function-alist.
585 (mh-letter-header-field-at-point, mh-letter-next-header-field)
586 (mh-letter-next-header-field-or-indent)
587 (mh-letter-previous-header-field): Commands for easier navigation
588 to header fields.
589 (mh-dont-prompt-for-address-flag): Variable which controls
590 whether MH-E prompts for addresses.
591 (mh-interactive-read-address, mh-interactive-read-string): Two
592 functions to ask user for input depending on the value of the
593 above flag.
594 (mh-letter-adjust-point): New function that sets point to the
595 first header field.
596 (mh-letter-mode-map): Add key bindings for TAB and S-TAB (closes
597 SF #745627).
598
5992003-05-23 Satyaki Das <satyakid@stanford.edu>
600
601 * mh-loaddefs.el: Regenerated.
602
603 * mh-comp.el (mh-complete-word): New function which is
604 approximately equivalent to mail-abbrev-complete-alias.
605 (mh-beginning-of-word): Refactor repeated code into its own
606 function.
607 (mh-folder-expand-at-point): Make Fcc completion work in XEmacs
608 by not using mail-abbrev-complete-alias.
609
610 * mh-alias.el (mh-alias-letter-expand-alias): Make alias
611 expansion work in XEmacs. Replace the use of the function
612 mail-abbrev-complete-alias, which isn't present in XEmacs.
613
614 * mh-mime.el (mh-mml-to-mime): If a MIME message is created
615 immediately after starting MH-E then invoking mh-mml-to-mime
616 causes an error because "message" isn't being loaded. The change
617 works around this problem.
618 (mh-mime-maybe-display-alternatives): Give better indication of
619 which MIME parts are alternatives.
620
6212003-05-22 Satyaki Das <satyakid@stanford.edu>
622
623 * mh-e.el (mh-add-sequence-notation, mh-remove-sequence-notation):
624 Just delete and add the same character in the scan line to make
625 font-lock refontify it. The previous trick of removing all text
626 properties didn't work in XEmacs.
627
628 * mh-seq.el (mh-put-msg-in-seq): Complain if the user tries to
629 create an invalid MH sequence.
630
631 * mh-mime.el (mh-mime-display-alternative): Modified to
632 optionally display alternatives as buttons.
633 (mh-mime-maybe-display-alternatives): New function which displays
634 alternative MIME parts as buttons.
635 (mh-mime-save-part): Initially mh-mime-save-parts-directory is
636 nil and calling file-name-as-directory with nil arg leads to an
637 error. So fall back on the default-directory in that case.
638
639 * mh-customize.el (mh-display-buttons-for-alternatives-flag): New
640 customizable variable that controls display of the alternative
641 MIME parts (closes SF #741288).
642
6432003-05-22 Peter S Galbraith <psg@debian.org>
644
645 * mh-customize.el (mh-invisible-header-fields): Commented out
646 "User-Agent:". It's similar to X-Mailer, so display it.
647
6482003-05-21 Satyaki Das <satyakid@stanford.edu>
649
650 * mh-customize.el (mh-tool-bar-define): Add an optional argument
651 to the button description that can dynamically enable/disable
652 buttons.
653 (mh-tool-bar-define): The alias grabbing button is disabled if the
654 current message doesn't have a From header or if the sender is
655 already in the user's alias. This functionality was inadvertently
656 lost when the Emacs/XEmacs toolbar unification took place.
657
6582003-05-20 Satyaki Das <satyakid@stanford.edu>
659
660 * mh-unit.el (mh-unit-construct-call-graph): Be more aggressive
661 and flag interactive functions that aren't autoloaded or have no
662 key bindings.
663 (mh-unit-interactive-function-p): Remove now unused function.
664 (mh-unit, mh-unit-construct-call-graph): Replace mh-files with
665 mh-unit-files.
666
6672003-05-20 Bill Wohler <wohler@newt.com>
668
669 * mh-unit.el (mh-prune-trailing-spaces): Renamed to
670 mh-unit-prune-trailing-spaces to clean up the namespace.
671 (mh-files): Renamed to mh-unit-files. Ditto.
672 (mh-unit): Checkdoc fix.
673
674 * mh-index.el (mh-index-p): Added autoload cookie since mh-index-p
675 is used by mh-customize.el. This calls for another mh-unit test
676 that looks for mh-autoloads for functions that are no longer used
677 in other files.
678
679 * mh-loaddefs.el: Regenerated.
680
6812003-05-20 Satyaki Das <satyakid@stanford.edu>
682
683 * mh-unit.el (mh-unit-construct-call-graph): Factor out the code
684 to read the lisp files to a separate function. Also change it to
685 construct a function call-graph. Autoloaded functions are taken
686 into account.
687 (mh-unit-find-all-used-functions, mh-unit-called-functions)
688 (mh-unit-find-all-unused-functions): Find all unused functions by
689 computing a fixed point starting from the set of top level
690 functions.
691 (mh-unit-analyze-block): Removed.
692 (mh-unit-update-call-graph): mh-unit-functions-called was renamed
693 with modifications to update the function call graph.
694
6952003-05-19 Satyaki Das <satyakid@stanford.edu>
696
697 * mh-loaddefs.el: Regenerated.
698
699 * mh-utils.el (mh-notate): Modified to keep track of notation
700 that was replaced when sequence notation is added. Thus when the
701 sequence is deleted, the original notation is recovered.
702 (mh-add-msgs-to-seq): Modified to work with the new sequence
703 notation code.
704
705 * mh-seq.el (mh-delete-seq, mh-put-msg-in-seq): Simplified since
706 we don't need to handle tick and unseen sequences specially any
707 more.
708 (mh-narrow-to-seq): Don't need to call mh-notate-user-sequences
709 since mh-copy-seq-to-eob already does that.
710 (mh-widen): Remove sequence notation, so that notation when
711 messages are replied to aren't lost.
712 (mh-copy-seq-to-eob): Simplified with the use of
713 mh-iterate-on-range.
714 (mh-thread-inc): This function doesn't need to notate user
715 sequences since its callers already do that.
716 (mh-thread-parse-scan-line): Simplified since mh-note-seq doesn't
717 appear in scan lines it is given as arguments.
718 (mh-thread-update-scan-line-map): Remove the test, since its
719 caller already does the required check.
720 (mh-thread-folder): Simplified by the use of mh-iterate-on-range.
721 (mh-tick-add-overlay, mh-tick-remove-overlay, mh-notate-tick):
722 These functions aren't needed any more, since overlays aren't used
723 any more. Also overlays aren't portable to XEmacs, so nasty
724 conditional code that used overlays in Emacs and extents in Xemacs
725 have been eliminated.
726 (mh-toggle-tick): Generalize it to work on a range of messages
727 like the other interactive messages.
728
729 * mh-funcs.el (mh-undo-folder): Use mh-remove-all-notation
730 instead of mh-unmark-all-headers.
731
732 * mh-e.el (mh-folder-font-lock-keywords): The entry for unseen
733 sequence highlighting is now done by the macro.
734 (mh-generate-sequence-font-lock): New macro to highlight any
735 arbitrary sequence. This macro is invoked twice to get the
736 highlighting for unseen and tick sequences.
737 (mh-sequence-notation-history, mh-folder-mode): New variable that
738 keeps track of the old notation when a message is notated with
739 mh-note-seq.
740 (mh-regenerate-headers, mh-get-new-mail): Add appropriate calls to
741 mh-notate-user-sequences and mh-remove-all-notation.
742 (mh-unmark-all-headers): Add comment that this function shouldn't
743 be used any more.
744 (mh-add-sequence-notation, mh-remove-sequence-notation): New
745 functions to notate message with mh-note-seq and to remove it.
746 (mh-remove-all-notation): Simplified to use mh-iterate-on-range.
747 (mh-process-commands): Use mh-remove-all-notation instead of
748 mh-unmark-all-headers.
749 (mh-notate-user-sequences, mh-delete-msg-from-seq): Simplified
750 since the tick and unseen sequences don't need special handling
751 any more.
752 (mh-internal-seq): Make it possible to dynamically change what
753 sequences are treated as internal (internal means font lock is
754 used to highlight the sequence).
755 (mh-clear-text-properties): Removed since it isn't needed
756 anymore.
757
7582003-05-19 Satyaki Das <satyakid@stanford.edu>
759
760 * mh-unit.el (mh-unit-analyze-block, mh-unit-interactive-function-p)
761 (mh-unit-find-all-unused-functions): Change argument name bl to
762 block.
763
7642003-05-19 Satyaki Das <satyakid@stanford.edu>
765
766 * mh-unit.el (mh-unit-find-all-unused-functions): New interactive
767 function to find all unused functions in MH-E.
768 (mh-unit-analyze-block, mh-unit-interactive-function-p)
769 (mh-unit-functions-called): Functions used by
770 mh-unit-find-all-unused-functions do its job.
771
772 * Makefile (compile): Byte-compile mh-unit.el, since the analysis
773 to find unused code runs faster when compiled.
774
7752003-05-18 Satyaki Das <satyakid@stanford.edu>
776
777 * mh-loaddefs.el: Regenerated.
778
779 * mh-seq.el (mh-notate-deleted-and-refiled): Add autoload
780 declaration since this function is used in mh-index.el.
781
782 * mh-e.el, mh-customize.el, mh-utils.el: Adjust require/provide
783 statements so that mh-e.el isn't loaded twice.
784
7852003-05-15 Satyaki Das <satyakid@stanford.edu>
786
787 * mh-utils.el (mh-defun-show-buffer): Arrange for the current
788 line in the folder buffer to be highlighted even when we are in
789 the show buffer.
790
7912003-05-14 Satyaki Das <satyakid@stanford.edu>
792
793 * mh-seq.el (mh-read-range): Allow this to work on invalid
794 sequences that only MH-E knows about.
795
796 * mh-index.el (mh-create-sequence-map, mh-index-add-to-sequence)
797 (mh-index-delete-from-sequence): Don't consider sequences that
798 aren't valid MH sequences.
799
800 * mh-e.el (mh-valid-seq-p): New predicate to check if a symbol
801 could be a MH sequence.
802 (mh-undefine-sequence, mh-define-sequence): Don't execute "mark"
803 unless the sequence name is a valid MH sequence.
804
805 * mh-utils.el (mh-exec-cmd): In case an error happens in the
806 call-process and non-strings are present in ARGS, then the error
807 message isn't properly displayed. The change fixes this.
808
8092003-05-14 Peter S Galbraith <psg@debian.org>
810
811 * mh-mime.el (mh-mime-save-part): Bug Fix: Make sure
812 `mm-default-directory' gets a trailing "/" if
813 `mh-mime-save-parts-directory' doesn't have one. Otherwise the
814 default in the prompt of `mh-mm-save-part' will be wrong. Perhaps
815 `mh-mm-save-part' needs to do this check itself.
816
8172003-05-14 Satyaki Das <satyakid@stanford.edu>
818
819 * mh-index.el (mh-unpropagated-sequences): New function and
820 variable to keep track of sequences that shouldn't be propagated.
821 (mh-create-sequence-map, mh-index-add-to-sequence)
822 (mh-index-delete-from-sequence): Use mh-unpropagated-sequences to
823 stop changes to some sequences being reflected back to the source
824 folders.
825
8262003-05-13 Satyaki Das <satyakid@stanford.edu>
827
828 * mh-loaddefs.el: Regenerated.
829
830 * mh-e.el (mh-process-commands): Preserve sequences when messages
831 are refiled (closes SF #737128).
832
833 * mh-index.el (mh-create-sequence-map)
834 (mh-index-create-sequences): Refactor code that is reused into a
835 new function.
836
837 * mh-customize.el (mh-refile-preserves-sequences-flag): New
838 customizable flag that controls whether sequences are preserved
839 when messages are refiled.
840
8412003-05-13 Eric Ding <ericding@alum.mit.edu>
842
843 * mh-e.el (mh-scan-format): The argument for scan format files
844 should be -form, not -format.
845
8462003-05-13 Satyaki Das <satyakid@stanford.edu>
847
848 * mh-seq.el (mh-widen): The scan line map stack was not being
849 properly updated when ALL-FLAG is non-nil. The change fixes that.
850
851 * mh-e.el (mh-reset-threads-and-narrowing): The change resets the
852 scan line map stack.
853
8542003-05-12 Satyaki Das <satyakid@stanford.edu>
855
856 * mh-loaddefs.el: Regenerated.
857
858 * mh-seq.el (mh-thread-scan-line-map-stack)
859 (mh-thread-old-scan-line-map): Instead of the old scan line map,
860 now we need to maintain a stack of scan line maps.
861 (mh-narrow-to-seq): Modified so that multiple level of narrowings
862 can be done. We now maintain a stack of old views instead of
863 hiding the old scan lines. This makes it possible to have
864 multiple levels of narrowings.
865 (mh-widen): A optional prefix arg was added to allow undoing all
866 narrowing.
867 (mh-read-seq-default, mh-read-range): Don't use
868 mh-narrowed-to-seq, since it doesn't exist any more.
869 (mh-thread-initialize-hash, mh-thread-initialize): The
870 mh-thread-initialize function has been refactored.
871 (mh-thread-update-scan-line-map): Maintain notations in the stack
872 of scan line maps.
873 (mh-notate-tick, mh-toggle-tick): Simplified, since we don't have
874 mh-narrowed-to-seq any more. This means there is a slight loss of
875 functionality. Earlier if we narrowed to the tick sequence the
876 ticked messages weren't highlighted. This feature isn't present
877 any more.
878
879 * mh-e.el (mh-execute-commands, mh-reset-threads-and-narrowing)
880 (mh-folder-sequence-menu, mh-get-new-mail): Use
881 mh-folder-view-stack instead of the now removed
882 mh-narrowed-to-seq.
883 (mh-narrowed-to-seq, mh-tick-seq-changed-when-narrowed-flag):
884 These variables have been removed.
885 (mh-folder-view-stack): New variable to keep track of a stack of
886 narrowings.
887 (mh-execute-commands, mh-get-new-mail): Add extra argument to
888 mh-widen so that all narrowings are undone.
889
890 * Makefile (MH-E-SRC, MH-E-OTHERS): Move mh-gnus.el from MH-E-SRC
891 to MH-E-OTHERS so that it isn't byte compiled.
892
8932003-05-10 Satyaki Das <satyakid@stanford.edu>
894
895 * mh-seq.el (mh-read-seq): Improve the function a bit by adding
896 history to the sequence prompt.
897
8982003-05-09 Satyaki Das <satyakid@stanford.edu>
899
900 * mh-gnus.el: New file that won't be byte-compiled. From now on
901 having different Gnus versions at run-time and compile-time won't
902 cause errors in MH-E.
903
904 * mh-mime.el (mh-small-show-buffer-p, mh-display-smileys)
905 (mh-display-emphasis): Handle all legal values of
906 font-lock-maximum-size. The existing code assumed didn't consider
907 the case where it could be an alist.
908 (mh-small-image-p): Simplified, so that aliasing XEmacs functions
909 in Emacs isn't necessary any more.
910 (mh-mm-display-part): Remove unnecessary call to fboundp. The
911 mh-funcall-if-exists does that for us any way.
912 (mh-defun-compat, gnus-local-map-property, mm-merge-handles)
913 (mm-set-handle-multipart-parameter, mm-readable-p)
914 (mm-long-lines-p, mm-keep-viewer-alive-p, mm-destroy-parts)
915 (mh-mm-save-part, mm-handle-multipart-ctl-parameter): These
916 compatibility functions have been moved to mh-gnus.el.
917
918 * Makefile (MH-E-SRC): Add mh-gnus.el.
919
920 * mh-seq.el (mh-narrow-to-header-field)
921 (mh-current-message-header-field): Checkdoc fixes.
922
923 * mh-e.el (mh-undefine-sequence): Since mh-coalesce-msg-list
924 returns a list, apply is needed.
925
9262003-05-09 Noel Cragg <noel@red-bean.com> (tiny change)
927
928 * mh-junk.el (mh-spamassassin-blacklist): Separate "--local" and
929 "--no-rebuild" arguments to call-process.
930 [Patch committed by satyaki]
931
9322003-05-08 Satyaki Das <satyakid@stanford.edu>
933
934 * mh-seq.el (mh-translate-range): Take into account differnt
935 semantics of split-string in Emacs and XEmacs.
936 (mh-read-pick-regexp, mh-narrow-to-from, mh-narrow-to-cc)
937 (mh-narrow-to-to, mh-narrow-to-header-field)
938 (mh-current-message-header-field, mh-narrow-to-range): New
939 narrowing functions that can select messages based on different
940 message headers.
941
942 * mh-utils.el (mh-show-limit-map): Add new narrowing functions
943 callable from the show buffer.
944
945 * mh-e.el (mh-help-messages): Add help text for new functions.
946 (mh-limit-map): Add new narrowing functions (closes SF #732823).
947
9482003-05-07 Satyaki Das <satyakid@stanford.edu>
949
950 * mh-utils.el (mh-collect-folder-names): Use mh-exec-daemon to
951 run flists. This means we don't have to remember to expand the MH
952 executable in the mh-progs path.
953 (mh-exec-cmd-daemon): Return the new process object produced.
954
9552003-05-06 Satyaki Das <satyakid@stanford.edu>
956
957 * mh-e.el (mh-folder-font-lock-unseen): Use mh-seq-list to do
958 unseen sequence highlighting instead of reading the .mh_sequences
959 file from disk every time.
960
9612003-05-05 Satyaki Das <satyakid@stanford.edu>
962
963 * mh-utils.el (mh-show-sequence-map): Add key binding for S'
964 (closes SF #732825).
965
966 * mh-e.el (mh-sequence-map): Ditto.
967 (mh-help-messages): Updated for S'.
968
9692003-05-04 Satyaki Das <satyakid@stanford.edu>
970
971 * mh-index.el (mh-index-write-data): The with-temp-buffer macro
972 is a bit better than write-file, so use that instead.
973
9742003-05-03 Satyaki Das <satyakid@stanford.edu>
975
976 * mh-index.el (mh-index-update-maps, mh-index-search)
977 (mh-index-sequenced-messages): Write index data to disk. This
978 allows us to recover index folder information if Emacs is
979 restarted, or the index folder is visited after the buffer has
980 been killed (closes SF #701762).
981 (mh-index-write-data, mh-index-read-data)
982 (mh-index-write-hashtable, mh-index-read-hashtable): Functions to
983 store and read index data information to disk.
984 (mh-index-insert-folder-headers, mh-index-group-by-folder): We
985 can no longer use object identity to compare strings, since they
986 might have been read back from disk.
987
988 * mh-e.el (mh-index-data-file): New variable that stores the name
989 of the file that keeps track of index folder data.
990 (mh-make-folder): Read index folder data if available.
991
992 * mh-utils.el (mh-show, mh-summary-height, mh-modify): Make
993 checkdoc happy.
994
995 * mh-seq.el (mh-tick-add-overlay): Rearrange code to make code
996 more uniform.
997
998 * mh-loaddefs.el: Regenerated.
999
10002003-05-02 Satyaki Das <satyakid@stanford.edu>
1001
1002 * mh-seq.el (mh-tick-add-overlay): If a message with a short scan
1003 line is ticked, then the highlighting didn't extend to the right
1004 margin. This change fixes that.
1005
10062003-05-01 Bill Wohler <wohler@newt.com>
1007
1008 * mh-e.el (mh-help-messages): Added brackets around / and
1009 downcased limit to be consistent with other commands with
1010 punctuation keybindings. Don't document aliases.
1011
10122003-05-01 Satyaki Das <satyakid@stanford.edu>
1013
1014 * mh-loaddefs.el: Regenerated.
1015
1016 * mh-seq.el (mh-read-range): Fix comment.
1017
10182003-04-30 Mark D. Baushke <mdb@gnu.org>
1019
1020 * mh-e.el (mh-help-messages): Better documentation for the F map.
1021
10222003-04-30 Satyaki Das <satyakid@stanford.edu>
1023
1024 * mh-utils.el (mh-find-path): Cache folder names so that
1025 folder name completion is always fast.
1026 (mh-flists-partial-line, mh-flists-process): Variables used for
1027 pre-caching folder names.
1028 (mh-collect-folder-names, mh-collect-folder-names-filter)
1029 (mh-populate-sub-folders-cache): Functions to pre-cache folder
1030 names.
1031 (mh-exec-cmd): Produce more info in *MH-E Log*.
1032
1033 * mh-index.el (mh-index-search): Call the correct function.
1034 (mh-index-sequenced-messages): If folders is nil, then all mail
1035 is searched. The change restores that.
1036
10372003-04-30 Peter S Galbraith <psg@debian.org>
1038
1039 * mh-customize.el (mh-summary-height): Move variable integer out
1040 of defcustom, and instead specify that `nil' means to calculate
1041 that size dynamically. Fixes SF #723267.
1042
1043 * mh-utils.el (mh-summary-height): New function. Return ideal
1044 mh-summary-height value for current frame height.
1045 (mh-show-msg): Use it.
1046
10472003-04-30 Mark D. Baushke <mdb@gnu.org>
1048
1049 * mh-index.el (mh-index-ticked-messages): Fix prompt and
1050 description string.
1051 (mh-index-new-messages): Ditto.
1052
1053 * mh-loaddefs.el: Regenerated.
1054
1055 * mh-index.el (mh-index-sequenced-messages): Renamed from
1056 mh-index-new-messages with minor argument change.
1057 (mh-index-new-messages): Implement by calling
1058 mh-index-sequenced-messages with the appropriate arguments.
1059 (mh-index-ticked-messages): New function. Does the same thing as
1060 mh-index-new-messages, but on its own set of folders and using the
1061 mh-tick-seq instead of mh-unseen-seq.
1062
1063 * mh-e.el (mh-folder-map): Add "F'" to the map for
1064 mh-index-ticked-messages.
1065 (mh-help-messages): Replace broken [t]hread with [n]ew messages.
1066
1067 * mh-customize.el (mh-index-ticked-messages-folders): New user
1068 customizable flag that controls the folders to be searched by
1069 mh-index-ticked-messages.
1070
1071 * mh-utils.el (mh-show-index-ticked-messages): Wrapper for
1072 mh-index-ticked-messages.
1073 (mh-show-folder-map): Add "F'" to the map for
1074 mh-index-ticked-messages.
1075
10762003-04-30 Satyaki Das <satyakid@stanford.edu>
1077
1078 * mh-index.el (mh-index-search): The old cur in the source folder
1079 might not exist. This could cause mh-exec-cmd to fail. So don't
1080 add an error message in that case.
1081
10822003-04-29 Satyaki Das <satyakid@stanford.edu>
1083
1084 * mh-e.el (mh-folder-from-address): Modified to allow multiple
1085 Cc: headers to work properly.
1086 (mh-inc-folder, mh-visit-folder): Fix an off by one error.
1087
1088 * mh-utils.el (mh-notate): Update the scan line map. This fixes a
1089 tiny bug. In threaded view, if a message is replied to then the
1090 message is notated with a "-". Now if inc is done then the "-"
1091 added is lost. The change fixes this.
1092
1093 * mh-seq.el (mh-translate-range): Use the correct function.
1094 (mh-thread-update-scan-line-map): New function that updates the
1095 scan line map when a message is notated.
1096
10972003-04-28 Satyaki Das <satyakid@stanford.edu>
1098
1099 * mh-index.el (mh-index-parse-search-regexp): Avoid compiler
1100 warning in GNU Emacs 21.3.
1101
1102 * mh-seq.el (mh-widen): Ditto.
1103
11042003-04-28 Satyaki Das <satyakid@stanford.edu>
1105
1106 * mh-customize.el (mh-interpret-number-as-range-flag): New user
1107 customizable flag that controls whether a single number, N is
1108 interpreted as the range last:N.
1109
1110 * mh-seq.el (mh-read-range): Generalize it for use when reading
1111 range to scan.
1112 (mh-interactive-range): Modified to use the new mh-read-range.
1113
1114 * mh-speed.el (mh-speed-view): Use mh-read-range instead of the
1115 now removed mh-read-msg-range function.
1116
1117 * mh-funcs.el (mh-pack-folder): Ditto.
1118
1119 * mh-e.el (mh-rescan-folder, mh-visit-folder): Ditto.
1120 (mh-read-msg-range): Removed.
1121
1122 * mh-loaddefs.el: Regenerated
1123
11242003-04-27 Satyaki Das <satyakid@stanford.edu>
1125
1126 * mh-loaddefs.el: Regenerated.
1127
1128 * mh-seq.el (mh-range-completion-function): Fix checkdoc warning.
1129 (mh-iterate-on-range): Mention that the macro can iterate over a
1130 MH message range too.
1131
11322003-04-27 Bill Wohler <wohler@newt.com>
1133
1134 * mh-unit.el (mh-unit): As it turns out, lm-crack-copyright has
1135 been updated to handle multiple-line copyrights in 21.3, so
1136 updated code to run lm-verify only if user has 21.3 or greater.
1137 Delete buffers after use, unless user already had buffer open.
1138
11392003-04-27 Satyaki Das <satyakid@stanford.edu>
1140
1141 * mh-loaddefs.el: Regenerated.
1142
1143 * mh-index.el (mh-index-search): The MH command "refile" changes
1144 cur. The change restores cur in source folders.
1145 (mh-index-new-messages): Use the appropriate arguments for
1146 mh-read-seq.
1147
1148 * mh-seq.el (mh-read-seq-default, mh-read-seq): Restore these
1149 functions to just read sequence names.
1150 (mh-range-seq-names, mh-range-history, mh-range-completion-map)
1151 (mh-range-completion-function, mh-read-range): New function which
1152 reads MH range with completion and history.
1153 (mh-interactive-range): Use mh-read-range instead of
1154 mh-read-seq-default.
1155 (mh-put-msg-in-seq): Change documentation about MH message range.
1156
1157 * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Change
1158 documentation about MH message range.
1159
1160 * mh-funcs.el (mh-copy-msg, mh-print-msg): Ditto.
1161
1162 * mh-e.el (mh-delete-msg, mh-delete-msg-no-motion)
1163 (mh-refile-msg, mh-undo, mh-delete-msg-from-seq): Ditto.
1164
1165 * mh-comp.el (mh-forward): Ditto.
1166
11672003-04-26 Satyaki Das <satyakid@stanford.edu>
1168
1169 * mh-comp.el, mh-e.el, mh-funcs.el, mh-junk.el, mh-seq.el:
1170 Replace msg-or-seq with range everywhere.
1171
1172 * mh-loaddefs.el: Regenerated.
1173
11742003-04-25 Satyaki Das <satyakid@stanford.edu>
1175
1176 * mh-e.el (mh-index-sequence-search-flag, mh-folder-mode): New
1177 local variable to remember that a folder buffer contains results
1178 from a sequence search. This is needed so that "C-u F i" will work
1179 as expected.
1180 (mh-visit-folder): Create sequences in the index folder.
1181 (mh-process-commands, mh-delete-msg-from-seq): If speedbar is on
1182 then update the speedbar message counts immediately.
1183 (mh-delete-msg-from-seq): Make the code faster by calling "mark"
1184 just once. Also update source folder sequence if messages are
1185 being deleted from a sequence in an index folder.
1186 (mh-undefine-sequence): Simplified to remove the speedbar updating
1187 code. Also DTRT and don't change any sequence when called with an
1188 empty list of messages.
1189 (mh-refile-msg, mh-delete-msg): Move to next message only if the
1190 current message has been deleted or refiled, as the case may be.
1191
1192 * mh-utils.el (mh-show-msg): Update the message counts in the
1193 speedbar, if it is on, immediately.
1194 (mh-speed-flists-active-p, mh-speed-flists-inhibit-flag): A new
1195 flag has been added which inhibits updating of the speedbar. This
1196 is used to avoid needless speedbar updates when
1197 mh-execute-commands is called in index folders.
1198
1199 * mh-speed.el (mh-speed-flists): Extended so that multiple
1200 folders can be given as arguments. Also the code that kept track
1201 of the current folder, needed since flists adds an extra ?+ char
1202 at the end of the current folder name, wasn't entirely correct.
1203 That has also been fixed.
1204
1205 * mh-seq.el (mh-delete-seq, mh-put-msg-in-seq): Modified so that
1206 sequence in source folder is updated if we delete a sequence in an
1207 index folder.
1208 (mh-read-seq, mh-read-seq-default, mh-translate-range)
1209 (mh-interactive-msg-or-seq): The mh-interactive-msg-or-seq
1210 function can read in an arbitrary MH message range.
1211 (mh-iterate-on-msg-or-seq): The macro has been extended to work on
1212 a MH range.
1213 (mh-subject-to-sequence, mh-subject-to-sequence-unthreaded)
1214 (mh-subject-to-sequence-threaded, mh-thread-find-msg-subject): Fix
1215 the mh-subject-to-sequence function so that it will work in
1216 threaded folders too.
1217 (mh-tick-add-overlay): Fix a leak of overlays.
1218 (mh-toggle-tick): Ticking, or unticking, messages in the index
1219 folder is propagated to the source folders (closes SF #709664).
1220
1221 * mh-index.el (mh-flists-results-folder, mh-flists-sequence)
1222 (mh-flists-called-flag): New variables to implement searching for
1223 arbitrary sequences.
1224 (mh-index-generate-pretty-name): Updated so that folder names are
1225 generated for flists search that can take any sequence name.
1226 (mh-index-search): Since sequences are now properly maintained the
1227 unseen-flag argument isn't needed and hence removed. Also redoing
1228 a sequence search with "C-u F i" is handled correctly. Finally
1229 the speedbar is updated to reflect the new index folder created.
1230 (mh-index-create-sequences): New function that creates sequences
1231 in the index folder.
1232 (mh-index-matching-source-msgs, mh-index-execute-commands):
1233 Improved so that scan lines for refiled/deleted messages are
1234 removed from the source folders as well.
1235 (mh-index-add-to-sequence, mh-index-delete-from-sequence): New
1236 functions to update sequences in source folder to reflect changes
1237 in index folder.
1238 (mh-index-quote-for-shell): A utility function to that quotes
1239 characters with special meaning to /bin/sh.
1240 (mh-flists-execute, mh-index-new-messages): Updated to search for
1241 arbitrary sequences (closes SF #718833).
1242
1243 * mh-loaddefs.el: Regenerated.
1244
12452003-04-25 Bill Wohler <wohler@newt.com>
1246
1247 * mh-customize.el (mh-kill-folder-suppress-prompt-hook): New hook
1248 used by mh-kill-folder to suppress the prompt.
1249
1250 * mh-funcs.el (mh-kill-folder): Suppress prompt not if
1251 mh-index-data is non-nil, but if any functions in
1252 mh-kill-folder-suppress-prompt-hook return non-nil.
1253
1254 * mh-index.el (mh-index-p): New function with returns non-nil if
1255 the current folder was generated by an index search for use by
1256 mh-kill-folder-suppress-prompt-hook
1257
1258 * mh-unit.el (mh-unit): Commented out lm-verify step until code
1259 updated to handle split Copyright lines.
1260
1261 * mh-e.el (mh-version): Set to 7.3+cvs.
3 1262
42003-04-24 Bill Wohler <wohler@newt.com> 12632003-04-24 Bill Wohler <wohler@newt.com>
5 1264
@@ -50,10 +1309,6 @@
50 runs checkdoc and lm-verify which is useful before releasing the 1309 runs checkdoc and lm-verify which is useful before releasing the
51 software. It can and should be expanded to do real unit tests. 1310 software. It can and should be expanded to do real unit tests.
52 1311
532004-04-22 Lars Hansen <larsh@math.ku.dk>
54
55 * mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings.
56
572003-04-22 Mark D Baushke <mdb@gnu.org> 13122003-04-22 Mark D Baushke <mdb@gnu.org>
58 1313
59 * mh-alias.el: Update Copyright. 1314 * mh-alias.el: Update Copyright.
@@ -78,11 +1333,6 @@
78 Emacs. 1333 Emacs.
79 (mh-exec-cmd-error): Add a comment, so that we change it later on. 1334 (mh-exec-cmd-error): Add a comment, so that we change it later on.
80 1335
812004-04-21 Lars Hansen <larsh@math.ku.dk>
82
83 * mh-e.el (mh-restore-desktop-buffer): Move from
84 desktop.el. Add Parameters.
85
862003-04-18 Steve Youngs <youngs@xemacs.org> 13362003-04-18 Steve Youngs <youngs@xemacs.org>
87 1337
88 * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons' 1338 * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons'
@@ -7589,7 +8839,7 @@
7589 (dist): Leave release in current directory. 8839 (dist): Leave release in current directory.
7590 8840
7591 8841
7592Copyright (C) 2003 Free Software Foundation, Inc. 8842Copyright (C) 2003, 2004 Free Software Foundation, Inc.
7593 8843
7594Copying and distribution of this file, with or without modification, 8844Copying and distribution of this file, with or without modification,
7595are permitted in any medium without royalty provided the copyright 8845are permitted in any medium without royalty provided the copyright
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 09c689de845..bd20b9118b0 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -1,7 +1,7 @@
1;;; mh-alias.el --- MH-E mail alias completion and expansion 1;;; mh-alias.el --- MH-E mail alias completion and expansion
2;; 2;;
3;; Copyright (C) 1994, 95, 96, 1997, 3;; Copyright (C) 1994, 95, 96, 1997,
4;; 2001, 02, 2003 Free Software Foundation, Inc. 4;; 2001, 02, 03, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Peter S. Galbraith <psg@debian.org> 6;; Author: Peter S. Galbraith <psg@debian.org>
7;; Maintainer: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -128,6 +128,14 @@
128 128
129;;; Alias Loading 129;;; Alias Loading
130 130
131(defmacro mh-assoc-ignore-case (key alist)
132 "Search for string KEY in ALIST.
133This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
134`assoc-ignore-case' which is now an obsolete function."
135 (cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t))
136 ((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist))
137 (t (error "The macro mh-assoc-ignore-case not implemented properly"))))
138
131(defun mh-alias-tstamp (arg) 139(defun mh-alias-tstamp (arg)
132 "Check whether alias files have been modified. 140 "Check whether alias files have been modified.
133Return t if any file listed in the MH profile component Aliasfile has been 141Return t if any file listed in the MH profile component Aliasfile has been
@@ -169,6 +177,29 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
169 (append userlist mh-alias-system-aliases)) 177 (append userlist mh-alias-system-aliases))
170 userlist)))) 178 userlist))))
171 179
180(defun mh-alias-gecos-name (gecos-name username comma-separator)
181 "Return a usable address string from a GECOS-NAME and USERNAME.
182Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is
183non-nil."
184 (let ((res gecos-name))
185 ;; Keep only string until first comma if COMMA-SEPARATOR is t.
186 (if (and comma-separator
187 (string-match "^\\([^,]+\\)," res))
188 (setq res (match-string 1 res)))
189 ;; Replace "&" with capitalized username
190 (if (string-match "&" res)
191 (setq res (mh-replace-in-string "&" (capitalize username) res)))
192 ;; Remove " character
193 (if (string-match "\"" res)
194 (setq res (mh-replace-in-string "\"" "" res)))
195 ;; If empty string, use username instead
196 (if (string-equal "" res)
197 (setq res username))
198 ;; Surround by quotes if doesn't consist of simple characters
199 (if (not (string-match "^[ a-zA-Z0-9-]+$" res))
200 (setq res (concat "\"" res "\"")))
201 res))
202
172(defun mh-alias-local-users () 203(defun mh-alias-local-users ()
173 "Return an alist of local users from /etc/passwd." 204 "Return an alist of local users from /etc/passwd."
174 (let (passwd-alist) 205 (let (passwd-alist)
@@ -185,23 +216,23 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
185 (goto-char (point-min)))) 216 (goto-char (point-min))))
186 (while (< (point) (point-max)) 217 (while (< (point) (point-max))
187 (cond 218 (cond
188 ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]") 219 ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):")
189 (when (> (string-to-int (match-string 2)) 200) 220 (when (> (string-to-int (match-string 2)) 200)
190 (let* ((username (match-string 1)) 221 (let* ((username (match-string 1))
191 (gecos-name (match-string 3)) 222 (gecos-name (match-string 3))
192 (realname 223 (realname (mh-alias-gecos-name
193 (if (string-match "&" gecos-name) 224 gecos-name username
194 (concat 225 mh-alias-passwd-gecos-comma-separator-flag)))
195 (substring gecos-name 0 (match-beginning 0))
196 (capitalize username)
197 (substring gecos-name (match-end 0)))
198 gecos-name)))
199 (setq passwd-alist 226 (setq passwd-alist
200 (cons (list username 227 (cons
201 (if (string-equal "" realname) 228 (list (if mh-alias-local-users-prefix
202 (concat "<" username ">") 229 (concat mh-alias-local-users-prefix
203 (concat realname " <" username ">"))) 230 (mh-alias-suggest-alias realname t))
204 passwd-alist)))))) 231 username)
232 (if (string-equal username realname)
233 (concat "<" username ">")
234 (concat realname " <" username ">")))
235 passwd-alist))))))
205 (forward-line 1))) 236 (forward-line 1)))
206 passwd-alist)) 237 passwd-alist))
207 238
@@ -219,12 +250,12 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
219 (cond 250 (cond
220 ((looking-at "^[ \t]")) ;Continuation line 251 ((looking-at "^[ \t]")) ;Continuation line
221 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias 252 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
222 (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist)) 253 (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-blind-alist))
223 (setq mh-alias-blind-alist 254 (setq mh-alias-blind-alist
224 (cons (list (match-string 1)) mh-alias-blind-alist)) 255 (cons (list (match-string 1)) mh-alias-blind-alist))
225 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) 256 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
226 ((looking-at "\\(.+\\): .*$") ; A new MH alias 257 ((looking-at "\\(.+\\): .*$") ; A new MH alias
227 (when (not (assoc-ignore-case (match-string 1) mh-alias-alist)) 258 (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist))
228 (setq mh-alias-alist 259 (setq mh-alias-alist
229 (cons (list (match-string 1)) mh-alias-alist))))) 260 (cons (list (match-string 1)) mh-alias-alist)))))
230 (forward-line 1))) 261 (forward-line 1)))
@@ -235,11 +266,12 @@ If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
235 user) 266 user)
236 (while local-users 267 (while local-users
237 (setq user (car local-users)) 268 (setq user (car local-users))
238 (if (not (assoc-ignore-case (car user) mh-alias-alist)) 269 (if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
239 (setq mh-alias-alist (append mh-alias-alist (list user)))) 270 (setq mh-alias-alist (append mh-alias-alist (list user))))
240 (setq local-users (cdr local-users))))) 271 (setq local-users (cdr local-users)))))
241 (message "Loading MH aliases...done")) 272 (message "Loading MH aliases...done"))
242 273
274;;;###mh-autoload
243(defun mh-alias-reload-maybe () 275(defun mh-alias-reload-maybe ()
244 "Load new MH aliases." 276 "Load new MH aliases."
245 (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it. 277 (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
@@ -269,10 +301,10 @@ ali returns the string unchanged if not defined. The same is done here."
269 "Return expansion for ALIAS. 301 "Return expansion for ALIAS.
270Blind aliases or users from /etc/passwd are not expanded." 302Blind aliases or users from /etc/passwd are not expanded."
271 (cond 303 (cond
272 ((assoc-ignore-case alias mh-alias-blind-alist) 304 ((mh-assoc-ignore-case alias mh-alias-blind-alist)
273 alias) ; Don't expand a blind alias 305 alias) ; Don't expand a blind alias
274 ((assoc-ignore-case alias mh-alias-passwd-alist) 306 ((mh-assoc-ignore-case alias mh-alias-passwd-alist)
275 (cadr (assoc-ignore-case alias mh-alias-passwd-alist))) 307 (cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist)))
276 (t 308 (t
277 (mh-alias-ali alias)))) 309 (mh-alias-ali alias))))
278 310
@@ -302,26 +334,12 @@ Blind aliases or users from /etc/passwd are not expanded."
302(defun mh-alias-minibuffer-confirm-address () 334(defun mh-alias-minibuffer-confirm-address ()
303 "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." 335 "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
304 (interactive) 336 (interactive)
305 (if (not mh-alias-flash-on-comma) 337 (when mh-alias-flash-on-comma
306 ()
307 (save-excursion 338 (save-excursion
308 (let* ((case-fold-search t) 339 (let* ((case-fold-search t)
309 (the-name (buffer-substring 340 (beg (mh-beginning-of-word))
310 (progn (skip-chars-backward " \t")(point)) 341 (the-name (buffer-substring-no-properties beg (point))))
311 ;; This moves over to previous comma, if any 342 (if (mh-assoc-ignore-case the-name mh-alias-alist)
312 (progn (or (and (not (= 0 (skip-chars-backward "^,")))
313 ;; the skips over leading whitespace
314 (skip-chars-forward " "))
315 ;; no comma, then to beginning of word
316 (skip-chars-backward "^ \t"))
317 ;; In Emacs21, the beginning of the prompt
318 ;; line is accessible, which wasn't the case
319 ;; in emacs20. Skip over it.
320 (if (looking-at "^[^ \t]+:")
321 (skip-chars-forward "^ \t"))
322 (skip-chars-forward " ")
323 (point)))))
324 (if (assoc-ignore-case the-name mh-alias-alist)
325 (message "%s -> %s" the-name (mh-alias-expand the-name)) 343 (message "%s -> %s" the-name (mh-alias-expand the-name))
326 ;; Check if if was a single word likely to be an alias 344 ;; Check if if was a single word likely to be an alias
327 (if (and (equal mh-alias-flash-on-comma 1) 345 (if (and (equal mh-alias-flash-on-comma 1)
@@ -335,30 +353,26 @@ Blind aliases or users from /etc/passwd are not expanded."
335(defun mh-alias-letter-expand-alias () 353(defun mh-alias-letter-expand-alias ()
336 "Expand mail alias before point." 354 "Expand mail alias before point."
337 (mh-alias-reload-maybe) 355 (mh-alias-reload-maybe)
338 (let ((mail-abbrevs mh-alias-alist)) 356 (let* ((end (point))
339 (mh-funcall-if-exists mail-abbrev-complete-alias)) 357 (begin (mh-beginning-of-word))
340 (when mh-alias-expand-aliases-flag 358 (input (buffer-substring-no-properties begin end)))
341 (let* ((end (point)) 359 (mh-complete-word input mh-alias-alist begin end)
342 (syntax-table (syntax-table)) 360 (when mh-alias-expand-aliases-flag
343 (beg (unwind-protect 361 (let* ((end (point))
344 (save-excursion 362 (expansion (mh-alias-expand (buffer-substring begin end))))
345 (set-syntax-table mail-abbrev-syntax-table) 363 (delete-region begin end)
346 (backward-word 1) 364 (insert expansion)))))
347 (point))
348 (set-syntax-table syntax-table)))
349 (alias (buffer-substring beg end))
350 (expansion (mh-alias-expand alias)))
351 (delete-region beg end)
352 (insert expansion))))
353 365
354;;; Adding addresses to alias file. 366;;; Adding addresses to alias file.
355 367
356(defun mh-alias-suggest-alias (string) 368(defun mh-alias-suggest-alias (string &optional no-comma-swap)
357 "Suggest an alias for STRING." 369 "Suggest an alias for STRING.
370Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is
371non-nil."
358 (cond 372 (cond
359 ((string-match "^<\\(.*\\)>$" string) 373 ((string-match "^<\\(.*\\)>$" string)
360 ;; <somename@foo.bar> -> recurse, stripping brackets. 374 ;; <somename@foo.bar> -> recurse, stripping brackets.
361 (mh-alias-suggest-alias (match-string 1 string))) 375 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
362 ((string-match "^\\sw+$" string) 376 ((string-match "^\\sw+$" string)
363 ;; One word -> downcase it. 377 ;; One word -> downcase it.
364 (downcase string)) 378 (downcase string))
@@ -372,47 +386,59 @@ Blind aliases or users from /etc/passwd are not expanded."
372 (downcase (match-string 1 string))) 386 (downcase (match-string 1 string)))
373 ((string-match "^\"\\(.*\\)\".*" string) 387 ((string-match "^\"\\(.*\\)\".*" string)
374 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name" 388 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
375 (mh-alias-suggest-alias (match-string 1 string))) 389 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
376 ((string-match "^\\(.*\\) +<.*>$" string) 390 ((string-match "^\\(.*\\) +<.*>$" string)
377 ;; Some name <somename@foo.bar> -> recurse -> Some name 391 ;; Some name <somename@foo.bar> -> recurse -> Some name
378 (mh-alias-suggest-alias (match-string 1 string))) 392 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
379 ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) 393 ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
380 ;; somename@foo.bar (Some name) -> recurse -> Some name 394 ;; somename@foo.bar (Some name) -> recurse -> Some name
381 (mh-alias-suggest-alias (match-string 1 string))) 395 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
382 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) 396 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
383 ;; Strip out title 397 ;; Strip out title
384 (mh-alias-suggest-alias (match-string 2 string))) 398 (mh-alias-suggest-alias (match-string 2 string) no-comma-swap))
385 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) 399 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
386 ;; Strip out tails with comma 400 ;; Strip out tails with comma
387 (mh-alias-suggest-alias (match-string 1 string))) 401 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
388 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) 402 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
389 ;; Strip out tails 403 ;; Strip out tails
390 (mh-alias-suggest-alias (match-string 1 string))) 404 (mh-alias-suggest-alias (match-string 1 string) no-comma-swap))
391 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) 405 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
392 ;; Strip out initials 406 ;; Strip out initials
393 (mh-alias-suggest-alias 407 (mh-alias-suggest-alias
394 (format "%s %s" (match-string 1 string) (match-string 2 string)))) 408 (format "%s %s" (match-string 1 string) (match-string 2 string))
395 ((string-match "^\\([^,]+\\), +\\(.*\\)$" string) 409 no-comma-swap))
396 ;; Reverse order of comma-separated fields 410 ((and (not no-comma-swap)
411 (string-match "^\\([^,]+\\), +\\(.*\\)$" string))
412 ;; Reverse order of comma-separated fields to handle:
413 ;; From: "Galbraith, Peter" <psg@debian.org>
414 ;; but don't this for a name string extracted from the passwd file
415 ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil.
397 (mh-alias-suggest-alias 416 (mh-alias-suggest-alias
398 (format "%s %s" (match-string 2 string) (match-string 1 string)))) 417 (format "%s %s" (match-string 2 string) (match-string 1 string))
418 no-comma-swap))
399 (t 419 (t
400 ;; Output string, with spaces replaced by dots. 420 ;; Output string, with spaces replaced by dots.
401 (mh-alias-canonicalize-suggestion string)))) 421 (mh-alias-canonicalize-suggestion string))))
402 422
403(defun mh-alias-canonicalize-suggestion (string) 423(defun mh-alias-canonicalize-suggestion (string)
404 "Process STRING to replace spacess by periods. 424 "Process STRING to replace spaces by periods.
405First all spaces are replaced by periods. Then every run of consecutive periods 425First all spaces and commas are replaced by periods. Then every run of
406are replaced with a single period. Finally the string is converted to lower 426consecutive periods are replaced with a single period. Finally the string
407case." 427is converted to lower case."
408 (with-temp-buffer 428 (with-temp-buffer
409 (insert string) 429 (insert string)
410 ;; Replace spaces with periods 430 ;; Replace spaces with periods
411 (goto-char (point-min)) 431 (goto-char (point-min))
412 (replace-regexp " +" ".") 432 (while (re-search-forward " +" nil t)
433 (replace-match "." nil nil))
434 ;; Replace commas with periods
435 (goto-char (point-min))
436 (while (re-search-forward ",+" nil t)
437 (replace-match "." nil nil))
413 ;; Replace consecutive periods with a single period 438 ;; Replace consecutive periods with a single period
414 (goto-char (point-min)) 439 (goto-char (point-min))
415 (replace-regexp "\\.\\.+" ".") 440 (while (re-search-forward "\\.\\.+" nil t)
441 (replace-match "." nil nil))
416 ;; Convert to lower case 442 ;; Convert to lower case
417 (downcase-region (point-min) (point-max)) 443 (downcase-region (point-min) (point-max))
418 ;; Whew! all done... 444 ;; Whew! all done...
@@ -617,6 +643,63 @@ already has an alias."
617 (mh-alias-add-alias nil address) 643 (mh-alias-add-alias nil address)
618 (message "No email address found under point.")))) 644 (message "No email address found under point."))))
619 645
646;;;###mh-autoload
647(defun mh-alias-apropos (regexp)
648 "Show all aliases that match REGEXP either in name or content."
649 (interactive "sAlias regexp: ")
650 (if mh-alias-local-users
651 (mh-alias-reload-maybe))
652 (let ((matches "")(group-matches "")(passwd-matches))
653 (save-excursion
654 (message "Reading MH aliases...")
655 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
656 (message "Reading MH aliases...done. Parsing...")
657 (while (re-search-forward regexp nil t)
658 (beginning-of-line)
659 (cond
660 ((looking-at "^[ \t]") ;Continuation line
661 (setq group-matches
662 (concat group-matches
663 (buffer-substring
664 (save-excursion
665 (or (re-search-backward "^[^ \t]" nil t)
666 (point)))
667 (progn
668 (if (re-search-forward "^[^ \t]" nil t)
669 (forward-char -1))
670 (point))))))
671 (t
672 (setq matches
673 (concat matches
674 (buffer-substring (point)(progn (end-of-line)(point)))
675 "\n")))))
676 (message "Reading MH aliases...done. Parsing...done.")
677 (when mh-alias-local-users
678 (message
679 "Reading MH aliases...done. Parsing...done. Passwd aliases...")
680 (setq passwd-matches
681 (mapconcat
682 '(lambda (elem)
683 (if (or (string-match regexp (car elem))
684 (string-match regexp (cadr elem)))
685 (format "%s: %s\n" (car elem) (cadr elem))))
686 mh-alias-passwd-alist ""))
687 (message
688 "Reading MH aliases...done. Parsing...done. Passwd aliases...done.")))
689 (if (and (string-equal "" matches)
690 (string-equal "" group-matches)
691 (string-equal "" passwd-matches))
692 (message "No matches")
693 (with-output-to-temp-buffer "*Help*"
694 (if (not (string-equal "" matches))
695 (princ matches))
696 (when (not (string-equal group-matches ""))
697 (princ "\nGroup Aliases:\n\n")
698 (princ group-matches))
699 (when (not (string-equal passwd-matches ""))
700 (princ "\nLocal User Aliases:\n\n")
701 (princ passwd-matches))))))
702
620(provide 'mh-alias) 703(provide 'mh-alias)
621 704
622;;; Local Variables: 705;;; Local Variables:
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 1d6cef7a831..489b6690bc7 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1,7 +1,7 @@
1;;; mh-comp.el --- MH-E functions for composing messages 1;;; mh-comp.el --- MH-E functions for composing messages
2 2
3;; Copyright (C) 1993, 95, 1997, 3;; Copyright (C) 1993, 95, 1997,
4;; 2000, 01, 02, 2003 Free Software Foundation, Inc. 4;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Bill Wohler <wohler@newt.com> 6;; Author: Bill Wohler <wohler@newt.com>
7;; Maintainer: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -36,7 +36,8 @@
36(require 'mh-e) 36(require 'mh-e)
37(require 'gnus-util) 37(require 'gnus-util)
38(require 'easymenu) 38(require 'easymenu)
39(require 'cl) 39(require 'mh-utils)
40(mh-require-cl)
40(eval-when (compile load eval) 41(eval-when (compile load eval)
41 (ignore-errors (require 'mailabbrev))) 42 (ignore-errors (require 'mailabbrev)))
42 43
@@ -199,6 +200,10 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
199(defvar mh-annotate-field nil 200(defvar mh-annotate-field nil
200 "Field name for message annotation.") 201 "Field name for message annotation.")
201 202
203(defvar mh-insert-auto-fields-done-local nil
204 "Buffer-local variable set when `mh-insert-auto-fields' successfully called.")
205(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
206
202;;;###autoload 207;;;###autoload
203(defun mh-smail () 208(defun mh-smail ()
204 "Compose and send mail with the MH mail system. 209 "Compose and send mail with the MH mail system.
@@ -279,7 +284,8 @@ See also documentation for `\\[mh-send]' function."
279 (save-buffer) 284 (save-buffer)
280 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil 285 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
281 config) 286 config)
282 (mh-letter-mode-message))) 287 (mh-letter-mode-message)
288 (mh-letter-adjust-point)))
283 289
284;;;###mh-autoload 290;;;###mh-autoload
285(defun mh-extract-rejected-mail (msg) 291(defun mh-extract-rejected-mail (msg)
@@ -309,22 +315,20 @@ See also documentation for `\\[mh-send]' function."
309 (mh-letter-mode-message))) 315 (mh-letter-mode-message)))
310 316
311;;;###mh-autoload 317;;;###mh-autoload
312(defun mh-forward (to cc &optional msg-or-seq) 318(defun mh-forward (to cc &optional range)
313 "Forward messages to the recipients TO and CC. 319 "Forward messages to the recipients TO and CC.
314Use optional MSG-OR-SEQ argument to specify a message or sequence to forward. 320Use optional RANGE argument to specify a message or sequence to forward.
315Default is the displayed message. 321Default is the displayed message.
316If optional prefix argument is provided, then prompt for the message sequence. 322
317If variable `transient-mark-mode' is non-nil and the mark is active, then the 323Check the documentation of `mh-interactive-range' to see how RANGE is read in
318selected region is forwarded. 324interactive use.
319In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
320region in a cons cell, or a sequence.
321 325
322See also documentation for `\\[mh-send]' function." 326See also documentation for `\\[mh-send]' function."
323 (interactive (list (mh-read-address "To: ") 327 (interactive (list (mh-interactive-read-address "To: ")
324 (mh-read-address "Cc: ") 328 (mh-interactive-read-address "Cc: ")
325 (mh-interactive-msg-or-seq "Forward"))) 329 (mh-interactive-range "Forward")))
326 (let* ((folder mh-current-folder) 330 (let* ((folder mh-current-folder)
327 (msgs (mh-msg-or-seq-to-msg-list msg-or-seq)) 331 (msgs (mh-range-to-msg-list range))
328 (config (current-window-configuration)) 332 (config (current-window-configuration))
329 (fwd-msg-file (mh-msg-filename (car msgs) folder)) 333 (fwd-msg-file (mh-msg-filename (car msgs) folder))
330 ;; forw always leaves file in "draft" since it doesn't have -draft 334 ;; forw always leaves file in "draft" since it doesn't have -draft
@@ -355,8 +359,7 @@ See also documentation for `\\[mh-send]' function."
355 ;; If using MML, translate mhn 359 ;; If using MML, translate mhn
356 (if (equal mh-compose-insertion 'gnus) 360 (if (equal mh-compose-insertion 'gnus)
357 (save-excursion 361 (save-excursion
358 (re-search-forward (format "^\\(%s\\)?$" 362 (goto-char (mh-mail-header-end))
359 mh-mail-header-separator))
360 (while 363 (while
361 (re-search-forward 364 (re-search-forward
362 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" 365 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
@@ -376,7 +379,7 @@ See also documentation for `\\[mh-send]' function."
376 ;; Postition just before forwarded message 379 ;; Postition just before forwarded message
377 (if (re-search-forward "^------- Forwarded Message" nil t) 380 (if (re-search-forward "^------- Forwarded Message" nil t)
378 (forward-line -1) 381 (forward-line -1)
379 (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator)) 382 (goto-char (mh-mail-header-end))
380 (forward-line 1)) 383 (forward-line 1))
381 (delete-other-windows) 384 (delete-other-windows)
382 (mh-add-msgs-to-seq msgs 'forwarded t) 385 (mh-add-msgs-to-seq msgs 'forwarded t)
@@ -384,7 +387,8 @@ See also documentation for `\\[mh-send]' function."
384 to forw-subject cc 387 to forw-subject cc
385 mh-note-forw "Forwarded:" 388 mh-note-forw "Forwarded:"
386 config) 389 config)
387 (mh-letter-mode-message))))) 390 (mh-letter-mode-message)
391 (mh-letter-adjust-point)))))
388 392
389(defun mh-forwarded-letter-subject (from subject) 393(defun mh-forwarded-letter-subject (from subject)
390 "Return a Subject suitable for a forwarded message. 394 "Return a Subject suitable for a forwarded message.
@@ -567,9 +571,9 @@ details.
567If `mh-compose-letter-function' is defined, it is called on the draft and 571If `mh-compose-letter-function' is defined, it is called on the draft and
568passed three arguments: TO, CC, and SUBJECT." 572passed three arguments: TO, CC, and SUBJECT."
569 (interactive (list 573 (interactive (list
570 (mh-read-address "To: ") 574 (mh-interactive-read-address "To: ")
571 (mh-read-address "Cc: ") 575 (mh-interactive-read-address "Cc: ")
572 (read-string "Subject: "))) 576 (mh-interactive-read-string "Subject: ")))
573 (let ((config (current-window-configuration))) 577 (let ((config (current-window-configuration)))
574 (delete-other-windows) 578 (delete-other-windows)
575 (mh-send-sub to cc subject config))) 579 (mh-send-sub to cc subject config)))
@@ -587,9 +591,9 @@ details.
587If `mh-compose-letter-function' is defined, it is called on the draft and 591If `mh-compose-letter-function' is defined, it is called on the draft and
588passed three arguments: TO, CC, and SUBJECT." 592passed three arguments: TO, CC, and SUBJECT."
589 (interactive (list 593 (interactive (list
590 (mh-read-address "To: ") 594 (mh-interactive-read-address "To: ")
591 (mh-read-address "Cc: ") 595 (mh-interactive-read-address "Cc: ")
592 (read-string "Subject: "))) 596 (mh-interactive-read-string "Subject: ")))
593 (let ((pop-up-windows t)) 597 (let ((pop-up-windows t))
594 (mh-send-sub to cc subject (current-window-configuration)))) 598 (mh-send-sub to cc subject (current-window-configuration))))
595 599
@@ -630,7 +634,8 @@ CONFIG is the window configuration before sending mail."
630 (mh-compose-and-send-mail draft "" folder msg-num 634 (mh-compose-and-send-mail draft "" folder msg-num
631 to subject cc 635 to subject cc
632 nil nil config) 636 nil nil config)
633 (mh-letter-mode-message)))) 637 (mh-letter-mode-message)
638 (mh-letter-adjust-point))))
634 639
635(defun mh-read-draft (use initial-contents delete-contents-file) 640(defun mh-read-draft (use initial-contents delete-contents-file)
636 "Read draft file into a draft buffer and make that buffer the current one. 641 "Read draft file into a draft buffer and make that buffer the current one.
@@ -695,7 +700,7 @@ MSG can be a message number, a list of message numbers, or a sequence."
695 (save-excursion 700 (save-excursion
696 (cond ((get-buffer buffer) ; Buffer may be deleted 701 (cond ((get-buffer buffer) ; Buffer may be deleted
697 (set-buffer buffer) 702 (set-buffer buffer)
698 (mh-iterate-on-msg-or-seq nil msg 703 (mh-iterate-on-range nil msg
699 (mh-notate nil note (1+ mh-cmd-note))))))) 704 (mh-notate nil note (1+ mh-cmd-note)))))))
700 705
701(defun mh-insert-fields (&rest name-values) 706(defun mh-insert-fields (&rest name-values)
@@ -867,7 +872,6 @@ When a message is composed, the hooks `text-mode-hook' and
867`mh-letter-mode-hook' are run. 872`mh-letter-mode-hook' are run.
868 873
869\\{mh-letter-mode-map}" 874\\{mh-letter-mode-map}"
870
871 (or mh-user-path (mh-find-path)) 875 (or mh-user-path (mh-find-path))
872 (make-local-variable 'mh-send-args) 876 (make-local-variable 'mh-send-args)
873 (make-local-variable 'mh-annotate-char) 877 (make-local-variable 'mh-annotate-char)
@@ -879,6 +883,14 @@ When a message is composed, the hooks `text-mode-hook' and
879 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el 883 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
880 (make-local-variable 'mh-help-messages) 884 (make-local-variable 'mh-help-messages)
881 (setq mh-help-messages mh-letter-mode-help-messages) 885 (setq mh-help-messages mh-letter-mode-help-messages)
886 (setq buffer-invisibility-spec '((vanish . t) t))
887 (set (make-local-variable 'line-move-ignore-invisible) t)
888
889 ;; Set mh-mail-header-end-marker to remember end of message header.
890 (set (make-local-variable 'mh-letter-mail-header-end-marker)
891 (set-marker (make-marker) (save-excursion
892 (goto-char (mh-mail-header-end))
893 (line-beginning-position 2))))
882 894
883 ;; From sendmail.el for proper paragraph fill 895 ;; From sendmail.el for proper paragraph fill
884 ;; sendmail.el also sets a normal-auto-fill-function (not done here) 896 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
@@ -908,8 +920,7 @@ When a message is composed, the hooks `text-mode-hook' and
908 920
909 ;; Enable undo since a show-mode buffer might have been reused. 921 ;; Enable undo since a show-mode buffer might have been reused.
910 (buffer-enable-undo) 922 (buffer-enable-undo)
911 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 923 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
912 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
913 (mh-funcall-if-exists mh-toolbar-init :letter) 924 (mh-funcall-if-exists mh-toolbar-init :letter)
914 (make-local-variable 'font-lock-defaults) 925 (make-local-variable 'font-lock-defaults)
915 (cond 926 (cond
@@ -919,7 +930,7 @@ When a message is composed, the hooks `text-mode-hook' and
919 ;; is that gnus uses static text properties which are not appropriate 930 ;; is that gnus uses static text properties which are not appropriate
920 ;; for a buffer that will be edited. So the choice here is either fontify 931 ;; for a buffer that will be edited. So the choice here is either fontify
921 ;; the citations and header... 932 ;; the citations and header...
922 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) 933 (setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
923 (t 934 (t
924 ;; ...or the header only 935 ;; ...or the header only
925 (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) 936 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
@@ -930,6 +941,36 @@ When a message is composed, the hooks `text-mode-hook' and
930 (make-local-variable 'auto-fill-function) 941 (make-local-variable 'auto-fill-function)
931 (setq auto-fill-function 'mh-auto-fill-for-letter))) 942 (setq auto-fill-function 'mh-auto-fill-for-letter)))
932 943
944(defun mh-font-lock-field-data (limit)
945 "Find header field region between point and LIMIT."
946 (and (< (point) (mh-letter-header-end))
947 (< (point) limit)
948 (let ((end (min limit (mh-letter-header-end)))
949 (point (point))
950 data-end data-begin field)
951 (end-of-line)
952 (setq data-end (if (re-search-forward "^[^ \t]" end t)
953 (match-beginning 0)
954 end))
955 (goto-char (1- data-end))
956 (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
957 (setq data-begin (point-min))
958 (setq data-begin (match-end 0))
959 (setq field (match-string 1)))
960 (setq data-begin (max point data-begin))
961 (if (and field (mh-letter-skipped-header-field-p field))
962 (set-match-data nil)
963 (set-match-data (list data-begin data-end data-begin data-end)))
964 (goto-char (if (equal point data-end) (1+ data-end) data-end))
965 t)))
966
967(defun mh-letter-header-end ()
968 "Find the end of header from `mh-letter-mail-header-end-marker'."
969 (save-excursion
970 (goto-char (marker-position mh-letter-mail-header-end-marker))
971 (forward-line -1)
972 (point)))
973
933(defun mh-auto-fill-for-letter () 974(defun mh-auto-fill-for-letter ()
934 "Perform auto-fill for message. 975 "Perform auto-fill for message.
935Header is treated specially by inserting a tab before continuation lines." 976Header is treated specially by inserting a tab before continuation lines."
@@ -1061,7 +1102,7 @@ MH the first time a message is composed.")
1061The versions of MH-E, Emacs, and MH are shown." 1102The versions of MH-E, Emacs, and MH are shown."
1062 1103
1063 ;; Lazily initialize mh-x-mailer-string. 1104 ;; Lazily initialize mh-x-mailer-string.
1064 (when (null mh-x-mailer-string) 1105 (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
1065 (save-window-excursion 1106 (save-window-excursion
1066 ;; User would be confused if version info buffer disappeared magically, 1107 ;; User would be confused if version info buffer disappeared magically,
1067 ;; so don't delete buffer if it already existed. 1108 ;; so don't delete buffer if it already existed.
@@ -1088,7 +1129,8 @@ The versions of MH-E, Emacs, and MH are shown."
1088 (kill-buffer mh-info-buffer))))) 1129 (kill-buffer mh-info-buffer)))))
1089 ;; Insert X-Mailer, but only if it doesn't already exist. 1130 ;; Insert X-Mailer, but only if it doesn't already exist.
1090 (save-excursion 1131 (save-excursion
1091 (when (null (mh-goto-header-field "X-Mailer")) 1132 (when (and mh-insert-x-mailer-flag
1133 (null (mh-goto-header-field "X-Mailer")))
1092 (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) 1134 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1093 1135
1094(defun mh-regexp-in-field-p (regexp &rest fields) 1136(defun mh-regexp-in-field-p (regexp &rest fields)
@@ -1106,39 +1148,60 @@ The versions of MH-E, Emacs, and MH are shown."
1106 (setq fields (cdr fields)))) 1148 (setq fields (cdr fields))))
1107 search-result))) 1149 search-result)))
1108 1150
1109(defun mh-insert-auto-fields () 1151;;;###mh-autoload
1110 "Insert custom fields if To or Cc match `mh-auto-fields-list'." 1152(defun mh-insert-auto-fields (&optional non-interactive)
1111 (save-excursion 1153 "Insert custom fields if To or Cc match `mh-auto-fields-list'.
1112 (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) 1154Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
1113 (let ((list mh-auto-fields-list)) 1155something. If NON-INTERACTIVE is non-nil, do not be verbose and only
1114 (while list 1156attempt matches if `mh-insert-auto-fields-done-local' is nil.
1115 (let ((regexp (nth 0 (car list))) 1157
1116 (entries (nth 1 (car list)))) 1158An `identity' entry is skipped if one was already entered manually."
1117 (when (mh-regexp-in-field-p regexp "To:" "cc:") 1159 (interactive)
1118 (let ((entry-list entries)) 1160 (when (or (not non-interactive) (not mh-insert-auto-fields-done-local))
1119 (while entry-list 1161 (save-excursion
1120 (let ((field (caar entry-list)) 1162 (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
1121 (value (cdar entry-list))) 1163 (let ((list mh-auto-fields-list))
1122 (cond 1164 (while list
1123 ((equal "identity" field) 1165 (let ((regexp (nth 0 (car list)))
1124 (when (assoc value mh-identity-list) 1166 (entries (nth 1 (car list))))
1125 (mh-insert-identity value))) 1167 (when (mh-regexp-in-field-p regexp "To:" "cc:")
1126 (t 1168 (setq mh-insert-auto-fields-done-local t)
1127 (mh-modify-header-field field value 1169 (if (not non-interactive)
1128 (equal field "From"))))) 1170 (message "Matched for regexp %s" regexp))
1129 (setq entry-list (cdr entry-list)))))) 1171 (let ((entry-list entries))
1130 (setq list (cdr list))))))) 1172 (while entry-list
1173 (let ((field (caar entry-list))
1174 (value (cdar entry-list)))
1175 (cond
1176 ((equal "identity" field)
1177 (when (and (not mh-identity-local)
1178 (assoc value mh-identity-list))
1179 (mh-insert-identity value)))
1180 (t
1181 (mh-modify-header-field field value
1182 (equal field "From")))))
1183 (setq entry-list (cdr entry-list))))))
1184 (setq list (cdr list))))))))
1131 1185
1132(defun mh-modify-header-field (field value &optional overwrite-flag) 1186(defun mh-modify-header-field (field value &optional overwrite-flag)
1133 "To header FIELD add VALUE. 1187 "To header FIELD add VALUE.
1134If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded." 1188If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
1135 (cond ((mh-goto-header-field (concat field ":")) 1189 (cond ((and overwrite-flag
1136 (insert value) 1190 (mh-goto-header-field (concat field ":")))
1137 (if overwrite-flag 1191 (insert " " value)
1138 (delete-region (point) (line-end-position)) 1192 (delete-region (point) (line-end-position)))
1139 (insert ", "))) 1193 ((and (not overwrite-flag)
1140 (t (mh-goto-header-end 0) 1194 (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
1141 (insert field ": " value "\n")))) 1195 ;; Already there, do nothing.
1196 )
1197 ((and (not overwrite-flag)
1198 (mh-goto-header-field (concat field ":")))
1199 (insert " " value ","))
1200 (t
1201 (mh-goto-header-end 0)
1202 (insert field ": " value "\n"))))
1203
1204(defvar mh-letter-mail-header-end-marker nil)
1142 1205
1143(defun mh-compose-and-send-mail (draft send-args 1206(defun mh-compose-and-send-mail (draft send-args
1144 sent-from-folder sent-from-msg 1207 sent-from-folder sent-from-msg
@@ -1157,8 +1220,8 @@ message. In that case, the ANNOTATE-FIELD is used to build a string
1157for `mh-annotate-msg'. 1220for `mh-annotate-msg'.
1158CONFIG is the window configuration to restore after sending the letter." 1221CONFIG is the window configuration to restore after sending the letter."
1159 (pop-to-buffer draft) 1222 (pop-to-buffer draft)
1160 (mh-insert-auto-fields)
1161 (mh-letter-mode) 1223 (mh-letter-mode)
1224 (mh-insert-auto-fields t)
1162 1225
1163 ;; mh-identity support 1226 ;; mh-identity support
1164 (if (and (boundp 'mh-identity-default) 1227 (if (and (boundp 'mh-identity-default)
@@ -1170,6 +1233,12 @@ CONFIG is the window configuration to restore after sending the letter."
1170 (mh-identity-make-menu) 1233 (mh-identity-make-menu)
1171 (easy-menu-add mh-identity-menu)) 1234 (easy-menu-add mh-identity-menu))
1172 1235
1236 ;; Extra fields
1237 (mh-insert-x-mailer)
1238 (mh-insert-x-face)
1239 ;; Hide skipped fields
1240 (mh-letter-hide-all-skipped-fields)
1241
1173 (setq mh-sent-from-folder sent-from-folder) 1242 (setq mh-sent-from-folder sent-from-folder)
1174 (setq mh-sent-from-msg sent-from-msg) 1243 (setq mh-sent-from-msg sent-from-msg)
1175 (setq mh-send-args send-args) 1244 (setq mh-send-args send-args)
@@ -1209,12 +1278,11 @@ Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
1209Insert X-Face field if the file specified by `mh-x-face-file' exists." 1278Insert X-Face field if the file specified by `mh-x-face-file' exists."
1210 (interactive "P") 1279 (interactive "P")
1211 (run-hooks 'mh-before-send-letter-hook) 1280 (run-hooks 'mh-before-send-letter-hook)
1281 (mh-insert-auto-fields t)
1212 (cond ((mh-mhn-directive-present-p) 1282 (cond ((mh-mhn-directive-present-p)
1213 (mh-edit-mhn)) 1283 (mh-edit-mhn))
1214 ((mh-mml-directive-present-p) 1284 ((mh-mml-directive-present-p)
1215 (mh-mml-to-mime))) 1285 (mh-mml-to-mime)))
1216 (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
1217 (mh-insert-x-face)
1218 (save-buffer) 1286 (save-buffer)
1219 (message "Sending...") 1287 (message "Sending...")
1220 (let ((draft-buffer (current-buffer)) 1288 (let ((draft-buffer (current-buffer))
@@ -1481,52 +1549,285 @@ This is useful in breaking up paragraphs in replies."
1481 1549
1482(mh-do-in-xemacs (defvar mail-abbrevs)) 1550(mh-do-in-xemacs (defvar mail-abbrevs))
1483 1551
1552;;;###mh-autoload
1553(defun mh-complete-word (word choices begin end)
1554 "Complete WORD at from CHOICES.
1555Any match found replaces the text from BEGIN to END."
1556 (let ((completion (try-completion word choices)))
1557 (cond ((eq completion t)
1558 (message "Completed: %s" word))
1559 ((null completion)
1560 (message "No completion for `%s'" word))
1561 ((stringp completion)
1562 (if (equal word completion)
1563 (with-output-to-temp-buffer "*Completions*"
1564 (display-completion-list (all-completions word choices)))
1565 (delete-region begin end)
1566 (insert completion))))))
1567
1568;;;###mh-autoload
1569(defun mh-beginning-of-word (&optional n)
1570 "Return position of the N th word backwards."
1571 (unless n (setq n 1))
1572 (let ((syntax-table (syntax-table)))
1573 (unwind-protect
1574 (save-excursion
1575 (mh-funcall-if-exists mail-abbrev-make-syntax-table)
1576 (set-syntax-table mail-abbrev-syntax-table)
1577 (backward-word n)
1578 (point))
1579 (set-syntax-table syntax-table))))
1580
1484(defun mh-folder-expand-at-point () 1581(defun mh-folder-expand-at-point ()
1485 "Do folder name completion in Fcc header field." 1582 "Do folder name completion in Fcc header field."
1486 (let* ((end (point)) 1583 (let* ((end (point))
1487 (syntax-table (syntax-table)) 1584 (beg (mh-beginning-of-word))
1488 (beg (unwind-protect
1489 (save-excursion
1490 (mh-funcall-if-exists mail-abbrev-make-syntax-table)
1491 (set-syntax-table mail-abbrev-syntax-table)
1492 (backward-word 1)
1493 (point))
1494 (set-syntax-table syntax-table)))
1495 (folder (buffer-substring beg end)) 1585 (folder (buffer-substring beg end))
1496 (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+))) 1586 (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
1497 (last-slash (mh-search-from-end ?/ folder)) 1587 (last-slash (mh-search-from-end ?/ folder))
1498 (prefix (and last-slash (substring folder 0 last-slash))) 1588 (prefix (and last-slash (substring folder 0 last-slash)))
1499 (mail-abbrevs 1589 (choices (mapcar #'(lambda (x)
1500 (mapcar #'(lambda (x) 1590 (list (cond (prefix (format "%s/%s" prefix x))
1501 (list (cond (prefix (format "%s/%s" prefix x)) 1591 (leading-plus (format "+%s" x))
1502 (leading-plus (format "+%s" x)) 1592 (t x))))
1503 (t x)))) 1593 (mh-folder-completion-function folder nil t))))
1504 (mh-folder-completion-function folder nil t)))) 1594 (mh-complete-word folder choices beg end)))
1505 (if (fboundp 'mail-abbrev-complete-alias) 1595
1506 (mh-funcall-if-exists mail-abbrev-complete-alias) 1596;; XXX: This should probably be customizable
1507 (error "Fcc completion not supported in your version of Emacs")))) 1597(defvar mh-letter-complete-function-alist
1598 '((cc . mh-alias-letter-expand-alias)
1599 (bcc . mh-alias-letter-expand-alias)
1600 (dcc . mh-alias-letter-expand-alias)
1601 (fcc . mh-folder-expand-at-point)
1602 (from . mh-alias-letter-expand-alias)
1603 (mail-followup-to . mh-alias-letter-expand-alias)
1604 (reply-to . mh-alias-letter-expand-alias)
1605 (to . mh-alias-letter-expand-alias))
1606 "Alist of header fields and completion functions to use.")
1508 1607
1509;;;###mh-autoload
1510(defun mh-letter-complete (arg) 1608(defun mh-letter-complete (arg)
1511 "Perform completion on header field or word preceding point. 1609 "Perform completion on header field or word preceding point.
1512Alias completion is done within the mail header on selected fields and 1610Alias completion is done within the mail header on selected fields based on
1513by the function designated by `mh-letter-complete-function' elsewhere, 1611the matches in `mh-letter-complete-function-alist'. Elsewhere the function
1514passing the prefix ARG if any." 1612designated by `mh-letter-complete-function' is used and given the prefix ARG,
1613if present."
1515 (interactive "P") 1614 (interactive "P")
1516 (let ((case-fold-search t)) 1615 (let ((func nil))
1517 (cond 1616 (cond ((not (mh-in-header-p))
1518 ((and (mh-in-header-p) 1617 (funcall mh-letter-complete-function arg))
1519 (save-excursion 1618 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1520 (mh-header-field-beginning) 1619 mh-letter-complete-function-alist)))
1521 (looking-at "^fcc:"))) 1620 (funcall func))
1522 (mh-folder-expand-at-point)) 1621 (t (funcall mh-letter-complete-function arg)))))
1523 ((and (mh-in-header-p) 1622
1524 (save-excursion 1623(defun mh-letter-complete-or-space (arg)
1525 (mh-header-field-beginning) 1624 "Perform completion or insert space.
1526 (looking-at "^.*\\(to\\|cc\\|from\\):"))) 1625If `mh-compose-space-does-completion-flag' is nil (the default) a space is
1527 (mh-alias-letter-expand-alias)) 1626inserted.
1528 (t 1627
1529 (funcall mh-letter-complete-function arg))))) 1628Otherwise, if point is in the message header and the preceding character is
1629not whitespace then do completion. Otherwise insert a space character.
1630
1631ARG is the number of spaces inserted."
1632 (interactive "p")
1633 (let ((func nil)
1634 (end-of-prev (save-excursion
1635 (goto-char (mh-beginning-of-word))
1636 (mh-beginning-of-word -1))))
1637 (cond ((not mh-compose-space-does-completion-flag)
1638 (self-insert-command arg))
1639 ((not (mh-in-header-p)) (self-insert-command arg))
1640 ((> (point) end-of-prev) (self-insert-command arg))
1641 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1642 mh-letter-complete-function-alist)))
1643 (funcall func))
1644 (t (self-insert-command arg)))))
1645
1646(defun mh-letter-confirm-address ()
1647 "Flash alias expansion if `mh-alias-flash-on-comma' is non-nil."
1648 (interactive)
1649 (cond ((not (mh-in-header-p)) (self-insert-command 1))
1650 ((eq (cdr (assoc (mh-letter-header-field-at-point)
1651 mh-letter-complete-function-alist))
1652 'mh-alias-letter-expand-alias)
1653 (mh-alias-reload-maybe)
1654 (mh-alias-minibuffer-confirm-address))
1655 (t (self-insert-command 1))))
1656
1657(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
1658
1659(defun mh-letter-header-field-at-point ()
1660 "Return the header field name at point.
1661A symbol is returned whose name is the string obtained by downcasing the field
1662name."
1663 (save-excursion
1664 (end-of-line)
1665 (and (re-search-backward mh-letter-header-field-regexp nil t)
1666 (intern (downcase (match-string 1))))))
1667
1668;;;###mh-autoload
1669(defun mh-letter-next-header-field-or-indent (arg)
1670 "Move to next field or indent depending on point.
1671In the message header, go to the next field. Elsewhere call
1672`indent-relative' as usual with optional prefix ARG."
1673 (interactive "P")
1674 (let ((header-end (save-excursion
1675 (goto-char (mh-mail-header-end))
1676 (forward-line)
1677 (point))))
1678 (if (> (point) header-end)
1679 (indent-relative arg)
1680 (mh-letter-next-header-field))))
1681
1682(defun mh-letter-next-header-field ()
1683 "Cycle to the next header field.
1684If we are at the last header field go to the start of the message body."
1685 (let ((header-end (mh-mail-header-end)))
1686 (cond ((>= (point) header-end) (goto-char (point-min)))
1687 ((< (point) (progn
1688 (beginning-of-line)
1689 (re-search-forward mh-letter-header-field-regexp
1690 (line-end-position) t)
1691 (point)))
1692 (beginning-of-line))
1693 (t (end-of-line)))
1694 (cond ((re-search-forward mh-letter-header-field-regexp header-end t)
1695 (if (mh-letter-skipped-header-field-p (match-string 1))
1696 (mh-letter-next-header-field)
1697 (mh-letter-skip-leading-whitespace-in-header-field)))
1698 (t (goto-char header-end)
1699 (forward-line)))))
1700
1701;;;###mh-autoload
1702(defun mh-letter-previous-header-field ()
1703 "Cycle to the previous header field.
1704If we are at the first header field go to the start of the message body."
1705 (interactive)
1706 (let ((header-end (mh-mail-header-end)))
1707 (if (>= (point) header-end)
1708 (goto-char header-end)
1709 (mh-header-field-beginning))
1710 (cond ((re-search-backward mh-letter-header-field-regexp nil t)
1711 (if (mh-letter-skipped-header-field-p (match-string 1))
1712 (mh-letter-previous-header-field)
1713 (goto-char (match-end 0))
1714 (mh-letter-skip-leading-whitespace-in-header-field)))
1715 (t (goto-char header-end)
1716 (forward-line)))))
1717
1718(defun mh-letter-skipped-header-field-p (field)
1719 "Check if FIELD is to be skipped."
1720 (let ((field (downcase field)))
1721 (loop for x in mh-compose-skipped-header-fields
1722 when (equal (downcase x) field) return t
1723 finally return nil)))
1724
1725(defun mh-letter-skip-leading-whitespace-in-header-field ()
1726 "Skip leading whitespace in a header field.
1727If the header field doesn't have at least one space after the colon then a
1728space character is added."
1729 (let ((need-space t))
1730 (while (memq (char-after) '(?\t ?\ ))
1731 (forward-char)
1732 (setq need-space nil))
1733 (when need-space (insert " "))))
1734
1735(defvar mh-hidden-header-keymap
1736 (let ((map (make-sparse-keymap)))
1737 (mh-do-in-gnu-emacs
1738 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
1739 (mh-do-in-xemacs
1740 (define-key map '(button2)
1741 'mh-letter-toggle-header-field-display-button))
1742 map))
1743
1744(defun mh-letter-toggle-header-field-display-button (event)
1745 "Toggle header field display at location of EVENT.
1746This function does the same thing as `mh-letter-toggle-header-field-display'
1747except that it is callable from a mouse button."
1748 (interactive "e")
1749 (mh-do-at-event-location event
1750 (mh-letter-toggle-header-field-display nil)))
1751
1752(defun mh-letter-toggle-header-field-display (arg)
1753 "Toggle display of header field at point.
1754If the header is long or spread over multiple lines then hiding it will show
1755the first few characters and replace the rest with an ellipsis.
1756
1757If ARG is negative then header is hidden, if positive it is displayed. If ARG
1758is the symbol `long' then keep at most the first 4 lines."
1759 (interactive (list nil))
1760 (when (and (mh-in-header-p)
1761 (progn
1762 (end-of-line)
1763 (re-search-backward mh-letter-header-field-regexp nil t)))
1764 (let ((buffer-read-only nil)
1765 (modified-flag (buffer-modified-p))
1766 (begin (point))
1767 end)
1768 (end-of-line)
1769 (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
1770 (match-beginning 0)
1771 (point-max))))
1772 (goto-char begin)
1773 ;; Make it clickable...
1774 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
1775 mouse-face highlight))
1776 (unwind-protect
1777 (cond ((or (and (not arg)
1778 (text-property-any begin end 'invisible 'vanish))
1779 (and (numberp arg) (>= arg 0))
1780 (and (eq arg 'long) (> (line-beginning-position 5) end)))
1781 (remove-text-properties begin end '(invisible nil))
1782 (search-forward ":" (line-end-position) t)
1783 (mh-letter-skip-leading-whitespace-in-header-field))
1784 ((eq arg 'long)
1785 (end-of-line 4)
1786 (mh-letter-truncate-header-field end)
1787 (beginning-of-line))
1788 (t (end-of-line)
1789 (mh-letter-truncate-header-field end)
1790 (beginning-of-line)))
1791 (set-buffer-modified-p modified-flag)))))
1792
1793(defun mh-letter-truncate-header-field (end)
1794 "Replace text from current line till END with an ellipsis.
1795If the current line is too long truncate a part of it as well."
1796 (let ((max-len (min (window-width) 62)))
1797 (when (> (+ (current-column) 4) max-len)
1798 (backward-char (- (+ (current-column) 5) max-len)))
1799 (when (> end (point))
1800 (add-text-properties (point) end '(invisible vanish)))))
1801
1802(defun mh-letter-hide-all-skipped-fields ()
1803 "Hide all skipped fields."
1804 (save-excursion
1805 (goto-char (point-min))
1806 (save-restriction
1807 (narrow-to-region (point) (mh-mail-header-end))
1808 (while (re-search-forward mh-letter-header-field-regexp nil t)
1809 (if (mh-letter-skipped-header-field-p (match-string 1))
1810 (mh-letter-toggle-header-field-display -1)
1811 (mh-letter-toggle-header-field-display 'long))
1812 (beginning-of-line 2)))))
1813
1814(defun mh-interactive-read-address (prompt)
1815 "Read an address.
1816If `mh-compose-prompt-flag' is non-nil, then read an address with PROMPT.
1817Otherwise return the empty string."
1818 (if mh-compose-prompt-flag (mh-read-address prompt) ""))
1819
1820(defun mh-interactive-read-string (prompt)
1821 "Read a string.
1822If `mh-compose-prompt-flag' is non-nil, then read a string with PROMPT.
1823Otherwise return the empty string."
1824 (if mh-compose-prompt-flag (read-string prompt) ""))
1825
1826(defun mh-letter-adjust-point ()
1827 "Move cursor to first header field if are using the no prompt mode."
1828 (unless mh-compose-prompt-flag
1829 (goto-char (point-max))
1830 (mh-letter-next-header-field)))
1530 1831
1531;;; Build the letter-mode keymap: 1832;;; Build the letter-mode keymap:
1532;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. 1833;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
@@ -1534,6 +1835,7 @@ passing the prefix ARG if any."
1534 "\C-c?" mh-help 1835 "\C-c?" mh-help
1535 "\C-c\C-c" mh-send-letter 1836 "\C-c\C-c" mh-send-letter
1536 "\C-c\C-d" mh-insert-identity 1837 "\C-c\C-d" mh-insert-identity
1838 "\C-c\M-d" mh-insert-auto-fields
1537 "\C-c\C-e" mh-edit-mhn 1839 "\C-c\C-e" mh-edit-mhn
1538 "\C-c\C-f\C-b" mh-to-field 1840 "\C-c\C-f\C-b" mh-to-field
1539 "\C-c\C-f\C-c" mh-to-field 1841 "\C-c\C-f\C-c" mh-to-field
@@ -1569,7 +1871,12 @@ passing the prefix ARG if any."
1569 "\C-c\C-^" mh-insert-signature ;if no C-s 1871 "\C-c\C-^" mh-insert-signature ;if no C-s
1570 "\C-c\C-w" mh-check-whom 1872 "\C-c\C-w" mh-check-whom
1571 "\C-c\C-y" mh-yank-cur-msg 1873 "\C-c\C-y" mh-yank-cur-msg
1572 "\M-\t" mh-letter-complete) 1874 "\C-c\C-t" mh-letter-toggle-header-field-display
1875 " " mh-letter-complete-or-space
1876 "\M-\t" mh-letter-complete
1877 "\t" mh-letter-next-header-field-or-indent
1878 [backtab] mh-letter-previous-header-field
1879 "," mh-letter-confirm-address)
1573 1880
1574;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. 1881;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1575 1882
diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el
index bcbfaf0586a..2ce36c88726 100644
--- a/lisp/mh-e/mh-customize.el
+++ b/lisp/mh-e/mh-customize.el
@@ -1,6 +1,6 @@
1;;; mh-customize.el --- MH-E customization 1;;; mh-customize.el --- MH-E customization
2 2
3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
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>
@@ -57,7 +57,10 @@
57 57
58;;; Code: 58;;; Code:
59(provide 'mh-customize) 59(provide 'mh-customize)
60(require 'mh-e) 60(require 'mh-utils)
61
62(when mh-xemacs-flag
63 (require 'mh-xemacs))
61 64
62;;;###mh-autoload 65;;;###mh-autoload
63(defun mh-customize (&optional delete-other-windows-flag) 66(defun mh-customize (&optional delete-other-windows-flag)
@@ -158,6 +161,13 @@ are removed."
158 :group 'mh-faces 161 :group 'mh-faces
159 :group 'mh-folder) 162 :group 'mh-folder)
160 163
164(defgroup mh-index-faces nil
165 "Faces used in indexed searches."
166 :link '(custom-manual "(mh-e)Customizing mh-e")
167 :prefix "mh-"
168 :group 'mh-faces
169 :group 'mh-index)
170
161(defgroup mh-show-faces nil 171(defgroup mh-show-faces nil
162 "Faces used in message display." 172 "Faces used in message display."
163 :link '(custom-manual "(mh-e)Customizing mh-e") 173 :link '(custom-manual "(mh-e)Customizing mh-e")
@@ -165,12 +175,12 @@ are removed."
165 :group 'mh-faces 175 :group 'mh-faces
166 :group 'mh-show) 176 :group 'mh-show)
167 177
168(defgroup mh-index-faces nil 178(defgroup mh-letter-faces nil
169 "Faces used in indexed searches." 179 "Faces used when composing messages."
170 :link '(custom-manual "(mh-e)Customizing mh-e") 180 :link '(custom-manual "(mh-e)Customizing mh-e")
171 :prefix "mh-" 181 :prefix "mh-"
172 :group 'mh-faces 182 :group 'mh-faces
173 :group 'mh-index) 183 :group 'mh-letter)
174 184
175 185
176 186
@@ -230,7 +240,6 @@ When INCLUDE-FLAG is non-nil, include message body being replied to."
230 240
231;; XEmacs has a couple of extra customizations... 241;; XEmacs has a couple of extra customizations...
232(mh-do-in-xemacs 242(mh-do-in-xemacs
233 (require 'mh-xemacs-icons)
234 (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar) 243 (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar)
235 (featurep 'xpm) 244 (featurep 'xpm)
236 (device-on-window-system-p)) 245 (device-on-window-system-p))
@@ -283,9 +292,10 @@ buttons in the folder and show mode buffers are being specified. If it is
283:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2, 292:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2,
284FUNC3, ... are the names of the functions that the buttons would execute. 293FUNC3, ... are the names of the functions that the buttons would execute.
285 294
286Each element of BUTTONS is a list of four things: 295Each element of BUTTONS is a list consisting of four mandatory items and one
296optional item as follows:
287 297
288 (FUNCTION MODES ICON DOC) 298 (FUNCTION MODES ICON DOC &optional ENABLE-EXPR)
289 299
290where, 300where,
291 301
@@ -308,7 +318,11 @@ where,
308 DOC is the documentation for the button. It is used in tool-tips and in 318 DOC is the documentation for the button. It is used in tool-tips and in
309 providing other help to the user. GNU Emacs uses only the first line of the 319 providing other help to the user. GNU Emacs uses only the first line of the
310 string. So the DOC should be formatted such that the first line is useful and 320 string. So the DOC should be formatted such that the first line is useful and
311 complete without the rest of the string." 321 complete without the rest of the string.
322
323 Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates
324 to nil, then the button is deactivated, otherwise it is active. If is in't
325 present then the button is always active."
312 ;; The following variable names have been carefully chosen to make code 326 ;; The following variable names have been carefully chosen to make code
313 ;; generation easier. Modifying the names should be done carefully. 327 ;; generation easier. Modifying the names should be done carefully.
314 (let (folder-buttons folder-docs folder-button-setter sequence-button-setter 328 (let (folder-buttons folder-docs folder-button-setter sequence-button-setter
@@ -320,7 +334,8 @@ where,
320 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x))) 334 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
321 ((eq (car x) :letter) (setq letter-defaults (cdr x))))) 335 ((eq (car x) :letter) (setq letter-defaults (cdr x)))))
322 (dolist (button buttons) 336 (dolist (button buttons)
323 (unless (and (listp button) (equal (length button) 4)) 337 (unless (and (listp button)
338 (or (equal (length button) 4) (equal (length button) 5)))
324 (error "Incorrect MH-E tool-bar button specification: %s" button)) 339 (error "Incorrect MH-E tool-bar button specification: %s" button))
325 (let* ((name (nth 0 button)) 340 (let* ((name (nth 0 button))
326 (name-str (symbol-name name)) 341 (name-str (symbol-name name))
@@ -331,6 +346,7 @@ where,
331 (doc (if (string-match "\\(.*\\)\n" full-doc) 346 (doc (if (string-match "\\(.*\\)\n" full-doc)
332 (match-string 1 full-doc) 347 (match-string 1 full-doc)
333 full-doc)) 348 full-doc))
349 (enable-expr (or (nth 4 button) t))
334 (modes (nth 1 button)) 350 (modes (nth 1 button))
335 functions show-sym) 351 functions show-sym)
336 (when (memq 'letter modes) (setq functions `(:letter ,name))) 352 (when (memq 'letter modes) (setq functions `(:letter ,name)))
@@ -369,7 +385,8 @@ where,
369 (add-to-list 385 (add-to-list
370 setter `(when (member ',name ,list) 386 setter `(when (member ',name ,list)
371 (mh-funcall-if-exists 387 (mh-funcall-if-exists
372 tool-bar-add-item ,icon ',function ',key :help ,doc))) 388 tool-bar-add-item ,icon ',function ',key
389 :help ,doc :enable ',enable-expr)))
373 (add-to-list mbuttons name) 390 (add-to-list mbuttons name)
374 (if docs (add-to-list docs doc)))))) 391 (if docs (add-to-list docs doc))))))
375 (setq folder-buttons (nreverse folder-buttons) 392 (setq folder-buttons (nreverse folder-buttons)
@@ -464,22 +481,22 @@ where,
464 (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag) 481 (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag)
465 (cond 482 (cond
466 ((eq mh-xemacs-toolbar-position 'top) 483 ((eq mh-xemacs-toolbar-position 'top)
467 (set-specifier top-toolbar (cons buffer toolbar)) 484 (set-specifier top-toolbar toolbar buffer)
468 (set-specifier top-toolbar-visible-p t) 485 (set-specifier top-toolbar-visible-p t)
469 (set-specifier top-toolbar-height height)) 486 (set-specifier top-toolbar-height height))
470 ((eq mh-xemacs-toolbar-position 'bottom) 487 ((eq mh-xemacs-toolbar-position 'bottom)
471 (set-specifier bottom-toolbar (cons buffer toolbar)) 488 (set-specifier bottom-toolbar toolbar buffer)
472 (set-specifier bottom-toolbar-visible-p t) 489 (set-specifier bottom-toolbar-visible-p t)
473 (set-specifier bottom-toolbar-height height)) 490 (set-specifier bottom-toolbar-height height))
474 ((eq mh-xemacs-toolbar-position 'left) 491 ((eq mh-xemacs-toolbar-position 'left)
475 (set-specifier left-toolbar (cons buffer toolbar)) 492 (set-specifier left-toolbar toolbar buffer)
476 (set-specifier left-toolbar-visible-p t) 493 (set-specifier left-toolbar-visible-p t)
477 (set-specifier left-toolbar-width width)) 494 (set-specifier left-toolbar-width width))
478 ((eq mh-xemacs-toolbar-position 'right) 495 ((eq mh-xemacs-toolbar-position 'right)
479 (set-specifier right-toolbar (cons buffer toolbar)) 496 (set-specifier right-toolbar toolbar buffer)
480 (set-specifier right-toolbar-visible-p t) 497 (set-specifier right-toolbar-visible-p t)
481 (set-specifier right-toolbar-width width)) 498 (set-specifier right-toolbar-width width))
482 (t (set-specifier default-toolbar (cons buffer toolbar)))))))) 499 (t (set-specifier default-toolbar toolbar buffer)))))))
483 ;; Declare customizable toolbars 500 ;; Declare customizable toolbars
484 (custom-declare-variable 501 (custom-declare-variable
485 'mh-tool-bar-folder-buttons 502 'mh-tool-bar-folder-buttons
@@ -541,7 +558,8 @@ This button runs `mh-previous-undeleted-msg'")
541 (mh-reply (folder) "mail/reply2" 558 (mh-reply (folder) "mail/reply2"
542 "Reply to this message\nThis button runs `mh-reply'") 559 "Reply to this message\nThis button runs `mh-reply'")
543 (mh-alias-grab-from-field (folder) "alias" 560 (mh-alias-grab-from-field (folder) "alias"
544 "Grab From alias\nThis button runs `mh-alias-grab-from-field'") 561 "Grab From alias\nThis button runs `mh-alias-grab-from-field'"
562 (mh-alias-from-has-no-alias-p))
545 (mh-send (folder) "mail_compose" 563 (mh-send (folder) "mail_compose"
546 "Compose new message\nThis button runs `mh-send'") 564 "Compose new message\nThis button runs `mh-send'")
547 (mh-rescan-folder (folder) "rescan" 565 (mh-rescan-folder (folder) "rescan"
@@ -661,7 +679,6 @@ the `mh-progs' directory unless it is an absolute pathname."
661 :type 'string 679 :type 'string
662 :group 'mh-folder) 680 :group 'mh-folder)
663 681
664
665(defcustom mh-inc-spool-list nil 682(defcustom mh-inc-spool-list nil
666 "*Alist of alternate spool files, corresponding folders and keybindings. 683 "*Alist of alternate spool files, corresponding folders and keybindings.
667Here's an example. Suppose you have subscribed to the MH-E devel mailing 684Here's an example. Suppose you have subscribed to the MH-E devel mailing
@@ -699,6 +716,13 @@ when clicking the xbuffy box with the middle mouse button."
699 :set 'mh-inc-spool-list-set 716 :set 'mh-inc-spool-list-set
700 :group 'mh-folder) 717 :group 'mh-folder)
701 718
719(defcustom mh-interpret-number-as-range-flag t
720 "Non-nil means interpret a number as a range.
721If the variable is non-nil, and you use an integer, N, when asked for a
722range to scan, then MH-E uses the range \"last:N\"."
723 :type 'boolean
724 :group 'mh-folder)
725
702(defcustom mh-lpr-command-format "lpr -J '%s'" 726(defcustom mh-lpr-command-format "lpr -J '%s'"
703 "*Format for Unix command that prints a message. 727 "*Format for Unix command that prints a message.
704The string should be a Unix command line, with the string '%s' where 728The string should be a Unix command line, with the string '%s' where
@@ -734,6 +758,18 @@ Recenter the summary window when the show window is toggled off if non-nil."
734 :type 'boolean 758 :type 'boolean
735 :group 'mh-folder) 759 :group 'mh-folder)
736 760
761;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following tot
762;;; he docstring: "Additional sequences that should not to be preserved can be
763;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX
764
765(defcustom mh-refile-preserves-sequences-flag t
766 "*Non-nil means that sequences are preserved when messages are refiled.
767If this variable is non-nil and a message belonging to a sequence other than
768cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the
769same sequence in the destination folder."
770 :type 'boolean
771 :group 'mh-folder)
772
737(defcustom mh-scan-format-file t 773(defcustom mh-scan-format-file t
738 "Specifies the format file to pass to the scan program. 774 "Specifies the format file to pass to the scan program.
739If t, the format string will be taken from the either `mh-scan-format-mh' 775If t, the format string will be taken from the either `mh-scan-format-mh'
@@ -819,6 +855,16 @@ found in the documentation of `mh-index-search'."
819 (const :tag "grep" grep)) 855 (const :tag "grep" grep))
820 :group 'mh-index) 856 :group 'mh-index)
821 857
858(defcustom mh-index-ticked-messages-folders t
859 "Folders searched for `mh-tick-seq'.
860If t, then `mh-inbox' is searched. If nil, all the top level folders are
861searched. Otherwise the list of folders specified as strings are searched.
862See also `mh-recursive-folders-flag'."
863 :group 'mh-index
864 :type '(choice (const :tag "Inbox" t)
865 (const :tag "All" nil)
866 (repeat :tag "Choose folders" (string :tag "Folder"))))
867
822 868
823 869
824;;; Spam Handling (:group 'mh-junk) 870;;; Spam Handling (:group 'mh-junk)
@@ -878,8 +924,9 @@ first one found is used."
878 924
879(defcustom mh-clean-message-header-flag t 925(defcustom mh-clean-message-header-flag t
880 "*Non-nil means clean headers of messages that are displayed or inserted. 926 "*Non-nil means clean headers of messages that are displayed or inserted.
881The variables `mh-invisible-headers' and `mh-visible-headers' control 927The variable `mh-invisible-headers' if set determines the header fields that
882what is removed." 928are displayed. If it isn't set, then the variable `mh-invisible-headers'
929determines the header fields that are removed."
883 :type 'boolean 930 :type 'boolean
884 :group 'mh-show) 931 :group 'mh-show)
885 932
@@ -888,6 +935,14 @@ what is removed."
888 :type 'boolean 935 :type 'boolean
889 :group 'mh-show) 936 :group 'mh-show)
890 937
938(defcustom mh-display-buttons-for-alternatives-flag nil
939 "*Non-nil means display buttons for all MIME alternatives.
940Default behavior is to display only the preferred alternative. If this
941variable is non-nil, then the preferred part is shown inline and buttons
942are shown for each of the other alternatives."
943 :type 'boolean
944 :group 'mh-show)
945
891(defcustom mh-display-buttons-for-inline-parts-flag nil 946(defcustom mh-display-buttons-for-inline-parts-flag nil
892 "*Non-nil means display buttons for all inline MIME parts. 947 "*Non-nil means display buttons for all inline MIME parts.
893If non-nil, buttons are displayed for all MIME parts. Inline parts start off 948If non-nil, buttons are displayed for all MIME parts. Inline parts start off
@@ -949,27 +1004,23 @@ The gnus method uses a different color for each indentation."
949 1004
950(defvar mh-invisible-headers nil 1005(defvar mh-invisible-headers nil
951 "*Regexp matching lines in a message header that are not to be shown. 1006 "*Regexp matching lines in a message header that are not to be shown.
952Use the function `mh-invisible-headers' to generate this variable. 1007Customize the variable `mh-invisible-header-fields' to generate this variable;
953If `mh-visible-headers' is non-nil, it is used instead to specify what 1008It will in turn automatically use the function `mh-invisible-headers' to
954to keep.") 1009generate this variable.
1010If the variable `mh-visible-headers' is non-nil, it is used instead to specify
1011what to keep.")
955 1012
956(defun mh-invisible-headers () 1013(defun mh-invisible-headers ()
957 "Make or remake the variable `mh-invisible-headers'. 1014 "Make or remake the variable `mh-invisible-headers'.
958Done using `mh-invisible-header-fields' as input." 1015Done using `mh-invisible-header-fields' as input."
959 (setq mh-invisible-headers 1016 (if mh-invisible-header-fields
960 (concat 1017 (setq mh-invisible-headers
961 "^" 1018 (concat
962 (let ((max-specpdl-size 1000) ;workaround for insufficient default 1019 "^"
963 (fields mh-invisible-header-fields)) 1020 (let ((max-specpdl-size 1000) ;workaround for insufficient default
964 (regexp-opt fields t))))) 1021 (fields mh-invisible-header-fields))
965 1022 (regexp-opt fields t))))
966(defun mh-invisible-header-fields-set (symbol value) 1023 (setq mh-invisible-headers nil)))
967 "Update `mh-invisible-header-fields'.
968The function is called with SYMBOL bound to `mh-invisible-header-fields' and
969VALUE is the the list of headers that are invisible. As a side effect, the
970variable `mh-invisible-fields' is set."
971 (set-default symbol value)
972 (mh-invisible-headers))
973 1024
974;; Keep fields alphabetized. Mention source, if known. 1025;; Keep fields alphabetized. Mention source, if known.
975(defcustom mh-invisible-header-fields 1026(defcustom mh-invisible-header-fields
@@ -982,6 +1033,7 @@ variable `mh-invisible-fields' is set."
982 "Delivery-Date:" ; MH 1033 "Delivery-Date:" ; MH
983 "Delivery:" 1034 "Delivery:"
984 "Encoding:" 1035 "Encoding:"
1036 "Envelope-to:"
985 "Errors-To:" 1037 "Errors-To:"
986 "Face:" ; Gnus Face header 1038 "Face:" ; Gnus Face header
987 "Forwarded:" ; MH 1039 "Forwarded:" ; MH
@@ -1023,7 +1075,7 @@ variable `mh-invisible-fields' is set."
1023 "Sensitivity:" ; MS Outlook 1075 "Sensitivity:" ; MS Outlook
1024 "Status:" ; sendmail 1076 "Status:" ; sendmail
1025 "Ua-Content-Id:" ; X400 1077 "Ua-Content-Id:" ; X400
1026 "User-Agent:" 1078;; "User-Agent:" ; Similar to X-Mailer, so display it.
1027 "Via:" ; MH 1079 "Via:" ; MH
1028 "X-Abuse-Info:" 1080 "X-Abuse-Info:"
1029 "X-Accept-Language:" 1081 "X-Accept-Language:"
@@ -1076,6 +1128,7 @@ variable `mh-invisible-fields' is set."
1076 "X-Orcl-Content-Type:" 1128 "X-Orcl-Content-Type:"
1077 "X-Original-Complaints-To:" 1129 "X-Original-Complaints-To:"
1078 "X-Original-Date:" ; SourceForge mailing list manager 1130 "X-Original-Date:" ; SourceForge mailing list manager
1131 "X-Original-To:"
1079 "X-Original-Trace:" 1132 "X-Original-Trace:"
1080 "X-OriginalArrivalTime:" ; Hotmail 1133 "X-OriginalArrivalTime:" ; Hotmail
1081 "X-Originating-IP:" ; Hotmail 1134 "X-Originating-IP:" ; Hotmail
@@ -1113,9 +1166,11 @@ variable `mh-invisible-fields' is set."
1113Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, 1166Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise,
1114the element can be used to render invisible an entire class of fields that 1167the element can be used to render invisible an entire class of fields that
1115start with the same prefix. 1168start with the same prefix.
1116This variable is ignored if `mh-visible-headers' is set." 1169This variable is ignored if the variable `mh-visible-headers' is set."
1117 :type '(repeat (string :tag "Header field")) 1170 :type '(repeat (string :tag "Header field"))
1118 :set 'mh-invisible-header-fields-set 1171 :set (lambda (symbol value)
1172 (set-default symbol value)
1173 (mh-invisible-headers))
1119 :group 'mh-show) 1174 :group 'mh-show)
1120 1175
1121(defcustom mh-max-inline-image-height nil 1176(defcustom mh-max-inline-image-height nil
@@ -1185,19 +1240,43 @@ inline images. So face images are not displayed in these versions."
1185 :type 'boolean 1240 :type 'boolean
1186 :group 'mh-show) 1241 :group 'mh-show)
1187 1242
1188(defcustom mh-summary-height (or (and (fboundp 'frame-height) 1243(defcustom mh-summary-height nil
1189 (> (frame-height) 24)
1190 (min 10 (/ (frame-height) 6)))
1191 4)
1192 "*Number of lines in MH-Folder window (including the mode line)." 1244 "*Number of lines in MH-Folder window (including the mode line)."
1193 :type 'integer 1245 :type '(choice (const :tag "Automatic" nil)
1246 (integer :tag "Fixed sized"))
1194 :group 'mh-show) 1247 :group 'mh-show)
1195 1248
1196(defcustom mh-visible-headers nil 1249(defvar mh-visible-headers nil
1197 "*Contains a regexp specifying the headers to keep when cleaning. 1250 "*Regexp matching lines in a message header that are to be shown.
1251Customize the variable `mh-visible-header-fields' to generate this variable;
1252It will in turn automatically use the function `mh-visible-headers' to
1253generate this variable.
1198Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides 1254Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
1199the variable `mh-invisible-headers'." 1255the variable `mh-invisible-headers'.")
1200 :type '(choice (const nil) regexp) 1256
1257(defun mh-visible-headers ()
1258 "Make or remake the variable `mh-visible-headers'.
1259Done using `mh-visible-header-fields' as input."
1260 (if mh-visible-header-fields
1261 (setq mh-visible-headers
1262 (concat
1263 "^"
1264 (let ((max-specpdl-size 1000) ;workaround for insufficient default
1265 (fields mh-visible-header-fields))
1266 (regexp-opt fields t))))
1267 (setq mh-visible-headers nil)))
1268
1269(defcustom mh-visible-header-fields nil
1270"*List of header fields that are to be shown.
1271Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise,
1272the element can be used to render visible an entire class of fields that
1273start with the same prefix.
1274Only used if `mh-clean-message-header-flag' is non-nil.
1275Setting it overrides the variable `mh-invisible-headers'."
1276 :type '(repeat (string :tag "Header field"))
1277 :set (lambda (symbol value)
1278 (set-default symbol value)
1279 (mh-visible-headers))
1201 :group 'mh-show) 1280 :group 'mh-show)
1202 1281
1203(defcustom mhl-formfile nil 1282(defcustom mhl-formfile nil
@@ -1227,6 +1306,23 @@ It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
1227 :type '(choice (const nil) function) 1306 :type '(choice (const nil) function)
1228 :group 'mh-letter) 1307 :group 'mh-letter)
1229 1308
1309(defcustom mh-compose-prompt-flag nil
1310 "*Non-nil means prompt for header fields when composing a new draft."
1311 :type 'boolean
1312 :group 'mh-letter)
1313
1314(defcustom mh-compose-skipped-header-fields
1315 '("from" "organization" "references" "in-reply-to" "x-face" "face"
1316 "x-mailer")
1317 "List of header fields to skip over when navigating in draft."
1318 :type '(repeat (string :tag "Field"))
1319 :group 'mh-letter)
1320
1321(defcustom mh-compose-space-does-completion-flag nil
1322 "*Non-nil means that SPACE does completion in message header."
1323 :type 'boolean
1324 :group 'mh-letter)
1325
1230(defcustom mh-delete-yanked-msg-window-flag nil 1326(defcustom mh-delete-yanked-msg-window-flag nil
1231 "*Non-nil means delete any window displaying the message. 1327 "*Non-nil means delete any window displaying the message.
1232Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. 1328Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
@@ -1428,6 +1524,33 @@ password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
1428 :type '(choice (boolean) (string)) 1524 :type '(choice (boolean) (string))
1429 :group 'mh-alias) 1525 :group 'mh-alias)
1430 1526
1527(defcustom mh-alias-local-users-prefix "local."
1528 "*String prepended to the real names of users from the passwd file.
1529If nil, use the username string unmodified instead of the real name from
1530the gecos field of the passwd file.
1531
1532For example, given the following passwd file line:
1533
1534 psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh
1535
1536here are the derived aliases for different values of this variable:
1537
1538 \"local.\" -> local.peter.galbraith
1539 \"\" -> peter.galbraith
1540 nii -> psg
1541
1542This variable is only meaningful if the variable `mh-alias-local-users' is
1543non-nil."
1544 :type '(choice (const :tag "Use username instead of real name" nil)
1545 (string))
1546 :group 'mh-alias)
1547
1548(defcustom mh-alias-passwd-gecos-comma-separator-flag t
1549 "*Non-nil means the gecos field in the passwd file uses comma as a separator.
1550Used to construct aliases for users in the passwd file."
1551 :type 'boolean
1552 :group 'mh-alias)
1553
1431(defcustom mh-alias-system-aliases 1554(defcustom mh-alias-system-aliases
1432 '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd") 1555 '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
1433 "*A list of system files from which to cull aliases. 1556 "*A list of system files from which to cull aliases.
@@ -1442,7 +1565,52 @@ You can update the alias list manually using \\[mh-alias-reload]."
1442 1565
1443;;; Multiple personalities (:group 'mh-identity) 1566;;; Multiple personalities (:group 'mh-identity)
1444 1567
1445(defvar mh-identity-list ()) 1568(defcustom mh-identity-list nil
1569 "*List holding MH-E identity.
1570Omit the colon and trailing space from the field names.
1571The keyword name \"none\" is reserved for internal use.
1572Use the keyname name \"signature\" to specify either a signature file or a
1573function to call to insert a signature at point.
1574
1575Providing an empty Value (\"\") will cause the field to be deleted.
1576
1577Example entries using the customize interface:
1578 Keyword name: work
1579 From
1580 Value: John Doe <john@work.com>
1581 Organization
1582 Value: Acme Inc.
1583 Keyword name: home
1584 From
1585 Value: John Doe <johndoe@home.net>
1586 Organization
1587 Value:
1588
1589This would produce the equivalent of:
1590 (setq mh-identity-list
1591 '((\"work\"
1592 ((\"From\" . \"John Doe <john@work.com>\")
1593 (\"Organization\" . \"Acme Inc.\")))
1594 (\"home\"
1595 ((\"From\" . \"John Doe <johndoe@home.net>\")
1596 (\"Organization\" . \"\")))))"
1597 :type '(repeat (list :tag ""
1598 (string :tag "Keyword name")
1599 (repeat :tag "At least one pair from below"
1600 (choice (cons :tag "From field"
1601 (const "From")
1602 (string :tag "Value"))
1603 (cons :tag "Organization field"
1604 (const "Organization")
1605 (string :tag "Value"))
1606 (cons :tag "Signature"
1607 (const "signature")
1608 (choice (file) (function)))
1609 (cons :tag "Other field & value pair"
1610 (string :tag "Field")
1611 (string :tag "Value"))))))
1612 :set 'mh-identity-list-set
1613 :group 'mh-identity)
1446 1614
1447(defcustom mh-auto-fields-list nil 1615(defcustom mh-auto-fields-list nil
1448 "Alist of addresses for which header lines are automatically inserted. 1616 "Alist of addresses for which header lines are automatically inserted.
@@ -1491,53 +1659,6 @@ prompted for in the customization interface."
1491 (mapcar 'car mh-identity-list)))) 1659 (mapcar 'car mh-identity-list))))
1492 :group 'mh-identity) 1660 :group 'mh-identity)
1493 1661
1494(defcustom mh-identity-list nil
1495 "*List holding MH-E identity.
1496Omit the colon and trailing space from the field names.
1497The keyword name \"none\" is reversed for internal use.
1498Use the keyname name \"signature\" to specify either a signature file or a
1499function to call to insert a signature at point.
1500
1501Providing an empty Value (\"\") will cause the field to be deleted.
1502
1503Example entries using the customize interface:
1504 Keyword name: work
1505 From
1506 Value: John Doe <john@work.com>
1507 Organization
1508 Value: Acme Inc.
1509 Keyword name: home
1510 From
1511 Value: John Doe <johndoe@home.net>
1512 Organization
1513 Value:
1514
1515This would produce the equivalent of:
1516 (setq mh-identity-list
1517 '((\"work\"
1518 ((\"From\" . \"John Doe <john@work.com>\")
1519 (\"Organization\" . \"Acme Inc.\")))
1520 (\"home\"
1521 ((\"From\" . \"John Doe <johndoe@home.net>\")
1522 (\"Organization\" . \"\")))))"
1523 :type '(repeat (list :tag ""
1524 (string :tag "Keyword name")
1525 (repeat :tag "At least one pair from below"
1526 (choice (cons :tag "From field"
1527 (const "From")
1528 (string :tag "Value"))
1529 (cons :tag "Organization field"
1530 (const "Organization")
1531 (string :tag "Value"))
1532 (cons :tag "Signature"
1533 (const "signature")
1534 (choice (file) (function)))
1535 (cons :tag "Other field & value pair"
1536 (string :tag "Field")
1537 (string :tag "Value"))))))
1538 :set 'mh-identity-list-set
1539 :group 'mh-identity)
1540
1541 1662
1542 1663
1543;;; Hooks (:group 'mh-hooks + group where hook defined) 1664;;; Hooks (:group 'mh-hooks + group where hook defined)
@@ -1597,6 +1718,23 @@ current folder, `mh-current-folder'."
1597 :group 'mh-hooks 1718 :group 'mh-hooks
1598 :group 'mh-folder) 1719 :group 'mh-folder)
1599 1720
1721(defcustom mh-kill-folder-suppress-prompt-hook '(mh-index-p)
1722 "Invoked at the beginning of the \\<mh-folder-mode-map>`\\[mh-kill-folder]' command.
1723This hook is a list of functions to be called, with no arguments, which should
1724return a value of non-nil if you should not be asked if you're sure that you
1725want to remove the folder. This is useful for folders that are easily
1726regenerated.
1727
1728The default value of `mh-index-p' suppresses the prompt on folders generated
1729by an index search.
1730
1731WARNING: Use this hook with care. If there is a bug in your hook which returns
1732t on +inbox and you hit \\<mh-folder-mode-map>`\\[mh-kill-folder]' by accident
1733in the +inbox buffer, you will not be happy."
1734 :type 'hook
1735 :group 'mh-hooks
1736 :group 'mh-folder)
1737
1600(defcustom mh-letter-insert-signature-hook nil 1738(defcustom mh-letter-insert-signature-hook nil
1601 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. 1739 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
1602Can be used to determine which signature file to use based on message content. 1740Can be used to determine which signature file to use based on message content.
@@ -1917,6 +2055,19 @@ The background and foreground is used in the image."
1917 "Face for highlighting folders in MH-Index buffers." 2055 "Face for highlighting folders in MH-Index buffers."
1918 :group 'mh-index-faces) 2056 :group 'mh-index-faces)
1919 2057
2058
2059
2060;;; Faces used when composing messages.
2061
2062(defface mh-letter-header-field-face
2063 '((((class color) (background light))
2064 (:background "gray90"))
2065 (((class color) (background dark))
2066 (:background "gray10"))
2067 (t (:bold t)))
2068 "Face for displaying header fields in draft buffers."
2069 :group 'mh-letter-faces)
2070
1920;;; Local Variables: 2071;;; Local Variables:
1921;;; indent-tabs-mode: nil 2072;;; indent-tabs-mode: nil
1922;;; sentence-end-double-space: nil 2073;;; sentence-end-double-space: nil
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 344a67f5725..ac5a7d5070c 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1,11 +1,11 @@
1;;; mh-e.el --- GNU Emacs interface to the MH mail system 1;;; mh-e.el --- GNU Emacs interface to the MH mail system
2 2
3;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999, 3;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,
4;; 2000, 01, 02, 2003 Free Software Foundation, Inc. 4;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Bill Wohler <wohler@newt.com> 6;; Author: Bill Wohler <wohler@newt.com>
7;; Maintainer: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com>
8;; Version: 7.3 8;; Version: 7.4.4
9;; Keywords: mail 9;; Keywords: mail
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
@@ -82,7 +82,9 @@
82 82
83;;; Code: 83;;; Code:
84 84
85(require 'cl) 85(provide 'mh-e)
86(require 'mh-utils)
87(mh-require-cl)
86 88
87(defvar recursive-load-depth-limit) 89(defvar recursive-load-depth-limit)
88(eval-when (compile load eval) 90(eval-when (compile load eval)
@@ -92,17 +94,14 @@
92 (setq recursive-load-depth-limit 50))) 94 (setq recursive-load-depth-limit 50)))
93 95
94(require 'mh-inc) 96(require 'mh-inc)
95(require 'mh-utils)
96(require 'gnus-util) 97(require 'gnus-util)
97(require 'easymenu) 98(require 'easymenu)
98(if mh-xemacs-flag
99 (require 'mh-xemacs-compat))
100 99
101;; Shush the byte-compiler 100;; Shush the byte-compiler
102(defvar font-lock-auto-fontify) 101(defvar font-lock-auto-fontify)
103(defvar font-lock-defaults) 102(defvar font-lock-defaults)
104 103
105(defconst mh-version "7.3" "Version number of MH-E.") 104(defconst mh-version "7.4.3" "Version number of MH-E.")
106 105
107;;; Autoloads 106;;; Autoloads
108(autoload 'Info-goto-node "info") 107(autoload 'Info-goto-node "info")
@@ -283,9 +282,7 @@ third should match the user name.")
283 '(3 mh-folder-scan-format-face)) 282 '(3 mh-folder-scan-format-face))
284 ;; Current message line 283 ;; Current message line
285 (list mh-scan-cur-msg-regexp 284 (list mh-scan-cur-msg-regexp
286 '(1 mh-folder-cur-msg-face prepend t)) 285 '(1 mh-folder-cur-msg-face prepend t)))
287 ;; Unseen messages in bold
288 '(mh-folder-font-lock-unseen (1 'bold append t)))
289 "Regexp keywords used to fontify the MH-Folder buffer.") 286 "Regexp keywords used to fontify the MH-Folder buffer.")
290 287
291(defvar mh-scan-cmd-note-width 1 288(defvar mh-scan-cmd-note-width 1
@@ -399,50 +396,61 @@ On nmh systems.")
399 (goto-char (point-min)) 396 (goto-char (point-min))
400 (sort (mh-read-msg-list) '<))))))))) 397 (sort (mh-read-msg-list) '<)))))))))
401 398
402(defvar mh-folder-unseen-seq-cache nil 399(defmacro mh-generate-sequence-font-lock (seq prefix face)
403 "Internal cache variable used for font-lock in MH-E. 400 "Generate the appropriate code to fontify messages in SEQ.
401PREFIX is used to generate unique names for the variables and functions
402defined by the macro. So a different prefix should be provided for every
403invocation.
404FACE is the font-lock face used to display the matching scan lines."
405 (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
406 (func (intern (format "mh-folder-font-lock-%s" prefix))))
407 `(progn
408 (defvar ,cache nil
409 "Internal cache variable used for font-lock in MH-E.
404Should only be non-nil through font-lock stepping, and nil once font-lock 410Should only be non-nil through font-lock stepping, and nil once font-lock
405is done highlighting.") 411is done highlighting.")
406(make-variable-buffer-local 'mh-folder-unseen-seq-cache) 412 (make-variable-buffer-local ',cache)
407 413
408(defun mh-folder-font-lock-unseen (limit) 414 (defun ,func (limit)
409 "Return unseen message lines to font-lock between point and LIMIT." 415 "Return unseen message lines to font-lock between point and LIMIT."
410 (if (not mh-folder-unseen-seq-cache) 416 (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
411 (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list))) 417 (let ((cur-msg (mh-get-msg-num nil)))
412 (let ((cur-msg (mh-get-msg-num nil))) 418 (cond ((not ,cache)
413 (cond 419 nil)
414 ((not mh-folder-unseen-seq-cache) 420 ((>= (point) limit) ;Presumably at end of buffer
415 nil) 421 (setq ,cache nil)
416 ((>= (point) limit) ;Presumably at end of buffer 422 nil)
417 (setq mh-folder-unseen-seq-cache nil) 423 ((member cur-msg ,cache)
418 nil) 424 (let ((bpoint (progn (beginning-of-line)(point)))
419 ((member cur-msg mh-folder-unseen-seq-cache) 425 (epoint (progn (forward-line 1)(point))))
420 (let ((bpoint (progn (beginning-of-line)(point))) 426 (if (<= limit (point)) (setq ,cache nil))
421 (epoint (progn (forward-line 1)(point)))) 427 (set-match-data (list bpoint epoint bpoint epoint))
422 (if (<= limit (point)) 428 t))
423 (setq mh-folder-unseen-seq-cache nil)) 429 (t
424 (set-match-data (list bpoint epoint bpoint epoint)) 430 ;; move forward one line at a time, checking each message
425 t)) 431 (while (and (= 0 (forward-line 1))
426 (t 432 (> limit (point))
427 ;; move forward one line at a time, checking each message number. 433 (not (member (mh-get-msg-num nil) ,cache))))
428 (while (and 434 ;; Examine how we must have exited the loop...
429 (= 0 (forward-line 1)) 435 (let ((cur-msg (mh-get-msg-num nil)))
430 (> limit (point)) 436 (cond ((or (<= limit (point))
431 (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache)))) 437 (not (member cur-msg ,cache)))
432 ;; Examine how we must have exited the loop... 438 (setq ,cache nil)
433 (let ((cur-msg (mh-get-msg-num nil))) 439 nil)
434 (cond 440 ((member cur-msg ,cache)
435 ((or (<= limit (point)) 441 (let ((bpoint (progn (beginning-of-line) (point)))
436 (not (member cur-msg mh-folder-unseen-seq-cache))) 442 (epoint (progn (forward-line 1) (point))))
437 (setq mh-folder-unseen-seq-cache nil) 443 (if (<= limit (point)) (setq ,cache nil))
438 nil) 444 (set-match-data
439 ((member cur-msg mh-folder-unseen-seq-cache) 445 (list bpoint epoint bpoint epoint))
440 (let ((bpoint (progn (beginning-of-line)(point))) 446 t))))))))
441 (epoint (progn (forward-line 1)(point)))) 447
442 (if (<= limit (point)) 448 (setq mh-folder-font-lock-keywords
443 (setq mh-folder-unseen-seq-cache nil)) 449 (append mh-folder-font-lock-keywords
444 (set-match-data (list bpoint epoint bpoint epoint)) 450 (list (list ',func (list 1 '',face 'prepend t))))))))
445 t)))))))) 451
452(mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
453(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face)
446 454
447 455
448 456
@@ -464,20 +472,15 @@ is done highlighting.")
464 472
465(defvar mh-next-direction 'forward) ;Direction to move to next message. 473(defvar mh-next-direction 'forward) ;Direction to move to next message.
466 474
467(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
468 ;nil if not narrowed.
469
470(defvar mh-tick-seq-changed-when-narrowed-flag nil)
471 ;Has tick sequence changed while the
472 ;folder was narrowed to it?
473
474(defvar mh-view-ops ()) ;Stack of ops that change the folder 475(defvar mh-view-ops ()) ;Stack of ops that change the folder
475 ;view (such as narrowing or threading). 476 ;view (such as narrowing or threading).
477(defvar mh-folder-view-stack ()) ;Stack of previous folder views.
476 478
477(defvar mh-index-data nil) ;Info about index search results 479(defvar mh-index-data nil) ;Info about index search results
478(defvar mh-index-previous-search nil) 480(defvar mh-index-previous-search nil)
479(defvar mh-index-msg-checksum-map nil) 481(defvar mh-index-msg-checksum-map nil)
480(defvar mh-index-checksum-origin-map nil) 482(defvar mh-index-checksum-origin-map nil)
483(defvar mh-index-sequence-search-flag nil)
481 484
482(defvar mh-first-msg-num nil) ;Number of first msg in buffer. 485(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
483 486
@@ -485,6 +488,10 @@ is done highlighting.")
485 488
486(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. 489(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
487 490
491(defvar mh-sequence-notation-history nil)
492 ;Rememeber original notation that
493 ;is overwritten by `mh-note-seq'.
494
488;;; Macros and generic functions: 495;;; Macros and generic functions:
489 496
490(defun mh-mapc (function list) 497(defun mh-mapc (function list)
@@ -494,7 +501,7 @@ is done highlighting.")
494 (setq list (cdr list)))) 501 (setq list (cdr list))))
495 502
496(defun mh-scan-format () 503(defun mh-scan-format ()
497 "Return \"-format\" argument for the scan program." 504 "Return the output format argument for the scan program."
498 (if (equal mh-scan-format-file t) 505 (if (equal mh-scan-format-file t)
499 (list "-format" (if mh-nmh-flag 506 (list "-format" (if mh-nmh-flag
500 (list (mh-update-scan-format 507 (list (mh-update-scan-format
@@ -502,7 +509,7 @@ is done highlighting.")
502 (list (mh-update-scan-format 509 (list (mh-update-scan-format
503 mh-scan-format-mh mh-cmd-note)))) 510 mh-scan-format-mh mh-cmd-note))))
504 (if (not (equal mh-scan-format-file nil)) 511 (if (not (equal mh-scan-format-file nil))
505 (list "-format" mh-scan-format-file)))) 512 (list "-form" mh-scan-format-file))))
506 513
507 514
508 515
@@ -536,34 +543,29 @@ the Emacs front end to the MH mail system."
536 543
537;;; User executable MH-E commands: 544;;; User executable MH-E commands:
538 545
539(defun mh-delete-msg (msg-or-seq) 546(defun mh-delete-msg (range)
540 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. 547 "Mark the specified RANGE for subsequent deletion and move to the next.
541Default is the displayed message. 548Default is the displayed message.
542If optional prefix argument is provided, then prompt for the message sequence. 549
543If variable `transient-mark-mode' is non-nil and the mark is active, then the 550Check the documentation of `mh-interactive-range' to see how RANGE is read in
544selected region is marked for deletion. 551interactive use."
545In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a 552 (interactive (list (mh-interactive-range "Delete")))
546region in a cons cell, or a sequence." 553 (mh-delete-msg-no-motion range)
547 (interactive (list (mh-interactive-msg-or-seq "Delete"))) 554 (if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg)))
548 (mh-delete-msg-no-motion msg-or-seq) 555
549 (mh-next-msg)) 556(defun mh-delete-msg-no-motion (range)
550 557 "Mark the specified RANGE for subsequent deletion.
551(defun mh-delete-msg-no-motion (msg-or-seq) 558
552 "Mark the specified MSG-OR-SEQ for subsequent deletion. 559Check the documentation of `mh-interactive-range' to see how RANGE is read in
553Default is the displayed message. 560interactive use."
554If optional prefix argument is provided, then prompt for the message sequence. 561 (interactive (list (mh-interactive-range "Delete")))
555If variable `transient-mark-mode' is non-nil and the mark is active, then the 562 (mh-iterate-on-range () range
556selected region is marked for deletion.
557In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
558region in a cons cell, or a sequence."
559 (interactive (list (mh-interactive-msg-or-seq "Delete")))
560 (mh-iterate-on-msg-or-seq () msg-or-seq
561 (mh-delete-a-msg nil))) 563 (mh-delete-a-msg nil)))
562 564
563(defun mh-execute-commands () 565(defun mh-execute-commands ()
564 "Process outstanding delete and refile requests." 566 "Process outstanding delete and refile requests."
565 (interactive) 567 (interactive)
566 (if mh-narrowed-to-seq (mh-widen)) 568 (if mh-folder-view-stack (mh-widen t))
567 (mh-process-commands mh-current-folder) 569 (mh-process-commands mh-current-folder)
568 (mh-set-scan-mode) 570 (mh-set-scan-mode)
569 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency 571 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
@@ -626,7 +628,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
626 (save-excursion 628 (save-excursion
627 (goto-char (point-min)) 629 (goto-char (point-min))
628 (or (null mh-large-folder) 630 (or (null mh-large-folder)
629 (not (equal (forward-line mh-large-folder) 0)) 631 (not (equal (forward-line (1+ mh-large-folder)) 0))
630 (and (message "Not threading since the number of messages exceeds `mh-large-folder'") 632 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
631 nil)))) 633 nil))))
632 (mh-toggle-threads)) 634 (mh-toggle-threads))
@@ -673,31 +675,19 @@ Takes the address in the From: header field, and returns one of:
673Returns nil if the address was not found in either place or if the variable 675Returns nil if the address was not found in either place or if the variable
674`mh-default-folder-must-exist-flag' is nil and the folder does not exist." 676`mh-default-folder-must-exist-flag' is nil and the folder does not exist."
675 ;; Loop for all entries in mh-default-folder-list 677 ;; Loop for all entries in mh-default-folder-list
676 (save-excursion 678 (save-restriction
677 (let ((folder-name 679 (goto-char (point-min))
678 (car 680 (re-search-forward "\n\n" nil t)
679 (delq nil 681 (narrow-to-region (point-min) (point))
680 (mapcar 682 (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
681 (lambda (list) 683 (or (message-fetch-field "cc") "")))
682 (let ((address-regexp (nth 0 list)) 684 (from (or (message-fetch-field "from") ""))
683 (folder (nth 1 list)) 685 folder-name)
684 (to-flag (nth 2 list))) 686 (setq folder-name
685 (when (or 687 (loop for list in mh-default-folder-list
686 (mh-goto-header-field (if to-flag "To:" "From:")) 688 when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
687 ; if the To: field is missing, try Cc: 689 return (nth 1 list)
688 (and to-flag (mh-goto-header-field "cc:"))) 690 finally return nil))
689 (let ((endfield (save-excursion
690 (mh-header-field-end)(point))))
691 (if (re-search-forward address-regexp endfield t)
692 folder
693 (when to-flag ;Try Cc: as well
694 (mh-goto-header-field "cc:")
695 (let ((endfield (save-excursion
696 (mh-header-field-end)(point))))
697 (when (re-search-forward
698 address-regexp endfield t)
699 folder))))))))
700 mh-default-folder-list)))))
701 691
702 ;; Make sure a result from `mh-default-folder-list' begins with "+" 692 ;; Make sure a result from `mh-default-folder-list' begins with "+"
703 ;; since 'mh-expand-file-name below depends on it 693 ;; since 'mh-expand-file-name below depends on it
@@ -746,27 +736,23 @@ Otherwise, a default folder name is generated by `mh-folder-from-address'."
746 ""))) 736 "")))
747 t)) 737 t))
748 738
749(defun mh-refile-msg (msg-or-seq folder 739(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
750 &optional dont-update-last-destination-flag) 740 "Refile RANGE into FOLDER.
751 "Refile MSG-OR-SEQ into FOLDER. 741
752Default is the displayed message. 742Check the documentation of `mh-interactive-range' to see how RANGE is read in
753If optional prefix argument is provided, then prompt for the message sequence. 743interactive use.
754If variable `transient-mark-mode' is non-nil and the mark is active, then the
755selected region is marked for refiling.
756In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
757region in a cons cell, or a sequence.
758 744
759If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the 745If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the
760variables `mh-last-destination' and `mh-last-destination-folder' are not 746variables `mh-last-destination' and `mh-last-destination-folder' are not
761updated." 747updated."
762 (interactive (list (mh-interactive-msg-or-seq "Refile") 748 (interactive (list (mh-interactive-range "Refile")
763 (intern (mh-prompt-for-refile-folder)))) 749 (intern (mh-prompt-for-refile-folder))))
764 (unless dont-update-last-destination-flag 750 (unless dont-update-last-destination-flag
765 (setq mh-last-destination (cons 'refile folder) 751 (setq mh-last-destination (cons 'refile folder)
766 mh-last-destination-folder mh-last-destination)) 752 mh-last-destination-folder mh-last-destination))
767 (mh-iterate-on-msg-or-seq () msg-or-seq 753 (mh-iterate-on-range () range
768 (mh-refile-a-msg nil folder)) 754 (mh-refile-a-msg nil folder))
769 (mh-next-msg)) 755 (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
770 756
771(defun mh-refile-or-write-again (message) 757(defun mh-refile-or-write-again (message)
772 "Re-execute the last refile or write command on the given MESSAGE. 758 "Re-execute the last refile or write command on the given MESSAGE.
@@ -1015,11 +1001,14 @@ end of buffer is reached) and save it."
1015 (when (consp part-index) (setq part-index (car part-index))) 1001 (when (consp part-index) (setq part-index (car part-index)))
1016 (mh-folder-mime-action part-index #'mh-mime-save-part nil)) 1002 (mh-folder-mime-action part-index #'mh-mime-save-part nil))
1017 1003
1004(defvar mh-thread-scan-line-map-stack)
1005
1018(defun mh-reset-threads-and-narrowing () 1006(defun mh-reset-threads-and-narrowing ()
1019 "Reset all variables pertaining to threads and narrowing. 1007 "Reset all variables pertaining to threads and narrowing.
1020Also removes all content from the folder buffer." 1008Also removes all content from the folder buffer."
1021 (setq mh-view-ops ()) 1009 (setq mh-view-ops ())
1022 (setq mh-narrowed-to-seq nil) 1010 (setq mh-folder-view-stack ())
1011 (setq mh-thread-scan-line-map-stack ())
1023 (let ((buffer-read-only nil)) (erase-buffer))) 1012 (let ((buffer-read-only nil)) (erase-buffer)))
1024 1013
1025(defun mh-rescan-folder (&optional range dont-exec-pending) 1014(defun mh-rescan-folder (&optional range dont-exec-pending)
@@ -1029,7 +1018,8 @@ messages to display. Otherwise show the entire folder.
1029If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 1018If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1030refiles aren't carried out." 1019refiles aren't carried out."
1031 (interactive (list (if current-prefix-arg 1020 (interactive (list (if current-prefix-arg
1032 (mh-read-msg-range mh-current-folder t) 1021 (mh-read-range "Rescan" mh-current-folder t nil t
1022 mh-interpret-number-as-range-flag)
1033 nil))) 1023 nil)))
1034 (setq mh-next-direction 'forward) 1024 (setq mh-next-direction 'forward)
1035 (let ((threaded-flag (memq 'unthread mh-view-ops))) 1025 (let ((threaded-flag (memq 'unthread mh-view-ops)))
@@ -1073,16 +1063,13 @@ Otherwise send the entire message including the headers."
1073 (mh-set-scan-mode) 1063 (mh-set-scan-mode)
1074 (mh-show))) 1064 (mh-show)))
1075 1065
1076(defun mh-undo (msg-or-seq) 1066(defun mh-undo (range)
1077 "Undo the pending deletion or refile of the specified MSG-OR-SEQ. 1067 "Undo the pending deletion or refile of the specified RANGE.
1078Default is the displayed message. 1068
1079If optional prefix argument is provided, then prompt for the message sequence. 1069Check the documentation of `mh-interactive-range' to see how RANGE is read in
1080If variable `transient-mark-mode' is non-nil and the mark is active, then the 1070interactive use."
1081selected region is unmarked. 1071 (interactive (list (mh-interactive-range "Undo")))
1082In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a 1072 (cond ((numberp range)
1083region in a cons cell, or a sequence."
1084 (interactive (list (mh-interactive-msg-or-seq "Undo")))
1085 (cond ((numberp msg-or-seq)
1086 (let ((original-position (point))) 1073 (let ((original-position (point)))
1087 (beginning-of-line) 1074 (beginning-of-line)
1088 (while (not (or (looking-at mh-scan-deleted-msg-regexp) 1075 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
@@ -1098,7 +1085,7 @@ region in a cons cell, or a sequence."
1098 (mh-maybe-show)) 1085 (mh-maybe-show))
1099 (goto-char original-position) 1086 (goto-char original-position)
1100 (error "Nothing to undo")))) 1087 (error "Nothing to undo"))))
1101 (t (mh-iterate-on-msg-or-seq () msg-or-seq 1088 (t (mh-iterate-on-range () range
1102 (mh-undo-msg nil)))) 1089 (mh-undo-msg nil))))
1103 (if (not (mh-outstanding-commands-p)) 1090 (if (not (mh-outstanding-commands-p))
1104 (mh-set-folder-modified-p nil))) 1091 (mh-set-folder-modified-p nil)))
@@ -1200,8 +1187,20 @@ used to avoid problems in corner cases involving folders whose names end with a
1200 (setq folder (substring folder 0 (1- (length folder))))) 1187 (setq folder (substring folder 0 (1- (length folder)))))
1201 (values (format "+%s" folder) (car unseen) (car total)))))))) 1188 (values (format "+%s" folder) (car unseen) (car total))))))))
1202 1189
1203(defun mh-folder-size (folder) 1190(defun mh-folder-size-folder (folder)
1204 "Find size of FOLDER." 1191 "Find size of FOLDER using `folder'."
1192 (with-temp-buffer
1193 (let ((u (length (cdr (assoc mh-unseen-seq
1194 (mh-read-folder-sequences folder nil))))))
1195 (call-process (expand-file-name "folder" mh-progs) nil t nil
1196 "-norecurse" folder)
1197 (goto-char (point-min))
1198 (if (re-search-forward " has \\([0-9]+\\) " nil t)
1199 (values (car (read-from-string (match-string 1))) u folder)
1200 (values 0 u folder)))))
1201
1202(defun mh-folder-size-flist (folder)
1203 "Find size of FOLDER using `flist'."
1205 (with-temp-buffer 1204 (with-temp-buffer
1206 (call-process (expand-file-name "flist" mh-progs) nil t nil 1205 (call-process (expand-file-name "flist" mh-progs) nil t nil
1207 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) 1206 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
@@ -1211,6 +1210,12 @@ used to avoid problems in corner cases involving folders whose names end with a
1211 (buffer-substring (point) (line-end-position))) 1210 (buffer-substring (point) (line-end-position)))
1212 (values total unseen folder)))) 1211 (values total unseen folder))))
1213 1212
1213(defun mh-folder-size (folder)
1214 "Find size of FOLDER."
1215 (if mh-flists-present-flag
1216 (mh-folder-size-flist folder)
1217 (mh-folder-size-folder folder)))
1218
1214(defun mh-visit-folder (folder &optional range index-data) 1219(defun mh-visit-folder (folder &optional range index-data)
1215 "Visit FOLDER and display RANGE of messages. 1220 "Visit FOLDER and display RANGE of messages.
1216Do not call this function from outside MH-E; see \\[mh-rmail] instead. 1221Do not call this function from outside MH-E; see \\[mh-rmail] instead.
@@ -1225,7 +1230,9 @@ A prefix argument will cause a prompt for the RANGE of messages
1225regardless of the size of the `mh-large-folder' variable." 1230regardless of the size of the `mh-large-folder' variable."
1226 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) 1231 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1227 (list folder-name 1232 (list folder-name
1228 (mh-read-msg-range folder-name current-prefix-arg)))) 1233 (mh-read-range "Scan" folder-name t nil
1234 current-prefix-arg
1235 mh-interpret-number-as-range-flag))))
1229 (let ((config (current-window-configuration)) 1236 (let ((config (current-window-configuration))
1230 (current-buffer (current-buffer)) 1237 (current-buffer (current-buffer))
1231 (threaded-view-flag mh-show-threads-flag)) 1238 (threaded-view-flag mh-show-threads-flag))
@@ -1238,13 +1245,14 @@ regardless of the size of the `mh-large-folder' variable."
1238 (setq mh-index-data (car index-data) 1245 (setq mh-index-data (car index-data)
1239 mh-index-msg-checksum-map (make-hash-table :test #'equal) 1246 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1240 mh-index-checksum-origin-map (make-hash-table :test #'equal)) 1247 mh-index-checksum-origin-map (make-hash-table :test #'equal))
1241 (mh-index-update-maps folder (cadr index-data))) 1248 (mh-index-update-maps folder (cadr index-data))
1249 (mh-index-create-sequences))
1242 (mh-scan-folder folder (or range "all")) 1250 (mh-scan-folder folder (or range "all"))
1243 (cond ((and threaded-view-flag 1251 (cond ((and threaded-view-flag
1244 (save-excursion 1252 (save-excursion
1245 (goto-char (point-min)) 1253 (goto-char (point-min))
1246 (or (null mh-large-folder) 1254 (or (null mh-large-folder)
1247 (not (equal (forward-line mh-large-folder) 0)) 1255 (not (equal (forward-line (1+ mh-large-folder)) 0))
1248 (and (message "Not threading since the number of messages exceeds `mh-large-folder'") 1256 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1249 nil)))) 1257 nil))))
1250 (mh-toggle-threads)) 1258 (mh-toggle-threads))
@@ -1405,6 +1413,9 @@ If MSG is nil then act on the message at point"
1405 1413
1406;;; The folder data abstraction. 1414;;; The folder data abstraction.
1407 1415
1416(defvar mh-index-data-file ".mhe_index"
1417 "MH-E specific file where index seach info is stored.")
1418
1408(defun mh-make-folder (name) 1419(defun mh-make-folder (name)
1409 "Create a new mail folder called NAME. 1420 "Create a new mail folder called NAME.
1410Make it the current folder." 1421Make it the current folder."
@@ -1417,6 +1428,9 @@ Make it the current folder."
1417 (mh-folder-mode) 1428 (mh-folder-mode)
1418 (mh-set-folder-modified-p nil) 1429 (mh-set-folder-modified-p nil)
1419 (setq buffer-file-name mh-folder-filename) 1430 (setq buffer-file-name mh-folder-filename)
1431 (when (and (not mh-index-data)
1432 (file-exists-p (concat buffer-file-name mh-index-data-file)))
1433 (mh-index-read-data))
1420 (mh-make-folder-mode-line)) 1434 (mh-make-folder-mode-line))
1421 1435
1422;;; Ensure new buffers won't get this mode if default-major-mode is nil. 1436;;; Ensure new buffers won't get this mode if default-major-mode is nil.
@@ -1437,7 +1451,7 @@ Make it the current folder."
1437 ["List Sequences in Folder..." mh-list-sequences t] 1451 ["List Sequences in Folder..." mh-list-sequences t]
1438 ["Delete Sequence..." mh-delete-seq t] 1452 ["Delete Sequence..." mh-delete-seq t]
1439 ["Narrow to Sequence..." mh-narrow-to-seq t] 1453 ["Narrow to Sequence..." mh-narrow-to-seq t]
1440 ["Widen from Sequence" mh-widen mh-narrowed-to-seq] 1454 ["Widen from Sequence" mh-widen mh-folder-view-stack]
1441 "--" 1455 "--"
1442 ["Narrow to Subject Sequence" mh-narrow-to-subject t] 1456 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
1443 ["Narrow to Tick Sequence" mh-narrow-to-tick 1457 ["Narrow to Tick Sequence" mh-narrow-to-tick
@@ -1512,9 +1526,6 @@ Make it the current folder."
1512 (set-specifier horizontal-scrollbar-visible-p nil 1526 (set-specifier horizontal-scrollbar-visible-p nil
1513 (cons (current-buffer) nil))))) 1527 (cons (current-buffer) nil)))))
1514 1528
1515;; Avoid compiler warnings in XEmacs and GNU Emacs 20
1516(eval-when-compile (defvar tool-bar-mode))
1517
1518(defmacro mh-write-file-functions-compat () 1529(defmacro mh-write-file-functions-compat ()
1519 "Return `write-file-functions' if it exists. 1530 "Return `write-file-functions' if it exists.
1520Otherwise return `local-write-file-hooks'. This macro exists purely for 1531Otherwise return `local-write-file-hooks'. This macro exists purely for
@@ -1524,8 +1535,11 @@ is used in previous versions and XEmacs."
1524 ''write-file-functions ;Emacs 21.4 1535 ''write-file-functions ;Emacs 21.4
1525 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs 1536 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
1526 1537
1527;; Avoid compiler warning 1538;; Avoid compiler warnings in non-bleeding edge versions of Emacs.
1528(defvar tool-bar-map) 1539(eval-when-compile
1540 (defvar tool-bar-mode)
1541 (defvar tool-bar-map)
1542 (defvar desktop-save-buffer)) ;Emacs 21.4
1529 1543
1530(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" 1544(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1531 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> 1545 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
@@ -1564,22 +1578,25 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1564 'mh-seq-list nil ; Alist of (seq . msgs) nums 1578 'mh-seq-list nil ; Alist of (seq . msgs) nums
1565 'mh-seen-list nil ; List of displayed messages 1579 'mh-seen-list nil ; List of displayed messages
1566 'mh-next-direction 'forward ; Direction to move to next message 1580 'mh-next-direction 'forward ; Direction to move to next message
1567 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1568 'mh-tick-seq-changed-when-narrowed-flag nil
1569 ; Tick seq changed while narrowed
1570 'mh-view-ops () ; Stack that keeps track of the order 1581 'mh-view-ops () ; Stack that keeps track of the order
1571 ; in which narrowing/threading has been 1582 ; in which narrowing/threading has been
1572 ; carried out. 1583 ; carried out.
1584 'mh-folder-view-stack () ; Stack of previous views of the
1585 ; folder.
1573 'mh-index-data nil ; If the folder was created by a call 1586 'mh-index-data nil ; If the folder was created by a call
1574 ; to mh-index-search this contains info 1587 ; to mh-index-search this contains info
1575 ; about the search results. 1588 ; about the search results.
1576 'mh-index-previous-search nil ; Previous folder and search-regexp 1589 'mh-index-previous-search nil ; Previous folder and search-regexp
1577 'mh-index-msg-checksum-map nil ; msg -> checksum map 1590 'mh-index-msg-checksum-map nil ; msg -> checksum map
1578 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) 1591 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
1592 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
1579 'mh-first-msg-num nil ; Number of first msg in buffer 1593 'mh-first-msg-num nil ; Number of first msg in buffer
1580 'mh-last-msg-num nil ; Number of last msg in buffer 1594 'mh-last-msg-num nil ; Number of last msg in buffer
1581 'mh-msg-count nil ; Number of msgs in buffer 1595 'mh-msg-count nil ; Number of msgs in buffer
1582 'mh-mode-line-annotation nil ; Indicates message range 1596 'mh-mode-line-annotation nil ; Indicates message range
1597 'mh-sequence-notation-history (make-hash-table)
1598 ; Remember what is overwritten by
1599 ; mh-note-seq.
1583 'mh-previous-window-config nil) ; Previous window configuration 1600 'mh-previous-window-config nil) ; Previous window configuration
1584 (mh-remove-xemacs-horizontal-scrollbar) 1601 (mh-remove-xemacs-horizontal-scrollbar)
1585 (setq truncate-lines t) 1602 (setq truncate-lines t)
@@ -1597,8 +1614,7 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1597 (easy-menu-add mh-folder-sequence-menu) 1614 (easy-menu-add mh-folder-sequence-menu)
1598 (easy-menu-add mh-folder-message-menu) 1615 (easy-menu-add mh-folder-message-menu)
1599 (easy-menu-add mh-folder-folder-menu) 1616 (easy-menu-add mh-folder-folder-menu)
1600 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 1617 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
1601 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
1602 (mh-funcall-if-exists mh-toolbar-init :folder) 1618 (mh-funcall-if-exists mh-toolbar-init :folder)
1603 (if (and mh-xemacs-flag 1619 (if (and mh-xemacs-flag
1604 font-lock-auto-fontify) 1620 font-lock-auto-fontify)
@@ -1611,6 +1627,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1611 (set (make-local-variable (car pairs)) (car (cdr pairs))) 1627 (set (make-local-variable (car pairs)) (car (cdr pairs)))
1612 (setq pairs (cdr (cdr pairs))))) 1628 (setq pairs (cdr (cdr pairs)))))
1613 1629
1630;;;###autoload
1631(defun mh-restore-desktop-buffer (desktop-buffer-file-name
1632 desktop-buffer-name
1633 desktop-buffer-misc)
1634 "Restore an MH folder buffer specified in a desktop file."
1635 (mh-find-path)
1636 (mh-visit-folder desktop-buffer-name)
1637 (current-buffer))
1638
1614(defun mh-scan-folder (folder range &optional dont-exec-pending) 1639(defun mh-scan-folder (folder range &optional dont-exec-pending)
1615 "Scan the FOLDER over the RANGE. 1640 "Scan the FOLDER over the RANGE.
1616If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 1641If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
@@ -1651,6 +1676,7 @@ If UPDATE, append the scan lines, otherwise replace."
1651 (range (if (and range (atom range)) (list range) range)) 1676 (range (if (and range (atom range)) (list range) range))
1652 scan-start) 1677 scan-start)
1653 (message "Scanning %s..." folder) 1678 (message "Scanning %s..." folder)
1679 (mh-remove-all-notation)
1654 (with-mh-folder-updating (nil) 1680 (with-mh-folder-updating (nil)
1655 (if update 1681 (if update
1656 (goto-char (point-max)) 1682 (goto-char (point-max))
@@ -1742,8 +1768,8 @@ Return in the current buffer."
1742 (message "inc %s..." folder)) 1768 (message "inc %s..." folder))
1743 (setq mh-next-direction 'forward) 1769 (setq mh-next-direction 'forward)
1744 (goto-char (point-max)) 1770 (goto-char (point-max))
1771 (mh-remove-all-notation)
1745 (let ((start-of-inc (point))) 1772 (let ((start-of-inc (point)))
1746 (mh-remove-cur-notation)
1747 (if maildrop-name 1773 (if maildrop-name
1748 ;; I think MH 5 used "-ms-file" instead of "-file", 1774 ;; I think MH 5 used "-ms-file" instead of "-file",
1749 ;; which would make inc'ing from maildrops fail. 1775 ;; which would make inc'ing from maildrops fail.
@@ -1763,11 +1789,12 @@ Return in the current buffer."
1763 (re-search-forward "^inc: no mail" nil t)) 1789 (re-search-forward "^inc: no mail" nil t))
1764 (message "No new mail%s%s" (if maildrop-name " in " "") 1790 (message "No new mail%s%s" (if maildrop-name " in " "")
1765 (if maildrop-name maildrop-name ""))) 1791 (if maildrop-name maildrop-name "")))
1766 ((and (when mh-narrowed-to-seq 1792 ((and (when mh-folder-view-stack
1767 (let ((saved-text (buffer-substring-no-properties 1793 (let ((saved-text (buffer-substring-no-properties
1768 start-of-inc (point-max)))) 1794 start-of-inc (point-max))))
1769 (delete-region start-of-inc (point-max)) 1795 (delete-region start-of-inc (point-max))
1770 (unwind-protect (mh-widen) 1796 (unwind-protect (mh-widen t)
1797 (mh-remove-all-notation)
1771 (goto-char (point-max)) 1798 (goto-char (point-max))
1772 (setq start-of-inc (point)) 1799 (setq start-of-inc (point))
1773 (insert saved-text) 1800 (insert saved-text)
@@ -1789,7 +1816,6 @@ Return in the current buffer."
1789 (setq mh-seq-list (mh-read-folder-sequences folder t)) 1816 (setq mh-seq-list (mh-read-folder-sequences folder t))
1790 (when (equal (point-max) start-of-inc) 1817 (when (equal (point-max) start-of-inc)
1791 (mh-notate-cur)) 1818 (mh-notate-cur))
1792 (mh-notate-user-sequences)
1793 (if new-mail-flag 1819 (if new-mail-flag
1794 (progn 1820 (progn
1795 (mh-make-folder-mode-line) 1821 (mh-make-folder-mode-line)
@@ -1798,7 +1824,9 @@ Return in the current buffer."
1798 (when (memq 'unthread mh-view-ops) 1824 (when (memq 'unthread mh-view-ops)
1799 (mh-thread-inc folder start-of-inc)) 1825 (mh-thread-inc folder start-of-inc))
1800 (mh-goto-cur-msg)) 1826 (mh-goto-cur-msg))
1801 (goto-char point-before-inc)))))) 1827 (goto-char point-before-inc))
1828 (mh-notate-user-sequences)
1829 (mh-notate-deleted-and-refiled)))))
1802 1830
1803(defun mh-make-folder-mode-line (&optional ignored) 1831(defun mh-make-folder-mode-line (&optional ignored)
1804 "Set the fields of the mode line for a folder buffer. 1832 "Set the fields of the mode line for a folder buffer.
@@ -1841,10 +1869,13 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1841 ("")))))) 1869 (""))))))
1842 (mh-logo-display)))) 1870 (mh-logo-display))))
1843 1871
1872;;; XXX: Remove this function, if no one uses it any more...
1844(defun mh-unmark-all-headers (remove-all-flags) 1873(defun mh-unmark-all-headers (remove-all-flags)
1845 "Remove all '+' flags from the folder listing. 1874 "Remove all '+' flags from the folder listing.
1846With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. 1875With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1847Optimized for speed (i.e., no regular expressions)." 1876Optimized for speed (i.e., no regular expressions).
1877
1878This function is deprecated. Use `mh-remove-all-notation' instead."
1848 (save-excursion 1879 (save-excursion
1849 (let ((case-fold-search nil) 1880 (let ((case-fold-search nil)
1850 (last-line (1- (point-max))) 1881 (last-line (1- (point-max)))
@@ -1869,6 +1900,39 @@ Optimized for speed (i.e., no regular expressions)."
1869 (insert " "))))) 1900 (insert " ")))))
1870 (forward-line))))) 1901 (forward-line)))))
1871 1902
1903(defun mh-add-sequence-notation (msg internal-seq-flag)
1904 "Add sequence notation to the MSG on the current line.
1905If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the
1906current line, so that font-lock would automatically refontify it."
1907 (with-mh-folder-updating (t)
1908 (save-excursion
1909 (beginning-of-line)
1910 (if internal-seq-flag
1911 (mh-notate nil nil mh-cmd-note)
1912 (forward-char (1+ mh-cmd-note))
1913 (let ((stack (gethash msg mh-sequence-notation-history)))
1914 (setf (gethash msg mh-sequence-notation-history)
1915 (cons (char-after) stack)))
1916 (mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
1917
1918(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
1919 "Remove sequence notation from the MSG on the current line.
1920If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the
1921sequence. In that case, no notation needs to be removed. Otherwise the effect
1922of inserting `mh-note-seq' needs to be reversed.
1923If ALL is non-nil, then all sequence marks on the scan line are removed."
1924 (with-mh-folder-updating (t)
1925 ;; This takes care of internal sequences...
1926 (mh-notate nil nil mh-cmd-note)
1927 (unless internal-seq-flag
1928 ;; ... and this takes care of user sequences.
1929 (let ((stack (gethash msg mh-sequence-notation-history)))
1930 (while (and all (cdr stack))
1931 (setq stack (cdr stack)))
1932 (when stack
1933 (mh-notate nil (car stack) (1+ mh-cmd-note)))
1934 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
1935
1872(defun mh-remove-cur-notation () 1936(defun mh-remove-cur-notation ()
1873 "Remove old cur notation." 1937 "Remove old cur notation."
1874 (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) 1938 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
@@ -1884,12 +1948,10 @@ Optimized for speed (i.e., no regular expressions)."
1884 (save-excursion 1948 (save-excursion
1885 (setq overlay-arrow-position nil) 1949 (setq overlay-arrow-position nil)
1886 (goto-char (point-min)) 1950 (goto-char (point-min))
1887 (while (not (eobp)) 1951 (mh-iterate-on-range msg (cons (point-min) (point-max))
1888 (unless (or (equal (char-after) ?+) (eolp)) 1952 (mh-notate nil ? mh-cmd-note)
1889 (mh-notate nil ? mh-cmd-note) 1953 (mh-remove-sequence-notation msg nil t))
1890 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) 1954 (clrhash mh-sequence-notation-history)))
1891 (mh-notate nil ? (1+ mh-cmd-note))))
1892 (forward-line))))
1893 1955
1894;;;###mh-autoload 1956;;;###mh-autoload
1895(defun mh-goto-cur-msg (&optional minimal-changes-flag) 1957(defun mh-goto-cur-msg (&optional minimal-changes-flag)
@@ -1934,22 +1996,47 @@ with no arguments, before the commands are processed."
1934 ;; Update the unseen sequence if it exists 1996 ;; Update the unseen sequence if it exists
1935 (mh-update-unseen) 1997 (mh-update-unseen)
1936 1998
1937 (let ((redraw-needed-flag mh-index-data)) 1999 (let ((redraw-needed-flag mh-index-data)
2000 (folders-changed (list mh-current-folder))
2001 (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
2002 (mh-create-sequence-map mh-seq-list)))
2003 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
2004 (make-hash-table))))
1938 ;; Remove invalid scan lines if we are in an index folder and then remove 2005 ;; Remove invalid scan lines if we are in an index folder and then remove
1939 ;; the real messages 2006 ;; the real messages
1940 (when mh-index-data 2007 (when mh-index-data
1941 (mh-index-delete-folder-headers) 2008 (mh-index-delete-folder-headers)
1942 (mh-index-execute-commands)) 2009 (setq folders-changed
2010 (append folders-changed (mh-index-execute-commands))))
1943 2011
1944 ;; Then refile messages 2012 ;; Then refile messages
1945 (mh-mapc #'(lambda (folder-msg-list) 2013 (mh-mapc #'(lambda (folder-msg-list)
1946 (let ((dest-folder (symbol-name (car folder-msg-list))) 2014 (let* ((dest-folder (symbol-name (car folder-msg-list)))
1947 (msgs (cdr folder-msg-list))) 2015 (last (car (mh-translate-range dest-folder "last")))
2016 (msgs (cdr folder-msg-list)))
2017 (push dest-folder folders-changed)
1948 (setq redraw-needed-flag t) 2018 (setq redraw-needed-flag t)
1949 (apply #'mh-exec-cmd 2019 (apply #'mh-exec-cmd
1950 "refile" "-src" folder dest-folder 2020 "refile" "-src" folder dest-folder
1951 (mh-coalesce-msg-list msgs)) 2021 (mh-coalesce-msg-list msgs))
1952 (mh-delete-scan-msgs msgs))) 2022 (mh-delete-scan-msgs msgs)
2023 ;; Preserve sequences in destination folder...
2024 (when (and mh-refile-preserves-sequences-flag
2025 (numberp last))
2026 (clrhash dest-map)
2027 (loop for i from (1+ last)
2028 for msg in (sort (copy-sequence msgs) #'<)
2029 do (loop for seq-name in (gethash msg seq-map)
2030 do (push i (gethash seq-name dest-map))))
2031 (maphash
2032 #'(lambda (seq msgs)
2033 ;; Run it in the background, since we don't care
2034 ;; about the results.
2035 (apply #'mh-exec-cmd-daemon "mark" #'ignore
2036 "-sequence" (symbol-name seq) dest-folder
2037 "-add" (mapcar #'(lambda (x) (format "%s" x))
2038 (mh-coalesce-msg-list msgs))))
2039 dest-map))))
1953 mh-refile-list) 2040 mh-refile-list)
1954 (setq mh-refile-list ()) 2041 (setq mh-refile-list ())
1955 2042
@@ -1969,7 +2056,7 @@ with no arguments, before the commands are processed."
1969 ;; Redraw folder buffer if needed 2056 ;; Redraw folder buffer if needed
1970 (when (and redraw-needed-flag) 2057 (when (and redraw-needed-flag)
1971 (when (mh-speed-flists-active-p) 2058 (when (mh-speed-flists-active-p)
1972 (mh-speed-flists t mh-current-folder)) 2059 (apply #'mh-speed-flists t folders-changed))
1973 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) 2060 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
1974 (mh-index-data (mh-index-insert-folder-headers))))) 2061 (mh-index-data (mh-index-insert-folder-headers)))))
1975 2062
@@ -1980,7 +2067,7 @@ with no arguments, before the commands are processed."
1980 (mh-invalidate-show-buffer)) 2067 (mh-invalidate-show-buffer))
1981 2068
1982 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) 2069 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1983 (mh-unmark-all-headers t) 2070 (mh-remove-all-notation)
1984 (mh-notate-user-sequences) 2071 (mh-notate-user-sequences)
1985 (message "Processing deletes and refiles for %s...done" folder))) 2072 (message "Processing deletes and refiles for %s...done" folder)))
1986 2073
@@ -2115,55 +2202,67 @@ Expands ranges into set of individual numbers."
2115 (setq msgs (cons num msgs))))) 2202 (setq msgs (cons num msgs)))))
2116 msgs)) 2203 msgs))
2117 2204
2118(defun mh-notate-user-sequences (&optional msg-or-seq) 2205(defun mh-notate-user-sequences (&optional range)
2119 "Mark user-defined sequences in the messages specified by MSG-OR-SEQ. 2206 "Mark user-defined sequences in the messages specified by RANGE.
2120The optional argument MSG-OR-SEQ can be a message number, a list of message 2207The optional argument RANGE can be a message number, a list of message
2121numbers, a sequence, a region in a cons cell, or nil in which case all 2208numbers, a sequence, a region in a cons cell. If nil all messages are notated."
2122messages in the folder buffer are notated." 2209 (unless range
2123 (unless msg-or-seq 2210 (setq range (cons (point-min) (point-max))))
2124 (setq msg-or-seq (cons (point-min) (point-max))))
2125 (let ((seqs mh-seq-list) 2211 (let ((seqs mh-seq-list)
2126 (msg-hash (make-hash-table)) 2212 (msg-hash (make-hash-table)))
2127 (tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))))
2128 (dolist (seq seqs) 2213 (dolist (seq seqs)
2129 (unless (mh-internal-seq (mh-seq-name seq)) 2214 (dolist (msg (mh-seq-msgs seq))
2130 (dolist (msg (mh-seq-msgs seq)) 2215 (push (car seq) (gethash msg msg-hash))))
2131 (setf (gethash msg msg-hash) t)))) 2216 (mh-iterate-on-range msg range
2132 (mh-iterate-on-msg-or-seq msg msg-or-seq 2217 (loop for seq in (gethash msg msg-hash)
2133 (when (gethash msg msg-hash) 2218 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
2134 (mh-notate nil mh-note-seq (1+ mh-cmd-note))) 2219
2135 (mh-notate-tick msg tick-msgs)))) 2220(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
2136 2221
2137(defun mh-internal-seq (name) 2222(defun mh-internal-seq (name)
2138 "Return non-nil if NAME is the name of an internal MH-E sequence." 2223 "Return non-nil if NAME is the name of an internal MH-E sequence."
2139 (or (memq name '(answered cur deleted forwarded printed)) 2224 (or (memq name mh-internal-seqs)
2140 (eq name mh-unseen-seq) 2225 (eq name mh-unseen-seq)
2141 (and mh-tick-seq (eq name mh-tick-seq)) 2226 (and mh-tick-seq (eq name mh-tick-seq))
2142 (eq name mh-previous-seq) 2227 (eq name mh-previous-seq)
2143 (mh-folder-name-p name))) 2228 (mh-folder-name-p name)))
2144 2229
2145(defun mh-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag) 2230(defun mh-valid-seq-p (name)
2146 "Delete MSG-OR-SEQ from SEQUENCE. 2231 "Return non-nil if NAME is a valid MH sequence name."
2147Default value of MSG-OR-SEQ is the displayed message. 2232 (and (symbolp name)
2148If optional prefix argument is provided, then prompt for the message sequence. 2233 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
2149If variable `transient-mark-mode' is non-nil and the mark is active, then the 2234
2150selected region is deleted from SEQUENCE.. 2235(defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
2151In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a 2236 "Delete RANGE from SEQUENCE.
2152region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil 2237
2153means do not inform MH of the change." 2238Check the documentation of `mh-interactive-range' to see how RANGE is read in
2154 (interactive (list (mh-interactive-msg-or-seq "Delete") 2239interactive use.
2240
2241Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the
2242change."
2243 (interactive (list (mh-interactive-range "Delete")
2155 (mh-read-seq-default "Delete from" t) 2244 (mh-read-seq-default "Delete from" t)
2156 nil)) 2245 nil))
2157 (let ((entry (mh-find-seq sequence))) 2246 (let ((entry (mh-find-seq sequence))
2247 (user-sequence-flag (not (mh-internal-seq sequence)))
2248 (folders-changed (list mh-current-folder))
2249 (msg-list ()))
2158 (when entry 2250 (when entry
2159 (mh-iterate-on-msg-or-seq msg msg-or-seq 2251 (mh-iterate-on-range msg range
2160 (when (memq msg (mh-seq-msgs entry)) 2252 (push msg msg-list)
2161 (mh-notate nil ? (1+ mh-cmd-note))) 2253 ;; Calling "mark" repeatedly takes too long. So we will pretend here
2162 (mh-delete-a-msg-from-seq msg sequence internal-flag) 2254 ;; that we are just modifying an internal sequence...
2163 (mh-clear-text-properties nil)) 2255 (when (memq msg (cdr entry))
2164 (mh-notate-user-sequences msg-or-seq) 2256 (mh-remove-sequence-notation msg (not user-sequence-flag)))
2257 (mh-delete-a-msg-from-seq msg sequence t))
2258 ;; ... and here we will "mark" all the messages at one go.
2259 (unless internal-flag (mh-undefine-sequence sequence msg-list))
2260 (when (and mh-index-data (not internal-flag))
2261 (setq folders-changed
2262 (append folders-changed
2263 (mh-index-delete-from-sequence sequence msg-list))))
2165 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) 2264 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
2166 (mh-speed-flists t mh-current-folder))))) 2265 (apply #'mh-speed-flists t folders-changed)))))
2167 2266
2168(defun mh-delete-a-msg-from-seq (msg sequence internal-flag) 2267(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
2169 "Delete MSG from SEQUENCE. 2268 "Delete MSG from SEQUENCE.
@@ -2174,31 +2273,18 @@ If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
2174 (mh-undefine-sequence sequence (list msg))) 2273 (mh-undefine-sequence sequence (list msg)))
2175 (setcdr entry (delq msg (mh-seq-msgs entry)))))) 2274 (setcdr entry (delq msg (mh-seq-msgs entry))))))
2176 2275
2177(defun mh-clear-text-properties (message)
2178 "Clear all text properties (except mh-tick) from the scan line for MESSAGE."
2179 (save-excursion
2180 (with-mh-folder-updating (t)
2181 (when (or (not message) (mh-goto-msg message t t))
2182 (beginning-of-line)
2183 (let ((tick-property (get-text-property (point) 'mh-tick)))
2184 (set-text-properties (point) (line-end-position) nil)
2185 (when tick-property
2186 (add-text-properties (point) (line-end-position)
2187 `(mh-tick ,tick-property))))))))
2188
2189(defun mh-undefine-sequence (seq msgs) 2276(defun mh-undefine-sequence (seq msgs)
2190 "Remove from the SEQ the list of MSGS." 2277 "Remove from the SEQ the list of MSGS."
2191 (prog1 (mh-exec-cmd "mark" mh-current-folder "-delete" 2278 (when (and (mh-valid-seq-p seq) msgs)
2192 "-sequence" (symbol-name seq) 2279 (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
2193 (mh-coalesce-msg-list msgs)) 2280 "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
2194 (when (and (eq seq mh-unseen-seq) (mh-speed-flists-active-p))
2195 (mh-speed-flists t mh-current-folder))))
2196 2281
2197(defun mh-define-sequence (seq msgs) 2282(defun mh-define-sequence (seq msgs)
2198 "Define the SEQ to contain the list of MSGS. 2283 "Define the SEQ to contain the list of MSGS.
2199Do not mark pseudo-sequences or empty sequences. 2284Do not mark pseudo-sequences or empty sequences.
2200Signals an error if SEQ is an illegal name." 2285Signals an error if SEQ is an illegal name."
2201 (if (and msgs 2286 (if (and msgs
2287 (mh-valid-seq-p seq)
2202 (not (mh-folder-name-p seq))) 2288 (not (mh-folder-name-p seq)))
2203 (save-excursion 2289 (save-excursion
2204 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" 2290 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
@@ -2237,31 +2323,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2237 2323
2238 2324
2239 2325
2240;;; User prompting commands.
2241
2242(defun mh-read-msg-range (folder &optional always-prompt-flag)
2243 "Prompt for message range from FOLDER.
2244If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
2245range."
2246 (multiple-value-bind (total unseen) (mh-folder-size folder)
2247 (cond
2248 ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
2249 (list (symbol-name mh-unseen-seq)))
2250 ((or (null mh-large-folder) (not (numberp total)))
2251 (list "all"))
2252 ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
2253 (let* ((prompt
2254 (format "Range or number of messages to read (default: %s): "
2255 total))
2256 (in (read-string prompt nil nil (number-to-string total))))
2257 (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
2258 (list (format "last:%s" (car (read-from-string in)))))
2259 ((equal in "") (list "all"))
2260 (t (split-string in)))))
2261 (t (list "all")))))
2262
2263
2264
2265;;; Build the folder-mode keymap: 2326;;; Build the folder-mode keymap:
2266 2327
2267(suppress-keymap mh-folder-mode-map) 2328(suppress-keymap mh-folder-mode-map)
@@ -2319,6 +2380,7 @@ range."
2319 2380
2320(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) 2381(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2321 "?" mh-prefix-help 2382 "?" mh-prefix-help
2383 "'" mh-index-ticked-messages
2322 "S" mh-sort-folder 2384 "S" mh-sort-folder
2323 "f" mh-alt-visit-folder 2385 "f" mh-alt-visit-folder
2324 "i" mh-index-search 2386 "i" mh-index-search
@@ -2327,6 +2389,7 @@ range."
2327 "n" mh-index-new-messages 2389 "n" mh-index-new-messages
2328 "o" mh-alt-visit-folder 2390 "o" mh-alt-visit-folder
2329 "p" mh-pack-folder 2391 "p" mh-pack-folder
2392 "q" mh-index-sequenced-messages
2330 "r" mh-rescan-folder 2393 "r" mh-rescan-folder
2331 "s" mh-search-folder 2394 "s" mh-search-folder
2332 "u" mh-undo-folder 2395 "u" mh-undo-folder
@@ -2340,6 +2403,7 @@ range."
2340 "w" mh-junk-whitelist) 2403 "w" mh-junk-whitelist)
2341 2404
2342(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) 2405(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2406 "'" mh-narrow-to-tick
2343 "?" mh-prefix-help 2407 "?" mh-prefix-help
2344 "d" mh-delete-msg-from-seq 2408 "d" mh-delete-msg-from-seq
2345 "k" mh-delete-seq 2409 "k" mh-delete-seq
@@ -2361,7 +2425,11 @@ range."
2361(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) 2425(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2362 "'" mh-narrow-to-tick 2426 "'" mh-narrow-to-tick
2363 "?" mh-prefix-help 2427 "?" mh-prefix-help
2428 "c" mh-narrow-to-cc
2429 "f" mh-narrow-to-from
2430 "r" mh-narrow-to-range
2364 "s" mh-narrow-to-subject 2431 "s" mh-narrow-to-subject
2432 "t" mh-narrow-to-to
2365 "w" mh-widen) 2433 "w" mh-widen)
2366 2434
2367(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) 2435(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
@@ -2411,16 +2479,16 @@ range."
2411 "[d]elete, [o]refile, e[x]ecute,\n" 2479 "[d]elete, [o]refile, e[x]ecute,\n"
2412 "[s]end, [r]eply.\n" 2480 "[s]end, [r]eply.\n"
2413 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," 2481 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
2414 "\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.") 2482 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
2415 2483
2416 (?F "[l]ist, [v]isit folder;\n" 2484 (?F "[l]ist; [v]isit folder;\n"
2417 "[t]hread; [s]earch; [i]ndexed search;\n" 2485 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
2418 "[p]ack; [S]ort; [r]escan; [k]ill") 2486 "[p]ack; [S]ort; [r]escan; [k]ill")
2419 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" 2487 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
2420 "[s]equences, [l]ist,\n" 2488 "[s]equences, [l]ist,\n"
2421 "[d]elete message from sequence, [k]ill sequence") 2489 "[d]elete message from sequence, [k]ill sequence")
2422 (?T "[t]oggle, [d]elete, [o]refile thread") 2490 (?T "[t]oggle, [d]elete, [o]refile thread")
2423 (?/ "Limit to [s]ubject; [w]iden") 2491 (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
2424 (?X "un[s]har, [u]udecode message") 2492 (?X "un[s]har, [u]udecode message")
2425 (?D "[b]urst digest") 2493 (?D "[b]urst digest")
2426 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" 2494 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
@@ -2443,17 +2511,6 @@ well.")
2443 "^There is no other window$")) 2511 "^There is no other window$"))
2444 (add-to-list 'debug-ignored-errors mess)) 2512 (add-to-list 'debug-ignored-errors mess))
2445 2513
2446;;;; Desktop support
2447
2448;;;###autoload
2449(defun mh-restore-desktop-buffer (desktop-buffer-file-name
2450 desktop-buffer-name
2451 desktop-buffer-misc)
2452 "Restore an mh folder buffer specified in a desktop file."
2453 (mh-find-path)
2454 (mh-visit-folder desktop-buffer-name)
2455 (current-buffer))
2456
2457(provide 'mh-e) 2514(provide 'mh-e)
2458 2515
2459;;; Local Variables: 2516;;; Local Variables:
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 15534b02a0e..46201860e2a 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -72,18 +72,15 @@ digest are inserted into the folder after that message."
72 (message "Bursting digest...done"))) 72 (message "Bursting digest...done")))
73 73
74;;;###mh-autoload 74;;;###mh-autoload
75(defun mh-copy-msg (msg-or-seq folder) 75(defun mh-copy-msg (range folder)
76 "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. 76 "Copy the specified RANGE to another FOLDER without deleting them.
77Default is the displayed message. 77
78If optional prefix argument is provided, then prompt for the message sequence. 78Check the documentation of `mh-interactive-range' to see how RANGE is read in
79If variable `transient-mark-mode' is non-nil and the mark is active, then the 79interactive use."
80selected region is copied. 80 (interactive (list (mh-interactive-range "Copy")
81In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
82region in a cons cell, or a sequence."
83 (interactive (list (mh-interactive-msg-or-seq "Copy")
84 (mh-prompt-for-folder "Copy to" "" t))) 81 (mh-prompt-for-folder "Copy to" "" t)))
85 (let ((msg-list (let ((result ())) 82 (let ((msg-list (let ((result ()))
86 (mh-iterate-on-msg-or-seq msg msg-or-seq 83 (mh-iterate-on-range msg range
87 (mh-notate nil mh-note-copied mh-cmd-note) 84 (mh-notate nil mh-note-copied mh-cmd-note)
88 (push msg result)) 85 (push msg result))
89 result))) 86 result)))
@@ -94,9 +91,13 @@ region in a cons cell, or a sequence."
94(defun mh-kill-folder () 91(defun mh-kill-folder ()
95 "Remove the current folder and all included messages. 92 "Remove the current folder and all included messages.
96Removes all of the messages (files) within the specified current folder, 93Removes all of the messages (files) within the specified current folder,
97and then removes the folder (directory) itself." 94and then removes the folder (directory) itself.
95The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to
96be called, with no arguments, which should return a value of non-nil if
97verification is not desired."
98 (interactive) 98 (interactive)
99 (if (or mh-index-data 99 (if (or (run-hook-with-args-until-success
100 'mh-kill-folder-suppress-prompt-hook)
100 (yes-or-no-p (format "Remove folder %s (and all included messages)? " 101 (yes-or-no-p (format "Remove folder %s (and all included messages)? "
101 mh-current-folder))) 102 mh-current-folder)))
102 (let ((folder mh-current-folder) 103 (let ((folder mh-current-folder)
@@ -154,7 +155,8 @@ First, offer to execute any outstanding commands for the current folder. If
154optional prefix argument provided, prompt for the RANGE of messages to display 155optional prefix argument provided, prompt for the RANGE of messages to display
155after packing. Otherwise, show the entire folder." 156after packing. Otherwise, show the entire folder."
156 (interactive (list (if current-prefix-arg 157 (interactive (list (if current-prefix-arg
157 (mh-read-msg-range mh-current-folder t) 158 (mh-read-range "Scan" mh-current-folder t nil t
159 mh-interpret-number-as-range-flag)
158 '("all")))) 160 '("all"))))
159 (let ((threaded-flag (memq 'unthread mh-view-ops))) 161 (let ((threaded-flag (memq 'unthread mh-view-ops)))
160 (mh-pack-folder-1 range) 162 (mh-pack-folder-1 range)
@@ -231,22 +233,19 @@ Otherwise just send the message's body without the headers."
231 (mh-recenter 0))) 233 (mh-recenter 0)))
232 234
233;;;###mh-autoload 235;;;###mh-autoload
234(defun mh-print-msg (msg-or-seq) 236(defun mh-print-msg (range)
235 "Print MSG-OR-SEQ on printer. 237 "Print RANGE on printer.
236Default is the displayed message. 238
237If optional prefix argument is provided, then prompt for the message sequence. 239Check the documentation of `mh-interactive-range' to see how RANGE is read in
238If variable `transient-mark-mode' is non-nil and the mark is active, then the 240interactive use.
239selected region is printed.
240In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
241region in a cons cell, or a sequence.
242 241
243The variable `mh-lpr-command-format' is used to generate the print command. 242The variable `mh-lpr-command-format' is used to generate the print command.
244The messages are formatted by mhl. See the variable `mhl-formfile'." 243The messages are formatted by mhl. See the variable `mhl-formfile'."
245 (interactive (list (mh-interactive-msg-or-seq "Print"))) 244 (interactive (list (mh-interactive-range "Print")))
246 (message "Printing...") 245 (message "Printing...")
247 (let (msgs) 246 (let (msgs)
248 ;; Gather message numbers and add them to "printed" sequence. 247 ;; Gather message numbers and add them to "printed" sequence.
249 (mh-iterate-on-msg-or-seq msg msg-or-seq 248 (mh-iterate-on-range msg range
250 (mh-add-msgs-to-seq msg 'printed t) 249 (mh-add-msgs-to-seq msg 'printed t)
251 (mh-notate nil mh-note-printed mh-cmd-note) 250 (mh-notate nil mh-note-printed mh-cmd-note)
252 (push msg msgs)) 251 (push msg msgs))
@@ -258,12 +257,12 @@ The messages are formatted by mhl. See the variable `mhl-formfile'."
258 (mh-coalesce-msg-list msgs)) " ")) 257 (mh-coalesce-msg-list msgs)) " "))
259 (lpr-command 258 (lpr-command
260 (format mh-lpr-command-format 259 (format mh-lpr-command-format
261 (cond ((listp msg-or-seq) 260 (cond ((listp range)
262 (format "Folder: %s, Messages: %s" 261 (format "Folder: %s, Messages: %s"
263 mh-current-folder msgs-string)) 262 mh-current-folder msgs-string))
264 ((symbolp msg-or-seq) 263 ((symbolp range)
265 (format "Folder: %s, Sequence: %s" 264 (format "Folder: %s, Sequence: %s"
266 mh-current-folder msg-or-seq))))) 265 mh-current-folder range)))))
267 (scan-command 266 (scan-command
268 (format "scan %s | %s" msgs-string lpr-command))) 267 (format "scan %s | %s" msgs-string lpr-command)))
269 (if mh-print-background-flag 268 (if mh-print-background-flag
@@ -319,7 +318,7 @@ Argument IGNORE is deprecated."
319 mh-seq-list nil 318 mh-seq-list nil
320 mh-next-direction 'forward) 319 mh-next-direction 'forward)
321 (with-mh-folder-updating (nil) 320 (with-mh-folder-updating (nil)
322 (mh-unmark-all-headers t))) 321 (mh-remove-all-notation)))
323 (t 322 (t
324 (message "Commands not undone.") 323 (message "Commands not undone.")
325 ;; Remove by 2003-06-30 if nothing seems amiss. XXX 324 ;; Remove by 2003-06-30 if nothing seems amiss. XXX
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
new file mode 100644
index 00000000000..82748335408
--- /dev/null
+++ b/lisp/mh-e/mh-gnus.el
@@ -0,0 +1,142 @@
1;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
2
3;; Copyright (C) 2003 Free Software Foundation, Inc.
4
5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
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;;; Change Log:
30
31;;; Code:
32
33(load "mm-decode" t t) ; Non-fatal dependency
34(load "mm-uu" t t) ; Non-fatal dependency
35(load "mailcap" t t) ; Non-fatal dependency
36(load "smiley" t t) ; Non-fatal dependency
37
38(defmacro mh-defun-compat (function arg-list &rest body)
39 "This is a macro to define functions which are not defined.
40It is used for Gnus utility functions which were added recently. If FUNCTION
41is not defined then it is defined to have argument list, ARG-LIST and body,
42BODY."
43 (let ((defined-p (fboundp function)))
44 (unless defined-p
45 `(defun ,function ,arg-list ,@body))))
46(put 'mh-defun-compat 'lisp-indent-function 'defun)
47
48(defmacro mh-defmacro-compat (function arg-list &rest body)
49 "This is a macro to define functions which are not defined.
50It is used for Gnus utility functions which were added recently. If FUNCTION
51is not defined then it is defined to have argument list, ARG-LIST and body,
52BODY."
53 (let ((defined-p (fboundp function)))
54 (unless defined-p
55 `(defmacro ,function ,arg-list ,@body))))
56(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
57
58;; Copy of original function from gnus-util.el
59(mh-defun-compat gnus-local-map-property (map)
60 "Return a list suitable for a text property list specifying keymap MAP."
61 (cond (mh-xemacs-flag (list 'keymap map))
62 ((>= emacs-major-version 21) (list 'keymap map))
63 (t (list 'local-map map))))
64
65;; Copy of original function from mm-decode.el
66(mh-defun-compat mm-merge-handles (handles1 handles2)
67 (append (if (listp (car handles1)) handles1 (list handles1))
68 (if (listp (car handles2)) handles2 (list handles2))))
69
70;; Copy of function from mm-decode.el
71(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
72 ;; HANDLE could be a CTL.
73 (if handle
74 (put-text-property 0 (length (car handle)) parameter value
75 (car handle))))
76
77;; Copy of original macro is in mm-decode.el
78(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
79 `(get-text-property 0 ,parameter (car ,handle)))
80
81(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
82
83;; Copy of original function in mm-decode.el
84(mh-defun-compat mm-readable-p (handle)
85 "Say whether the content of HANDLE is readable."
86 (and (< (with-current-buffer (mm-handle-buffer handle)
87 (buffer-size)) 10000)
88 (mm-with-unibyte-buffer
89 (mm-insert-part handle)
90 (and (eq (mm-body-7-or-8) '7bit)
91 (not (mm-long-lines-p 76))))))
92
93;; Copy of original function in mm-bodies.el
94(mh-defun-compat mm-long-lines-p (length)
95 "Say whether any of the lines in the buffer is longer than LENGTH."
96 (save-excursion
97 (goto-char (point-min))
98 (end-of-line)
99 (while (and (not (eobp))
100 (not (> (current-column) length)))
101 (forward-line 1)
102 (end-of-line))
103 (and (> (current-column) length)
104 (current-column))))
105
106(mh-defun-compat mm-keep-viewer-alive-p (handle)
107 ;; Released Gnus doesn't keep handles associated with externally displayed
108 ;; MIME parts. So this will always return nil.
109 nil)
110
111(mh-defun-compat mm-destroy-parts (list)
112 "Older emacs don't have this function."
113 nil)
114
115;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
116;;; buggy (the args to read-file-name are incorrect). When all supported
117;;; versions of Emacs come with at least Gnus 5.10, we can delete this
118;;; function and rename calls to mh-mm-save-part to mm-save-part.
119(defun mh-mm-save-part (handle)
120 "Write HANDLE to a file."
121 (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
122 (filename (mail-content-type-get
123 (mm-handle-disposition handle) 'filename))
124 file)
125 (when filename
126 (setq filename (file-name-nondirectory filename)))
127 (setq file (read-file-name "Save MIME part to: "
128 (or mm-default-directory
129 default-directory)
130 nil nil (or filename name "")))
131 (setq mm-default-directory (file-name-directory file))
132 (and (or (not (file-exists-p file))
133 (yes-or-no-p (format "File %s already exists; overwrite? "
134 file)))
135 (mm-save-part-to-file handle file))))
136
137(provide 'mh-gnus)
138;;; Local Variables:
139;;; no-byte-compile: t
140;;; no-update-autoloads: t
141;;; End:
142;;; mh-gnus.el ends here
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 982a743a227..f4edc7a2087 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -1,6 +1,6 @@
1;;; mh-identity.el --- Multiple identify support for MH-E. 1;;; mh-identity.el --- Multiple identify support for MH-E.
2 2
3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Peter S. Galbraith <psg@debian.org> 5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -40,7 +40,8 @@
40;;; Code: 40;;; Code:
41 41
42 42
43(require 'cl) 43(require 'mh-utils)
44(mh-require-cl)
44 45
45(eval-when (compile load eval) 46(eval-when (compile load eval)
46 (defvar mh-comp-loaded nil) 47 (defvar mh-comp-loaded nil)
@@ -63,6 +64,8 @@
63 ;; ["home" (mh-insert-identity "home") 64 ;; ["home" (mh-insert-identity "home")
64 ;; :style radio :active (not (equal mh-identity-local "home")) 65 ;; :style radio :active (not (equal mh-identity-local "home"))
65 ;; :selected (equal mh-identity-local "home")] 66 ;; :selected (equal mh-identity-local "home")]
67 '(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list]
68 "--")
66 (mapcar (function 69 (mapcar (function
67 (lambda (arg) 70 (lambda (arg)
68 `[,arg (mh-insert-identity ,arg) :style radio 71 `[,arg (mh-insert-identity ,arg) :style radio
diff --git a/lisp/mh-e/mh-index.el b/lisp/mh-e/mh-index.el
index ef08c6e890a..734ce938616 100644
--- a/lisp/mh-e/mh-index.el
+++ b/lisp/mh-e/mh-index.el
@@ -1,6 +1,6 @@
1;;; mh-index -- MH-E interface to indexing programs 1;;; mh-index -- MH-E interface to indexing programs
2 2
3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Satyaki Das <satyaki@theforce.stanford.edu> 5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -43,7 +43,8 @@
43 43
44;;; Code: 44;;; Code:
45 45
46(require 'cl) 46(require 'mh-utils)
47(mh-require-cl)
47(require 'mh-e) 48(require 'mh-e)
48(require 'mh-mime) 49(require 'mh-mime)
49(require 'mh-pick) 50(require 'mh-pick)
@@ -259,10 +260,60 @@ checksum -> (origin-folder, origin-index) map is updated too."
259 (save-excursion 260 (save-excursion
260 (set-buffer folder) 261 (set-buffer folder)
261 (mh-index-update-single-msg msg checksum origin-map))) 262 (mh-index-update-single-msg msg checksum origin-map)))
262 (forward-line)))))) 263 (forward-line)))))
264 (mh-index-write-data))
263 265
264(defvar mh-flists-results-folder "new" 266(defvar mh-unpropagated-sequences '(cur range subject search)
267 "List of sequences that aren't preserved.")
268
269(defun mh-unpropagated-sequences ()
270 "Return a list of sequences that aren't propagated to the source folders.
271It is just the sequences in the variable `mh-unpropagated-sequences' in
272addition to the Previous-Sequence (see mh-profile 5)."
273 (if mh-previous-seq
274 (cons mh-previous-seq mh-unpropagated-sequences)
275 mh-unpropagated-sequences))
276
277;;;###mh-autoload
278(defun mh-create-sequence-map (seq-list)
279 "Return a map from msg number to list of sequences in which it is present.
280SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the
281list of messages in that sequence."
282 (loop with map = (make-hash-table)
283 for seq in seq-list
284 when (and (not (memq (car seq) (mh-unpropagated-sequences)))
285 (mh-valid-seq-p (car seq)))
286 do (loop for msg in (cdr seq)
287 do (push (car seq) (gethash msg map)))
288 finally return map))
289
290;;;###mh-autoload
291(defun mh-index-create-sequences ()
292 "Mirror sequences present in source folders in index folder."
293 (let ((seq-hash (make-hash-table :test #'equal))
294 (seq-list ()))
295 (loop for folder being the hash-keys of mh-index-data
296 do (setf (gethash folder seq-hash)
297 (mh-create-sequence-map
298 (mh-read-folder-sequences folder nil))))
299 (dolist (msg (mh-translate-range mh-current-folder "all"))
300 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
301 (pair (gethash checksum mh-index-checksum-origin-map))
302 (ofolder (car pair))
303 (omsg (cdr pair)))
304 (loop for seq in (gethash omsg (gethash ofolder seq-hash))
305 do (if (assoc seq seq-list)
306 (push msg (cdr (assoc seq seq-list)))
307 (push (list seq msg) seq-list)))))
308 (loop for seq in seq-list
309 do (apply #'mh-exec-cmd "mark" mh-current-folder
310 "-sequence" (symbol-name (car seq)) "-add"
311 (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
312
313(defvar mh-flists-results-folder "sequence"
265 "Subfolder for `mh-index-folder' where flists output is placed.") 314 "Subfolder for `mh-index-folder' where flists output is placed.")
315(defvar mh-flists-sequence)
316(defvar mh-flists-called-flag nil)
266 317
267(defun mh-index-generate-pretty-name (string) 318(defun mh-index-generate-pretty-name (string)
268 "Given STRING generate a name which is suitable for use as a folder name. 319 "Given STRING generate a name which is suitable for use as a folder name.
@@ -293,13 +344,14 @@ they are concatenated to construct the base name."
293 (subst-char-in-region (point-min) (point-max) ?\r ?_ t) 344 (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
294 (subst-char-in-region (point-min) (point-max) ?/ ?$ t) 345 (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
295 (let ((out (truncate-string-to-width (buffer-string) 20))) 346 (let ((out (truncate-string-to-width (buffer-string) 20)))
296 (cond ((eq mh-indexer 'flists) mh-flists-results-folder) 347 (cond ((eq mh-indexer 'flists)
348 (format "%s/%s" mh-flists-results-folder mh-flists-sequence))
297 ((equal out mh-flists-results-folder) (concat out "1")) 349 ((equal out mh-flists-results-folder) (concat out "1"))
298 (t out))))) 350 (t out)))))
299 351
300;;;###mh-autoload 352;;;###mh-autoload
301(defun* mh-index-search (redo-search-flag folder search-regexp 353(defun* mh-index-search (redo-search-flag folder search-regexp
302 &optional window-config unseen-flag) 354 &optional window-config)
303 "Perform an indexed search in an MH mail folder. 355 "Perform an indexed search in an MH mail folder.
304Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. 356Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
305 357
@@ -308,8 +360,7 @@ index search, then the search is repeated. Otherwise, FOLDER is searched with
308SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is 360SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
309\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG 361\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
310stores the window configuration that will be restored after the user quits the 362stores the window configuration that will be restored after the user quits the
311folder containing the index search results. If optional argument UNSEEN-FLAG 363folder containing the index search results.
312is non-nil, then all the messages are marked as unseen.
313 364
314Four indexing programs are supported; if none of these are present, then grep 365Four indexing programs are supported; if none of these are present, then grep
315is used. This function picks the first program that is available on your 366is used. This function picks the first program that is available on your
@@ -344,7 +395,8 @@ This has the effect of renaming already present X-MHE-Checksum headers."
344 (list current-prefix-arg 395 (list current-prefix-arg
345 (progn 396 (progn
346 (unless mh-find-path-run (mh-find-path)) 397 (unless mh-find-path-run (mh-find-path))
347 (or (and current-prefix-arg (car mh-index-previous-search)) 398 (or (and current-prefix-arg mh-index-sequence-search-flag)
399 (and current-prefix-arg (car mh-index-previous-search))
348 (mh-prompt-for-folder "Search" "+" nil "all" t))) 400 (mh-prompt-for-folder "Search" "+" nil "all" t)))
349 (progn 401 (progn
350 ;; Yes, we do want to call mh-index-choose every time in case the 402 ;; Yes, we do want to call mh-index-choose every time in case the
@@ -360,6 +412,13 @@ This has the effect of renaming already present X-MHE-Checksum headers."
360 mh-index-regexp-builder) 412 mh-index-regexp-builder)
361 (current-window-configuration) 413 (current-window-configuration)
362 nil))) 414 nil)))
415 ;; Redoing a sequence search?
416 (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
417 (not mh-flists-called-flag))
418 (let ((mh-flists-called-flag t))
419 (apply #'mh-index-sequenced-messages mh-index-previous-search))
420 (return-from mh-index-search))
421 ;; We have fancy query parsing
363 (when (symbolp search-regexp) 422 (when (symbolp search-regexp)
364 (mh-search-folder folder window-config) 423 (mh-search-folder folder window-config)
365 (setq mh-searching-function 'mh-index-do-search) 424 (setq mh-searching-function 'mh-index-do-search)
@@ -401,23 +460,23 @@ This has the effect of renaming already present X-MHE-Checksum headers."
401 460
402 ;; Copy the search results over 461 ;; Copy the search results over
403 (maphash #'(lambda (folder msgs) 462 (maphash #'(lambda (folder msgs)
404 (let ((msgs (sort (loop for msg being the hash-keys of msgs 463 (let ((cur (car (mh-translate-range folder "cur")))
464 (msgs (sort (loop for msg being the hash-keys of msgs
405 collect msg) 465 collect msg)
406 #'<))) 466 #'<)))
407 (mh-exec-cmd "refile" msgs "-src" folder 467 (mh-exec-cmd "refile" msgs "-src" folder
408 "-link" index-folder) 468 "-link" index-folder)
469 ;; Restore cur to old value, that refile changed
470 (when cur
471 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
472 "-sequence" "cur" (format "%s" cur)))
409 (loop for msg in msgs 473 (loop for msg in msgs
410 do (incf result-count) 474 do (incf result-count)
411 (setf (gethash result-count origin-map) 475 (setf (gethash result-count origin-map)
412 (cons folder msg))))) 476 (cons folder msg)))))
413 folder-results-map) 477 folder-results-map)
414 478
415 ;; Mark messages as unseen (if needed) 479 ;; Vist the results folder
416 (when (and unseen-flag (> result-count 0))
417 (mh-exec-cmd "mark" index-folder "all"
418 "-sequence" (symbol-name mh-unseen-seq) "-add"))
419
420 ;; Generate scan lines for the hits.
421 (mh-visit-folder index-folder () (list folder-results-map origin-map)) 480 (mh-visit-folder index-folder () (list folder-results-map origin-map))
422 481
423 (goto-char (point-min)) 482 (goto-char (point-min))
@@ -425,11 +484,18 @@ This has the effect of renaming already present X-MHE-Checksum headers."
425 (mh-update-sequences) 484 (mh-update-sequences)
426 (mh-recenter nil) 485 (mh-recenter nil)
427 486
487 ;; Update the speedbar, if needed
488 (when (mh-speed-flists-active-p)
489 (mh-speed-flists t mh-current-folder))
490
428 ;; Maintain history 491 ;; Maintain history
429 (when (or (and redo-search-flag previous-search) window-config) 492 (when (or (and redo-search-flag previous-search) window-config)
430 (setq mh-previous-window-config old-window-config)) 493 (setq mh-previous-window-config old-window-config))
431 (setq mh-index-previous-search (list folder search-regexp)) 494 (setq mh-index-previous-search (list folder search-regexp))
432 495
496 ;; Write out data to disk
497 (unless mh-flists-called-flag (mh-index-write-data))
498
433 (message "%s found %s matches in %s folders" 499 (message "%s found %s matches in %s folders"
434 (upcase-initials (symbol-name mh-indexer)) 500 (upcase-initials (symbol-name mh-indexer))
435 (loop for msg-hash being hash-values of mh-index-data 501 (loop for msg-hash being hash-values of mh-index-data
@@ -437,6 +503,78 @@ This has the effect of renaming already present X-MHE-Checksum headers."
437 (loop for msg-hash being hash-values of mh-index-data 503 (loop for msg-hash being hash-values of mh-index-data
438 count (> (hash-table-count msg-hash) 0)))))) 504 count (> (hash-table-count msg-hash) 0))))))
439 505
506
507
508;;; Functions to serialize index data...
509
510(defun mh-index-write-data ()
511 "Write index data to file."
512 (ignore-errors
513 (unless (eq major-mode 'mh-folder-mode)
514 (error "Can't be called from folder in `%s'" major-mode))
515 (let ((data mh-index-data)
516 (msg-checksum-map mh-index-msg-checksum-map)
517 (checksum-origin-map mh-index-checksum-origin-map)
518 (previous-search mh-index-previous-search)
519 (sequence-search-flag mh-index-sequence-search-flag)
520 (outfile (concat buffer-file-name mh-index-data-file))
521 (print-length nil)
522 (print-level nil))
523 (with-temp-file outfile
524 (mh-index-write-hashtable
525 data (lambda (x) (loop for y being the hash-keys of x collect y)))
526 (mh-index-write-hashtable msg-checksum-map #'identity)
527 (mh-index-write-hashtable checksum-origin-map #'identity)
528 (pp previous-search (current-buffer)) (insert "\n")
529 (pp sequence-search-flag (current-buffer)) (insert "\n")))))
530
531;;;###mh-autoload
532(defun mh-index-read-data ()
533 "Read index data from file."
534 (ignore-errors
535 (unless (eq major-mode 'mh-folder-mode)
536 (error "Can't be called from folder in `%s'" major-mode))
537 (let ((infile (concat buffer-file-name mh-index-data-file))
538 t1 t2 t3 t4 t5)
539 (with-temp-buffer
540 (insert-file-contents-literally infile)
541 (goto-char (point-min))
542 (setq t1 (mh-index-read-hashtable
543 (lambda (data)
544 (loop with table = (make-hash-table :test #'equal)
545 for x in data do (setf (gethash x table) t)
546 finally return table)))
547 t2 (mh-index-read-hashtable #'identity)
548 t3 (mh-index-read-hashtable #'identity)
549 t4 (read (current-buffer))
550 t5 (read (current-buffer))))
551 (setq mh-index-data t1
552 mh-index-msg-checksum-map t2
553 mh-index-checksum-origin-map t3
554 mh-index-previous-search t4
555 mh-index-sequence-search-flag t5))))
556
557(defun mh-index-write-hashtable (table proc)
558 "Write TABLE to `current-buffer'.
559PROC is used to serialize the values corresponding to the hash table keys."
560 (pp (loop for x being the hash-keys of table
561 collect (cons x (funcall proc (gethash x table))))
562 (current-buffer))
563 (insert "\n"))
564
565(defun mh-index-read-hashtable (proc)
566 "From BUFFER read a hash table serialized as a list.
567PROC is used to convert the value to actual data."
568 (loop with table = (make-hash-table :test #'equal)
569 for pair in (read (current-buffer))
570 do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
571 finally return table))
572
573;;;###mh-autoload
574(defun mh-index-p ()
575 "Non-nil means that this folder was generated by an index search."
576 mh-index-data)
577
440;;;###mh-autoload 578;;;###mh-autoload
441(defun mh-index-do-search () 579(defun mh-index-do-search ()
442 "Construct appropriate regexp and call `mh-index-search'." 580 "Construct appropriate regexp and call `mh-index-search'."
@@ -452,8 +590,9 @@ This has the effect of renaming already present X-MHE-Checksum headers."
452(defun mh-replace-string (old new) 590(defun mh-replace-string (old new)
453 "Replace all occurrences of OLD with NEW in the current buffer." 591 "Replace all occurrences of OLD with NEW in the current buffer."
454 (goto-char (point-min)) 592 (goto-char (point-min))
455 (while (search-forward old nil t) 593 (let ((case-fold-search t))
456 (replace-match new))) 594 (while (search-forward old nil t)
595 (replace-match new t t))))
457 596
458;;;###mh-autoload 597;;;###mh-autoload
459(defun mh-index-parse-search-regexp (input-string) 598(defun mh-index-parse-search-regexp (input-string)
@@ -463,16 +602,18 @@ NOT as appropriate. Then the resulting string is parsed."
463 (let (input) 602 (let (input)
464 (with-temp-buffer 603 (with-temp-buffer
465 (insert input-string) 604 (insert input-string)
466 (downcase-region (point-min) (point-max))
467 ;; replace tabs 605 ;; replace tabs
468 (mh-replace-string "\t" " ") 606 (mh-replace-string "\t" " ")
469 ;; synonyms of AND 607 ;; synonyms of AND
608 (mh-replace-string " AND " " and ")
470 (mh-replace-string "&" " and ") 609 (mh-replace-string "&" " and ")
471 (mh-replace-string " -and " " and ") 610 (mh-replace-string " -and " " and ")
472 ;; synonyms of OR 611 ;; synonyms of OR
612 (mh-replace-string " OR " " or ")
473 (mh-replace-string "|" " or ") 613 (mh-replace-string "|" " or ")
474 (mh-replace-string " -or " " or ") 614 (mh-replace-string " -or " " or ")
475 ;; synonyms of NOT 615 ;; synonyms of NOT
616 (mh-replace-string " NOT " " not ")
476 (mh-replace-string "!" " not ") 617 (mh-replace-string "!" " not ")
477 (mh-replace-string "~" " not ") 618 (mh-replace-string "~" " not ")
478 (mh-replace-string " -not " " not ") 619 (mh-replace-string " -not " " not ")
@@ -498,21 +639,21 @@ NOT as appropriate. Then the resulting string is parsed."
498 (multiple-value-setq (op-stack operand-stack) 639 (multiple-value-setq (op-stack operand-stack)
499 (mh-index-evaluate op-stack operand-stack)) 640 (mh-index-evaluate op-stack operand-stack))
500 (when (eq (car op-stack) 'not) 641 (when (eq (car op-stack) 'not)
501 (pop op-stack) 642 (setq op-stack (cdr op-stack))
502 (push `(not ,(pop operand-stack)) operand-stack)) 643 (push `(not ,(pop operand-stack)) operand-stack))
503 (when (eq (car op-stack) 'and) 644 (when (eq (car op-stack) 'and)
504 (pop op-stack) 645 (setq op-stack (cdr op-stack))
505 (setq oper1 (pop operand-stack)) 646 (setq oper1 (pop operand-stack))
506 (push `(and ,(pop operand-stack) ,oper1) operand-stack))) 647 (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
507 ((eq (car op-stack) 'not) 648 ((eq (car op-stack) 'not)
508 (pop op-stack) 649 (setq op-stack (cdr op-stack))
509 (push `(not ,token) operand-stack) 650 (push `(not ,token) operand-stack)
510 (when (eq (car op-stack) 'and) 651 (when (eq (car op-stack) 'and)
511 (pop op-stack) 652 (setq op-stack (cdr op-stack))
512 (setq oper1 (pop operand-stack)) 653 (setq oper1 (pop operand-stack))
513 (push `(and ,(pop operand-stack) ,oper1) operand-stack))) 654 (push `(and ,(pop operand-stack) ,oper1) operand-stack)))
514 ((eq (car op-stack) 'and) 655 ((eq (car op-stack) 'and)
515 (pop op-stack) 656 (setq op-stack (cdr op-stack))
516 (push `(and ,(pop operand-stack) ,token) operand-stack)) 657 (push `(and ,(pop operand-stack) ,token) operand-stack))
517 (t (push token operand-stack)))) 658 (t (push token operand-stack))))
518 (prog1 (pop operand-stack) 659 (prog1 (pop operand-stack)
@@ -632,7 +773,7 @@ we find a new folder name."
632 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil) 773 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
633 mh-index-msg-checksum-map) 774 mh-index-msg-checksum-map)
634 mh-index-checksum-origin-map))) 775 mh-index-checksum-origin-map)))
635 (when (and current-folder (not (eq current-folder last-folder))) 776 (when (and current-folder (not (equal current-folder last-folder)))
636 (insert (if last-folder "\n" "") current-folder "\n") 777 (insert (if last-folder "\n" "") current-folder "\n")
637 (setq last-folder current-folder)) 778 (setq last-folder current-folder))
638 (forward-line)) 779 (forward-line))
@@ -646,7 +787,7 @@ Returns an alist with the the folder names in the car and the cdr being the
646list of messages originally from that folder." 787list of messages originally from that folder."
647 (save-excursion 788 (save-excursion
648 (goto-char (point-min)) 789 (goto-char (point-min))
649 (let ((result-table (make-hash-table))) 790 (let ((result-table (make-hash-table :test #'equal)))
650 (loop for msg being hash-keys of mh-index-msg-checksum-map 791 (loop for msg being hash-keys of mh-index-msg-checksum-map
651 do (push msg (gethash (car (gethash 792 do (push msg (gethash (car (gethash
652 (gethash msg mh-index-msg-checksum-map) 793 (gethash msg mh-index-msg-checksum-map)
@@ -722,24 +863,113 @@ Also `mh-update-unseen' is called in the original folder, if we have it open."
722 (string-equal (buffer-substring-no-properties (point) (line-end-position)) 863 (string-equal (buffer-substring-no-properties (point) (line-end-position))
723 checksum))) 864 checksum)))
724 865
866(defun mh-index-matching-source-msgs (msgs &optional delete-from-index-data)
867 "Return a table of original messages and folders for messages in MSGS.
868If optional argument DELETE-FROM-INDEX-DATA is non-nil, then each of the
869messages, whose counter-part is found in some source folder, is removed from
870`mh-index-data'."
871 (let ((table (make-hash-table :test #'equal)))
872 (dolist (msg msgs)
873 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
874 (pair (gethash checksum mh-index-checksum-origin-map)))
875 (when (and checksum (car pair) (cdr pair)
876 (mh-index-match-checksum (cdr pair) (car pair) checksum))
877 (push (cdr pair) (gethash (car pair) table))
878 (when delete-from-index-data
879 (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
880 table))
881
725;;;###mh-autoload 882;;;###mh-autoload
726(defun mh-index-execute-commands () 883(defun mh-index-execute-commands ()
727 "Delete/refile the actual messages. 884 "Delete/refile the actual messages.
728The copies in the searched folder are then deleted/refiled to get the desired 885The copies in the searched folder are then deleted/refiled to get the desired
729result. Before deleting the messages we make sure that the message being 886result. Before deleting the messages we make sure that the message being
730deleted is identical to the one that the user has marked in the index buffer." 887deleted is identical to the one that the user has marked in the index buffer."
731 (let ((message-table (make-hash-table :test #'equal))) 888 (save-excursion
732 (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list))) 889 (let ((folders ())
733 (dolist (msg msg-list) 890 (mh-speed-flists-inhibit-flag t))
734 (let* ((checksum (gethash msg mh-index-msg-checksum-map)) 891 (maphash
735 (pair (gethash checksum mh-index-checksum-origin-map))) 892 (lambda (folder msgs)
736 (when (and checksum (car pair) (cdr pair) 893 (push folder folders)
737 (mh-index-match-checksum (cdr pair) (car pair) checksum)) 894 (if (not (get-buffer folder))
738 (push (cdr pair) (gethash (car pair) message-table)) 895 ;; If source folder not open, just delete the messages...
739 (remhash (cdr pair) (gethash (car pair) mh-index-data)))))) 896 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
740 (maphash (lambda (folder msgs) 897 ;; Otherwise delete the messages in the source buffer...
741 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))) 898 (save-excursion
742 message-table))) 899 (set-buffer folder)
900 (let ((old-refile-list mh-refile-list)
901 (old-delete-list mh-delete-list))
902 (setq mh-refile-list nil
903 mh-delete-list msgs)
904 (unwind-protect (mh-execute-commands)
905 (setq mh-refile-list
906 (mapcar (lambda (x)
907 (cons (car x)
908 (loop for y in (cdr x)
909 unless (memq y msgs) collect y)))
910 old-refile-list)
911 mh-delete-list
912 (loop for x in old-delete-list
913 unless (memq x msgs) collect x))
914 (mh-set-folder-modified-p (mh-outstanding-commands-p))
915 (when (mh-outstanding-commands-p)
916 (mh-notate-deleted-and-refiled)))))))
917 (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
918 append (cdr x))
919 mh-delete-list)
920 t))
921 folders)))
922
923;;;###mh-autoload
924(defun mh-index-add-to-sequence (seq msgs)
925 "Add to SEQ the messages in the list MSGS.
926This function updates the source folder sequences. Also makes an attempt to
927update the source folder buffer if we have it open."
928 ;; Don't need to do anything for cur
929 (save-excursion
930 (when (and (not (memq seq (mh-unpropagated-sequences)))
931 (mh-valid-seq-p seq))
932 (let ((folders ())
933 (mh-speed-flists-inhibit-flag t))
934 (maphash (lambda (folder msgs)
935 (push folder folders)
936 ;; Add messages to sequence in source folder...
937 (apply #'mh-exec-cmd-quiet nil "mark" folder
938 "-add" "-nozero" "-sequence" (symbol-name seq)
939 (mapcar (lambda (x) (format "%s" x))
940 (mh-coalesce-msg-list msgs)))
941 ;; Update source folder buffer if we have it open...
942 (when (get-buffer folder)
943 (save-excursion
944 (set-buffer folder)
945 (mh-put-msg-in-seq msgs seq))))
946 (mh-index-matching-source-msgs msgs))
947 folders))))
948
949;;;###mh-autoload
950(defun mh-index-delete-from-sequence (seq msgs)
951 "Delete from SEQ the messages in MSGS.
952This function updates the source folder sequences. Also makes an attempt to
953update the source folder buffer if present."
954 (save-excursion
955 (when (and (not (memq seq (mh-unpropagated-sequences)))
956 (mh-valid-seq-p seq))
957 (let ((folders ())
958 (mh-speed-flists-inhibit-flag t))
959 (maphash (lambda (folder msgs)
960 (push folder folders)
961 ;; Remove messages from sequence in source folder...
962 (apply #'mh-exec-cmd-quiet nil "mark" folder
963 "-del" "-nozero" "-sequence" (symbol-name seq)
964 (mapcar (lambda (x) (format "%s" x))
965 (mh-coalesce-msg-list msgs)))
966 ;; Update source folder buffer if we have it open...
967 (when (get-buffer folder)
968 (save-excursion
969 (set-buffer folder)
970 (mh-delete-msg-from-seq msgs seq t))))
971 (mh-index-matching-source-msgs msgs))
972 folders))))
743 973
744 974
745 975
@@ -1051,61 +1281,114 @@ REGEXP-LIST is an alist of fields and values."
1051 1281
1052(defvar mh-flists-search-folders) 1282(defvar mh-flists-search-folders)
1053 1283
1284;; XXX: This should probably be in mh-utils.el and used in other places where
1285;; MH-E calls out to /bin/sh.
1286(defun mh-index-quote-for-shell (string)
1287 "Quote STRING for /bin/sh."
1288 (concat "\""
1289 (loop for x across string
1290 concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
1291 "\""))
1292
1054(defun mh-flists-execute (&rest args) 1293(defun mh-flists-execute (&rest args)
1055 "Search for unseen messages in `mh-flists-search-folders'. 1294 "Execute flists.
1056If `mh-recursive-folders-flag' is t, then the folders are searched 1295Search for messages belonging to `mh-flists-sequence' in the folders
1057recursively. All parameters ARGS are ignored." 1296specified by `mh-flists-search-folders'. If `mh-recursive-folders-flag' is t,
1297then the folders are searched recursively. All parameters ARGS are ignored."
1058 (set-buffer (get-buffer-create mh-index-temp-buffer)) 1298 (set-buffer (get-buffer-create mh-index-temp-buffer))
1059 (erase-buffer) 1299 (erase-buffer)
1060 (unless (executable-find "sh") 1300 (unless (executable-find "sh")
1061 (error "Didn't find sh")) 1301 (error "Didn't find sh"))
1062 (with-temp-buffer 1302 (with-temp-buffer
1063 (let ((unseen (symbol-name mh-unseen-seq))) 1303 (let ((seq (symbol-name mh-flists-sequence)))
1064 (insert "for folder in `flists " 1304 (insert "for folder in `" (expand-file-name "flists" mh-progs) " "
1065 (cond ((eq mh-flists-search-folders t) mh-inbox) 1305 (cond ((eq mh-flists-search-folders t)
1306 (mh-index-quote-for-shell mh-inbox))
1066 ((eq mh-flists-search-folders nil) "") 1307 ((eq mh-flists-search-folders nil) "")
1067 ((listp mh-flists-search-folders) 1308 ((listp mh-flists-search-folders)
1068 (loop for folder in mh-flists-search-folders 1309 (loop for folder in mh-flists-search-folders
1069 concat (concat " " folder)))) 1310 concat
1311 (concat " " (mh-index-quote-for-shell folder)))))
1070 (if mh-recursive-folders-flag " -recurse" "") 1312 (if mh-recursive-folders-flag " -recurse" "")
1071 " -sequence " unseen " -noshowzero -fast` ; do\n" 1313 " -sequence " seq " -noshowzero -fast` ; do\n"
1072 "mhpath \"+$folder\" " unseen "\n" "done\n")) 1314 (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
1315 "done\n"))
1073 (call-process-region 1316 (call-process-region
1074 (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer)))) 1317 (point-min) (point-max) "sh" nil (get-buffer mh-index-temp-buffer))))
1075 1318
1076;;;###mh-autoload 1319;;;###mh-autoload
1077(defun mh-index-new-messages (folders) 1320(defun mh-index-sequenced-messages (folders sequence)
1078 "Display new messages. 1321 "Display messages from FOLDERS in SEQUENCE.
1079All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
1080By default the folders specified by `mh-index-new-messages-folders' are 1322By default the folders specified by `mh-index-new-messages-folders' are
1081searched. With a prefix argument, enter a space-separated list of folders, or 1323searched. With a prefix argument, enter a space-separated list of folders, or
1082nothing to search all folders." 1324nothing to search all folders.
1325
1326Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
1327function searches for in each of the FOLDERS. With a prefix argument, enter a
1328sequence to use."
1083 (interactive 1329 (interactive
1084 (list (if current-prefix-arg 1330 (list (if current-prefix-arg
1085 (split-string (read-string "Folders to search: ")) 1331 (split-string (read-string "Search folder(s) [all]? "))
1086 mh-index-new-messages-folders))) 1332 mh-index-new-messages-folders)
1333 (mh-read-seq-default "Search" nil)))
1334 (unless sequence (setq sequence mh-unseen-seq))
1087 (let* ((mh-flists-search-folders folders) 1335 (let* ((mh-flists-search-folders folders)
1336 (mh-flists-sequence sequence)
1337 (mh-flists-called-flag t)
1088 (mh-indexer 'flists) 1338 (mh-indexer 'flists)
1089 (mh-index-execute-search-function 'mh-flists-execute) 1339 (mh-index-execute-search-function 'mh-flists-execute)
1090 (mh-index-next-result-function 'mh-mairix-next-result) 1340 (mh-index-next-result-function 'mh-mairix-next-result)
1091 (mh-mairix-folder mh-user-path) 1341 (mh-mairix-folder mh-user-path)
1092 (mh-index-regexp-builder nil) 1342 (mh-index-regexp-builder nil)
1093 (new-folder (format "%s/%s" mh-index-folder mh-flists-results-folder)) 1343 (new-folder (format "%s/%s/%s" mh-index-folder
1344 mh-flists-results-folder sequence))
1094 (window-config (if (equal new-folder mh-current-folder) 1345 (window-config (if (equal new-folder mh-current-folder)
1095 mh-previous-window-config 1346 mh-previous-window-config
1096 (current-window-configuration))) 1347 (current-window-configuration)))
1097 (redo-flag nil)) 1348 (redo-flag nil)
1349 message)
1098 (cond ((buffer-live-p (get-buffer new-folder)) 1350 (cond ((buffer-live-p (get-buffer new-folder))
1099 ;; The destination folder is being visited. Trick `mh-index-search' 1351 ;; The destination folder is being visited. Trick `mh-index-search'
1100 ;; into thinking that the folder was the result of a previous search. 1352 ;; into thinking that the folder resulted from a previous search.
1101 (set-buffer new-folder) 1353 (set-buffer new-folder)
1102 (setq mh-index-previous-search (list "+" mh-flists-results-folder)) 1354 (setq mh-index-previous-search (list folders sequence))
1103 (setq redo-flag t)) 1355 (setq redo-flag t))
1104 ((mh-folder-exists-p new-folder) 1356 ((mh-folder-exists-p new-folder)
1105 ;; Folder exists but we don't have it open. That means they are 1357 ;; Folder exists but we don't have it open. That means they are
1106 ;; stale results from a old flists search. Clear it out. 1358 ;; stale results from a old flists search. Clear it out.
1107 (mh-exec-cmd-quiet nil "rmf" new-folder))) 1359 (mh-exec-cmd-quiet nil "rmf" new-folder)))
1108 (mh-index-search redo-flag "+" mh-flists-results-folder window-config t))) 1360 (setq message (mh-index-search redo-flag "+" mh-flists-results-folder
1361 window-config)
1362 mh-index-sequence-search-flag t
1363 mh-index-previous-search (list folders sequence))
1364 (mh-index-write-data)
1365 (when (stringp message) (message message))))
1366
1367;;;###mh-autoload
1368(defun mh-index-new-messages (folders)
1369 "Display unseen messages.
1370All messages in the `unseen' sequence from FOLDERS are displayed.
1371By default the folders specified by `mh-index-new-messages-folders'
1372are searched. With a prefix argument, enter a space-separated list of
1373folders, or nothing to search all folders."
1374 (interactive
1375 (list (if current-prefix-arg
1376 (split-string (read-string "Search folder(s) [all]? "))
1377 mh-index-new-messages-folders)))
1378 (mh-index-sequenced-messages folders mh-unseen-seq))
1379
1380;;;###mh-autoload
1381(defun mh-index-ticked-messages (folders)
1382 "Display ticked messages.
1383All messages in the `tick' sequence from FOLDERS are displayed.
1384By default the folders specified by `mh-index-ticked-messages-folders'
1385are searched. With a prefix argument, enter a space-separated list of
1386folders, or nothing to search all folders."
1387 (interactive
1388 (list (if current-prefix-arg
1389 (split-string (read-string "Search folder(s) [all]? "))
1390 mh-index-ticked-messages-folders)))
1391 (mh-index-sequenced-messages folders mh-tick-seq))
1109 1392
1110 1393
1111 1394
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 2b839408b63..42ec4c444d3 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -36,14 +36,11 @@
36 36
37;; Interactive functions callable from the folder buffer 37;; Interactive functions callable from the folder buffer
38;;;###mh-autoload 38;;;###mh-autoload
39(defun mh-junk-blacklist (msg-or-seq) 39(defun mh-junk-blacklist (range)
40 "Blacklist MSG-OR-SEQ as spam. 40 "Blacklist RANGE as spam.
41Default is the displayed message. 41
42If optional prefix argument is provided, then prompt for the message sequence. 42Check the documentation of `mh-interactive-range' to see how RANGE is read in
43If variable `transient-mark-mode' is non-nil and the mark is active, then the 43interactive use.
44selected region is blacklisted.
45In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
46region in a cons cell, or a sequence.
47 44
48First the appropriate function is called depending on the value of 45First the appropriate function is called depending on the value of
49`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is 46`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
@@ -58,7 +55,7 @@ for the different spam fighting programs:
58 - `mh-bogofilter-blacklist' 55 - `mh-bogofilter-blacklist'
59 - `mh-spamprobe-blacklist' 56 - `mh-spamprobe-blacklist'
60 - `mh-spamassassin-blacklist'" 57 - `mh-spamassassin-blacklist'"
61 (interactive (list (mh-interactive-msg-or-seq "Blacklist"))) 58 (interactive (list (mh-interactive-range "Blacklist")))
62 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) 59 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
63 (unless blacklist-func 60 (unless blacklist-func
64 (error "Customize `mh-junk-program' appropriately")) 61 (error "Customize `mh-junk-program' appropriately"))
@@ -70,7 +67,7 @@ for the different spam fighting programs:
70 (concat mh-current-folder "/" 67 (concat mh-current-folder "/"
71 (substring mh-junk-mail-folder 1))) 68 (substring mh-junk-mail-folder 1)))
72 (t (concat "+" mh-junk-mail-folder))))) 69 (t (concat "+" mh-junk-mail-folder)))))
73 (mh-iterate-on-msg-or-seq msg msg-or-seq 70 (mh-iterate-on-range msg range
74 (funcall (symbol-function blacklist-func) msg) 71 (funcall (symbol-function blacklist-func) msg)
75 (if dest 72 (if dest
76 (mh-refile-a-msg nil (intern dest)) 73 (mh-refile-a-msg nil (intern dest))
@@ -78,25 +75,22 @@ for the different spam fighting programs:
78 (mh-next-msg)))) 75 (mh-next-msg))))
79 76
80;;;###mh-autoload 77;;;###mh-autoload
81(defun mh-junk-whitelist (msg-or-seq) 78(defun mh-junk-whitelist (range)
82 "Whitelist MSG-OR-SEQ incorrectly classified as spam. 79 "Whitelist RANGE incorrectly classified as spam.
83Default is the displayed message. 80
84If optional prefix argument is provided, then prompt for the message sequence. 81Check the documentation of `mh-interactive-range' to see how RANGE is read in
85If variable `transient-mark-mode' is non-nil and the mark is active, then the 82interactive use.
86selected region is whitelisted.
87In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
88region in a cons cell, or a sequence.
89 83
90First the appropriate function is called depending on the value of 84First the appropriate function is called depending on the value of
91`mh-junk-choice'. Then the message is refiled to `mh-inbox'. 85`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
92 86
93To change the spam program being used, customize `mh-junk-program'. Directly 87To change the spam program being used, customize `mh-junk-program'. Directly
94setting `mh-junk-choice' is not recommended." 88setting `mh-junk-choice' is not recommended."
95 (interactive (list (mh-interactive-msg-or-seq "Whitelist"))) 89 (interactive (list (mh-interactive-range "Whitelist")))
96 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) 90 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
97 (unless whitelist-func 91 (unless whitelist-func
98 (error "Customize `mh-junk-program' appropriately")) 92 (error "Customize `mh-junk-program' appropriately"))
99 (mh-iterate-on-msg-or-seq msg msg-or-seq 93 (mh-iterate-on-range msg range
100 (funcall (symbol-function whitelist-func) msg) 94 (funcall (symbol-function whitelist-func) msg)
101 (mh-refile-a-msg nil (intern mh-inbox))) 95 (mh-refile-a-msg nil (intern mh-inbox)))
102 (mh-next-msg))) 96 (mh-next-msg)))
@@ -302,7 +296,7 @@ be done by adding the following to your crontab:
302 (when mh-sa-learn-executable 296 (when mh-sa-learn-executable
303 (message "Recategorizing this message as spam...") 297 (message "Recategorizing this message as spam...")
304 (call-process mh-sa-learn-executable msg-file mh-log-buffer nil 298 (call-process mh-sa-learn-executable msg-file mh-log-buffer nil
305 "--single" "--spam" "--local --no-rebuild")) 299 "--single" "--spam" "--local" "--no-rebuild"))
306 (message "Blacklisting address...") 300 (message "Blacklisting address...")
307 (set-buffer (get-buffer-create mh-temp-buffer)) 301 (set-buffer (get-buffer-create mh-temp-buffer))
308 (erase-buffer) 302 (erase-buffer)
diff --git a/lisp/mh-e/mh-loaddefs.el b/lisp/mh-e/mh-loaddefs.el
index dfee534147e..9b2423dcda9 100644
--- a/lisp/mh-e/mh-loaddefs.el
+++ b/lisp/mh-e/mh-loaddefs.el
@@ -1,18 +1,19 @@
1;;; mh-loaddefs.el --- automatically extracted autoloads 1;;; mh-loaddefs.el --- automatically extracted autoloads
2;; 2;;
3;;; Copyright (C) 2003 Free Software Foundation, Inc. 3;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
4;;; Author: Bill Wohler <wohler@newt.com> 4;;; Author: Bill Wohler <wohler@newt.com>
5;;; Keywords: mail 5;;; Keywords: mail
6;;; Commentary: 6;;; Commentary:
7;;; Change Log: 7;;; Change Log:
8;;; Code: 8;;; Code:
9 9
10;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft 10;;;### (autoloads (mh-letter-previous-header-field mh-letter-next-header-field-or-indent
11;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom 11;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft
12;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function 12;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields
13;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
13;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward 14;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
14;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el" 15;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
15;;;;;; (16040 52697)) 16;;;;;; (16625 53169))
16;;; Generated autoloads from mh-comp.el 17;;; Generated autoloads from mh-comp.el
17 18
18(autoload (quote mh-edit-again) "mh-comp" "\ 19(autoload (quote mh-edit-again) "mh-comp" "\
@@ -29,13 +30,11 @@ See also documentation for `\\[mh-send]' function." t nil)
29 30
30(autoload (quote mh-forward) "mh-comp" "\ 31(autoload (quote mh-forward) "mh-comp" "\
31Forward messages to the recipients TO and CC. 32Forward messages to the recipients TO and CC.
32Use optional MSG-OR-SEQ argument to specify a message or sequence to forward. 33Use optional RANGE argument to specify a message or sequence to forward.
33Default is the displayed message. 34Default is the displayed message.
34If optional prefix argument is provided, then prompt for the message sequence. 35
35If variable `transient-mark-mode' is non-nil and the mark is active, then the 36Check the documentation of `mh-interactive-range' to see how RANGE is read in
36selected region is forwarded. 37interactive use.
37In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
38region in a cons cell, or a sequence.
39 38
40See also documentation for `\\[mh-send]' function." t nil) 39See also documentation for `\\[mh-send]' function." t nil)
41 40
@@ -104,6 +103,14 @@ called, with no arguments, before the signature is actually inserted." t nil)
104(autoload (quote mh-check-whom) "mh-comp" "\ 103(autoload (quote mh-check-whom) "mh-comp" "\
105Verify recipients of the current letter, showing expansion of any aliases." t nil) 104Verify recipients of the current letter, showing expansion of any aliases." t nil)
106 105
106(autoload (quote mh-insert-auto-fields) "mh-comp" "\
107Insert custom fields if To or Cc match `mh-auto-fields-list'.
108Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
109something. If NON-INTERACTIVE is non-nil, do not be verbose and only
110attempt matches if `mh-insert-auto-fields-done-local' is nil.
111
112An `identity' entry is skipped if one was already entered manually." t nil)
113
107(autoload (quote mh-send-letter) "mh-comp" "\ 114(autoload (quote mh-send-letter) "mh-comp" "\
108Send the draft letter in the current buffer. 115Send the draft letter in the current buffer.
109If optional prefix argument ARG is provided, monitor delivery. 116If optional prefix argument ARG is provided, monitor delivery.
@@ -143,16 +150,26 @@ Insert a newline and leave point after it.
143In addition, insert newline and quoting characters before text after point. 150In addition, insert newline and quoting characters before text after point.
144This is useful in breaking up paragraphs in replies." t nil) 151This is useful in breaking up paragraphs in replies." t nil)
145 152
146(autoload (quote mh-letter-complete) "mh-comp" "\ 153(autoload (quote mh-complete-word) "mh-comp" "\
147Perform completion on header field or word preceding point. 154Complete WORD at from CHOICES.
148Alias completion is done within the mail header on selected fields and 155Any match found replaces the text from BEGIN to END." nil nil)
149by the function designated by `mh-letter-complete-function' elsewhere, 156
150passing the prefix ARG if any." t nil) 157(autoload (quote mh-beginning-of-word) "mh-comp" "\
158Return position of the N th word backwards." nil nil)
159
160(autoload (quote mh-letter-next-header-field-or-indent) "mh-comp" "\
161Move to next field or indent depending on point.
162In the message header, go to the next field. Elsewhere call
163`indent-relative' as usual with optional prefix ARG." t nil)
164
165(autoload (quote mh-letter-previous-header-field) "mh-comp" "\
166Cycle to the previous header field.
167If we are at the first header field go to the start of the message body." t nil)
151 168
152;;;*** 169;;;***
153 170
154;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el" 171;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
155;;;;;; (16040 52697)) 172;;;;;; (16625 53481))
156;;; Generated autoloads from mh-customize.el 173;;; Generated autoloads from mh-customize.el
157 174
158(autoload (quote mh-customize) "mh-customize" "\ 175(autoload (quote mh-customize) "mh-customize" "\
@@ -163,7 +180,7 @@ are removed." t nil)
163;;;*** 180;;;***
164 181
165;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p) 182;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
166;;;;;; "mh-e" "mh-e.el" (16040 52698)) 183;;;;;; "mh-e" "mh-e.el" (16627 18152))
167;;; Generated autoloads from mh-e.el 184;;; Generated autoloads from mh-e.el
168 185
169(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\ 186(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
@@ -186,7 +203,7 @@ recenter the folder buffer." nil nil)
186;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards 203;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
187;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders 204;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
188;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el" 205;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
189;;;;;; (16040 52698)) 206;;;;;; (16625 54011))
190;;; Generated autoloads from mh-funcs.el 207;;; Generated autoloads from mh-funcs.el
191 208
192(autoload (quote mh-burst-digest) "mh-funcs" "\ 209(autoload (quote mh-burst-digest) "mh-funcs" "\
@@ -195,18 +212,18 @@ The message is replaced by its table of contents and the messages from the
195digest are inserted into the folder after that message." t nil) 212digest are inserted into the folder after that message." t nil)
196 213
197(autoload (quote mh-copy-msg) "mh-funcs" "\ 214(autoload (quote mh-copy-msg) "mh-funcs" "\
198Copy the specified MSG-OR-SEQ to another FOLDER without deleting them. 215Copy the specified RANGE to another FOLDER without deleting them.
199Default is the displayed message. 216
200If optional prefix argument is provided, then prompt for the message sequence. 217Check the documentation of `mh-interactive-range' to see how RANGE is read in
201If variable `transient-mark-mode' is non-nil and the mark is active, then the 218interactive use." t nil)
202selected region is copied.
203In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
204region in a cons cell, or a sequence." t nil)
205 219
206(autoload (quote mh-kill-folder) "mh-funcs" "\ 220(autoload (quote mh-kill-folder) "mh-funcs" "\
207Remove the current folder and all included messages. 221Remove the current folder and all included messages.
208Removes all of the messages (files) within the specified current folder, 222Removes all of the messages (files) within the specified current folder,
209and then removes the folder (directory) itself." t nil) 223and then removes the folder (directory) itself.
224The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to
225be called, with no arguments, which should return a value of non-nil if
226verification is not desired." t nil)
210 227
211(autoload (quote mh-list-folders) "mh-funcs" "\ 228(autoload (quote mh-list-folders) "mh-funcs" "\
212List mail folders." t nil) 229List mail folders." t nil)
@@ -229,13 +246,10 @@ Advance displayed message to next digested message." t nil)
229Back up displayed message to previous digested message." t nil) 246Back up displayed message to previous digested message." t nil)
230 247
231(autoload (quote mh-print-msg) "mh-funcs" "\ 248(autoload (quote mh-print-msg) "mh-funcs" "\
232Print MSG-OR-SEQ on printer. 249Print RANGE on printer.
233Default is the displayed message. 250
234If optional prefix argument is provided, then prompt for the message sequence. 251Check the documentation of `mh-interactive-range' to see how RANGE is read in
235If variable `transient-mark-mode' is non-nil and the mark is active, then the 252interactive use.
236selected region is printed.
237In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
238region in a cons cell, or a sequence.
239 253
240The variable `mh-lpr-command-format' is used to generate the print command. 254The variable `mh-lpr-command-format' is used to generate the print command.
241The messages are formatted by mhl. See the variable `mhl-formfile'." t nil) 255The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
@@ -274,7 +288,7 @@ Display cheat sheet for the commands of the current prefix in minibuffer." t nil
274;;;*** 288;;;***
275 289
276;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu) 290;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
277;;;;;; "mh-identity" "mh-identity.el" (16040 52698)) 291;;;;;; "mh-identity" "mh-identity.el" (16625 54171))
278;;; Generated autoloads from mh-identity.el 292;;; Generated autoloads from mh-identity.el
279 293
280(autoload (quote mh-identity-make-menu) "mh-identity" "\ 294(autoload (quote mh-identity-make-menu) "mh-identity" "\
@@ -292,8 +306,8 @@ Edit the `mh-identity-list' variable to define identity." t nil)
292 306
293;;;*** 307;;;***
294 308
295;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16040 309;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625
296;;;;;; 52698)) 310;;;;;; 54212))
297;;; Generated autoloads from mh-inc.el 311;;; Generated autoloads from mh-inc.el
298 312
299(autoload (quote mh-inc-spool-list-set) "mh-inc" "\ 313(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
@@ -304,12 +318,15 @@ This is called after 'customize is used to alter `mh-inc-spool-list'." nil nil)
304;;;*** 318;;;***
305 319
306;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search 320;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search
307;;;;;; mh-swish-execute-search mh-index-new-messages mh-glimpse-execute-search 321;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages
308;;;;;; mh-index-execute-commands mh-index-update-unseen mh-index-visit-folder 322;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence
309;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-insert-folder-headers 323;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen
310;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-parse-search-regexp 324;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder
311;;;;;; mh-index-do-search mh-index-search mh-index-update-maps) 325;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder
312;;;;;; "mh-index" "mh-index.el" (16040 52698)) 326;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p
327;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences
328;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el"
329;;;;;; (16625 54348))
313;;; Generated autoloads from mh-index.el 330;;; Generated autoloads from mh-index.el
314 331
315(autoload (quote mh-index-update-maps) "mh-index" "\ 332(autoload (quote mh-index-update-maps) "mh-index" "\
@@ -319,6 +336,14 @@ is a hashtable which maps each message in the index folder to the original
319folder and message from whence it was copied. If present the 336folder and message from whence it was copied. If present the
320checksum -> (origin-folder, origin-index) map is updated too." nil nil) 337checksum -> (origin-folder, origin-index) map is updated too." nil nil)
321 338
339(autoload (quote mh-create-sequence-map) "mh-index" "\
340Return a map from msg number to list of sequences in which it is present.
341SEQ-LIST is an assoc list whose keys are sequence names and whose cdr is the
342list of messages in that sequence." nil nil)
343
344(autoload (quote mh-index-create-sequences) "mh-index" "\
345Mirror sequences present in source folders in index folder." nil nil)
346
322(autoload (quote mh-index-search) "mh-index" "\ 347(autoload (quote mh-index-search) "mh-index" "\
323Perform an indexed search in an MH mail folder. 348Perform an indexed search in an MH mail folder.
324Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below. 349Use a prefix argument to repeat the search, as in REDO-SEARCH-FLAG below.
@@ -328,8 +353,7 @@ index search, then the search is repeated. Otherwise, FOLDER is searched with
328SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is 353SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
329\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG 354\"+\" then mail in all folders are searched. Optional argument WINDOW-CONFIG
330stores the window configuration that will be restored after the user quits the 355stores the window configuration that will be restored after the user quits the
331folder containing the index search results. If optional argument UNSEEN-FLAG 356folder containing the index search results.
332is non-nil, then all the messages are marked as unseen.
333 357
334Four indexing programs are supported; if none of these are present, then grep 358Four indexing programs are supported; if none of these are present, then grep
335is used. This function picks the first program that is available on your 359is used. This function picks the first program that is available on your
@@ -361,6 +385,12 @@ procmail recipe should avoid this:
361 385
362This has the effect of renaming already present X-MHE-Checksum headers." t nil) 386This has the effect of renaming already present X-MHE-Checksum headers." t nil)
363 387
388(autoload (quote mh-index-read-data) "mh-index" "\
389Read index data from file." nil nil)
390
391(autoload (quote mh-index-p) "mh-index" "\
392Non-nil means that this folder was generated by an index search." nil nil)
393
364(autoload (quote mh-index-do-search) "mh-index" "\ 394(autoload (quote mh-index-do-search) "mh-index" "\
365Construct appropriate regexp and call `mh-index-search'." t nil) 395Construct appropriate regexp and call `mh-index-search'." t nil)
366 396
@@ -402,6 +432,16 @@ The copies in the searched folder are then deleted/refiled to get the desired
402result. Before deleting the messages we make sure that the message being 432result. Before deleting the messages we make sure that the message being
403deleted is identical to the one that the user has marked in the index buffer." nil nil) 433deleted is identical to the one that the user has marked in the index buffer." nil nil)
404 434
435(autoload (quote mh-index-add-to-sequence) "mh-index" "\
436Add to SEQ the messages in the list MSGS.
437This function updates the source folder sequences. Also makes an attempt to
438update the source folder buffer if we have it open." nil nil)
439
440(autoload (quote mh-index-delete-from-sequence) "mh-index" "\
441Delete from SEQ the messages in MSGS.
442This function updates the source folder sequences. Also makes an attempt to
443update the source folder buffer if present." nil nil)
444
405(autoload (quote mh-glimpse-execute-search) "mh-index" "\ 445(autoload (quote mh-glimpse-execute-search) "mh-index" "\
406Execute glimpse and read the results. 446Execute glimpse and read the results.
407 447
@@ -435,12 +475,29 @@ daily from cron:
435 475
436FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) 476FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
437 477
438(autoload (quote mh-index-new-messages) "mh-index" "\ 478(autoload (quote mh-index-sequenced-messages) "mh-index" "\
439Display new messages. 479Display messages from FOLDERS in SEQUENCE.
440All messages in the `mh-unseen-seq' sequence from FOLDERS are displayed.
441By default the folders specified by `mh-index-new-messages-folders' are 480By default the folders specified by `mh-index-new-messages-folders' are
442searched. With a prefix argument, enter a space-separated list of folders, or 481searched. With a prefix argument, enter a space-separated list of folders, or
443nothing to search all folders." t nil) 482nothing to search all folders.
483
484Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the
485function searches for in each of the FOLDERS. With a prefix argument, enter a
486sequence to use." t nil)
487
488(autoload (quote mh-index-new-messages) "mh-index" "\
489Display unseen messages.
490All messages in the `unseen' sequence from FOLDERS are displayed.
491By default the folders specified by `mh-index-new-messages-folders'
492are searched. With a prefix argument, enter a space-separated list of
493folders, or nothing to search all folders." t nil)
494
495(autoload (quote mh-index-ticked-messages) "mh-index" "\
496Display ticked messages.
497All messages in the `tick' sequence from FOLDERS are displayed.
498By default the folders specified by `mh-index-ticked-messages-folders'
499are searched. With a prefix argument, enter a space-separated list of
500folders, or nothing to search all folders." t nil)
444 501
445(autoload (quote mh-swish-execute-search) "mh-index" "\ 502(autoload (quote mh-swish-execute-search) "mh-index" "\
446Execute swish-e and read the results. 503Execute swish-e and read the results.
@@ -564,17 +621,14 @@ system." nil nil)
564;;;*** 621;;;***
565 622
566;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk" 623;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
567;;;;;; "mh-junk.el" (16040 52698)) 624;;;;;; "mh-junk.el" (16625 54386))
568;;; Generated autoloads from mh-junk.el 625;;; Generated autoloads from mh-junk.el
569 626
570(autoload (quote mh-junk-blacklist) "mh-junk" "\ 627(autoload (quote mh-junk-blacklist) "mh-junk" "\
571Blacklist MSG-OR-SEQ as spam. 628Blacklist RANGE as spam.
572Default is the displayed message. 629
573If optional prefix argument is provided, then prompt for the message sequence. 630Check the documentation of `mh-interactive-range' to see how RANGE is read in
574If variable `transient-mark-mode' is non-nil and the mark is active, then the 631interactive use.
575selected region is blacklisted.
576In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
577region in a cons cell, or a sequence.
578 632
579First the appropriate function is called depending on the value of 633First the appropriate function is called depending on the value of
580`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is 634`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
@@ -591,13 +645,10 @@ for the different spam fighting programs:
591 - `mh-spamassassin-blacklist'" t nil) 645 - `mh-spamassassin-blacklist'" t nil)
592 646
593(autoload (quote mh-junk-whitelist) "mh-junk" "\ 647(autoload (quote mh-junk-whitelist) "mh-junk" "\
594Whitelist MSG-OR-SEQ incorrectly classified as spam. 648Whitelist RANGE incorrectly classified as spam.
595Default is the displayed message. 649
596If optional prefix argument is provided, then prompt for the message sequence. 650Check the documentation of `mh-interactive-range' to see how RANGE is read in
597If variable `transient-mark-mode' is non-nil and the mark is active, then the 651interactive use.
598selected region is whitelisted.
599In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
600region in a cons cell, or a sequence.
601 652
602First the appropriate function is called depending on the value of 653First the appropriate function is called depending on the value of
603`mh-junk-choice'. Then the message is refiled to `mh-inbox'. 654`mh-junk-choice'. Then the message is refiled to `mh-inbox'.
@@ -616,7 +667,7 @@ setting `mh-junk-choice' is not recommended." t nil)
616;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit 667;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit
617;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar 668;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
618;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward 669;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
619;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16040 52699)) 670;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523))
620;;; Generated autoloads from mh-mime.el 671;;; Generated autoloads from mh-mime.el
621 672
622(autoload (quote mh-compose-insertion) "mh-mime" "\ 673(autoload (quote mh-compose-insertion) "mh-mime" "\
@@ -792,7 +843,7 @@ Toggle display of the raw MIME part." t nil)
792;;;*** 843;;;***
793 844
794;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search 845;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search
795;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16040 52699)) 846;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571))
796;;; Generated autoloads from mh-pick.el 847;;; Generated autoloads from mh-pick.el
797 848
798(autoload (quote mh-search-folder) "mh-pick" "\ 849(autoload (quote mh-search-folder) "mh-pick" "\
@@ -822,16 +873,19 @@ indexing program specified in `mh-index-program' is used." t nil)
822 873
823;;;*** 874;;;***
824 875
825;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-notate-tick 876;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile
826;;;;;; mh-thread-refile mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling 877;;;;;; mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling
827;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads 878;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads
828;;;;;; mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread 879;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc
829;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list 880;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range
830;;;;;; mh-interactive-msg-or-seq mh-msg-or-seq-to-msg-list mh-iterate-on-msg-or-seq 881;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject
831;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur 882;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list
832;;;;;; mh-notate-seq mh-map-to-seq-msgs mh-rename-seq mh-widen mh-put-msg-in-seq 883;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence
833;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq) 884;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
834;;;;;; "mh-seq" "mh-seq.el" (16040 52700)) 885;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled
886;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
887;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625
888;;;;;; 54690))
835;;; Generated autoloads from mh-seq.el 889;;; Generated autoloads from mh-seq.el
836 890
837(autoload (quote mh-delete-seq) "mh-seq" "\ 891(autoload (quote mh-delete-seq) "mh-seq" "\
@@ -849,16 +903,64 @@ Restrict display of this folder to just messages in SEQUENCE.
849Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) 903Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
850 904
851(autoload (quote mh-put-msg-in-seq) "mh-seq" "\ 905(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
852Add MSG-OR-SEQ to SEQUENCE. 906Add RANGE to SEQUENCE.
853Default is the displayed message. 907
854If optional prefix argument is provided, then prompt for the message sequence. 908Check the documentation of `mh-interactive-range' to see how RANGE is read in
855If variable `transient-mark-mode' is non-nil and the mark is active, then the 909interactive use." t nil)
856selected region is added to the sequence.
857In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
858region in a cons cell, or a sequence." t nil)
859 910
860(autoload (quote mh-widen) "mh-seq" "\ 911(autoload (quote mh-widen) "mh-seq" "\
861Remove restrictions from current folder, thereby showing all messages." t nil) 912Remove last restriction from current folder.
913If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
914of the view stack thereby showing all messages that the buffer originally
915contained." t nil)
916
917(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\
918Notate messages marked for deletion or refiling.
919Messages to be deleted are given by `mh-delete-list' while messages to be
920refiled are present in `mh-refile-list'." nil nil)
921
922(autoload (quote mh-read-seq-default) "mh-seq" "\
923Read and return sequence name with default narrowed or previous sequence.
924PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
925non-empty sequence is read." nil nil)
926
927(autoload (quote mh-read-range) "mh-seq" "\
928Read a message range with PROMPT.
929
930If FOLDER is non-nil then a range is read from that folder, otherwise use
931`mh-current-folder'.
932
933If DEFAULT is a string then use that as default range to return. If DEFAULT is
934nil then ask user with default answer a range based on the sequences that seem
935relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen
936messages, if present, are returned. If the folder has fewer than
937`mh-large-folder' messages then \"all\" messages are returned. Finally as a
938last resort prompt the user.
939
940If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the
941input is returned. If this list is empty then an error is raised. If
942EXPAND-FLAG is nil just return the input string. In this case we don't check
943if the range is empty.
944
945If ASK-FLAG is non-nil, then the user is always queried for a range of
946messages. If ASK-FLAG is nil, then the function checks if the unseen sequence
947is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in
948it depending on the value of EXPAND, is returned. Otherwise if the folder has
949fewer than `mh-large-folder' messages then the list of messages corresponding
950to \"all\" is returned. If neither of the above holds then as a last resort
951the user is queried for a range of messages.
952
953If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it
954is interpreted as the range \"last:N\".
955
956This function replaces the existing function `mh-read-msg-range'. Calls to:
957 (mh-read-msg-range folder flag)
958should be replaced with:
959 (mh-read-range \"Suitable prompt\" folder t nil flag
960 mh-interpret-number-as-range-flag)" nil nil)
961
962(autoload (quote mh-translate-range) "mh-seq" "\
963In FOLDER, translate the string EXPR to a list of messages numbers." nil nil)
862 964
863(autoload (quote mh-rename-seq) "mh-seq" "\ 965(autoload (quote mh-rename-seq) "mh-seq" "\
864Rename SEQUENCE to have NEW-NAME." t nil) 966Rename SEQUENCE to have NEW-NAME." t nil)
@@ -888,33 +990,39 @@ till END. In each step BODY is executed.
888 990
889If VAR is nil then the loop is executed without any binding." nil (quote macro)) 991If VAR is nil then the loop is executed without any binding." nil (quote macro))
890 992
891(autoload (quote mh-iterate-on-msg-or-seq) "mh-seq" "\ 993(autoload (quote mh-iterate-on-range) "mh-seq" "\
892Iterate an operation over a region or sequence. 994Iterate an operation over a region or sequence.
893 995
894VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a 996VAR is bound to each message in turn in a loop over RANGE, which can be a
895message number, a list of message numbers, a sequence, or a region in a cons 997message number, a list of message numbers, a sequence, a region in a cons
896cell. In each iteration, BODY is executed. 998cell, or a MH range (something like last:20) in a string. In each iteration,
999BODY is executed.
897 1000
898The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq' 1001The parameter RANGE is usually created with `mh-interactive-range'
899in order to provide a uniform interface to MH-E functions." nil (quote macro)) 1002in order to provide a uniform interface to MH-E functions." nil (quote macro))
900 1003
901(autoload (quote mh-msg-or-seq-to-msg-list) "mh-seq" "\ 1004(autoload (quote mh-range-to-msg-list) "mh-seq" "\
902Return a list of messages for MSG-OR-SEQ. 1005Return a list of messages for RANGE.
903MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or 1006RANGE can be a message number, a list of message numbers, a sequence, or
904a region in a cons cell." nil nil) 1007a region in a cons cell." nil nil)
905 1008
906(autoload (quote mh-interactive-msg-or-seq) "mh-seq" "\ 1009(autoload (quote mh-interactive-range) "mh-seq" "\
907Return interactive specification for message, sequence, or region. 1010Return interactive specification for message, sequence, range or region.
908By convention, the name of this argument is msg-or-seq. 1011By convention, the name of this argument is RANGE.
909 1012
910If variable `transient-mark-mode' is non-nil and the mark is active, then this 1013If variable `transient-mark-mode' is non-nil and the mark is active, then this
911function returns a cons-cell of the region. 1014function returns a cons-cell of the region.
912If optional prefix argument provided, then prompt for message sequence with 1015
913SEQUENCE-PROMPT and return sequence. 1016If optional prefix argument is provided, then prompt for message range with
1017RANGE-PROMPT. A list of messages in that range is returned.
1018
1019If a MH range is given, say something like last:20, then a list containing
1020the messages in that range is returned.
1021
914Otherwise, the message number at point is returned. 1022Otherwise, the message number at point is returned.
915 1023
916This function is usually used with `mh-iterate-on-msg-or-seq' in order to 1024This function is usually used with `mh-iterate-on-range' in order to provide
917provide a uniform interface to MH-E functions." nil nil) 1025a uniform interface to MH-E functions." nil nil)
918 1026
919(autoload (quote mh-region-to-msg-list) "mh-seq" "\ 1027(autoload (quote mh-region-to-msg-list) "mh-seq" "\
920Return a list of messages within the region between BEGIN and END." nil nil) 1028Return a list of messages within the region between BEGIN and END." nil nil)
@@ -922,6 +1030,27 @@ Return a list of messages within the region between BEGIN and END." nil nil)
922(autoload (quote mh-narrow-to-subject) "mh-seq" "\ 1030(autoload (quote mh-narrow-to-subject) "mh-seq" "\
923Narrow to a sequence containing all following messages with same subject." t nil) 1031Narrow to a sequence containing all following messages with same subject." t nil)
924 1032
1033(autoload (quote mh-narrow-to-from) "mh-seq" "\
1034Limit to messages with the same From header field as the message at point.
1035With a prefix argument, prompt for the regular expression, REGEXP given to
1036pick." t nil)
1037
1038(autoload (quote mh-narrow-to-cc) "mh-seq" "\
1039Limit to messages with the same Cc header field as the message at point.
1040With a prefix argument, prompt for the regular expression, REGEXP given to
1041pick." t nil)
1042
1043(autoload (quote mh-narrow-to-to) "mh-seq" "\
1044Limit to messages with the same To header field as the message at point.
1045With a prefix argument, prompt for the regular expression, REGEXP given to
1046pick." t nil)
1047
1048(autoload (quote mh-narrow-to-range) "mh-seq" "\
1049Limit to messages in RANGE.
1050
1051Check the documentation of `mh-interactive-range' to see how RANGE is read in
1052interactive use." t nil)
1053
925(autoload (quote mh-delete-subject) "mh-seq" "\ 1054(autoload (quote mh-delete-subject) "mh-seq" "\
926Mark all following messages with same subject to be deleted. 1055Mark all following messages with same subject to be deleted.
927This puts the messages in a sequence named subject. You can undo the last 1056This puts the messages in a sequence named subject. You can undo the last
@@ -939,6 +1068,10 @@ subject for deletion." t nil)
939Update thread tree for FOLDER. 1068Update thread tree for FOLDER.
940All messages after START-POINT are added to the thread tree." nil nil) 1069All messages after START-POINT are added to the thread tree." nil nil)
941 1070
1071(autoload (quote mh-thread-update-scan-line-map) "mh-seq" "\
1072In threaded view update `mh-thread-scan-line-map'.
1073MSG is the message being notated with NOTATION at OFFSET." nil nil)
1074
942(autoload (quote mh-thread-add-spaces) "mh-seq" "\ 1075(autoload (quote mh-thread-add-spaces) "mh-seq" "\
943Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil) 1076Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
944 1077
@@ -966,13 +1099,8 @@ Mark current message and all its children for subsequent deletion." t nil)
966(autoload (quote mh-thread-refile) "mh-seq" "\ 1099(autoload (quote mh-thread-refile) "mh-seq" "\
967Mark current message and all its children for refiling to FOLDER." t nil) 1100Mark current message and all its children for refiling to FOLDER." t nil)
968 1101
969(autoload (quote mh-notate-tick) "mh-seq" "\
970Highlight current line if MSG is in TICKED-MSGS.
971If optional argument IGNORE-NARROWING is non-nil then highlighting is carried
972out even if folder is narrowed to `mh-tick-seq'." nil nil)
973
974(autoload (quote mh-toggle-tick) "mh-seq" "\ 1102(autoload (quote mh-toggle-tick) "mh-seq" "\
975Toggle tick mark of all messages in region BEGIN to END." t nil) 1103Toggle tick mark of all messages in RANGE." t nil)
976 1104
977(autoload (quote mh-narrow-to-tick) "mh-seq" "\ 1105(autoload (quote mh-narrow-to-tick) "mh-seq" "\
978Restrict display of this folder to just messages in `mh-tick-seq'. 1106Restrict display of this folder to just messages in `mh-tick-seq'.
@@ -982,7 +1110,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
982 1110
983;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists 1111;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
984;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons) 1112;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
985;;;;;; "mh-speed" "mh-speed.el" (16040 52700)) 1113;;;;;; "mh-speed" "mh-speed.el" (16625 54721))
986;;; Generated autoloads from mh-speed.el 1114;;; Generated autoloads from mh-speed.el
987 1115
988(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\ 1116(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@@ -1003,7 +1131,9 @@ Optional ARGS are ignored." t nil)
1003 1131
1004(autoload (quote mh-speed-flists) "mh-speed" "\ 1132(autoload (quote mh-speed-flists) "mh-speed" "\
1005Execute flists -recurse and update message counts. 1133Execute flists -recurse and update message counts.
1006If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run 1134If FORCE is non-nil the timer is reset.
1135
1136Any number of optional FOLDERS can be specified. If specified, flists is run
1007only for that one folder." t nil) 1137only for that one folder." t nil)
1008 1138
1009(autoload (quote mh-speed-invalidate-map) "mh-speed" "\ 1139(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
@@ -1016,7 +1146,7 @@ The function invalidates the latest ancestor that is present." nil nil)
1016;;;*** 1146;;;***
1017 1147
1018;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point) 1148;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
1019;;;;;; "mh-utils" "mh-utils.el" (16040 52700)) 1149;;;;;; "mh-utils" "mh-utils.el" (16625 54979))
1020;;; Generated autoloads from mh-utils.el 1150;;; Generated autoloads from mh-utils.el
1021 1151
1022(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\ 1152(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
@@ -1031,16 +1161,19 @@ not pointing to a message." nil nil)
1031 1161
1032;;;*** 1162;;;***
1033 1163
1034;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field 1164;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point
1035;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-address-to-alias 1165;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p
1036;;;;;; mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address 1166;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
1037;;;;;; mh-read-address mh-alias-reload) "mh-alias" "mh-alias.el" 1167;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias"
1038;;;;;; (16040 52696)) 1168;;;;;; "mh-alias.el" (16625 53006))
1039;;; Generated autoloads from mh-alias.el 1169;;; Generated autoloads from mh-alias.el
1040 1170
1041(autoload (quote mh-alias-reload) "mh-alias" "\ 1171(autoload (quote mh-alias-reload) "mh-alias" "\
1042Load MH aliases into `mh-alias-alist'." t nil) 1172Load MH aliases into `mh-alias-alist'." t nil)
1043 1173
1174(autoload (quote mh-alias-reload-maybe) "mh-alias" "\
1175Load new MH aliases." nil nil)
1176
1044(autoload (quote mh-read-address) "mh-alias" "\ 1177(autoload (quote mh-read-address) "mh-alias" "\
1045Read an address from the minibuffer with PROMPT." nil nil) 1178Read an address from the minibuffer with PROMPT." nil nil)
1046 1179
@@ -1071,6 +1204,9 @@ already has an alias." t nil)
1071(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\ 1204(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
1072Insert an alias for email address under point." t nil) 1205Insert an alias for email address under point." t nil)
1073 1206
1207(autoload (quote mh-alias-apropos) "mh-alias" "\
1208Show all aliases that match REGEXP either in name or content." t nil)
1209
1074;;;*** 1210;;;***
1075 1211
1076(provide 'mh-loaddefs) 1212(provide 'mh-loaddefs)
@@ -1079,6 +1215,5 @@ Insert an alias for email address under point." t nil)
1079;;; no-byte-compile: t 1215;;; no-byte-compile: t
1080;;; no-update-autoloads: t 1216;;; no-update-autoloads: t
1081;;; End: 1217;;; End:
1082
1083;;; arch-tag: bc36a104-1edb-45d5-8aad-a85b45648378 1218;;; arch-tag: bc36a104-1edb-45d5-8aad-a85b45648378
1084;;; mh-loaddefs.el ends here 1219;;; mh-loaddefs.el ends here
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 2cd950550b2..91cbcec0c06 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1,6 +1,6 @@
1;;; mh-mime.el --- MH-E support for composing MIME messages 1;;; mh-mime.el --- MH-E support for composing MIME messages
2 2
3;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
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>
@@ -34,14 +34,11 @@
34 34
35;;; Code: 35;;; Code:
36 36
37(require 'cl)
38(require 'mh-comp)
39(require 'mh-utils) 37(require 'mh-utils)
40(load "mm-decode" t t) ; Non-fatal dependency 38(mh-require-cl)
41(load "mm-uu" t t) ; Non-fatal dependency 39(require 'mh-comp)
42(load "mailcap" t t) ; Non-fatal dependency
43(load "smiley" t t) ; Non-fatal dependency
44(require 'gnus-util) 40(require 'gnus-util)
41(require 'mh-gnus)
45 42
46(autoload 'gnus-article-goto-header "gnus-art") 43(autoload 'gnus-article-goto-header "gnus-art")
47(autoload 'article-emphasize "gnus-art") 44(autoload 'article-emphasize "gnus-art")
@@ -450,6 +447,7 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
450This step is performed automatically when sending the message, but this 447This step is performed automatically when sending the message, but this
451function may be called manually before sending the draft as well." 448function may be called manually before sending the draft as well."
452 (interactive) 449 (interactive)
450 (require 'message)
453 (when mh-gnus-pgp-support-flag ;; This is only needed for PGP 451 (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
454 (message-options-set-recipient)) 452 (message-options-set-recipient))
455 (mml-to-mime)) 453 (mml-to-mime))
@@ -529,99 +527,6 @@ If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
529 527
530 528
531 529
532;;; MIME decoding
533
534(defmacro mh-defun-compat (function arg-list &rest body)
535 "This is a macro to define functions which are not defined.
536It is used for Gnus utility functions which were added recently. If FUNCTION
537is not defined then it is defined to have argument list, ARG-LIST and body,
538BODY."
539 (let ((defined-p (fboundp function)))
540 (unless defined-p
541 `(defun ,function ,arg-list ,@body))))
542(put 'mh-defun-compat 'lisp-indent-function 'defun)
543
544;; Copy of original function from gnus-util.el
545(mh-defun-compat gnus-local-map-property (map)
546 "Return a list suitable for a text property list specifying keymap MAP."
547 (cond (mh-xemacs-flag (list 'keymap map))
548 ((>= emacs-major-version 21) (list 'keymap map))
549 (t (list 'local-map map))))
550
551;; Copy of original function from mm-decode.el
552(mh-defun-compat mm-merge-handles (handles1 handles2)
553 (append (if (listp (car handles1)) handles1 (list handles1))
554 (if (listp (car handles2)) handles2 (list handles2))))
555
556;; Copy of function from mm-decode.el
557(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
558 ;; HANDLE could be a CTL.
559 (if handle
560 (put-text-property 0 (length (car handle)) parameter value
561 (car handle))))
562
563;; Copy of original macro is in mm-decode.el
564(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
565 (get-text-property 0 parameter (car handle)))
566
567(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
568
569;; Copy of original function in mm-decode.el
570(mh-defun-compat mm-readable-p (handle)
571 "Say whether the content of HANDLE is readable."
572 (and (< (with-current-buffer (mm-handle-buffer handle)
573 (buffer-size)) 10000)
574 (mm-with-unibyte-buffer
575 (mm-insert-part handle)
576 (and (eq (mm-body-7-or-8) '7bit)
577 (not (mm-long-lines-p 76))))))
578
579;; Copy of original function in mm-bodies.el
580(mh-defun-compat mm-long-lines-p (length)
581 "Say whether any of the lines in the buffer is longer than LINES."
582 (save-excursion
583 (goto-char (point-min))
584 (end-of-line)
585 (while (and (not (eobp))
586 (not (> (current-column) length)))
587 (forward-line 1)
588 (end-of-line))
589 (and (> (current-column) length)
590 (current-column))))
591
592(mh-defun-compat mm-keep-viewer-alive-p (handle)
593 ;; Released Gnus doesn't keep handles associated with externally displayed
594 ;; MIME parts. So this will always return nil.
595 nil)
596
597(mh-defun-compat mm-destroy-parts (list)
598 "Older emacs don't have this function."
599 nil)
600
601;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
602;;; buggy (the args to read-file-name are incorrect). When all supported
603;;; versions of Emacs come with at least Gnus 5.10, we can delete this
604;;; function and rename calls to mh-mm-save-part to mm-save-part.
605(defun mh-mm-save-part (handle)
606 "Write HANDLE to a file."
607 (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
608 (filename (mail-content-type-get
609 (mm-handle-disposition handle) 'filename))
610 file)
611 (when filename
612 (setq filename (file-name-nondirectory filename)))
613 (setq file (read-file-name "Save MIME part to: "
614 (or mm-default-directory
615 default-directory)
616 nil nil (or filename name "")))
617 (setq mm-default-directory (file-name-directory file))
618 (and (or (not (file-exists-p file))
619 (yes-or-no-p (format "File %s already exists; overwrite? "
620 file)))
621 (mm-save-part-to-file handle file))))
622
623
624
625;;; MIME cleanup 530;;; MIME cleanup
626 531
627;;;###mh-autoload 532;;;###mh-autoload
@@ -668,28 +573,36 @@ undisplayer FUNCTION."
668I have seen this only in spam, so maybe we shouldn't fix this ;-)" 573I have seen this only in spam, so maybe we shouldn't fix this ;-)"
669 (save-excursion 574 (save-excursion
670 (goto-char (point-min)) 575 (goto-char (point-min))
671 (when (and (message-fetch-field "content-type") 576 (re-search-forward "\n\n" nil t)
672 (not (message-fetch-field "mime-version"))) 577 (save-restriction
673 (when (search-forward "\n\n" nil t) 578 (narrow-to-region (point-min) (point))
674 (forward-line -1) 579 (when (and (message-fetch-field "content-type")
580 (not (message-fetch-field "mime-version")))
581 (goto-char (point-min))
675 (insert "MIME-Version: 1.0\n"))))) 582 (insert "MIME-Version: 1.0\n")))))
676 583
584(defun mh-small-show-buffer-p ()
585 "Check if show buffer is small.
586This is used to decide if smileys and graphical emphasis will be displayed."
587 (let ((max nil))
588 (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size)
589 (cond ((numberp font-lock-maximum-size)
590 (setq max font-lock-maximum-size))
591 ((listp font-lock-maximum-size)
592 (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size)
593 (assoc t font-lock-maximum-size)))))))
594 (or (not (numberp max)) (>= (/ max 8) (buffer-size)))))
595
677;;;###mh-autoload 596;;;###mh-autoload
678(defun mh-display-smileys () 597(defun mh-display-smileys ()
679 "Function to display smileys." 598 "Function to display smileys."
680 (when (and mh-graphical-smileys-flag 599 (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p))
681 (fboundp 'smiley-region) 600 (mh-funcall-if-exists smiley-region (point-min) (point-max))))
682 (boundp 'font-lock-maximum-size)
683 font-lock-maximum-size
684 (>= (/ font-lock-maximum-size 8) (buffer-size)))
685 (smiley-region (point-min) (point-max))))
686 601
687;;;###mh-autoload 602;;;###mh-autoload
688(defun mh-display-emphasis () 603(defun mh-display-emphasis ()
689 "Function to display graphical emphasis." 604 "Function to display graphical emphasis."
690 (when (and mh-graphical-emphasis-flag 605 (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p))
691 (if font-lock-maximum-size
692 (>= (/ font-lock-maximum-size 8) (buffer-size))))
693 (flet ((article-goto-body ())) ; shadow this function to do nothing 606 (flet ((article-goto-body ())) ; shadow this function to do nothing
694 (save-excursion 607 (save-excursion
695 (goto-char (point-min)) 608 (goto-char (point-min))
@@ -799,10 +712,15 @@ actual storing."
799(defun mh-decode-message-body () 712(defun mh-decode-message-body ()
800 "Decode message based on charset. 713 "Decode message based on charset.
801If message has been encoded for transfer take that into account." 714If message has been encoded for transfer take that into account."
802 (let* ((ct (ignore-errors (mail-header-parse-content-type 715 (let (ct charset cte)
803 (message-fetch-field "Content-Type" t)))) 716 (goto-char (point-min))
804 (charset (mail-content-type-get ct 'charset)) 717 (re-search-forward "\n\n" nil t)
805 (cte (message-fetch-field "Content-Transfer-Encoding"))) 718 (save-restriction
719 (narrow-to-region (point-min) (point))
720 (setq ct (ignore-errors (mail-header-parse-content-type
721 (message-fetch-field "Content-Type" t)))
722 charset (mail-content-type-get ct 'charset)
723 cte (message-fetch-field "Content-Transfer-Encoding")))
806 (when (stringp cte) (setq cte (mail-header-strip cte))) 724 (when (stringp cte) (setq cte (mail-header-strip cte)))
807 (when (or (not ct) (equal (car ct) "text/plain")) 725 (when (or (not ct) (equal (car ct) "text/plain"))
808 (save-restriction 726 (save-restriction
@@ -881,16 +799,31 @@ displayed."
881(defun mh-mime-display-alternative (handles) 799(defun mh-mime-display-alternative (handles)
882 "Choose among the alternatives, HANDLES the part that will be displayed. 800 "Choose among the alternatives, HANDLES the part that will be displayed.
883If no part is preferred then all the parts are displayed." 801If no part is preferred then all the parts are displayed."
884 (let ((preferred (mm-preferred-alternative handles))) 802 (let* ((preferred (mm-preferred-alternative handles))
803 (others (loop for x in handles unless (eq x preferred) collect x)))
885 (cond ((and preferred (stringp (car preferred))) 804 (cond ((and preferred (stringp (car preferred)))
886 (mh-mime-display-part preferred)) 805 (mh-mime-display-part preferred)
806 (mh-mime-maybe-display-alternatives others))
887 (preferred 807 (preferred
888 (save-restriction 808 (save-restriction
889 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) 809 (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
890 (mh-mime-display-single preferred) 810 (mh-mime-display-single preferred)
811 (mh-mime-maybe-display-alternatives others)
891 (goto-char (point-max)))) 812 (goto-char (point-max))))
892 (t (mh-mime-display-mixed handles))))) 813 (t (mh-mime-display-mixed handles)))))
893 814
815(defun mh-mime-maybe-display-alternatives (alternatives)
816 "Show buttons for ALTERNATIVES.
817If `mh-mime-display-alternatives-flag' is non-nil then display buttons for
818alternative parts that are usually suppressed."
819 (when (and mh-display-buttons-for-alternatives-flag alternatives)
820 (insert "\n----------------------------------------------------\n")
821 (insert "Alternatives:\n")
822 (dolist (x alternatives)
823 (insert "\n")
824 (mh-insert-mime-button x (mh-mime-part-index x) nil))
825 (insert "\n----------------------------------------------------\n")))
826
894(defun mh-mime-display-mixed (handles) 827(defun mh-mime-display-mixed (handles)
895 "Display the list of MIME parts, HANDLES recursively." 828 "Display the list of MIME parts, HANDLES recursively."
896 (mapcar #'mh-mime-display-part handles)) 829 (mapcar #'mh-mime-display-part handles))
@@ -904,12 +837,6 @@ opened)."
904 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) 837 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
905 (incf (mh-mime-parts-count (mh-buffer-data)))))) 838 (incf (mh-mime-parts-count (mh-buffer-data))))))
906 839
907;;; Avoid compiler warnings for XEmacs functions...
908(eval-when (compile)
909 (loop for function in '(glyph-width window-pixel-width
910 glyph-height window-pixel-height)
911 do (or (fboundp function) (defalias function 'ignore))))
912
913(defun mh-small-image-p (handle) 840(defun mh-small-image-p (handle)
914 "Decide whether HANDLE is a \"small\" image that can be displayed inline. 841 "Decide whether HANDLE is a \"small\" image that can be displayed inline.
915This is only useful if a Content-Disposition header is not present." 842This is only useful if a Content-Disposition header is not present."
@@ -922,27 +849,20 @@ This is only useful if a Content-Disposition header is not present."
922 ; this only tells us if the image is 849 ; this only tells us if the image is
923 ; something that emacs can display 850 ; something that emacs can display
924 (let* ((image (mm-get-image handle))) 851 (let* ((image (mm-get-image handle)))
925 (cond ((fboundp 'glyph-width) 852 (or (mh-do-in-xemacs
926 ;; XEmacs -- totally untested, copied from gnus 853 (and (mh-funcall-if-exists glyphp image)
927 (and (mh-funcall-if-exists glyphp image) 854 (< (glyph-width image)
928 (< (glyph-width image) 855 (or mh-max-inline-image-width (window-pixel-width)))
929 (or mh-max-inline-image-width 856 (< (glyph-height image)
930 (window-pixel-width))) 857 (or mh-max-inline-image-height
931 (< (glyph-height image) 858 (window-pixel-height)))))
932 (or mh-max-inline-image-height 859 (mh-do-in-gnu-emacs
933 (window-pixel-height))))) 860 (let ((size (mh-funcall-if-exists image-size image)))
934 ((fboundp 'image-size) 861 (and size
935 ;; Emacs21 -- copied from gnus 862 (< (cdr size) (or mh-max-inline-image-height
936 (let ((size (mh-funcall-if-exists image-size image))) 863 (1- (window-height))))
937 (and size 864 (< (car size) (or mh-max-inline-image-width
938 (< (cdr size) 865 (window-width)))))))))))
939 (or mh-max-inline-image-height
940 (1- (window-height))))
941 (< (car size)
942 (or mh-max-inline-image-width (window-width))))))
943 (t
944 ;; Can't show image inline
945 nil))))))
946 866
947(defun mh-inline-vcard-p (handle) 867(defun mh-inline-vcard-p (handle)
948 "Decide if HANDLE is a vcard that must be displayed inline." 868 "Decide if HANDLE is a vcard that must be displayed inline."
@@ -1062,7 +982,7 @@ like \"K v\" which operate on individual MIME parts."
1062 (progn 982 (progn
1063 ;; Delete the button and displayed part (if any) 983 ;; Delete the button and displayed part (if any)
1064 (let ((region (get-text-property point 'mh-region))) 984 (let ((region (get-text-property point 'mh-region)))
1065 (when (and region (fboundp 'remove-images)) 985 (when region
1066 (mh-funcall-if-exists 986 (mh-funcall-if-exists
1067 remove-images (car region) (cdr region))) 987 remove-images (car region) (cdr region)))
1068 (mm-display-part handle) 988 (mm-display-part handle)
@@ -1130,33 +1050,14 @@ If the MIME part is visible then it is removed. Otherwise the part is
1130displayed. This function is called when the mouse is used to click the MIME 1050displayed. This function is called when the mouse is used to click the MIME
1131button." 1051button."
1132 (interactive "e") 1052 (interactive "e")
1133 (save-excursion 1053 (mh-do-at-event-location event
1134 (let* ((event-window 1054 (let ((folder mh-show-folder-buffer)
1135 (or (mh-funcall-if-exists posn-window (event-start event));GNU Emacs 1055 (mm-inline-media-tests mh-mm-inline-media-tests)
1136 (mh-funcall-if-exists event-window event))) ;XEmacs 1056 (data (get-text-property (point) 'mh-data))
1137 (event-position 1057 (function (get-text-property (point) 'mh-callback)))
1138 (or (mh-funcall-if-exists posn-point (event-start event)) ;GNU Emacs 1058 (flet ((mm-handle-set-external-undisplayer (handle func)
1139 (mh-funcall-if-exists event-closest-point event))) ;XEmacs 1059 (mh-handle-set-external-undisplayer folder handle func)))
1140 (original-window (selected-window)) 1060 (and function (funcall function data))))))
1141 (original-position (progn
1142 (set-buffer (window-buffer event-window))
1143 (set-marker (make-marker) (point))))
1144 (folder mh-show-folder-buffer)
1145 (mm-inline-media-tests mh-mm-inline-media-tests)
1146 (data (get-text-property event-position 'mh-data))
1147 (function (get-text-property event-position 'mh-callback))
1148 (buffer-read-only nil))
1149 (unwind-protect
1150 (progn
1151 (select-window event-window)
1152 (flet ((mm-handle-set-external-undisplayer (handle func)
1153 (mh-handle-set-external-undisplayer folder handle func)))
1154 (goto-char event-position)
1155 (and function (funcall function data))))
1156 (set-buffer-modified-p nil)
1157 (goto-char original-position)
1158 (set-marker original-position nil)
1159 (select-window original-window)))))
1160 1061
1161;;;###mh-autoload 1062;;;###mh-autoload
1162(defun mh-mime-save-part () 1063(defun mh-mime-save-part ()
@@ -1164,7 +1065,9 @@ button."
1164 (interactive) 1065 (interactive)
1165 (let ((data (get-text-property (point) 'mh-data))) 1066 (let ((data (get-text-property (point) 'mh-data)))
1166 (when data 1067 (when data
1167 (let ((mm-default-directory mh-mime-save-parts-directory)) 1068 (let ((mm-default-directory
1069 (file-name-as-directory (or mh-mime-save-parts-directory
1070 default-directory))))
1168 (mh-mm-save-part data) 1071 (mh-mm-save-part data)
1169 (setq mh-mime-save-parts-directory mm-default-directory))))) 1072 (setq mh-mime-save-parts-directory mm-default-directory)))))
1170 1073
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index e441466a7b4..20950d36c4c 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -1,6 +1,6 @@
1;;; mh-seq.el --- MH-E sequences support 1;;; mh-seq.el --- MH-E sequences support
2 2
3;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc.
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>
@@ -70,7 +70,8 @@
70 70
71;;; Code: 71;;; Code:
72 72
73(require 'cl) 73(require 'mh-utils)
74(mh-require-cl)
74(require 'mh-e) 75(require 'mh-e)
75 76
76;; Shush the byte-compiler 77;; Shush the byte-compiler
@@ -110,7 +111,7 @@
110 "Table to look up message identifier from message index.") 111 "Table to look up message identifier from message index.")
111(defvar mh-thread-scan-line-map nil 112(defvar mh-thread-scan-line-map nil
112 "Map of message index to various parts of the scan line.") 113 "Map of message index to various parts of the scan line.")
113(defvar mh-thread-old-scan-line-map nil 114(defvar mh-thread-scan-line-map-stack nil
114 "Old map of message index to various parts of the scan line. 115 "Old map of message index to various parts of the scan line.
115This is the original map that is stored when the folder is narrowed.") 116This is the original map that is stored when the folder is narrowed.")
116(defvar mh-thread-subject-container-hash nil 117(defvar mh-thread-subject-container-hash nil
@@ -131,7 +132,7 @@ redone to get the new thread tree. This makes incremental threading easier.")
131(make-variable-buffer-local 'mh-thread-id-index-map) 132(make-variable-buffer-local 'mh-thread-id-index-map)
132(make-variable-buffer-local 'mh-thread-index-id-map) 133(make-variable-buffer-local 'mh-thread-index-id-map)
133(make-variable-buffer-local 'mh-thread-scan-line-map) 134(make-variable-buffer-local 'mh-thread-scan-line-map)
134(make-variable-buffer-local 'mh-thread-old-scan-line-map) 135(make-variable-buffer-local 'mh-thread-scan-line-map-stack)
135(make-variable-buffer-local 'mh-thread-subject-container-hash) 136(make-variable-buffer-local 'mh-thread-subject-container-hash)
136(make-variable-buffer-local 'mh-thread-duplicates) 137(make-variable-buffer-local 'mh-thread-duplicates)
137(make-variable-buffer-local 'mh-thread-history) 138(make-variable-buffer-local 'mh-thread-history)
@@ -140,14 +141,19 @@ redone to get the new thread tree. This makes incremental threading easier.")
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 (let ((msg-list (mh-seq-to-msgs sequence))) 144 (let ((msg-list (mh-seq-to-msgs sequence))
145 (internal-flag (mh-internal-seq sequence))
146 (folders-changed (list mh-current-folder)))
147 (mh-iterate-on-range msg sequence
148 (mh-remove-sequence-notation msg internal-flag))
144 (mh-undefine-sequence sequence '("all")) 149 (mh-undefine-sequence sequence '("all"))
145 (mh-delete-seq-locally sequence) 150 (mh-delete-seq-locally sequence)
146 (mh-iterate-on-messages-in-region msg (point-min) (point-max) 151 (when mh-index-data
147 (cond ((and mh-tick-seq (eq sequence mh-tick-seq)) 152 (setq folders-changed
148 (mh-notate-tick msg ())) 153 (append folders-changed
149 ((and (member msg msg-list) (not (mh-seq-containing-msg msg nil))) 154 (mh-index-delete-from-sequence sequence msg-list))))
150 (mh-notate nil ? (1+ mh-cmd-note))))))) 155 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
156 (apply #'mh-speed-flists t folders-changed))))
151 157
152;; Avoid compiler warnings 158;; Avoid compiler warnings
153(defvar view-exit-action) 159(defvar view-exit-action)
@@ -221,16 +227,15 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
221 (interactive (list (mh-read-seq "Narrow to" t))) 227 (interactive (list (mh-read-seq "Narrow to" t)))
222 (with-mh-folder-updating (t) 228 (with-mh-folder-updating (t)
223 (cond ((mh-seq-to-msgs sequence) 229 (cond ((mh-seq-to-msgs sequence)
224 (mh-widen)
225 (mh-remove-all-notation) 230 (mh-remove-all-notation)
226 (let ((eob (point-max)) 231 (let ((eob (point-max))
227 (msg-at-cursor (mh-get-msg-num nil))) 232 (msg-at-cursor (mh-get-msg-num nil)))
228 (setq mh-thread-old-scan-line-map mh-thread-scan-line-map) 233 (push mh-thread-scan-line-map mh-thread-scan-line-map-stack)
229 (setq mh-thread-scan-line-map (make-hash-table :test #'eql)) 234 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
230 (mh-copy-seq-to-eob sequence) 235 (mh-copy-seq-to-eob sequence)
231 (narrow-to-region eob (point-max)) 236 (push (buffer-substring-no-properties (point-min) eob)
232 (setq mh-narrowed-to-seq sequence) 237 mh-folder-view-stack)
233 (mh-notate-user-sequences) 238 (delete-region (point-min) eob)
234 (mh-notate-deleted-and-refiled) 239 (mh-notate-deleted-and-refiled)
235 (mh-notate-cur) 240 (mh-notate-cur)
236 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t)) 241 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
@@ -252,29 +257,31 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
252 (error "No messages in sequence `%s'" (symbol-name sequence)))))) 257 (error "No messages in sequence `%s'" (symbol-name sequence))))))
253 258
254;;;###mh-autoload 259;;;###mh-autoload
255(defun mh-put-msg-in-seq (msg-or-seq sequence) 260(defun mh-put-msg-in-seq (range sequence)
256 "Add MSG-OR-SEQ to SEQUENCE. 261 "Add RANGE to SEQUENCE.
257Default is the displayed message. 262
258If optional prefix argument is provided, then prompt for the message sequence. 263Check the documentation of `mh-interactive-range' to see how RANGE is read in
259If variable `transient-mark-mode' is non-nil and the mark is active, then the 264interactive use."
260selected region is added to the sequence. 265 (interactive (list (mh-interactive-range "Add messages from")
261In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
262region in a cons cell, or a sequence."
263 (interactive (list (mh-interactive-msg-or-seq "Add messages from")
264 (mh-read-seq-default "Add to" nil))) 266 (mh-read-seq-default "Add to" nil)))
265 (when (and (interactive-p) mh-tick-seq (eq sequence mh-tick-seq)) 267 (unless (mh-valid-seq-p sequence)
266 (error "Use `mh-toggle-tick' to add messages to %s" mh-tick-seq)) 268 (error "Can't put message in invalid sequence `%s'" sequence))
267 (let* ((internal-seq-flag (mh-internal-seq sequence)) 269 (let* ((internal-seq-flag (mh-internal-seq sequence))
268 (note-seq (if internal-seq-flag nil mh-note-seq)) 270 (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
271 (folders (list mh-current-folder))
269 (msg-list ())) 272 (msg-list ()))
270 (mh-iterate-on-msg-or-seq m msg-or-seq 273 (mh-iterate-on-range m range
271 (push m msg-list) 274 (push m msg-list)
272 (mh-notate nil note-seq (1+ mh-cmd-note))) 275 (unless (memq m original-msgs)
276 (mh-add-sequence-notation m internal-seq-flag)))
273 (mh-add-msgs-to-seq msg-list sequence nil t) 277 (mh-add-msgs-to-seq msg-list sequence nil t)
274 (if (not internal-seq-flag) 278 (if (not internal-seq-flag)
275 (setq mh-last-seq-used sequence)) 279 (setq mh-last-seq-used sequence))
280 (when mh-index-data
281 (setq folders
282 (append folders (mh-index-add-to-sequence sequence msg-list))))
276 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) 283 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
277 (mh-speed-flists t mh-current-folder)))) 284 (apply #'mh-speed-flists t folders))))
278 285
279(defun mh-valid-view-change-operation-p (op) 286(defun mh-valid-view-change-operation-p (op)
280 "Check if the view change operation can be performed. 287 "Check if the view change operation can be performed.
@@ -284,33 +291,46 @@ OP is one of 'widen and 'unthread."
284 (t nil))) 291 (t nil)))
285 292
286;;;###mh-autoload 293;;;###mh-autoload
287(defun mh-widen () 294(defun mh-widen (&optional all-flag)
288 "Remove restrictions from current folder, thereby showing all messages." 295 "Remove last restriction from current folder.
289 (interactive) 296If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
297of the view stack thereby showing all messages that the buffer originally
298contained."
299 (interactive "P")
290 (let ((msg (mh-get-msg-num nil))) 300 (let ((msg (mh-get-msg-num nil)))
291 (when mh-narrowed-to-seq 301 (when mh-folder-view-stack
292 (cond ((mh-valid-view-change-operation-p 'widen) nil) 302 (cond (all-flag
303 (while (cdr mh-view-ops)
304 (setq mh-view-ops (cdr mh-view-ops)))
305 (when (eq (car mh-view-ops) 'widen)
306 (setq mh-view-ops (cdr mh-view-ops))))
307 ((mh-valid-view-change-operation-p 'widen) nil)
293 ((memq 'widen mh-view-ops) 308 ((memq 'widen mh-view-ops)
294 (while (not (eq (car mh-view-ops) 'widen)) 309 (while (not (eq (car mh-view-ops) 'widen))
295 (setq mh-view-ops (cdr mh-view-ops))) 310 (setq mh-view-ops (cdr mh-view-ops)))
296 (pop mh-view-ops)) 311 (setq mh-view-ops (cdr mh-view-ops)))
297 (t (error "Widening is not applicable"))) 312 (t (error "Widening is not applicable")))
298 (when (memq 'unthread mh-view-ops) 313 ;; If ALL-FLAG is non-nil then rewind stacks
299 (setq mh-thread-scan-line-map mh-thread-old-scan-line-map)) 314 (when all-flag
315 (while (cdr mh-thread-scan-line-map-stack)
316 (setq mh-thread-scan-line-map-stack
317 (cdr mh-thread-scan-line-map-stack)))
318 (while (cdr mh-folder-view-stack)
319 (setq mh-folder-view-stack (cdr mh-folder-view-stack))))
320 (setq mh-thread-scan-line-map (pop mh-thread-scan-line-map-stack))
300 (with-mh-folder-updating (t) 321 (with-mh-folder-updating (t)
301 (delete-region (point-min) (point-max)) 322 (delete-region (point-min) (point-max))
302 (widen) 323 (insert (pop mh-folder-view-stack))
324 (mh-remove-all-notation)
303 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) 325 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
304 (mh-make-folder-mode-line)) 326 (mh-make-folder-mode-line))
305 (if msg 327 (if msg
306 (mh-goto-msg msg t t)) 328 (mh-goto-msg msg t t))
307 (setq mh-narrowed-to-seq nil)
308 (setq mh-tick-seq-changed-when-narrowed-flag nil)
309 (mh-notate-deleted-and-refiled) 329 (mh-notate-deleted-and-refiled)
310 (mh-notate-user-sequences) 330 (mh-notate-user-sequences)
311 (mh-notate-cur) 331 (mh-notate-cur)
312 (mh-recenter nil))) 332 (mh-recenter nil)))
313 (when (and (boundp 'tool-bar-mode) tool-bar-mode) 333 (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode)
314 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) 334 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
315 (when (buffer-live-p (get-buffer mh-show-buffer)) 335 (when (buffer-live-p (get-buffer mh-show-buffer))
316 (save-excursion 336 (save-excursion
@@ -319,6 +339,7 @@ OP is one of 'widen and 'unthread."
319 339
320;; FIXME? We may want to clear all notations and add one for current-message 340;; FIXME? We may want to clear all notations and add one for current-message
321;; and process user sequences. 341;; and process user sequences.
342;;;###mh-autoload
322(defun mh-notate-deleted-and-refiled () 343(defun mh-notate-deleted-and-refiled ()
323 "Notate messages marked for deletion or refiling. 344 "Notate messages marked for deletion or refiling.
324Messages to be deleted are given by `mh-delete-list' while messages to be 345Messages to be deleted are given by `mh-delete-list' while messages to be
@@ -342,13 +363,15 @@ refiled are present in `mh-refile-list'."
342;;; of the form: 363;;; of the form:
343;;; ((seq-name msgs ...) (seq-name msgs ...) ...) 364;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
344 365
366(defvar mh-sequence-history ())
367
368;;;###mh-autoload
345(defun mh-read-seq-default (prompt not-empty) 369(defun mh-read-seq-default (prompt not-empty)
346 "Read and return sequence name with default narrowed or previous sequence. 370 "Read and return sequence name with default narrowed or previous sequence.
347PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a 371PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
348non-empty sequence is read." 372non-empty sequence is read."
349 (mh-read-seq prompt not-empty 373 (mh-read-seq prompt not-empty
350 (or mh-narrowed-to-seq 374 (or mh-last-seq-used
351 mh-last-seq-used
352 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) 375 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
353 376
354(defun mh-read-seq (prompt not-empty &optional default) 377(defun mh-read-seq (prompt not-empty &optional default)
@@ -360,7 +383,8 @@ defaults to the first sequence containing the current message."
360 (if default 383 (if default
361 (format "[%s] " default) 384 (format "[%s] " default)
362 "")) 385 ""))
363 (mh-seq-names mh-seq-list))) 386 (mh-seq-names mh-seq-list)
387 nil nil nil 'mh-sequence-history))
364 (seq (cond ((equal input "%") 388 (seq (cond ((equal input "%")
365 (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) 389 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
366 ((equal input "") default) 390 ((equal input "") default)
@@ -370,6 +394,126 @@ defaults to the first sequence containing the current message."
370 (error "No messages in sequence `%s'" seq)) 394 (error "No messages in sequence `%s'" seq))
371 seq)) 395 seq))
372 396
397;;; Functions to read ranges with completion...
398(defvar mh-range-seq-names)
399(defvar mh-range-history ())
400(defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map))
401(define-key mh-range-completion-map " " 'self-insert-command)
402
403(defun mh-range-completion-function (string predicate flag)
404 "Programmable completion of message ranges.
405STRING is the user input that is to be completed. PREDICATE if non-nil is a
406function used to filter the possible choices and FLAG determines whether the
407completion is over."
408 (let* ((candidates mh-range-seq-names)
409 (last-char (and (not (equal string ""))
410 (aref string (1- (length string)))))
411 (last-word (cond ((null last-char) "")
412 ((memq last-char '(? ?- ?:)) "")
413 (t (car (last (split-string string "[ -:]+"))))))
414 (prefix (substring string 0 (- (length string) (length last-word)))))
415 (cond ((eq flag nil)
416 (let ((res (try-completion last-word candidates predicate)))
417 (cond ((null res) nil)
418 ((eq res t) t)
419 (t (concat prefix res)))))
420 ((eq flag t)
421 (all-completions last-word candidates predicate))
422 ((eq flag 'lambda)
423 (loop for x in candidates
424 when (equal x last-word) return t
425 finally return nil)))))
426
427;;;###mh-autoload
428(defun mh-read-range (prompt &optional folder default
429 expand-flag ask-flag number-as-range-flag)
430 "Read a message range with PROMPT.
431
432If FOLDER is non-nil then a range is read from that folder, otherwise use
433`mh-current-folder'.
434
435If DEFAULT is a string then use that as default range to return. If DEFAULT is
436nil then ask user with default answer a range based on the sequences that seem
437relevant. Finally if DEFAULT is t, try to avoid prompting the user. Unseen
438messages, if present, are returned. If the folder has fewer than
439`mh-large-folder' messages then \"all\" messages are returned. Finally as a
440last resort prompt the user.
441
442If EXPAND-FLAG is non-nil then a list of message numbers corresponding to the
443input is returned. If this list is empty then an error is raised. If
444EXPAND-FLAG is nil just return the input string. In this case we don't check
445if the range is empty.
446
447If ASK-FLAG is non-nil, then the user is always queried for a range of
448messages. If ASK-FLAG is nil, then the function checks if the unseen sequence
449is non-empty. If that is the case, `mh-unseen-seq', or the list of messages in
450it depending on the value of EXPAND, is returned. Otherwise if the folder has
451fewer than `mh-large-folder' messages then the list of messages corresponding
452to \"all\" is returned. If neither of the above holds then as a last resort
453the user is queried for a range of messages.
454
455If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as input, it
456is interpreted as the range \"last:N\".
457
458This function replaces the existing function `mh-read-msg-range'. Calls to:
459 (mh-read-msg-range folder flag)
460should be replaced with:
461 (mh-read-range \"Suitable prompt\" folder t nil flag
462 mh-interpret-number-as-range-flag)"
463 (setq default (or default mh-last-seq-used
464 (car (mh-seq-containing-msg (mh-get-msg-num nil) t)))
465 prompt (format "%s range" prompt))
466 (let* ((folder (or folder mh-current-folder))
467 (default (cond ((or (eq default t) (stringp default)) default)
468 ((symbolp default) (symbol-name default))))
469 (guess (eq default t))
470 (counts (and guess (mh-folder-size folder)))
471 (unseen (and counts (> (cadr counts) 0)))
472 (large (and counts mh-large-folder (> (car counts) mh-large-folder)))
473 (str (cond ((and guess large
474 (setq default (format "last:%s" mh-large-folder)
475 prompt (format "%s (folder has %s messages)"
476 prompt (car counts)))
477 nil))
478 ((and guess (not large) (setq default "all") nil))
479 ((eq default nil) "")
480 (t (format "[%s] " default))))
481 (minibuffer-local-completion-map mh-range-completion-map)
482 (seq-list (if (eq folder mh-current-folder)
483 mh-seq-list
484 (mh-read-folder-sequences folder nil)))
485 (mh-range-seq-names
486 (append '(("first") ("last") ("all") ("prev") ("next"))
487 (mh-seq-names seq-list)))
488 (input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq))
489 ((and (not ask-flag) (not large)) "all")
490 (t (completing-read (format "%s: %s" prompt str)
491 'mh-range-completion-function nil nil
492 nil 'mh-range-history default))))
493 msg-list)
494 (when (and number-as-range-flag
495 (string-match "^[ \t]*\\([0-9]+\\)[ \t]*$" input))
496 (setq input (concat "last:" (match-string 1 input))))
497 (cond ((not expand-flag) input)
498 ((assoc (intern input) seq-list)
499 (cdr (assoc (intern input) seq-list)))
500 ((setq msg-list (mh-translate-range folder input)) msg-list)
501 (t (error "No messages in range `%s'" input)))))
502
503;;;###mh-autoload
504(defun mh-translate-range (folder expr)
505 "In FOLDER, translate the string EXPR to a list of messages numbers."
506 (save-excursion
507 (let ((strings (delete "" (split-string expr "[ \t\n]")))
508 (result ()))
509 (ignore-errors
510 (apply #'mh-exec-cmd-quiet nil "mhpath" folder strings)
511 (set-buffer mh-temp-buffer)
512 (goto-char (point-min))
513 (while (re-search-forward "/\\([0-9]*\\)$" nil t)
514 (push (car (read-from-string (match-string 1))) result))
515 (nreverse result)))))
516
373(defun mh-seq-names (seq-list) 517(defun mh-seq-names (seq-list)
374 "Return an alist containing the names of the SEQ-LIST." 518 "Return an alist containing the names of the SEQ-LIST."
375 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry)))) 519 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
@@ -427,7 +571,7 @@ uses `overlay-arrow-position' to put a marker in the fringe."
427(defun mh-add-to-sequence (seq msgs) 571(defun mh-add-to-sequence (seq msgs)
428 "The sequence SEQ is augmented with the messages in MSGS." 572 "The sequence SEQ is augmented with the messages in MSGS."
429 ;; Add to a SEQUENCE each message the list of MSGS. 573 ;; Add to a SEQUENCE each message the list of MSGS.
430 (if (not (mh-folder-name-p seq)) 574 (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
431 (if msgs 575 (if msgs
432 (apply 'mh-exec-cmd "mark" mh-current-folder "-add" 576 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
433 "-sequence" (symbol-name seq) 577 "-sequence" (symbol-name seq)
@@ -458,17 +602,15 @@ uses `overlay-arrow-position' to put a marker in the fringe."
458 (mh-regenerate-headers coalesced-msgs t) 602 (mh-regenerate-headers coalesced-msgs t)
459 (cond ((memq 'unthread mh-view-ops) 603 (cond ((memq 'unthread mh-view-ops)
460 ;; Populate restricted scan-line map 604 ;; Populate restricted scan-line map
461 (goto-char (point-min)) 605 (mh-remove-all-notation)
462 (while (not (eobp)) 606 (mh-iterate-on-range msg (cons (point-min) (point-max))
463 (let ((msg (mh-get-msg-num nil))) 607 (setf (gethash msg mh-thread-scan-line-map)
464 (when (numberp msg) 608 (mh-thread-parse-scan-line)))
465 (setf (gethash msg mh-thread-scan-line-map)
466 (mh-thread-parse-scan-line))))
467 (forward-line))
468 ;; Remove scan lines and read results from pre-computed tree 609 ;; Remove scan lines and read results from pre-computed tree
469 (delete-region (point-min) (point-max)) 610 (delete-region (point-min) (point-max))
470 (mh-thread-print-scan-lines 611 (mh-thread-print-scan-lines
471 (mh-thread-generate mh-current-folder ()))) 612 (mh-thread-generate mh-current-folder ()))
613 (mh-notate-user-sequences))
472 (mh-index-data 614 (mh-index-data
473 (mh-index-insert-folder-headers))))))) 615 (mh-index-insert-folder-headers)))))))
474 616
@@ -509,32 +651,36 @@ If VAR is nil then the loop is executed without any binding."
509(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun) 651(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
510 652
511;;;###mh-autoload 653;;;###mh-autoload
512(defmacro mh-iterate-on-msg-or-seq (var msg-or-seq &rest body) 654(defmacro mh-iterate-on-range (var range &rest body)
513 "Iterate an operation over a region or sequence. 655 "Iterate an operation over a region or sequence.
514 656
515VAR is bound to each message in turn in a loop over MSG-OR-SEQ, which can be a 657VAR is bound to each message in turn in a loop over RANGE, which can be a
516message number, a list of message numbers, a sequence, or a region in a cons 658message number, a list of message numbers, a sequence, a region in a cons
517cell. In each iteration, BODY is executed. 659cell, or a MH range (something like last:20) in a string. In each iteration,
660BODY is executed.
518 661
519The parameter MSG-OR-SEQ is usually created with `mh-interactive-msg-or-seq' 662The parameter RANGE is usually created with `mh-interactive-range'
520in order to provide a uniform interface to MH-E functions." 663in order to provide a uniform interface to MH-E functions."
521 (unless (symbolp var) 664 (unless (symbolp var)
522 (error "Can not bind the non-symbol %s" var)) 665 (error "Can not bind the non-symbol %s" var))
523 (let ((binding-needed-flag var) 666 (let ((binding-needed-flag var)
524 (msgs (make-symbol "msgs")) 667 (msgs (make-symbol "msgs"))
525 (seq-hash-table (make-symbol "seq-hash-table"))) 668 (seq-hash-table (make-symbol "seq-hash-table")))
526 `(cond ((numberp ,msg-or-seq) 669 `(cond ((numberp ,range)
527 (when (mh-goto-msg ,msg-or-seq t t) 670 (when (mh-goto-msg ,range t t)
528 (let ,(if binding-needed-flag `((,var ,msg-or-seq)) ()) 671 (let ,(if binding-needed-flag `((,var ,range)) ())
529 ,@body))) 672 ,@body)))
530 ((and (consp ,msg-or-seq) 673 ((and (consp ,range)
531 (numberp (car ,msg-or-seq)) (numberp (cdr ,msg-or-seq))) 674 (numberp (car ,range)) (numberp (cdr ,range)))
532 (mh-iterate-on-messages-in-region ,var 675 (mh-iterate-on-messages-in-region ,var
533 (car ,msg-or-seq) (cdr ,msg-or-seq) 676 (car ,range) (cdr ,range)
534 ,@body)) 677 ,@body))
535 (t (let ((,msgs (if (and ,msg-or-seq (symbolp ,msg-or-seq)) 678 (t (let ((,msgs (cond ((and ,range (symbolp ,range))
536 (mh-seq-to-msgs ,msg-or-seq) 679 (mh-seq-to-msgs ,range))
537 ,msg-or-seq)) 680 ((stringp ,range)
681 (mh-translate-range mh-current-folder
682 ,range))
683 (t ,range)))
538 (,seq-hash-table (make-hash-table))) 684 (,seq-hash-table (make-hash-table)))
539 (dolist (msg ,msgs) 685 (dolist (msg ,msgs)
540 (setf (gethash msg ,seq-hash-table) t)) 686 (setf (gethash msg ,seq-hash-table) t))
@@ -543,38 +689,39 @@ in order to provide a uniform interface to MH-E functions."
543 (let ,(if binding-needed-flag `((,var v)) ()) 689 (let ,(if binding-needed-flag `((,var v)) ())
544 ,@body)))))))) 690 ,@body))))))))
545 691
546(put 'mh-iterate-on-msg-or-seq 'lisp-indent-hook 'defun) 692(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
547 693
548;;;###mh-autoload 694;;;###mh-autoload
549(defun mh-msg-or-seq-to-msg-list (msg-or-seq) 695(defun mh-range-to-msg-list (range)
550 "Return a list of messages for MSG-OR-SEQ. 696 "Return a list of messages for RANGE.
551MSG-OR-SEQ can be a message number, a list of message numbers, a sequence, or 697RANGE can be a message number, a list of message numbers, a sequence, or
552a region in a cons cell." 698a region in a cons cell."
553 (let (msg-list) 699 (let (msg-list)
554 (mh-iterate-on-msg-or-seq msg msg-or-seq 700 (mh-iterate-on-range msg range
555 (push msg msg-list)) 701 (push msg msg-list))
556 (nreverse msg-list))) 702 (nreverse msg-list)))
557 703
558;;;###mh-autoload 704;;;###mh-autoload
559(defun mh-interactive-msg-or-seq (sequence-prompt) 705(defun mh-interactive-range (range-prompt)
560 "Return interactive specification for message, sequence, or region. 706 "Return interactive specification for message, sequence, range or region.
561By convention, the name of this argument is msg-or-seq. 707By convention, the name of this argument is RANGE.
562 708
563If variable `transient-mark-mode' is non-nil and the mark is active, then this 709If variable `transient-mark-mode' is non-nil and the mark is active, then this
564function returns a cons-cell of the region. 710function returns a cons-cell of the region.
565If optional prefix argument provided, then prompt for message sequence with 711
566SEQUENCE-PROMPT and return sequence. 712If optional prefix argument is provided, then prompt for message range with
713RANGE-PROMPT. A list of messages in that range is returned.
714
715If a MH range is given, say something like last:20, then a list containing
716the messages in that range is returned.
717
567Otherwise, the message number at point is returned. 718Otherwise, the message number at point is returned.
568 719
569This function is usually used with `mh-iterate-on-msg-or-seq' in order to 720This function is usually used with `mh-iterate-on-range' in order to provide
570provide a uniform interface to MH-E functions." 721a uniform interface to MH-E functions."
571 (cond 722 (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
572 ((mh-mark-active-p t) 723 (current-prefix-arg (mh-read-range range-prompt nil nil t t))
573 (cons (region-beginning) (region-end))) 724 (t (mh-get-msg-num t))))
574 (current-prefix-arg
575 (mh-read-seq-default sequence-prompt t))
576 (t
577 (mh-get-msg-num t))))
578 725
579;;;###mh-autoload 726;;;###mh-autoload
580(defun mh-region-to-msg-list (begin end) 727(defun mh-region-to-msg-list (begin end)
@@ -591,6 +738,8 @@ provide a uniform interface to MH-E functions."
591;;; Commands to handle new 'subject sequence. 738;;; Commands to handle new 'subject sequence.
592;;; Or "Poor man's threading" by psg. 739;;; Or "Poor man's threading" by psg.
593 740
741;;; XXX: The function mh-subject-to-sequence-unthreaded uses the magic number
742;;; 41 for the max size of the subject part. Avoiding this would be desirable.
594(defun mh-subject-to-sequence (all) 743(defun mh-subject-to-sequence (all)
595 "Put all following messages with same subject in sequence 'subject. 744 "Put all following messages with same subject in sequence 'subject.
596If arg ALL is t, move to beginning of folder buffer to collect all messages. 745If arg ALL is t, move to beginning of folder buffer to collect all messages.
@@ -601,6 +750,21 @@ Return number of messages put in the sequence:
601 nil -> there was no subject line. 750 nil -> there was no subject line.
602 0 -> there were no later messages with the same subject (sequence not made) 751 0 -> there were no later messages with the same subject (sequence not made)
603 >1 -> the total number of messages including current one." 752 >1 -> the total number of messages including current one."
753 (if (memq 'unthread mh-view-ops)
754 (mh-subject-to-sequence-threaded all)
755 (mh-subject-to-sequence-unthreaded all)))
756
757(defun mh-subject-to-sequence-unthreaded (all)
758 "Put all following messages with same subject in sequence 'subject.
759This function only works with an unthreaded folder. If arg ALL is t, move to
760beginning of folder buffer to collect all messages. If arg ALL is nil, collect
761only messages fron current one on forward.
762
763Return number of messages put in the sequence:
764
765 nil -> there was no subject line.
766 0 -> there were no later messages with the same subject (sequence not made)
767 >1 -> the total number of messages including current one."
604 (if (not (eq major-mode 'mh-folder-mode)) 768 (if (not (eq major-mode 'mh-folder-mode))
605 (error "Not in a folder buffer")) 769 (error "Not in a folder buffer"))
606 (save-excursion 770 (save-excursion
@@ -628,8 +792,7 @@ Return number of messages put in the sequence:
628 ;; If we created a new sequence, add the initial message to it too. 792 ;; If we created a new sequence, add the initial message to it too.
629 (if (not (member (mh-get-msg-num t) list)) 793 (if (not (member (mh-get-msg-num t) list))
630 (setq list (cons (mh-get-msg-num t) list))) 794 (setq list (cons (mh-get-msg-num t) list)))
631 (if (member '("subject") (mh-seq-names mh-seq-list)) 795 (if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
632 (mh-delete-seq 'subject))
633 ;; sort the result into a sequence 796 ;; sort the result into a sequence
634 (let ((sorted-list (sort (copy-sequence list) 'mh-lessp))) 797 (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
635 (while sorted-list 798 (while sorted-list
@@ -639,6 +802,39 @@ Return number of messages put in the sequence:
639 (t 802 (t
640 0)))))) 803 0))))))
641 804
805(defun mh-subject-to-sequence-threaded (all)
806 "Put all messages with the same subject in the 'subject sequence.
807This function works when the folder is threaded. In this situation the subject
808could get truncated and so the normal matching doesn't work.
809
810The parameter ALL is non-nil then all the messages in the buffer are
811considered, otherwise only the messages after the current one are taken into
812account."
813 (let* ((cur (mh-get-msg-num nil))
814 (subject (mh-thread-find-msg-subject cur))
815 region msgs)
816 (if (null subject)
817 (and (message "No subject line") nil)
818 (setq region (cons (if all (point-min) (point)) (point-max)))
819 (mh-iterate-on-range msg region
820 (when (eq (mh-thread-find-msg-subject msg) subject)
821 (push msg msgs)))
822 (setq msgs (sort msgs #'mh-lessp))
823 (if (null msgs)
824 0
825 (when (assoc 'subject mh-seq-list)
826 (mh-delete-seq 'subject))
827 (mh-add-msgs-to-seq msgs 'subject)
828 (length msgs)))))
829
830(defun mh-thread-find-msg-subject (msg)
831 "Find canonicalized subject of MSG.
832This function can only be used the folder is threaded."
833 (ignore-errors
834 (mh-message-subject
835 (mh-container-message (gethash (gethash msg mh-thread-index-id-map)
836 mh-thread-id-table)))))
837
642;;;###mh-autoload 838;;;###mh-autoload
643(defun mh-narrow-to-subject () 839(defun mh-narrow-to-subject ()
644 "Narrow to a sequence containing all following messages with same subject." 840 "Narrow to a sequence containing all following messages with same subject."
@@ -657,6 +853,99 @@ Return number of messages put in the sequence:
657 (if (numberp num) 853 (if (numberp num)
658 (mh-goto-msg num t t)))))) 854 (mh-goto-msg num t t))))))
659 855
856(defun mh-read-pick-regexp (default)
857 "With prefix arg read a pick regexp.
858If no prefix arg is given, then return DEFAULT."
859 (let ((default-string (loop for x in default concat (format " %s" x))))
860 (if (or current-prefix-arg (equal default-string ""))
861 (delete "" (split-string (read-string "Pick regexp: " default-string)))
862 default)))
863
864;;;###mh-autoload
865(defun mh-narrow-to-from (&optional regexp)
866 "Limit to messages with the same From header field as the message at point.
867With a prefix argument, prompt for the regular expression, REGEXP given to
868pick."
869 (interactive
870 (list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
871 (mh-narrow-to-header-field 'from regexp))
872
873;;;###mh-autoload
874(defun mh-narrow-to-cc (&optional regexp)
875 "Limit to messages with the same Cc header field as the message at point.
876With a prefix argument, prompt for the regular expression, REGEXP given to
877pick."
878 (interactive
879 (list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
880 (mh-narrow-to-header-field 'cc regexp))
881
882;;;###mh-autoload
883(defun mh-narrow-to-to (&optional regexp)
884 "Limit to messages with the same To header field as the message at point.
885With a prefix argument, prompt for the regular expression, REGEXP given to
886pick."
887 (interactive
888 (list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
889 (mh-narrow-to-header-field 'to regexp))
890
891(defun mh-narrow-to-header-field (header-field regexp)
892 "Limit to messages whose HEADER-FIELD match REGEXP.
893The MH command pick is used to do the match."
894 (let ((folder mh-current-folder)
895 (original (mh-coalesce-msg-list
896 (mh-range-to-msg-list (cons (point-min) (point-max)))))
897 (msg-list ()))
898 (with-temp-buffer
899 (apply #'mh-exec-cmd-output "pick" nil folder
900 (append original (list "-list") regexp))
901 (goto-char (point-min))
902 (while (not (eobp))
903 (let ((num (read-from-string
904 (buffer-substring (point) (line-end-position)))))
905 (when (numberp (car num)) (push (car num) msg-list))
906 (forward-line))))
907 (if (null msg-list)
908 (message "No matches")
909 (when (assoc 'header mh-seq-list) (mh-delete-seq 'header))
910 (mh-add-msgs-to-seq msg-list 'header)
911 (mh-narrow-to-seq 'header))))
912
913(defun mh-current-message-header-field (header-field)
914 "Return a pick regexp to match HEADER-FIELD of the message at point."
915 (let ((num (mh-get-msg-num nil)))
916 (when num
917 (let ((folder mh-current-folder))
918 (with-temp-buffer
919 (insert-file-contents-literally (mh-msg-filename num folder))
920 (goto-char (point-min))
921 (when (search-forward "\n\n" nil t)
922 (narrow-to-region (point-min) (point)))
923 (let* ((field (or (message-fetch-field (format "%s" header-field))
924 ""))
925 (field-option (format "-%s" header-field))
926 (patterns (loop for x in (split-string field "[ ]*,[ ]*")
927 unless (equal x "")
928 collect (if (string-match "<\\(.*@.*\\)>" x)
929 (match-string 1 x)
930 x))))
931 (when patterns
932 (loop with accum = `(,field-option ,(car patterns))
933 for e in (cdr patterns)
934 do (setq accum `(,field-option ,e "-or" ,@accum))
935 finally return accum))))))))
936
937;;;###mh-autoload
938(defun mh-narrow-to-range (range)
939 "Limit to messages in RANGE.
940
941Check the documentation of `mh-interactive-range' to see how RANGE is read in
942interactive use."
943 (interactive (list (mh-interactive-range "Narrow to")))
944 (when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
945 (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
946 (mh-narrow-to-seq 'range))
947
948
660;;;###mh-autoload 949;;;###mh-autoload
661(defun mh-delete-subject () 950(defun mh-delete-subject ()
662 "Mark all following messages with same subject to be deleted. 951 "Mark all following messages with same subject to be deleted.
@@ -689,28 +978,23 @@ subject for deletion."
689 978
690;;; Message threading: 979;;; Message threading:
691 980
981(defmacro mh-thread-initialize-hash (var test)
982 "Initialize the hash table in VAR.
983TEST is the test to use when creating a new hash table."
984 (unless (symbolp var) (error "Expected a symbol: %s" var))
985 `(if ,var (clrhash ,var) (setq ,var (make-hash-table :test ,test))))
986
692(defun mh-thread-initialize () 987(defun mh-thread-initialize ()
693 "Make hash tables, otherwise clear them." 988 "Make new hash tables, or clear them if already present."
694 (cond 989 (mh-thread-initialize-hash mh-thread-id-hash #'equal)
695 (mh-thread-id-hash 990 (mh-thread-initialize-hash mh-thread-subject-hash #'equal)
696 (clrhash mh-thread-id-hash) 991 (mh-thread-initialize-hash mh-thread-id-table #'eq)
697 (clrhash mh-thread-subject-hash) 992 (mh-thread-initialize-hash mh-thread-id-index-map #'eq)
698 (clrhash mh-thread-id-table) 993 (mh-thread-initialize-hash mh-thread-index-id-map #'eql)
699 (clrhash mh-thread-id-index-map) 994 (mh-thread-initialize-hash mh-thread-scan-line-map #'eql)
700 (clrhash mh-thread-index-id-map) 995 (mh-thread-initialize-hash mh-thread-subject-container-hash #'eq)
701 (clrhash mh-thread-scan-line-map) 996 (mh-thread-initialize-hash mh-thread-duplicates #'eq)
702 (clrhash mh-thread-subject-container-hash) 997 (setq mh-thread-history ()))
703 (clrhash mh-thread-duplicates)
704 (setq mh-thread-history ()))
705 (t (setq mh-thread-id-hash (make-hash-table :test #'equal))
706 (setq mh-thread-subject-hash (make-hash-table :test #'equal))
707 (setq mh-thread-id-table (make-hash-table :test #'eq))
708 (setq mh-thread-id-index-map (make-hash-table :test #'eq))
709 (setq mh-thread-index-id-map (make-hash-table :test #'eql))
710 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
711 (setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
712 (setq mh-thread-duplicates (make-hash-table :test #'eq))
713 (setq mh-thread-history ()))))
714 998
715(defsubst mh-thread-id-container (id) 999(defsubst mh-thread-id-container (id)
716 "Given ID, return the corresponding container in `mh-thread-id-table'. 1000 "Given ID, return the corresponding container in `mh-thread-id-table'.
@@ -959,7 +1243,7 @@ preference to something that has it."
959 (push root results))))) 1243 (push root results)))))
960 (nreverse results))) 1244 (nreverse results)))
961 1245
962(defsubst mh-thread-process-in-reply-to (reply-to-header) 1246(defun mh-thread-process-in-reply-to (reply-to-header)
963 "Extract message id's from REPLY-TO-HEADER. 1247 "Extract message id's from REPLY-TO-HEADER.
964Ideally this should have some regexp which will try to guess if a string 1248Ideally this should have some regexp which will try to guess if a string
965between < and > is a message id and not an email address. For now it will 1249between < and > is a message id and not an email address. For now it will
@@ -1071,6 +1355,7 @@ Only information about messages in MSG-LIST are added to the tree."
1071 "Update thread tree for FOLDER. 1355 "Update thread tree for FOLDER.
1072All messages after START-POINT are added to the thread tree." 1356All messages after START-POINT are added to the thread tree."
1073 (mh-thread-rewind-pruning) 1357 (mh-thread-rewind-pruning)
1358 (mh-remove-all-notation)
1074 (goto-char start-point) 1359 (goto-char start-point)
1075 (let ((msg-list ())) 1360 (let ((msg-list ()))
1076 (while (not (eobp)) 1361 (while (not (eobp))
@@ -1085,7 +1370,6 @@ All messages after START-POINT are added to the thread tree."
1085 (old-buffer-modified-flag (buffer-modified-p))) 1370 (old-buffer-modified-flag (buffer-modified-p)))
1086 (delete-region (point-min) (point-max)) 1371 (delete-region (point-min) (point-max))
1087 (mh-thread-print-scan-lines thread-tree) 1372 (mh-thread-print-scan-lines thread-tree)
1088 (mh-notate-user-sequences)
1089 (mh-notate-deleted-and-refiled) 1373 (mh-notate-deleted-and-refiled)
1090 (mh-notate-cur) 1374 (mh-notate-cur)
1091 (set-buffer-modified-p old-buffer-modified-flag)))) 1375 (set-buffer-modified-p old-buffer-modified-flag))))
@@ -1150,18 +1434,30 @@ Otherwise uses the line at point as the scan line to parse."
1150 (let* ((string (or string 1434 (let* ((string (or string
1151 (buffer-substring-no-properties (line-beginning-position) 1435 (buffer-substring-no-properties (line-beginning-position)
1152 (line-end-position)))) 1436 (line-end-position))))
1153 (first-string (substring string 0 (+ mh-cmd-note 8)))) 1437 (address-start (+ mh-cmd-note mh-scan-field-from-start-offset))
1154 (setf (elt first-string mh-cmd-note) ? ) 1438 (body-start (+ mh-cmd-note mh-scan-field-from-end-offset))
1155 (when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0)) 1439 (first-string (substring string 0 address-start)))
1156 (setf (elt first-string (1+ mh-cmd-note)) ? ))
1157 (list first-string 1440 (list first-string
1158 (substring string 1441 (substring string address-start (- body-start 2))
1159 (+ mh-cmd-note mh-scan-field-from-start-offset) 1442 (substring string body-start)
1160 (+ mh-cmd-note mh-scan-field-from-end-offset -2))
1161 (substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
1162 string))) 1443 string)))
1163 1444
1164;;;###mh-autoload 1445;;;###mh-autoload
1446(defun mh-thread-update-scan-line-map (msg notation offset)
1447 "In threaded view update `mh-thread-scan-line-map'.
1448MSG is the message being notated with NOTATION at OFFSET."
1449 (let* ((msg (or msg (mh-get-msg-num nil)))
1450 (cur-scan-line (and mh-thread-scan-line-map
1451 (gethash msg mh-thread-scan-line-map)))
1452 (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
1453 collect (and map (gethash msg map))))
1454 (notation (if (stringp notation) (aref notation 0) notation)))
1455 (when cur-scan-line
1456 (setf (aref (car cur-scan-line) offset) notation))
1457 (dolist (line old-scan-lines)
1458 (when line (setf (aref (car line) offset) notation)))))
1459
1460;;;###mh-autoload
1165(defun mh-thread-add-spaces (count) 1461(defun mh-thread-add-spaces (count)
1166 "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." 1462 "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
1167 (let ((spaces (format (format "%%%ss" count) ""))) 1463 (let ((spaces (format (format "%%%ss" count) "")))
@@ -1197,14 +1493,11 @@ Otherwise uses the line at point as the scan line to parse."
1197 (message "Threading %s..." (buffer-name)) 1493 (message "Threading %s..." (buffer-name))
1198 (mh-thread-initialize) 1494 (mh-thread-initialize)
1199 (goto-char (point-min)) 1495 (goto-char (point-min))
1496 (mh-remove-all-notation)
1200 (let ((msg-list ())) 1497 (let ((msg-list ()))
1201 (while (not (eobp)) 1498 (mh-iterate-on-range msg (cons (point-min) (point-max))
1202 (let ((index (mh-get-msg-num nil))) 1499 (setf (gethash msg mh-thread-scan-line-map) (mh-thread-parse-scan-line))
1203 (when (numberp index) 1500 (push msg msg-list))
1204 (push index msg-list)
1205 (setf (gethash index mh-thread-scan-line-map)
1206 (mh-thread-parse-scan-line))))
1207 (forward-line))
1208 (let* ((range (mh-coalesce-msg-list msg-list)) 1501 (let* ((range (mh-coalesce-msg-list msg-list))
1209 (thread-tree (mh-thread-generate (buffer-name) range))) 1502 (thread-tree (mh-thread-generate (buffer-name) range)))
1210 (delete-region (point-min) (point-max)) 1503 (delete-region (point-min) (point-max))
@@ -1403,68 +1696,31 @@ start of the region and the second is the point at the end."
1403 1696
1404;; Tick mark handling 1697;; Tick mark handling
1405 1698
1406;; Functions to highlight and unhighlight ticked messages.
1407(defun mh-tick-add-overlay ()
1408 "Add tick overlay to current line."
1409 (with-mh-folder-updating (t)
1410 (let ((overlay
1411 (or (mh-funcall-if-exists make-overlay (point) (line-end-position))
1412 (mh-funcall-if-exists make-extent (point) (line-end-position)))))
1413 (or (mh-funcall-if-exists overlay-put overlay 'face 'mh-folder-tick-face)
1414 (mh-funcall-if-exists set-extent-face overlay 'mh-folder-tick-face))
1415 (mh-funcall-if-exists set-extent-priority overlay 10)
1416 (add-text-properties (point) (line-end-position) `(mh-tick ,overlay)))))
1417
1418(defun mh-tick-remove-overlay ()
1419 "Remove tick overlay from current line."
1420 (let ((overlay (get-text-property (point) 'mh-tick)))
1421 (when overlay
1422 (with-mh-folder-updating (t)
1423 (or (mh-funcall-if-exists delete-overlay overlay)
1424 (mh-funcall-if-exists delete-extent overlay))
1425 (remove-text-properties (point) (line-end-position) `(mh-tick nil))))))
1426
1427;;;###mh-autoload
1428(defun mh-notate-tick (msg ticked-msgs &optional ignore-narrowing)
1429 "Highlight current line if MSG is in TICKED-MSGS.
1430If optional argument IGNORE-NARROWING is non-nil then highlighting is carried
1431out even if folder is narrowed to `mh-tick-seq'."
1432 (when mh-tick-seq
1433 (let ((narrowed-to-tick (and (not ignore-narrowing)
1434 (eq mh-narrowed-to-seq mh-tick-seq)))
1435 (overlay (get-text-property (point) 'mh-tick))
1436 (in-tick (member msg ticked-msgs)))
1437 (cond (narrowed-to-tick (mh-tick-remove-overlay))
1438 ((and (not overlay) in-tick) (mh-tick-add-overlay))
1439 ((and overlay (not in-tick)) (mh-tick-remove-overlay))))))
1440
1441;; Interactive function to toggle tick.
1442;;;###mh-autoload 1699;;;###mh-autoload
1443(defun mh-toggle-tick (begin end) 1700(defun mh-toggle-tick (range)
1444 "Toggle tick mark of all messages in region BEGIN to END." 1701 "Toggle tick mark of all messages in RANGE."
1445 (interactive (cond ((mh-mark-active-p t) 1702 (interactive (list (mh-interactive-range "Tick")))
1446 (list (region-beginning) (region-end)))
1447 (t (list (line-beginning-position) (line-end-position)))))
1448 (unless mh-tick-seq 1703 (unless mh-tick-seq
1449 (error "Enable ticking by customizing `mh-tick-seq'")) 1704 (error "Enable ticking by customizing `mh-tick-seq'"))
1450 (let* ((tick-seq (mh-find-seq mh-tick-seq)) 1705 (let* ((tick-seq (mh-find-seq mh-tick-seq))
1451 (tick-seq-msgs (mh-seq-msgs tick-seq))) 1706 (tick-seq-msgs (mh-seq-msgs tick-seq))
1452 (mh-iterate-on-messages-in-region msg begin end 1707 (ticked ())
1708 (unticked ()))
1709 (mh-iterate-on-range msg range
1453 (cond ((member msg tick-seq-msgs) 1710 (cond ((member msg tick-seq-msgs)
1454 (mh-undefine-sequence mh-tick-seq (list msg)) 1711 (push msg unticked)
1455 (setcdr tick-seq (delq msg (cdr tick-seq))) 1712 (setcdr tick-seq (delq msg (cdr tick-seq)))
1456 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) 1713 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
1457 (mh-tick-remove-overlay)) 1714 (mh-remove-sequence-notation msg t))
1458 (t 1715 (t
1459 (mh-add-msgs-to-seq (list msg) mh-tick-seq nil t) 1716 (push msg ticked)
1460 (setq mh-last-seq-used mh-tick-seq) 1717 (setq mh-last-seq-used mh-tick-seq)
1461 (mh-tick-add-overlay)))) 1718 (mh-add-sequence-notation msg t))))
1462 (when (and (eq mh-tick-seq mh-narrowed-to-seq) 1719 (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
1463 (not mh-tick-seq-changed-when-narrowed-flag)) 1720 (mh-undefine-sequence mh-tick-seq unticked)
1464 (setq mh-tick-seq-changed-when-narrowed-flag t) 1721 (when mh-index-data
1465 (let ((ticked-msgs (mh-seq-msgs (mh-find-seq mh-tick-seq)))) 1722 (mh-index-add-to-sequence mh-tick-seq ticked)
1466 (mh-iterate-on-messages-in-region msg (point-min) (point-max) 1723 (mh-index-delete-from-sequence mh-tick-seq unticked))))
1467 (mh-notate-tick msg ticked-msgs t))))))
1468 1724
1469;;;###mh-autoload 1725;;;###mh-autoload
1470(defun mh-narrow-to-tick () 1726(defun mh-narrow-to-tick ()
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index fd3e984bc3c..967984d1104 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -1,6 +1,6 @@
1;;; mh-speed.el --- Speedbar interface for MH-E. 1;;; mh-speed.el --- Speedbar interface for MH-E.
2 2
3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Satyaki Das <satyaki@theforce.stanford.edu> 5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com> 6;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -34,7 +34,8 @@
34;;; Code: 34;;; Code:
35 35
36;; Requires 36;; Requires
37(require 'cl) 37(require 'mh-utils)
38(mh-require-cl)
38(require 'mh-e) 39(require 'mh-e)
39(require 'speedbar) 40(require 'speedbar)
40 41
@@ -340,7 +341,9 @@ Optional ARGS are ignored."
340 (interactive) 341 (interactive)
341 (declare (ignore args)) 342 (declare (ignore args))
342 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) 343 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
343 (range (and (stringp folder) (mh-read-msg-range folder)))) 344 (range (and (stringp folder)
345 (mh-read-range "Scan" folder t nil nil
346 mh-interpret-number-as-range-flag))))
344 (when (stringp folder) 347 (when (stringp folder)
345 (speedbar-with-attached-buffer 348 (speedbar-with-attached-buffer
346 (mh-visit-folder folder range) 349 (mh-visit-folder folder range)
@@ -350,9 +353,11 @@ Optional ARGS are ignored."
350(defvar mh-speed-flists-folder nil) 353(defvar mh-speed-flists-folder nil)
351 354
352;;;###mh-autoload 355;;;###mh-autoload
353(defun mh-speed-flists (force &optional folder) 356(defun mh-speed-flists (force &rest folders)
354 "Execute flists -recurse and update message counts. 357 "Execute flists -recurse and update message counts.
355If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run 358If FORCE is non-nil the timer is reset.
359
360Any number of optional FOLDERS can be specified. If specified, flists is run
356only for that one folder." 361only for that one folder."
357 (interactive (list t)) 362 (interactive (list t))
358 (when force 363 (when force
@@ -365,7 +370,7 @@ only for that one folder."
365 (kill-process mh-speed-flists-process) 370 (kill-process mh-speed-flists-process)
366 (setq mh-speed-partial-line "") 371 (setq mh-speed-partial-line "")
367 (setq mh-speed-flists-process nil))) 372 (setq mh-speed-flists-process nil)))
368 (setq mh-speed-flists-folder folder) 373 (setq mh-speed-flists-folder folders)
369 (unless mh-speed-flists-timer 374 (unless mh-speed-flists-timer
370 (setq mh-speed-flists-timer 375 (setq mh-speed-flists-timer
371 (run-at-time 376 (run-at-time
@@ -376,17 +381,19 @@ only for that one folder."
376 'exit))) 381 'exit)))
377 (setq mh-speed-current-folder 382 (setq mh-speed-current-folder
378 (concat 383 (concat
379 (with-temp-buffer 384 (if mh-speed-flists-folder
380 (call-process (expand-file-name "folder" mh-progs) 385 (substring (car (reverse mh-speed-flists-folder)) 1)
381 nil '(t nil) nil "-fast") 386 (with-temp-buffer
382 (buffer-substring (point-min) (1- (point-max)))) 387 (call-process (expand-file-name "folder" mh-progs)
388 nil '(t nil) nil "-fast")
389 (buffer-substring (point-min) (1- (point-max)))))
383 "+")) 390 "+"))
384 (setq mh-speed-flists-process 391 (setq mh-speed-flists-process
385 (start-process "*flists*" nil 392 (apply #'start-process "*flists*" nil
386 (expand-file-name "flists" mh-progs) 393 (expand-file-name "flists" mh-progs)
387 (or mh-speed-flists-folder "-recurse") 394 (if mh-speed-flists-folder "-noall" "-all")
388 (if mh-speed-flists-folder "-noall" "-all") 395 "-sequence" (symbol-name mh-unseen-seq)
389 "-sequence" (symbol-name mh-unseen-seq))) 396 (or mh-speed-flists-folder '("-recurse"))))
390 ;; Run flists on all folders the next time around... 397 ;; Run flists on all folders the next time around...
391 (setq mh-speed-flists-folder nil) 398 (setq mh-speed-flists-folder nil)
392 (set-process-filter mh-speed-flists-process 399 (set-process-filter mh-speed-flists-process
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 3e9c87f5eb5..b1966915e86 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -1,7 +1,7 @@
1;;; mh-utils.el --- MH-E code needed for both sending and reading 1;;; mh-utils.el --- MH-E code needed for both sending and reading
2 2
3;; Copyright (C) 1993, 95, 1997, 3;; Copyright (C) 1993, 95, 1997,
4;; 2000, 01, 02, 2003 Free Software Foundation, Inc. 4;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Bill Wohler <wohler@newt.com> 6;; Author: Bill Wohler <wohler@newt.com>
7;; Maintainer: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -37,14 +37,28 @@
37(defvar mh-xemacs-flag (featurep 'xemacs) 37(defvar mh-xemacs-flag (featurep 'xemacs)
38 "Non-nil means the current Emacs is XEmacs.") 38 "Non-nil means the current Emacs is XEmacs.")
39 39
40(require 'cl) 40;; The Emacs coding conventions require that the cl package not be required at
41;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
42;; routines in their macro expansions. Use mh-require-cl to provide the cl
43;; routines in the best way possible.
44(eval-when-compile (require 'cl))
45(defmacro mh-require-cl ()
46 (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
47 `(require 'cl)
48 `(eval-when-compile (require 'cl))))
49
50(mh-require-cl)
41(require 'gnus-util) 51(require 'gnus-util)
42(require 'font-lock) 52(require 'font-lock)
53(require 'mouse)
54(load "tool-bar" t t)
43(require 'mh-loaddefs) 55(require 'mh-loaddefs)
44(require 'mh-customize) 56(require 'mh-customize)
57(require 'mh-inc)
45 58
46(load "mm-decode" t t) ; Non-fatal dependency 59(load "mm-decode" t t) ; Non-fatal dependency
47(load "mm-view" t t) ; Non-fatal dependency 60(load "mm-view" t t) ; Non-fatal dependency
61(load "hl-line" t t) ; Non-fatal dependency
48(load "executable" t t) ; Non-fatal dependency on 62(load "executable" t t) ; Non-fatal dependency on
49 ; executable-find 63 ; executable-find
50 64
@@ -52,7 +66,6 @@
52(defvar font-lock-auto-fontify) 66(defvar font-lock-auto-fontify)
53(defvar font-lock-defaults) 67(defvar font-lock-defaults)
54(defvar mark-active) 68(defvar mark-active)
55(defvar tool-bar-mode)
56 69
57;;; Autoloads 70;;; Autoloads
58(autoload 'gnus-article-highlight-citation "gnus-cite") 71(autoload 'gnus-article-highlight-citation "gnus-cite")
@@ -81,6 +94,9 @@ This directory contains, among other things, the mhl program.")
81(defvar mh-nmh-flag nil 94(defvar mh-nmh-flag nil
82 "Non-nil means nmh is installed on this system instead of MH.") 95 "Non-nil means nmh is installed on this system instead of MH.")
83 96
97(defvar mh-flists-present-flag nil
98 "Non-nil means that we have `flists'.")
99
84;;;###autoload 100;;;###autoload
85(put 'mh-progs 'risky-local-variable t) 101(put 'mh-progs 'risky-local-variable t)
86;;;###autoload 102;;;###autoload
@@ -311,7 +327,7 @@ passed through `regexp-quote' before being used by functions like
311 327
312;; Copy of `goto-address-mail-regexp' 328;; Copy of `goto-address-mail-regexp'
313(defvar mh-address-mail-regexp 329(defvar mh-address-mail-regexp
314 "[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+" 330 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
315 "A regular expression probably matching an e-mail address.") 331 "A regular expression probably matching an e-mail address.")
316 332
317;; From goto-addr.el, which we don't want to force-load on users. 333;; From goto-addr.el, which we don't want to force-load on users.
@@ -435,6 +451,10 @@ Argument LIMIT limits search."
435 (4 font-lock-comment-face nil t))))))) 451 (4 font-lock-comment-face nil t)))))))
436 "Additional expressions to highlight in MH-show mode.") 452 "Additional expressions to highlight in MH-show mode.")
437 453
454(defvar mh-letter-font-lock-keywords
455 `(,@mh-show-font-lock-keywords-with-cite
456 (mh-font-lock-field-data (1 'mh-letter-header-field-face prepend t))))
457
438(defun mh-show-font-lock-fontify-region (beg end loudly) 458(defun mh-show-font-lock-fontify-region (beg end loudly)
439 "Limit font-lock in `mh-show-mode' to the header. 459 "Limit font-lock in `mh-show-mode' to the header.
440Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be 460Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
@@ -632,6 +652,39 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
632 652
633(put 'mh-in-show-buffer 'lisp-indent-hook 'defun) 653(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
634 654
655(defmacro mh-do-at-event-location (event &rest body)
656 "Switch to the location of EVENT and execute BODY.
657After BODY has been executed return to original window. The modification flag
658of the buffer in the event window is preserved."
659 (let ((event-window (make-symbol "event-window"))
660 (event-position (make-symbol "event-position"))
661 (original-window (make-symbol "original-window"))
662 (original-position (make-symbol "original-position"))
663 (modified-flag (make-symbol "modified-flag")))
664 `(save-excursion
665 (let* ((,event-window
666 (or (mh-funcall-if-exists posn-window (event-start ,event))
667 (mh-funcall-if-exists event-window ,event)))
668 (,event-position
669 (or (mh-funcall-if-exists posn-point (event-start ,event))
670 (mh-funcall-if-exists event-closest-point ,event)))
671 (,original-window (selected-window))
672 (,original-position (progn
673 (set-buffer (window-buffer ,event-window))
674 (set-marker (make-marker) (point))))
675 (,modified-flag (buffer-modified-p))
676 (buffer-read-only nil))
677 (unwind-protect (progn
678 (select-window ,event-window)
679 (goto-char ,event-position)
680 ,@body)
681 (set-buffer-modified-p ,modified-flag)
682 (goto-char ,original-position)
683 (set-marker ,original-position nil)
684 (select-window ,original-window))))))
685
686(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
687
635(defmacro mh-make-seq (name msgs) 688(defmacro mh-make-seq (name msgs)
636 "Create sequence NAME with the given MSGS." 689 "Create sequence NAME with the given MSGS."
637 (list 'cons name msgs)) 690 (list 'cons name msgs))
@@ -761,6 +814,8 @@ still visible.\n")
761 (prog1 (call-interactively (function ,original-function)) 814 (prog1 (call-interactively (function ,original-function))
762 (setq normal-exit t)) 815 (setq normal-exit t))
763 (mh-funcall-if-exists deactivate-mark) 816 (mh-funcall-if-exists deactivate-mark)
817 (when (eq major-mode 'mh-folder-mode)
818 (mh-funcall-if-exists hl-line-highlight))
764 (cond ((not normal-exit) 819 (cond ((not normal-exit)
765 (set-window-configuration config)) 820 (set-window-configuration config))
766 ,(if dont-return 821 ,(if dont-return
@@ -823,8 +878,11 @@ still visible.\n")
823(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq) 878(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
824(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) 879(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
825(mh-defun-show-buffer mh-show-widen mh-widen) 880(mh-defun-show-buffer mh-show-widen mh-widen)
826(mh-defun-show-buffer mh-show-narrow-to-subject 881(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
827 mh-narrow-to-subject) 882(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
883(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
884(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
885(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
828(mh-defun-show-buffer mh-show-store-msg mh-store-msg) 886(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
829(mh-defun-show-buffer mh-show-page-digest mh-page-digest) 887(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
830(mh-defun-show-buffer mh-show-page-digest-backwards 888(mh-defun-show-buffer mh-show-page-digest-backwards
@@ -854,6 +912,9 @@ still visible.\n")
854(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist) 912(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
855(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) 913(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
856(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) 914(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
915(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
916(mh-defun-show-buffer mh-show-index-sequenced-messages
917 mh-index-sequenced-messages)
857 918
858;;; Populate mh-show-mode-map 919;;; Populate mh-show-mode-map
859(gnus-define-keys mh-show-mode-map 920(gnus-define-keys mh-show-mode-map
@@ -898,6 +959,7 @@ still visible.\n")
898 959
899(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) 960(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
900 "?" mh-prefix-help 961 "?" mh-prefix-help
962 "'" mh-index-ticked-messages
901 "S" mh-show-sort-folder 963 "S" mh-show-sort-folder
902 "f" mh-show-visit-folder 964 "f" mh-show-visit-folder
903 "i" mh-index-search 965 "i" mh-index-search
@@ -905,6 +967,7 @@ still visible.\n")
905 "l" mh-show-list-folders 967 "l" mh-show-list-folders
906 "n" mh-index-new-messages 968 "n" mh-index-new-messages
907 "o" mh-show-visit-folder 969 "o" mh-show-visit-folder
970 "q" mh-show-index-sequenced-messages
908 "r" mh-show-rescan-folder 971 "r" mh-show-rescan-folder
909 "s" mh-show-search-folder 972 "s" mh-show-search-folder
910 "t" mh-show-toggle-threads 973 "t" mh-show-toggle-threads
@@ -912,6 +975,7 @@ still visible.\n")
912 "v" mh-show-visit-folder) 975 "v" mh-show-visit-folder)
913 976
914(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) 977(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
978 "'" mh-show-narrow-to-tick
915 "?" mh-prefix-help 979 "?" mh-prefix-help
916 "d" mh-show-delete-msg-from-seq 980 "d" mh-show-delete-msg-from-seq
917 "k" mh-show-delete-seq 981 "k" mh-show-delete-seq
@@ -940,7 +1004,11 @@ still visible.\n")
940(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) 1004(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
941 "'" mh-show-narrow-to-tick 1005 "'" mh-show-narrow-to-tick
942 "?" mh-prefix-help 1006 "?" mh-prefix-help
1007 "c" mh-show-narrow-to-cc
1008 "f" mh-show-narrow-to-from
1009 "r" mh-show-narrow-to-range
943 "s" mh-show-narrow-to-subject 1010 "s" mh-show-narrow-to-subject
1011 "t" mh-show-narrow-to-to
944 "w" mh-show-widen) 1012 "w" mh-show-widen)
945 1013
946(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) 1014(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
@@ -1039,8 +1107,10 @@ still visible.\n")
1039;;; Ensure new buffers won't get this mode if default-major-mode is nil. 1107;;; Ensure new buffers won't get this mode if default-major-mode is nil.
1040(put 'mh-show-mode 'mode-class 'special) 1108(put 'mh-show-mode 'mode-class 'special)
1041 1109
1042;; Avoid compiler warning 1110;; Avoid compiler warnings in XEmacs and Emacs 20
1043(defvar tool-bar-map) 1111(eval-when-compile
1112 (defvar tool-bar-mode)
1113 (defvar tool-bar-map))
1044 1114
1045(define-derived-mode mh-show-mode text-mode "MH-Show" 1115(define-derived-mode mh-show-mode text-mode "MH-Show"
1046 "Major mode for showing messages in MH-E.\\<mh-show-mode-map> 1116 "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
@@ -1051,6 +1121,8 @@ be called, with no arguments, upon entry to this mode."
1051 (mh-show-unquote-From) 1121 (mh-show-unquote-From)
1052 (mh-show-xface) 1122 (mh-show-xface)
1053 (mh-show-addr) 1123 (mh-show-addr)
1124 (setq buffer-invisibility-spec '((vanish . t) t))
1125 (set (make-local-variable 'line-move-ignore-invisible) t)
1054 (make-local-variable 'font-lock-defaults) 1126 (make-local-variable 'font-lock-defaults)
1055 ;;(set (make-local-variable 'font-lock-support-mode) nil) 1127 ;;(set (make-local-variable 'font-lock-support-mode) nil)
1056 (cond 1128 (cond
@@ -1067,8 +1139,7 @@ be called, with no arguments, upon entry to this mode."
1067 (if (and mh-xemacs-flag 1139 (if (and mh-xemacs-flag
1068 font-lock-auto-fontify) 1140 font-lock-auto-fontify)
1069 (turn-on-font-lock)) 1141 (turn-on-font-lock))
1070 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 1142 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
1071 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
1072 (mh-funcall-if-exists mh-toolbar-init :show) 1143 (mh-funcall-if-exists mh-toolbar-init :show)
1073 (when mh-decode-mime-flag 1144 (when mh-decode-mime-flag
1074 (mh-make-local-hook 'kill-buffer-hook) 1145 (mh-make-local-hook 'kill-buffer-hook)
@@ -1318,8 +1389,8 @@ If optional arg MSG is non-nil, display that message instead."
1318(defun mh-show (&optional message) 1389(defun mh-show (&optional message)
1319 "Show message at cursor. 1390 "Show message at cursor.
1320If optional argument MESSAGE is non-nil, display that message instead. 1391If optional argument MESSAGE is non-nil, display that message instead.
1321Force a two-window display with the folder window on top (size 1392Force a two-window display with the folder window on top (size given by the
1322`mh-summary-height') and the show buffer below it. 1393variable `mh-summary-height') and the show buffer below it.
1323If the message is already visible, display the start of the message. 1394If the message is already visible, display the start of the message.
1324 1395
1325Display of the message is controlled by setting the variables 1396Display of the message is controlled by setting the variables
@@ -1338,6 +1409,14 @@ Type \"\\[mh-header-display]\" to see the message with all its headers."
1338 (mouse-set-point EVENT) 1409 (mouse-set-point EVENT)
1339 (mh-show)) 1410 (mh-show))
1340 1411
1412(defun mh-summary-height ()
1413 "Return ideal value for the variable `mh-summary-height'.
1414The current frame height is taken into consideration."
1415 (or (and (fboundp 'frame-height)
1416 (> (frame-height) 24)
1417 (min 10 (/ (frame-height) 6)))
1418 4))
1419
1341(defun mh-show-msg (msg) 1420(defun mh-show-msg (msg)
1342 "Show MSG. 1421 "Show MSG.
1343The value of `mh-show-hook' is a list of functions to be called, with no 1422The value of `mh-show-hook' is a list of functions to be called, with no
@@ -1347,6 +1426,7 @@ arguments, after the message has been displayed."
1347 (mh-showing-mode t) 1426 (mh-showing-mode t)
1348 (setq mh-page-to-next-msg-flag nil) 1427 (setq mh-page-to-next-msg-flag nil)
1349 (let ((folder mh-current-folder) 1428 (let ((folder mh-current-folder)
1429 (folders (list mh-current-folder))
1350 (clean-message-header mh-clean-message-header-flag) 1430 (clean-message-header mh-clean-message-header-flag)
1351 (show-window (get-buffer-window mh-show-buffer))) 1431 (show-window (get-buffer-window mh-show-buffer)))
1352 (if (not (eq (next-window (minibuffer-window)) (selected-window))) 1432 (if (not (eq (next-window (minibuffer-window)) (selected-window)))
@@ -1358,22 +1438,29 @@ arguments, after the message has been displayed."
1358 (goto-char (point-min)) 1438 (goto-char (point-min))
1359 (if (not clean-message-header) 1439 (if (not clean-message-header)
1360 (mh-start-of-uncleaned-message))) 1440 (mh-start-of-uncleaned-message)))
1361 (mh-display-msg msg folder)))) 1441 (mh-display-msg msg folder)))
1362 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split 1442 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
1363 (shrink-window (- (window-height) mh-summary-height))) 1443 (shrink-window (- (window-height) (or mh-summary-height
1364 (mh-recenter nil) 1444 (mh-summary-height)))))
1365 (if (not (memq msg mh-seen-list)) 1445 (mh-recenter nil)
1366 (setq mh-seen-list (cons msg mh-seen-list))) 1446 (if (not (memq msg mh-seen-list))
1367 (when mh-update-sequences-after-mh-show-flag 1447 (setq mh-seen-list (cons msg mh-seen-list)))
1368 (if mh-index-data (mh-index-update-unseen msg)) 1448 (when mh-update-sequences-after-mh-show-flag
1369 (mh-update-sequences)) 1449 (mh-update-sequences)
1370 (run-hooks 'mh-show-hook)) 1450 (when mh-index-data
1451 (setq folders
1452 (append (mh-index-delete-from-sequence mh-unseen-seq (list msg))
1453 folders)))
1454 (when (mh-speed-flists-active-p)
1455 (apply #'mh-speed-flists t folders)))
1456 (run-hooks 'mh-show-hook)))
1371 1457
1372(defun mh-modify (&optional message) 1458(defun mh-modify (&optional message)
1373 "Edit message at cursor. 1459 "Edit message at cursor.
1374If optional argument MESSAGE is non-nil, edit that message instead. 1460If optional argument MESSAGE is non-nil, edit that message instead.
1375Force a two-window display with the folder window on top (size 1461Force a two-window display with the folder window on top (size given by the
1376`mh-summary-height') and the message editing buffer below it. 1462value of the variable `mh-summary-height') and the message editing buffer below
1463it.
1377 1464
1378The message is displayed in raw form." 1465The message is displayed in raw form."
1379 (interactive) 1466 (interactive)
@@ -1533,8 +1620,10 @@ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
1533 (beginning-of-line) 1620 (beginning-of-line)
1534 (mh-delete-line 1) 1621 (mh-delete-line 1)
1535 (while (looking-at "[ \t]") 1622 (while (looking-at "[ \t]")
1536 (mh-delete-line 1)))) 1623 (mh-delete-line 1)))))
1537 (unlock-buffer)))) 1624 (let ((mh-compose-skipped-header-fields ()))
1625 (mh-letter-hide-all-skipped-fields))
1626 (unlock-buffer)))
1538 1627
1539(defun mh-delete-line (lines) 1628(defun mh-delete-line (lines)
1540 "Delete the next LINES lines." 1629 "Delete the next LINES lines."
@@ -1550,9 +1639,26 @@ If NOTATION is nil then no change in the buffer occurs."
1550 (with-mh-folder-updating (t) 1639 (with-mh-folder-updating (t)
1551 (beginning-of-line) 1640 (beginning-of-line)
1552 (forward-char offset) 1641 (forward-char offset)
1553 (let ((notation (or notation (char-after)))) 1642 (let* ((change-stack-flag (and (stringp notation)
1554 (delete-char 1) 1643 (equal offset (1+ mh-cmd-note))
1555 (insert notation)))))) 1644 (not (eq notation mh-note-seq))))
1645 (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
1646 (stack (and msg (gethash msg mh-sequence-notation-history)))
1647 (notation (or notation (char-after))))
1648 (if stack
1649 ;; The presence of the stack tells us that we don't need to
1650 ;; notate the message, since the notation would be replaced
1651 ;; by a sequence notation. So we will just put the notation
1652 ;; at the bottom of the stack. If the sequence is deleted,
1653 ;; the correct notation will be shown.
1654 (setf (gethash msg mh-sequence-notation-history)
1655 (reverse (cons (aref notation 0) (cdr (reverse stack)))))
1656 ;; Since we don't have any sequence notations in the way, just
1657 ;; notate the scan line.
1658 (delete-char 1)
1659 (insert notation))
1660 (when change-stack-flag
1661 (mh-thread-update-scan-line-map msg notation offset)))))))
1556 1662
1557(defun mh-find-msg-get-num (step) 1663(defun mh-find-msg-get-num (step)
1558 "Return the message number of the message nearest the cursor. 1664 "Return the message number of the message nearest the cursor.
@@ -1666,7 +1772,8 @@ arguments, after these variable have been set."
1666 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) 1772 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
1667 (if mh-previous-seq 1773 (if mh-previous-seq
1668 (setq mh-previous-seq (intern mh-previous-seq))) 1774 (setq mh-previous-seq (intern mh-previous-seq)))
1669 (run-hooks 'mh-find-path-hook)))) 1775 (run-hooks 'mh-find-path-hook)
1776 (mh-collect-folder-names))))
1670 1777
1671(defun mh-file-command-p (file) 1778(defun mh-file-command-p (file)
1672 "Return t if file FILE is the name of a executable regular file." 1779 "Return t if file FILE is the name of a executable regular file."
@@ -1710,7 +1817,9 @@ directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1710 mh-nmh-flag t))) 1817 mh-nmh-flag t)))
1711 (kill-buffer tmp-buffer)))) 1818 (kill-buffer tmp-buffer))))
1712 (unless (and mh-progs mh-lib mh-lib-progs) 1819 (unless (and mh-progs mh-lib mh-lib-progs)
1713 (error "Unable to determine paths from `mhparam' command"))))) 1820 (error "Unable to determine paths from `mhparam' command"))
1821 (setq mh-flists-present-flag
1822 (file-exists-p (expand-file-name "flists" mh-progs))))))
1714 1823
1715(defun mh-path-search (path file) 1824(defun mh-path-search (path file)
1716 "Search PATH, a list of directory names, for FILE. 1825 "Search PATH, a list of directory names, for FILE.
@@ -1799,18 +1908,21 @@ addition.
1799 1908
1800If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are 1909If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are
1801not updated." 1910not updated."
1802 (let ((entry (mh-find-seq seq))) 1911 (let ((entry (mh-find-seq seq))
1912 (internal-seq-flag (mh-internal-seq seq)))
1803 (if (and msgs (atom msgs)) (setq msgs (list msgs))) 1913 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
1914 (unless internal-flag
1915 (mh-add-to-sequence seq msgs)
1916 (when (not dont-annotate-flag)
1917 (mh-iterate-on-range msg msgs
1918 (unless (memq msg (cdr entry))
1919 (mh-add-sequence-notation msg internal-seq-flag)))))
1804 (if (null entry) 1920 (if (null entry)
1805 (setq mh-seq-list 1921 (setq mh-seq-list
1806 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) 1922 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
1807 mh-seq-list)) 1923 mh-seq-list))
1808 (if msgs (setcdr entry (mh-canonicalize-sequence 1924 (if msgs (setcdr entry (mh-canonicalize-sequence
1809 (append msgs (mh-seq-msgs entry)))))) 1925 (append msgs (mh-seq-msgs entry))))))))
1810 (cond ((not internal-flag)
1811 (mh-add-to-sequence seq msgs)
1812 (unless dont-annotate-flag
1813 (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note)))))))
1814 1926
1815(defun mh-canonicalize-sequence (msgs) 1927(defun mh-canonicalize-sequence (msgs)
1816 "Sort MSGS in decreasing order and remove duplicates." 1928 "Sort MSGS in decreasing order and remove duplicates."
@@ -1824,6 +1936,54 @@ not updated."
1824 1936
1825(defvar mh-sub-folders-cache (make-hash-table :test #'equal)) 1937(defvar mh-sub-folders-cache (make-hash-table :test #'equal))
1826(defvar mh-current-folder-name nil) 1938(defvar mh-current-folder-name nil)
1939(defvar mh-flists-partial-line "")
1940(defvar mh-flists-process nil)
1941
1942;; Initialize mh-sub-folders-cache...
1943(defun mh-collect-folder-names ()
1944 "Collect folder names by running `flists'."
1945 (unless mh-flists-process
1946 (setq mh-flists-process
1947 (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter
1948 "-recurse" "-fast"))))
1949
1950(defun mh-collect-folder-names-filter (process output)
1951 "Read folder names.
1952PROCESS is the flists process that was run to collect folder names and the
1953function is called when OUTPUT is available."
1954 (let ((position 0)
1955 (prevailing-match-data (match-data))
1956 line-end folder)
1957 (unwind-protect
1958 (while (setq line-end (string-match "\n" output position))
1959 (setq folder (format "+%s%s"
1960 mh-flists-partial-line
1961 (substring output position line-end)))
1962 (setq mh-flists-partial-line "")
1963 (unless (equal (aref folder 1) ?.)
1964 (mh-populate-sub-folders-cache folder))
1965 (setq position (1+ line-end)))
1966 (set-match-data prevailing-match-data))
1967 (setq mh-flists-partial-line (substring output position))))
1968
1969(defun mh-populate-sub-folders-cache (folder)
1970 "Tell `mh-sub-folders-cache' about FOLDER."
1971 (let* ((last-slash (mh-search-from-end ?/ folder))
1972 (child1 (substring folder (1+ (or last-slash 0))))
1973 (parent (and last-slash (substring folder 0 last-slash)))
1974 (parent-slash (and parent (mh-search-from-end ?/ parent)))
1975 (child2 (and parent (substring parent (1+ (or parent-slash 0)))))
1976 (grand-parent (and parent-slash (substring parent 0 parent-slash)))
1977 (cache-entry (gethash parent mh-sub-folders-cache)))
1978 (unless (loop for x in cache-entry when (equal (car x) child1) return t
1979 finally return nil)
1980 (push (list child1) cache-entry)
1981 (setf (gethash parent mh-sub-folders-cache)
1982 (sort cache-entry (lambda (x y) (string< (car x) (car y)))))
1983 (when parent
1984 (loop for x in (gethash grand-parent mh-sub-folders-cache)
1985 when (equal (car x) child2)
1986 do (progn (setf (cdr x) t) (return)))))))
1827 1987
1828(defun mh-normalize-folder-name (folder &optional empty-string-okay 1988(defun mh-normalize-folder-name (folder &optional empty-string-okay
1829 dont-remove-trailing-slash) 1989 dont-remove-trailing-slash)
@@ -1979,9 +2139,12 @@ This variable should never be set.")
1979(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) 2139(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map))
1980(define-key mh-folder-completion-map " " 'minibuffer-complete) 2140(define-key mh-folder-completion-map " " 'minibuffer-complete)
1981 2141
2142(defvar mh-speed-flists-inhibit-flag nil)
2143
1982(defun mh-speed-flists-active-p () 2144(defun mh-speed-flists-active-p ()
1983 "Check if speedbar is running with message counts enabled." 2145 "Check if speedbar is running with message counts enabled."
1984 (and (featurep 'mh-speed) 2146 (and (featurep 'mh-speed)
2147 (not mh-speed-flists-inhibit-flag)
1985 (> (hash-table-count mh-speed-flists-cache) 0))) 2148 (> (hash-table-count mh-speed-flists-cache) 0)))
1986 2149
1987(defun mh-folder-completion-function (name predicate flag) 2150(defun mh-folder-completion-function (name predicate flag)
@@ -2119,14 +2282,19 @@ Any output is assumed to be an error and is shown to the user.
2119The output is not read or parsed by MH-E." 2282The output is not read or parsed by MH-E."
2120 (save-excursion 2283 (save-excursion
2121 (set-buffer (get-buffer-create mh-log-buffer)) 2284 (set-buffer (get-buffer-create mh-log-buffer))
2122 (let ((initial-size (mh-truncate-log-buffer))) 2285 (let* ((initial-size (mh-truncate-log-buffer))
2123 (apply 'call-process 2286 (start (point))
2124 (expand-file-name command mh-progs) nil t nil 2287 (args (mh-list-to-string args)))
2125 (mh-list-to-string args)) 2288 (apply 'call-process (expand-file-name command mh-progs) nil t nil args)
2126 (if (> (buffer-size) initial-size) 2289 (when (> (buffer-size) initial-size)
2127 (save-window-excursion 2290 (save-excursion
2128 (switch-to-buffer-other-window mh-log-buffer) 2291 (goto-char start)
2129 (sit-for 5)))))) 2292 (insert "Errors when executing: " command)
2293 (loop for arg in args do (insert " " arg))
2294 (insert "\n"))
2295 (save-window-excursion
2296 (switch-to-buffer-other-window mh-log-buffer)
2297 (sit-for 5))))))
2130 2298
2131(defun mh-exec-cmd-error (env command &rest args) 2299(defun mh-exec-cmd-error (env command &rest args)
2132 "In environment ENV, execute mh-command COMMAND with ARGS. 2300 "In environment ENV, execute mh-command COMMAND with ARGS.
@@ -2161,7 +2329,8 @@ ARGS are passed to COMMAND as command line arguments."
2161 command nil 2329 command nil
2162 (expand-file-name command mh-progs) 2330 (expand-file-name command mh-progs)
2163 (mh-list-to-string args)))) 2331 (mh-list-to-string args))))
2164 (set-process-filter process (or filter 'mh-process-daemon)))) 2332 (set-process-filter process (or filter 'mh-process-daemon))
2333 process))
2165 2334
2166(defun mh-exec-cmd-env-daemon (env command filter &rest args) 2335(defun mh-exec-cmd-env-daemon (env command filter &rest args)
2167 "In ennvironment ENV, execute mh-command COMMAND in the background. 2336 "In ennvironment ENV, execute mh-command COMMAND in the background.
@@ -2283,6 +2452,23 @@ Put the output into buffer after point. Set mark after inserted text."
2283 (setq l (cdr l))) 2452 (setq l (cdr l)))
2284 new-list)) 2453 new-list))
2285 2454
2455(defun mh-replace-in-string (regexp newtext string)
2456 "Replace REGEXP with NEWTEXT everywhere in STRING and return result.
2457NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
2458
2459The function body was copied from `dired-replace-in-string' in dired.el.
2460Emacs21 has `replace-regexp-in-string' while XEmacs has `replace-in-string'.
2461Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 and above
2462has `gnus-replace-in-string'. We should use that when we decide to not support
2463older versions of Gnus."
2464 (let ((result "") (start 0) mb me)
2465 (while (string-match regexp string start)
2466 (setq mb (match-beginning 0)
2467 me (match-end 0)
2468 result (concat result (substring string start mb) newtext)
2469 start me))
2470 (concat result (substring string start))))
2471
2286(provide 'mh-utils) 2472(provide 'mh-utils)
2287 2473
2288;;; Local Variables: 2474;;; Local Variables:
diff --git a/lisp/mh-e/mh-xemacs-compat.el b/lisp/mh-e/mh-xemacs-compat.el
deleted file mode 100644
index 5d4bf63a453..00000000000
--- a/lisp/mh-e/mh-xemacs-compat.el
+++ /dev/null
@@ -1,99 +0,0 @@
1;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
2
3;; Copyright (C) 2001, 02, 2003 Free Software Foundation, Inc.
4
5;; Author: FSF
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;;; Change Log:
30
31;;; Code:
32
33;;; Some requires:
34(require 'rfc822)
35
36(eval-when-compile (require 'mh-utils))
37
38;;; Simple compatibility:
39
40(unless (fboundp 'match-string-no-properties)
41 (defsubst match-string-no-properties (match)
42 (buffer-substring-no-properties
43 (match-beginning match) (match-end match))))
44
45(unless (fboundp 'line-beginning-position)
46 (defalias 'line-beginning-position 'point-at-bol))
47(unless (fboundp 'line-end-position)
48 (defalias 'line-end-position 'point-at-eol))
49
50(unless (fboundp 'timerp)
51 (defalias 'timerp 'itimerp))
52(unless (fboundp 'cancel-timer)
53 (defalias 'cancel-timer 'delete-itimer))
54
55;; Set up the modeline glyph
56(defconst mh-modeline-logo
57 "/* XPM */
58static char * file[] = {
59\"18 13 2 1\",
60\"# c #666699\",
61\". c None s None\",
62\"........##........\",
63\".......####.......\",
64\"......######......\",
65\"......######......\",
66\"....#########.....\",
67\"..##############..\",
68\".##...######....#.\",
69\"##...#.#.####...#.\",
70\"....#..#.##.#...#.\",
71\"...#..##.#.#.#....\",
72\"...#..#..#..#.#...\",
73\"...#..#.##..#.##..\",
74\"...#..#.#..#....#.\"};"
75 "The image for the modeline logo.")
76
77(mh-do-in-xemacs
78 (defvar mh-modeline-glyph
79 (progn
80 (let* ((data mh-modeline-logo)
81 (glyph (make-glyph
82 (cond ((and (featurep 'xpm)
83 (device-on-window-system-p)
84 has-modeline-p)
85 `[xpm :data ,data])
86 (t [string :data "MH-E"])))))
87 (set-glyph-face glyph 'modeline-buffer-id)
88 glyph))
89 "Cute little logo to put in the modeline of MH-E buffers."))
90
91(provide 'mh-xemacs-compat)
92
93;;; Local Variables:
94;;; indent-tabs-mode: nil
95;;; sentence-end-double-space: nil
96;;; End:
97
98;;; arch-tag: f531e3cc-98ba-4f9f-b6a1-e282173a6aa9
99;;; mh-xemacs-compat.el ends here
diff --git a/lisp/mh-e/mh-xemacs-icons.el b/lisp/mh-e/mh-xemacs-icons.el
deleted file mode 100644
index 7c4947df2fa..00000000000
--- a/lisp/mh-e/mh-xemacs-icons.el
+++ /dev/null
@@ -1,1307 +0,0 @@
1;;; mh-xemacs-icons.el --- icons for the MH-E toolbars under XEmacs
2;;
3;; Copyright (C) 2003 Free Software Foundation, Inc.
4
5;; Author: Various (See below)
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail toolbar
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;; This file contains the toolbar icons that MH-E uses under XEmacs. Some
30;; icons were created for MH-E and others were copied from other Emacs modes.
31;; The XPM files are copied into defconst's and the background colour is
32;; changed.
33
34;; The alist `mh-xemacs-icon-map' contains a map of the icon file names under
35;; GNU Emacs to the constant name under XEmacs. To add new icons for XEmacs
36;; this variable should be updated as well.
37
38;;; Change Log:
39
40;;; Code:
41
42;; Avoid compiler warning
43(eval-and-compile
44 (require 'mh-utils)
45 (defvar mh-xemacs-toolbar-folder-toolbar nil)
46 (defvar mh-xemacs-toolbar-letter-toolbar nil))
47
48
49
50;; Define the toolbar icons.
51
52;; Derived From lisp/toolbar/mail.xpm
53(defconst mh-xemacs-toolbar-inc-folder-icon
54 (mh-funcall-if-exists toolbar-make-button-list
55 "/* XPM */
56static char *magick[] = {
57/* columns rows colors chars-per-pixel */
58\"24 24 5 1\",
59\" c Gray0\",
60\". c #673e666663d4\",
61\"X c #a852a7bea3d2\",
62\"o c #eb46ea1de471\",
63\"O c Gray75 s backgroundToolBarColor\",
64/* pixels */
65\"OOOOOOOOOOOOOOOOOOOOOOOO\",
66\"OOOOOOOOOOOOOOOOOOOOOOOO\",
67\"OOOOOOOOOOOOOOOOOOOOOOOO\",
68\"OOOOOOOOOOOOOOOOOOOOOOOO\",
69\"OOOOOOOOOOOOOOOOOOOOOOOO\",
70\"OOOOOOOOOOOOOO OOOOOO\",
71\"OOOOOOOOO .ooX OOOOO\",
72\"OOOO .XooooooX OOOOO\",
73\"OOO .Xoooooooooo.XX OOOO\",
74\"OOO o..ooooooooX.Xo OOOO\",
75\"OOO XoX..oooooo.Xoo OOOO\",
76\"OOOO oooXX.Xoo...ooX OOO\",
77\"OOOO oooooXX..XoX.Xo OOO\",
78\"OOOO Xoooo.ooooooo.X OOO\",
79\"OOOOO oooXXoooooooo.X OO\",
80\"OOOOO ooo.oooooooooX OO\",
81\"OOOOO XoXXooooooX OOOO\",
82\"OOOOOO o.ooooX OOOOOOO\",
83\"OOOOOO .XoX OOOOOOOOOO\",
84\"OOOOOO .. OOOOOOOOOOOOO\",
85\"OOOOOOO OOOOOOOOOOOOOOO\",
86\"OOOOOOOOOOOOOOOOOOOOOOOO\",
87\"OOOOOOOOOOOOOOOOOOOOOOOO\",
88\"OOOOOOOOOOOOOOOOOOOOOOOO\"};")
89 "*MH inc folder icon.")
90
91;; Derived from lisp/toolbar/attach.pbm
92(defconst mh-xemacs-toolbar-mime-save-parts-icon
93 (mh-funcall-if-exists toolbar-make-button-list
94 "/* XPM */
95static char * file[] = {
96\"24 24 2 1\",
97\". c Gray75 s backgroundToolBarColor\",
98\" c black\",
99/* pixels */
100\"........................\",
101\"........................\",
102\"........................\",
103\"........... ...........\",
104\".......... .. ..........\",
105\"......... .... .........\",
106\"......... .... .........\",
107\"......... .... .........\",
108\"......... . .. .........\",
109\"......... . .. .........\",
110\"......... . .. . .......\",
111\"......... . .. . .......\",
112\"......... . .. . .......\",
113\"......... . .. . .......\",
114\"......... . .. . .......\",
115\"......... . .. . .......\",
116\"......... . .. . .......\",
117\"......... .. .. .......\",
118\".......... .... ........\",
119\"........... .. .........\",
120\"............ ..........\",
121\"........................\",
122\"........................\",
123\"........................\"};")
124 "*MH save MIME parts icon.")
125
126;; Derived from lisp/toolbar/right_arrow.xpm
127(defconst mh-xemacs-toolbar-next-undeleted-msg-icon
128 (mh-funcall-if-exists toolbar-make-button-list
129 "/* XPM */
130static char * right_arrow_xpm[] = {
131\"24 24 9 1\",
132\" c Gray75 s backgroundToolBarColor\",
133\". c #020202\",
134\"+ c #1A1A1A\",
135\"@ c #779D6D\",
136\"# c #88AE80\",
137\"$ c #97B78B\",
138\"% c #9EBA92\",
139\"& c #E9EFE8\",
140\"* c #3C5936\",
141\" \",
142\" \",
143\" \",
144\" \",
145\" \",
146\" .. \",
147\" .&.. \",
148\" .&&&.. \",
149\" .&&&&&.. \",
150\" .&&&&&&&.. \",
151\" .&&&&&&&&&+. \",
152\" +&&&&&&&&&&%.. \",
153\" .%#######@@*.. \",
154\" .%#####@@*.. \",
155\" .%###@@*.. \",
156\" .$#@@*.. \",
157\" .#@*.. \",
158\" .*.. \",
159\" .. \",
160\" \",
161\" \",
162\" \",
163\" \",
164\" \"};")
165 "*MH previous message icon.")
166
167;; Derived from mh-e/page-down.xpm
168(defconst mh-xemacs-toolbar-page-msg-icon
169 (mh-funcall-if-exists toolbar-make-button-list
170 "/* XPM */
171static char * mail_page_xpm[] = {
172/* columns rows colors chars-per-pixel */
173\"24 24 5 1\",
174\" c Gray75 s backgroundToolBarColor\",
175\". c black\",
176\"X c #ea03ea03d271\",
177\"o c #a5d8a5d89550\",
178\"O c #d305d305bc3c\",
179/* pixels */
180\" \",
181\" \",
182\" .................. \",
183\" .XXXXXXXXXXXXXXXX. \",
184\" .XXXXXXXXXXXXXXXX. \",
185\" .XoooooooooooooXX. \",
186\" .XXXXXXXXXXXXXXXX. \",
187\" .XXXXXXXXXXXXXXXX. \",
188\" .Xoooooooooo..oXX. \",
189\" .XXXXXXXXXXX..XXX. \",
190\" .XXXXXXXXXXX..XXX. \",
191\" .XooooooXXXX..XXX. \",
192\" .XXXXXXXXXXX..XXX. \",
193\" .XXXXXXXXX.O..O.X. \",
194\" .Xoooooooo.....XX. \",
195\" .XXXXXXXXXX....XX. \",
196\" .XXXXXXXXXXX..XXX. \",
197\" .XXXXXXXXXXXooXXX. \",
198\" .XXXXXXXXXXXXXXXX. \",
199\" .XXXXXXXXXXXXXXXX. \",
200\" .................. \",
201\" \",
202\" \",
203\" \"};")
204 "MH page message icon.")
205
206;; Derived from lisp/toolbar/left_arrow.xpm
207(defconst mh-xemacs-toolbar-previous-undeleted-msg-icon
208 (mh-funcall-if-exists toolbar-make-button-list
209 "/* XPM */
210static char * left_arrow_xpm[] = {
211\"24 24 9 1\",
212\" c Gray75 s backgroundToolBarColor\",
213\". c #020202\",
214\"+ c #121A12\",
215\"@ c #78A16E\",
216\"# c #86AD7D\",
217\"$ c #B2C6AE\",
218\"% c #263222\",
219\"& c #E7EDE6\",
220\"* c #497241\",
221\" \",
222\" \",
223\" \",
224\" \",
225\" \",
226\" .. \",
227\" ..$. \",
228\" ..&&$. \",
229\" ..&&&&$. \",
230\" ..&&&&&&$. \",
231\" .+&&&&&&&&$. \",
232\" ..$&&&&&&&&&$% \",
233\" ..**@@@#####@. \",
234\" ..**@#@###@. \",
235\" ..**@#@#@. \",
236\" ..**@@@. \",
237\" ..*@*. \",
238\" ..*. \",
239\" .. \",
240\" \",
241\" \",
242\" \",
243\" \",
244\" \"};")
245 "MH next message icon.")
246
247;; Derived from lisp/toolbar/close.xpm
248(defconst mh-xemacs-toolbar-delete-msg-icon
249 (mh-funcall-if-exists toolbar-make-button-list
250 "/* XPM */
251static char *magick[] = {
252/* columns rows colors chars-per-pixel */
253\"24 24 2 1\",
254\" c Gray0\",
255\". c Gray75 s backgroundToolBarColor\",
256/* pixels */
257\"........................\",
258\"........................\",
259\"........................\",
260\"........................\",
261\"........................\",
262\"........................\",
263\"....... .... ..........\",
264\"....... .. .........\",
265\"........ . ..........\",
266\"........ ...........\",
267\"......... ............\",
268\"......... ...........\",
269\"........ ..........\",
270\"........ . .........\",
271\"....... ... ........\",
272\"....... ..... .........\",
273\"........................\",
274\"........................\",
275\"........................\",
276\"........................\",
277\"........................\",
278\"........................\",
279\"........................\",
280\"........................\"};")
281 "MH delete message icon.")
282
283;; Derived from mh-e/refile.xpm
284(defconst mh-xemacs-toolbar-refile-msg-icon
285 (mh-funcall-if-exists toolbar-make-button-list
286"/* XPM */
287static char * refile_xpm[] = {
288/* columns rows colors chars-per-pixel */
289\"24 24 7 1\",
290\" c Gray75 s backgroundToolBarColor\",
291\". c black\",
292\"X c #a5d8a5d89550\",
293\"o c #d305d305bc3c\",
294\"O c #ea03ea03d271\",
295\"+ c #828282827474\",
296\"@ c #61b761b7600a\",
297/* pixels */
298\" . \",
299\" ..X. \",
300\" ..XoO.... \",
301\" ..XooooO.+. \",
302\" ..XooooooOX.. .. \",
303\" .@@ooooooOOO@. ... \",
304\" .O@oooooOOOOO..@@. \",
305\" .OO@oooOOOOOO..@@. \",
306\" ...OO@XooOOOOO...@@. \",
307\" ..+.O@XooOOOO..@@@@@. \",
308\" .++..XooOOOO..@@@@@@. \",
309\" .++.@oooOO...@@@@@@@. \",
310\" ..+.XooOOO..@@@@@@@. \",
311\" .++.OOOO.@@@@@@@@. \",
312\" .+.oOO..@@@@@@@. \",
313\" .++.OO.@@@@@@@. \",
314\" .++.O.@@@@@.. \",
315\" ..+.O.@@@@@. \",
316\" .++..@@@@. \",
317\" ..++.@@@. \",
318\" .+.@@. \",
319\" ...@. \",
320\" ... \",
321\" . \"};")
322 "MH refile message icon.")
323
324;; Derived from lisp/toolbar/undo.xpm
325(defconst mh-xemacs-toolbar-undo-icon
326 (mh-funcall-if-exists toolbar-make-button-list
327 "/* XPM */
328static char *magick[] = {
329/* columns rows colors chars-per-pixel */
330\"24 24 5 1\",
331\" c Gray0\",
332\". c #ae6e66e76a0a\",
333\"X c #c6c67d7d8181\",
334\"o c #e4e4e4e4dcdc\",
335\"O c Gray75 s backgroundToolBarColor\",
336/* pixels */
337\"OOOOOOOOOOOOOOOOOOOOOOOO\",
338\"OOOOOOOOOOOOOOOOOOOOOOOO\",
339\"OOOOOOOOOOOOOOOOOOOOOOOO\",
340\"OOOOOOOOOOOOOOOOOOOOOOOO\",
341\"OOOOOOOOOOOOOOOOOOOOOOOO\",
342\"OOOOOOOOOOOOOOOOOOOOOOOO\",
343\"OOOOOOOOO OOOOOOOOOOOOOO\",
344\"OOOOOOOO OOOOOOOOOOOOOO\",
345\"OOOOOOO oX OOOOOOOOOOO\",
346\"OOOOOO ooooX. OOOOOOOOO\",
347\"OOOOOOO oo .. OOOOOOOO\",
348\"OOOOOOOO OOO . OOOOOOOO\",
349\"OOOOOOOOO OOOO . OOOOOOO\",
350\"OOOOOOOOOOOOOOO OOOOOOO\",
351\"OOOOOOOOOOOOOOO OOOOOOO\",
352\"OOOOOOOOOOOOOOO OOOOOOOO\",
353\"OOOOOOOOOOOOOO OOOOOOOOO\",
354\"OOOOOOOOOOOOOOOOOOOOOOOO\",
355\"OOOOOOOOOOOOOOOOOOOOOOOO\",
356\"OOOOOOOOOOOOOOOOOOOOOOOO\",
357\"OOOOOOOOOOOOOOOOOOOOOOOO\",
358\"OOOOOOOOOOOOOOOOOOOOOOOO\",
359\"OOOOOOOOOOOOOOOOOOOOOOOO\",
360\"OOOOOOOOOOOOOOOOOOOOOOOO\"};")
361 "MH undo icon.")
362
363;; Derived from mh-e/execute.xpm
364(defconst mh-xemacs-toolbar-execute-commands-icon
365 (mh-funcall-if-exists toolbar-make-button-list
366 "/* XPM */
367static char * mail_exec_xpm[] = {
368/* columns rows colors chars-per-pixel */
369\"24 24 6 1\",
370\" c Gray75 s backgroundToolBarColor\",
371\". c black\",
372\"X c #a5d8a5d89550\",
373\"o c #d305d305bc3c\",
374\"O c #ea03ea03d271\",
375\"+ c white\",
376/* pixels */
377\" \",
378\" \",
379\" \",
380\" .. \",
381\" XX .. \",
382\" oo XX .. \",
383\" OO oo XX .. \",
384\" OO oo XX .. \",
385\" OO oo XX .. \",
386\" OO oo XX .. \",
387\" OO oo XX .. \",
388\" OO oo XX .. \",
389\" OO oo XX .. \",
390\" OO oo XX \",
391\" OO oo \",
392\" OO + .. \",
393\" XX .. \",
394\" oo XX \",
395\" OO oo \",
396\" OO \",
397\" \",
398\" \",
399\" \",
400\" \"};")
401 "MH execute commands icon.")
402
403;; Derived from mh-e/highlight.xpm
404(defconst mh-xemacs-toolbar-toggle-tick-icon
405 (mh-funcall-if-exists toolbar-make-button-list
406 "/* XPM */
407static char * highlight_xpm[] = {
408/* columns rows colors chars-per-pixel */
409\"24 24 4 1\",
410\" c Gray75 s backgroundToolBarColor\",
411\". c black\",
412\"X c #828282827474\",
413\"o c #dd00df007e00\",
414/* pixels */
415\" ..... \",
416\" ..XXX.. \",
417\" .XXXXX. \",
418\" .XXXXX.. \",
419\" .XXXXX. \",
420\" .XXXXX. \",
421\" .XXXXX. \",
422\" .ooXX. \",
423\" ..ooo. \",
424\" oooo .... \",
425\"oo.ooo....oo ... \",
426\"o.o.ooo.oo.o.ooo.o \",
427\".ooo.oo.oo.o.ooooo \",
428\".ooo.oo.oo.o.ooooo \",
429\".ooo.oo...oo.ooooo \",
430\".....oo.oo.o.ooooo \",
431\".ooo.oo.oo.o.ooooo \",
432\".ooo.oo.oo.o.ooo.o \",
433\". oo.o....ooo...o \",
434\" oo oooo \",
435\" \",
436\" \",
437\" \",
438\" \"};")
439 "MH toggle tick icon.")
440
441;; Derived from mh-e/show.xpm
442(defconst mh-xemacs-toolbar-toggle-showing-icon
443 (mh-funcall-if-exists toolbar-make-button-list
444 "/* XPM */
445static char * mail_show_xpm[] = {
446/* columns rows colors chars-per-pixel */
447\"24 24 4 1\",
448\" c Gray75 s backgroundToolBarColor\",
449\". c black\",
450\"X c #ea03ea03d271\",
451\"o c #a5d8a5d89550\",
452/* pixels */
453\" \",
454\" \",
455\" .................. \",
456\" .XXXXXXXXXXXXXXXX. \",
457\" .XXXXXXXXXXXXXXXX. \",
458\" .XoooooooooooooXX. \",
459\" .XXXXXXXXXXXXXXXX. \",
460\" .XXXXXXXXXXXXXXXX. \",
461\" .XoooooooooooooXX. \",
462\" .XXXXXXXXXXXXXXXX. \",
463\" .XXXXXXXXXXXXXXXX. \",
464\" .XooooooXXXXXXXXX. \",
465\" .XXXXXXXXXXXXXXXX. \",
466\" .XXXXXXXXXXXXXXXX. \",
467\" .XoooooooooXXXXXX. \",
468\" .XXXXXXXXXXXXXXXX. \",
469\" .XXXXXXXXXXXXXXXX. \",
470\" .XXXXXXXXXXXXXXXX. \",
471\" .XXXXXXXXXXXXXXXX. \",
472\" .XXXXXXXXXXXXXXXX. \",
473\" .................. \",
474\" \",
475\" \",
476\" \"};")
477 "MH toggle showing icon.")
478
479;; Derived from mh-e/reply-all.xpm
480(defconst mh-xemacs-toolbar-reply-all-icon
481 (mh-funcall-if-exists toolbar-make-button-list
482 "/* XPM */
483static char * reply_all_xpm[] = {
484/* columns rows colors chars-per-pixel */
485\"24 24 9 1\",
486\" c Gray75 s backgroundToolBarColor\",
487\". c black\",
488\"X c #673e666663d4\",
489\"o c #eb46ea1de471\",
490\"O c #a852a7bea3d2\",
491\"+ c #ae51c17b9b26\",
492\"@ c #8d4d97577838\",
493\"# c #7c7c8b8b6e6e\",
494\"$ c #5e0868be52d3\",
495/* pixels */
496\" \",
497\" \",
498\" .... \",
499\" .....XooO. \",
500\" .....XOooooooO. \",
501\" .XOooooooooooXOO. \",
502\" .oXXooooooooOXOo. \",
503\" .OoOXXooooooXOoo. \",
504\" .oooOOXOooXXXooO. \",
505\" ........XXOoOXOo. \",
506\" ..++++@.ooooooXO. \",
507\" ..+@@@.oooooooXO. \",
508\" ..+@@@#.oooooooO.. \",
509\" ..++@@@#$.ooooO... \",
510\" .++++@@#.$ .. \",
511\" .+@@@#.o .. .O .O \",
512\" .+@#$. .O. .O .O \",
513\" .#$. .O .o .O .O \",
514\" .$. . .O .O .O \",
515\" . ....O .O .O \",
516\" .O .O .O .O \",
517\" .O .O .O .O \",
518\" .O .O .O .O \",
519\" \"};")
520 "Reply to \"All\" icon.")
521
522;; Derived from mh-e/reply-from.xpm
523(defconst mh-xemacs-toolbar-reply-from-icon
524 (mh-funcall-if-exists toolbar-make-button-list
525 "/* XPM */
526static char * reply_from_xpm[] = {
527/* columns rows colors chars-per-pixel */
528\"24 24 9 1\",
529\" c Gray75 s backgroundToolBarColor\",
530\". c black\",
531\"X c #673e666663d4\",
532\"o c #eb46ea1de471\",
533\"O c #a852a7bea3d2\",
534\"+ c #ae51c17b9b26\",
535\"@ c #8d4d97577838\",
536\"# c #7c7c8b8b6e6e\",
537\"$ c #5e0868be52d3\",
538/* pixels */
539\" \",
540\" \",
541\" .... \",
542\" .....XooO. \",
543\" .....XOooooooO. \",
544\" .XOooooooooooXOO. \",
545\" .oXXooooooooOXOo. \",
546\" .OoOXXooooooXOoo. \",
547\" .oooOOXOooXXXooO. \",
548\" ........XXOoOXOo. \",
549\" ..++++@.ooooooXO. \",
550\" ..+@@@.oooooooXO. \",
551\" ..+@@@#.oooooooO.. \",
552\" ..++@@@#$.ooooO... \",
553\" #.$.oO... \",
554\" ...O . .... \",
555\" ...O \",
556\" .O \",
557\" ...O ..O .... .O O. \",
558\" ...O ..O .OO. ..... \",
559\" .O .O . . . . . \",
560\" .O .O .OO. . . . \",
561\" .O .O .... . O . \",
562\" \"};")
563 "Reply to \"From\" icon..")
564
565;; Derived from mh-e/reply-to.xpm
566(defconst mh-xemacs-toolbar-reply-to-icon
567 (mh-funcall-if-exists toolbar-make-button-list
568 "/* XPM */
569static char * reply_to_xpm[] = {
570/* columns rows colors chars-per-pixel */
571\"24 24 9 1\",
572\" c Gray75 s backgroundToolBarColor\",
573\". c black\",
574\"X c #673e666663d4\",
575\"o c #eb46ea1de471\",
576\"O c #a852a7bea3d2\",
577\"+ c #ae51c17b9b26\",
578\"@ c #8d4d97577838\",
579\"# c #7c7c8b8b6e6e\",
580\"$ c #5e0868be52d3\",
581/* pixels */
582\" \",
583\" \",
584\" .... \",
585\" .....XooO. \",
586\" .....XOooooooO. \",
587\" .XOooooooooooXOO. \",
588\" .oXXooooooooOXOo. \",
589\" .OoOXXooooooXOoo. \",
590\" .oooOOXOooXXXooO. \",
591\" ........XXOoOXOo. \",
592\" ..++++@.ooooooXO. \",
593\" ..+@@@.oooooooXO. \",
594\" ..+@@@#.oooooooO.. \",
595\" ..++@@@#$.ooooO... \",
596\" .++++@@#.$ \",
597\" .+@@@#.o ...... \",
598\" .+@#$. OO.OOO \",
599\" .#$. .O \",
600\" .$. .O .... \",
601\" . .O .OO. \",
602\" .O . . \",
603\" .O .OO. \",
604\" .O .... \",
605\" \"};")
606 "Reply to \"To\" icon..")
607
608;; Derived from mh-e/mail/reply2.xpm
609(defconst mh-xemacs-toolbar-reply-icon
610 (mh-funcall-if-exists toolbar-make-button-list
611 "/* XPM */
612static char * mail_reply_xpm[] = {
613/* columns rows colors chars-per-pixel */
614\"24 24 9 1\",
615\" c Gray75 s backgroundToolBarColor\",
616\". c black\",
617\"X c #673e666663d4\",
618\"o c #eb46ea1de471\",
619\"O c #a852a7bea3d2\",
620\"+ c #ae51c17b9b26\",
621\"@ c #8d4d97577838\",
622\"# c #7c7c8b8b6e6e\",
623\"$ c #5e0868be52d3\",
624/* pixels */
625\" \",
626\" \",
627\" \",
628\" \",
629\" \",
630\" .... \",
631\" .....XooO. \",
632\" .....XOooooooO. \",
633\" .XOooooooooooXOO. \",
634\" .oXXooooooooOXOo. \",
635\" .OoOXXooooooXOoo. \",
636\" .oooOOXOooXXXooO. \",
637\" ........XXOoOXOo. \",
638\" ..++++@.ooooooXO. \",
639\" ..+@@@.oooooooXO. \",
640\" ..+@@@#.oooooooO.. \",
641\" ..++@@@#$.ooooO... \",
642\" .++++@@#.$.oO... \",
643\" .+@@@#.o.... \",
644\" .+@#$... \",
645\" .#$. \",
646\" .$. \",
647\" . \",
648\" \"};")
649 "Reply to current message icon.")
650
651;; Derived from mh-e/alias.xpm
652(defconst mh-xemacs-toolbar-alias-grab-from-field-icon
653 (mh-funcall-if-exists toolbar-make-button-list
654 "/* XPM */
655static char * alias_xpm[] = {
656/* columns rows colors chars-per-pixel */
657\"24 24 4 1\",
658\" c Gray75 s backgroundToolBarColor\",
659\". c #61b761b7600a\",
660\"X c #a5d8a5d89550\",
661\"o c black\",
662/* pixels */
663\" \",
664\" \",
665\" \",
666\" ...... \",
667\" ...XXXX..XX \",
668\" o..ooooooo... \",
669\" ooo oooo..X \",
670\" o.X ooo... \",
671\" o.X ooo.XX \",
672\" o.X oo.. \",
673\" o.X oo. \",
674\" o... oo.. \",
675\" o.X o.. \",
676\" o.XX oX. \",
677\" o.... oo. \",
678\" o..XX oooo \",
679\" o...XXX XXoooo \",
680\" ooo........ooooo \",
681\" oooooXXooooo.oo \",
682\" ooo o..oo\",
683\" o...\",
684\" ooo\",
685\" oo\",
686\" \"};")
687 "MH alias grab from field icon.")
688
689;; Derived from toolbar/mail_send.xpm
690(defconst mh-xemacs-toolbar-send-icon
691 (mh-funcall-if-exists toolbar-make-button-list
692 "/* XPM */
693static char *magick[] = {
694/* columns rows colors chars-per-pixel */
695\"24 24 9 1\",
696\" c Gray0\",
697\". c #757560602020\",
698\"X c #6711662663d9\",
699\"o c #8e8e7d7d4545\",
700\"O c #adad8e8e3030\",
701\"+ c #d8d8bebe6a6a\",
702\"@ c #a8fba84da483\",
703\"# c #eb79ea70e4f4\",
704\"$ c Gray75 s backgroundToolBarColor\",
705/* pixels */
706\"$$$$$$$$$$$$$$$$$$$$$$$$\",
707\"$$$$$$$$$$$$$$$$$$$$$$$$\",
708\"$$$$$$$$$$$$$ $$$$$$$\",
709\"$$$$$$$$ X##@ $$$$$$\",
710\"$$$ X@######@ $$$$$$\",
711\"$$ X@##########X@@ $$$$$\",
712\"$$ #XX########@X@# $$$$$\",
713\"$$ @#@XX######X@## $$$$$\",
714\"$$$ ###@@X@##XXX##@ $ $$\",
715\"$$$ #####@@XX@#@X@# + $\",
716\"$$$ @####X#######X@ +o $\",
717\"$$$$ ###@@######## +o $$\",
718\"$$$$ ###X######## +o $$$\",
719\"$$$$ @#@@######@ +o $$$$\",
720\"$$$$$ #X####@ +o $$$$$\",
721\"$$$$$ X@#@ $ +o $$$$$$\",
722\"$$$$$ XX $$$ +o $$$$$$$\",
723\"$$$$$$ $$$$ +o $$$$$$$$\",
724\"$$$$$$$$$$$O. $$$$$$$$$\",
725\"$$$$$$$$$$$ $$$$$$$$$$$\",
726\"$$$$$$$$$$$$$$$$$$$$$$$$\",
727\"$$$$$$$$$$$$$$$$$$$$$$$$\",
728\"$$$$$$$$$$$$$$$$$$$$$$$$\",
729\"$$$$$$$$$$$$$$$$$$$$$$$$\"};")
730 "MH send icon.")
731
732;; Derived from mh-e/rescan.xpm
733(defconst mh-xemacs-toolbar-rescan-folder-icon
734 (mh-funcall-if-exists toolbar-make-button-list
735 "/* XPM */
736static char * mail_rescan_xpm[] = {
737/* columns rows colors chars-per-pixel */
738\"24 24 6 1\",
739\" c Gray75 s backgroundToolBarColor\",
740\". c black\",
741\"X c #a5d8a5d89550\",
742\"o c #d305d305bc3c\",
743\"O c #ea03ea03d271\",
744\"+ c #828282827474\",
745/* pixels */
746\" \",
747\" \",
748\" .............. \",
749\" .XXXXXXXXXXXX.. \",
750\" .XXXXXXXXXXXX.X. \",
751\" .XXXXXXXXXXXX.oo. \",
752\" ..............ooo. \",
753\" .OOOOOOOOOOOO.ooo. \",
754\" .O++++++++++O.ooo. \",
755\" .O+XXXXXXXX+O.ooo. \",
756\" .O+XXXXXXXX+O.ooo. \",
757\" .O+XXXXXXXX+O.ooo. \",
758\" .O+XXXXXXXX+O.ooo. \",
759\" .O++++++++++O.ooo. \",
760\" .OOOOOOOOOOOO.ooo. \",
761\" .O++++++++++O.ooo. \",
762\" .O+XXXXXXXX+O.ooo. \",
763\" .O+XXXXXXXX+O.ooX. \",
764\" .O+XXXXXXXX+O.oo.. \",
765\" .O++++++++++O.o.. \",
766\" ..OOOOOOOOOOOO... \",
767\" ................ \",
768\" \",
769\" \"};")
770 "MH rescan folder icon.")
771
772;; Derived from mh-e/repack.xpm
773(defconst mh-xemacs-toolbar-pack-folder-icon
774 (mh-funcall-if-exists toolbar-make-button-list
775 "/* XPM */
776static char * mail_repack_xpm[] = {
777/* columns rows colors chars-per-pixel */
778\"24 24 6 1\",
779\" c Gray75 s backgroundToolBarColor\",
780\". c black\",
781\"X c #a5d8a5d89550\",
782\"o c #d305d305bc3c\",
783\"O c #ea03ea03d271\",
784\"+ c #828282827474\",
785/* pixels */
786\" \",
787\" \",
788\" .............. \",
789\" .XXXXXXXXXXXX.. \",
790\" .XXXXXXXXXXXX.X. \",
791\" .XXXXXXXXXXXX.oo. \",
792\" ..............ooo. \",
793\" .OOOOOOOOOOOO.oo. \",
794\" .O++++++++++O.oo. \",
795\" .O+XXXXXXXX+O.o. \",
796\" .+XXXXXXXX+.o.. \",
797\" .+XX...XXX+.... \",
798\" ....o.......oo. \",
799\" ....o.....Oooo. \",
800\" .OOO...OOOO.oooo. \",
801\" .++++++++++.oooo. \",
802\" .+XXXXXXXX+.oooo. \",
803\" .O+XXXXXXXX+O.ooX. \",
804\" .O+XXXXXXXX+O.oo.. \",
805\" .O++++++++++O.o.. \",
806\" ..OOOOOOOOOOOO... \",
807\" ................ \",
808\" \",
809\" \"};")
810 "MH repack folder icon.")
811
812;; Derived from lisp/toolbar/search.xpm
813(defconst mh-xemacs-toolbar-search-icon
814 (mh-funcall-if-exists toolbar-make-button-list
815 "/* XPM */
816static char *magick[] = {
817/* columns rows colors chars-per-pixel */
818\"24 24 8 1\",
819\" c #011801180102\",
820\". c #464646463e3e\",
821\"X c #5c5c5c5c57a0\",
822\"o c #878787877979\",
823\"O c #a910a91097af\",
824\"+ c #ce5ace5ab851\",
825\"@ c #e79de79dd134\",
826\"# c Gray75 s backgroundToolBarColor\",
827/* pixels */
828\"########################\",
829\"########################\",
830\"############# ##########\",
831\"########### O #########\",
832\"######### O@@.#########\",
833\"####### O@@@@@ ########\",
834\"##### O+@@@@@@O #######\",
835\"#### XX@++@@@@@@.#######\",
836\"#### @.O+@@@@@@@@ ######\",
837\"#### @@.++@@@@@@@O #####\",
838\"#### @@.o+O. .+@@ #####\",
839\"#### @XO+O.O++o.+@@ ####\",
840\"#### O+@.O@@+Oo.@@+ ###\",
841\"#### X@@@ +#+OOO @@@@ ##\",
842\"#### O@@@ +@OOOo @@@o ##\",
843\"##### @@@.oOOOoX.@@ ###\",
844\"##### O@@O.oOOX @ #####\",
845\"######X@@@O. .X ######\",
846\"###### @@@@@@@+ #####\",
847\"####### @@@@@O ## ####\",
848\"####### O@@+. #### ###\",
849\"######## @O ####### ###\",
850\"######### #############\",
851\"########################\"};")
852 "MH search icon.")
853
854;; Derived from lisp/toolbar/fld_open.xpm
855(defconst mh-xemacs-toolbar-visit-folder-icon
856 (mh-funcall-if-exists toolbar-make-button-list
857 "/* XPM */
858static char *magick[] = {
859/* columns rows colors chars-per-pixel */
860\"24 24 4 1\",
861\" c Gray0\",
862\". c #909090909090\",
863\"X c #fefefefefefe\",
864\"o c Gray75 s backgroundToolBarColor\",
865/* pixels */
866\"oooooooooooooooooooooooo\",
867\"oooooooooooooooooooooooo\",
868\"oooooooooooooooooooooooo\",
869\"oooooooooooooooooooooooo\",
870\"oooooooooooooooooooooooo\",
871\"oooooooooooooo oooooooo\",
872\"ooooooooooo .. ooooooo\",
873\"oooo oo ....XXo ooo\",
874\"ooo .. ....XXXX .. ooo\",
875\"ooo .....XXXXX .... ooo\",
876\"oooo ..XXXXX ...... ooo\",
877\"oooo ..XXX ........ ooo\",
878\"ooooo .XX .......... ooo\",
879\"ooooo ..X .......... ooo\",
880\"oooooo .X .......... ooo\",
881\"oooooo .. ........ oooo\",
882\"ooooooo . ...... oooooo\",
883\"ooooooo . ..... oooooooo\",
884\"oooooooo ... ooooooooo\",
885\"oooooooo . ooooooooooo\",
886\"ooooooooo ooooooooooooo\",
887\"oooooooooooooooooooooooo\",
888\"oooooooooooooooooooooooo\",
889\"oooooooooooooooooooooooo\"};")
890 "MH visit folder icon.")
891
892;; Derived from lisp/toolbar/help.xpm
893(defconst mh-xemacs-toolbar-help-icon
894 (mh-funcall-if-exists toolbar-make-button-list
895 "/* XPM */
896static char *magick[] = {
897/* columns rows colors chars-per-pixel */
898\"24 24 6 1\",
899\" c Gray0\",
900\". c #65658b8b5e5e\",
901\"X c #934ab2448dfb\",
902\"o c #b35dc8c8afaf\",
903\"O c #e0b2e944df83\",
904\"+ c Gray75 s backgroundToolBarColor\",
905/* pixels */
906\"++++++++++++++++++++++++\",
907\"++++++++++++++++++++++++\",
908\"++++++++++++++++++++++++\",
909\"++++++++++++++++++++++++\",
910\"+++++++++ ++++++++++\",
911\"++++++++ oOOOO +++++++++\",
912\"+++++++ OOOOOOO ++++++++\",
913\"++++++ oOo oOo +++++++\",
914\"+++++++ O +++ OO +++++++\",
915\"+++++++O ++++ Oo +++++++\",
916\"++++++++++++ OO. +++++++\",
917\"+++++++++++ OOX ++++++++\",
918\"++++++++++ OOX +++++++++\",
919\"+++++++++ XOX ++++++++++\",
920\"+++++++++ OX +++++++++++\",
921\"+++++++++ +++++++++++\",
922\"++++++++++++++++++++++++\",
923\"++++++++++ ++++++++++++\",
924\"+++++++++ Oo +++++++++++\",
925\"+++++++++ oX +++++++++++\",
926\"++++++++++ ++++++++++++\",
927\"++++++++++++++++++++++++\",
928\"++++++++++++++++++++++++\",
929\"++++++++++++++++++++++++\"};")
930 "MH help icon.")
931
932;; Derived from lisp/toolbar/mail_send.xpm
933(defconst mh-xemacs-toolbar-send-letter-icon
934 (mh-funcall-if-exists toolbar-make-button-list
935 "/* XPM */
936static char *magick[] = {
937/* columns rows colors chars-per-pixel */
938\"24 24 9 1\",
939\" c Gray0\",
940\". c #675e6580613e\",
941\"X c #8c8c7c7c6969\",
942\"o c #9b458d377822\",
943\"O c #a941a6459f3e\",
944\"+ c #c8c8b2b29898\",
945\"@ c #dadac2c2a5a5\",
946\"# c #eb4dea2fe4ad\",
947\"$ c Gray75 s backgroundToolBarColor\",
948/* pixels */
949\"$$$$$$$$$$$$$$$$$$$$$$$$\",
950\"$$$$$$$$$$$$$$$$$$$$$$$$\",
951\"$$$$$$$$$$$$$ $$$$$$$\",
952\"$$$$$$$$ .@#+ $$$$$$\",
953\"$$$ .+#####@O $$$$$$\",
954\"$$ .+##########.+O $$$$$\",
955\"$$ @..########O.+# $$$$$\",
956\"$$ O@O..@#####.+## $$$$$\",
957\"$$$ ###+O.O##...##O $$$$\",
958\"$$$ @####@+..O#O.+# $$$$\",
959\"$$$ O####.#######.O $$$$\",
960\"$$$$ ###+O########.O $$$\",
961\"$$$$ ###.########@O $$$\",
962\"$$$$ +#+O#####@O $$$$$\",
963\"$$$$$ #.###@O $$$$$$\",
964\"$$$$$ .O@O $$ .. $$$$$\",
965\"$$$$$ .. $$$$ .oo. $$$$\",
966\"$$$$$$ $$$$$ oo $$$\",
967\"$$$$$$$$$$$$$$$ Oo $$$$$\",
968\"$$$$$$$$$$$$$$ oOOX $$$$\",
969\"$$$$$$$$$$$$$$ ++++ $$$$\",
970\"$$$$$$$$$$$$$ O@@@@O $$$\",
971\"$$$$$$$$$$$$$ $$$\",
972\"$$$$$$$$$$$$$$$$$$$$$$$$\"};")
973 "MH send letter icon.")
974
975;; This is the same icon as `mh-xemacs-toolbar-mime-save-parts-icon',
976;; so there is no point in duplicating it.
977(defconst mh-xemacs-toolbar-compose-insertion-icon
978 mh-xemacs-toolbar-mime-save-parts-icon
979 "MH compose insertion icon.")
980
981;; Derived from lisp/toolbar/spell.xpm
982(defconst mh-xemacs-toolbar-ispell-message-icon
983 (mh-funcall-if-exists toolbar-make-button-list
984 "/* XPM */
985static char *magick[] = {
986/* columns rows colors chars-per-pixel */
987\"24 24 5 1\",
988\" c Gray0\",
989\". c #41415b5b3939\",
990\"X c #4c2f6b4e42d1\",
991\"o c #5fe086865454\",
992\"O c Gray75 s backgroundToolBarColor\",
993/* pixels */
994\"OOOOOOOOOOOOOOOOOOOOOOOO\",
995\"OOOOOOOOOOOOOOOOOOOOOOOO\",
996\"OOOOOOOOOOOOOOOOOOOOOOOO\",
997\"OOOOOOOOOOOOOOOOOOOOOOOO\",
998\"OOOO OO OOO OOOOOOOO\",
999\"OOO OO O OO O OO OOOOOOO\",
1000\"OOO O OO OOOOOOOOOO\",
1001\"OOO OO O OO O OO OOOOOOO\",
1002\"OOO OO O OOO OOOO OO\",
1003\"OOOOOOOOOOOOOOOOOOO OOO\",
1004\"OOOOOOOOOOO OOOOO OOOO\",
1005\"OOOOOOOOOOO X OOO . OOOO\",
1006\"OOOOOOOOOOOO X O X OOOOO\",
1007\"OOOOOOOOOOOO Xo o. OOOOO\",
1008\"OOOOOOOOOOOOO XoX OOOOOO\",
1009\"OOOOOOOOOOOOO Xo. OOOOOO\",
1010\"OOOOOOOOOOOOOO X OOOOOOO\",
1011\"OOOOOOOOOOOOOO X OOOOOOO\",
1012\"OOOOOOOOOOOOOOO OOOOOOOO\",
1013\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1014\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1015\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1016\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1017\"OOOOOOOOOOOOOOOOOOOOOOOO\"};")
1018 "MH Ispell message icon.")
1019
1020;; Derived from lisp/toolbar/save.xpm
1021(defconst mh-xemacs-toolbar-save-buffer-icon
1022 (mh-funcall-if-exists toolbar-make-button-list
1023 "/* XPM */
1024static char *magick[] = {
1025/* columns rows colors chars-per-pixel */
1026\"24 24 5 1\",
1027\" c #01be01be01be\",
1028\". c #62dd62dd62dd\",
1029\"X c Gray62\",
1030\"o c #e625e625e625\",
1031\"O c Gray75 s backgroundToolBarColor\",
1032/* pixels */
1033\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1034\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1035\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1036\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1037\"OOOOOOOOOOOOO OOOOOOOOO\",
1038\"OOOOOOOOOOO X. OOOOOOOO\",
1039\"OOOOOOOOO oXoX OOOOOOOO\",
1040\"OOOOOOO oXoooXX OOOOOOO\",
1041\"OOOOO oXoooooo. OOOOOOO\",
1042\"OOO XoooooooooX OOOOOO\",
1043\"OO XooooooooooooX OOOOOO\",
1044\"OO .XoooooooooooX. OOOOO\",
1045\"OOO XooooooooooXXX OOOOO\",
1046\"OOO .XoooooooXX..X. OOOO\",
1047\"OOOO XoooooXX...X.X OOOO\",
1048\"OOOO .XooXX.Xoo.X.X. OOO\",
1049\"OOOOO XXX.oooooX.X. OOO\",
1050\"OOOOO .XXoo.ooooXX OOO\",
1051\"OOOOOO XX.o XooX. OOOOO\",
1052\"OOOOOO .XXooXoX OOOOOOO\",
1053\"OOOOOOO .X.oX OOOOOOOOO\",
1054\"OOOOOOOO OOOOOOOOOOO\",
1055\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1056\"OOOOOOOOOOOOOOOOOOOOOOOO\"};")
1057 "MH save buffer icon.")
1058
1059;; Derived from lisp/toolbar/cut.xpm
1060(defconst mh-xemacs-toolbar-kill-region-icon
1061 (mh-funcall-if-exists toolbar-make-button-list
1062 "/* XPM */
1063static char *magick[] = {
1064/* columns rows colors chars-per-pixel */
1065\"24 24 2 1\",
1066\" c Gray0\",
1067\". c Gray75 s backgroundToolBarColor\",
1068/* pixels */
1069\"........................\",
1070\"........................\",
1071\"........................\",
1072\"........................\",
1073\"........................\",
1074\".................. .....\",
1075\"................ ......\",
1076\"............... .......\",
1077\".............. ........\",
1078\"............. .........\",
1079\".... .... ..... ..\",
1080\"... ... .. ... ....\",
1081\"... ... ......\",
1082\".... ... .........\",
1083\".......... ............\",
1084\"......... ............\",
1085\"........ .. ............\",
1086\"....... ... ............\",
1087\"....... .. .............\",
1088\"....... ..............\",
1089\"........................\",
1090\"........................\",
1091\"........................\",
1092\"........................\"};")
1093 "MH kill region icon.")
1094
1095;; Derived from lisp/toolbar/copy.xpm
1096(defconst mh-xemacs-toolbar-kill-ring-save-icon
1097 (mh-funcall-if-exists toolbar-make-button-list
1098 "/* XPM */
1099static char *magick[] = {
1100/* columns rows colors chars-per-pixel */
1101\"24 24 7 1\",
1102\" c Gray0\",
1103\". c #424242423a3a\",
1104\"X c #68e968e96363\",
1105\"o c #a8b1a8b1992b\",
1106\"O c #d3d3d3d3bdbd\",
1107\"+ c #e419e419cd6b\",
1108\"@ c Gray75 s backgroundToolBarColor\",
1109/* pixels */
1110\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1111\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1112\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1113\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1114\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1115\"@@@@@@@@ @@@@@@@@@@@@@@\",
1116\"@@@@@@ Oo @@@@@@@@@@@@@\",
1117\"@@@@ .ooOO @@@@ @@@@@@@\",
1118\"@@@@ +XoOOo @ Oo @@@@@@\",
1119\"@@@@ +.oO++ .ooOO @@@@@@\",
1120\"@@@@ XoO+++ +XoOOo @@@@@\",
1121\"@@@@ oOO+++ +.oO++ @@@@@\",
1122\"@@@@ oO++++ XoOO++o @@@@\",
1123\"@@@@@ +++++ oOO++++o @@@\",
1124\"@@@@@ o++++ oO++++++ @@@\",
1125\"@@@@@@ ++o +++++++o @@\",
1126\"@@@@@@ o @@ o++++o @@@\",
1127\"@@@@@@@ @@@@@ ++o @@@@@\",
1128\"@@@@@@@@@@ @@ o @@@@@@@\",
1129\"@@@@@@@ @@ @@@@@@@@@\",
1130\"@@@@@@@ @@@@@@@@@@@@\",
1131\"@@@@@@@@@@ @@@@@@@@@@@@@\",
1132\"@@@@@@@@@@@@@@@@@@@@@@@@\",
1133\"@@@@@@@@@@@@@@@@@@@@@@@@\"};")
1134 "MH kill ring save icon.")
1135
1136;; Derived from lisp/toolbar/paste.xpm
1137(defconst mh-xemacs-toolbar-yank-icon
1138 (mh-funcall-if-exists toolbar-make-button-list
1139 "/* XPM */
1140static char *magick[] = {
1141/* columns rows colors chars-per-pixel */
1142\"24 24 5 1\",
1143\" c Gray0\",
1144\". c #62ee62ee62ee\",
1145\"X c Gray68\",
1146\"o c Gray82\",
1147\"O c Gray75 s backgroundToolBarColor\",
1148/* pixels */
1149\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1150\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1151\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1152\"OOOOOOOOO OOOOOOOOOOOO\",
1153\"OOOOOOO ooo OOOOOO OOOO\",
1154\"OOOOO ooooo OOO OOO\",
1155\"OOO oo. .Xoo OO OOO\",
1156\"OO ooo.oX..oo OOOOO OOOO\",
1157\"OO ooo.X..oooo OOOOOOOOO\",
1158\"OOO oo..Xooooo O OOOOOO\",
1159\"OOO oooooooooo oX OOOOO\",
1160\"OOOO ooooooo XXoo OOOOO\",
1161\"OOOO ooooooo o.XooX OOOO\",
1162\"OOOOO oooooo o.Xooo OOOO\",
1163\"OOOOO oooooo .XooooX OOO\",
1164\"OOOOOO ooooX XooooooX OO\",
1165\"OOOOOO XXOXX Xooooooo OO\",
1166\"OOOOOOO XXXX oooooooX O\",
1167\"OOOOOOO XX O XooooX OO\",
1168\"OOOOOOOO OOOO ooX OOOO\",
1169\"OOOOOOOOOOOOOO X OOOOOO\",
1170\"OOOOOOOOOOOOOOO OOOOOOOO\",
1171\"OOOOOOOOOOOOOOOOOOOOOOOO\",
1172\"OOOOOOOOOOOOOOOOOOOOOOOO\"};")
1173 "MH yank icon.")
1174
1175;; This is the same icon as `mh-xemacs-toolbar-delete-msg-icon'
1176;; so there is no point in duplicating it here.
1177(defconst mh-xemacs-toolbar-fully-kill-draft-icon
1178 mh-xemacs-toolbar-delete-msg-icon
1179 "MH fully kill draft icon.")
1180
1181;; Derived from lisp/toolbar/preferences.xpm
1182(defconst mh-xemacs-toolbar-preferences-icon
1183 (mh-funcall-if-exists toolbar-make-button-list
1184 "/* XPM */
1185static char * preferences_xpm[] = {
1186\"24 24 8 1\",
1187\" c Gray75 s backgroundToolBarColor\",
1188\". c #000000\",
1189\"+ c #E1E0E0\",
1190\"@ c #D7C99B\",
1191\"# c #9A6C4E\",
1192\"$ c #A4A199\",
1193\"% c #858579\",
1194\"& c #AD8E30\",
1195\" \",
1196\" \",
1197\" \",
1198\" .. \",
1199\" ..++. . \",
1200\" ..++++. .@. \",
1201\" ...+++++++. .@#. \",
1202\" ..++++++++++. .@#. \",
1203\" .++++++#++++++.@#. \",
1204\" .+++++#++++++.@#. \",
1205\" .++#+#+++++.@#. \",
1206\" .++#$#++++.@#.+. \",
1207\" .++##+++.@#.++@. \",
1208\" .++++++.@#.+++@%. \",
1209\" .++++&+..@$$$$%. \",
1210\" .++++..$$$$$$@. \",
1211\" .+$%%$+++++.. \",
1212\" .+++++++++. \",
1213\" .++++++.. \",
1214\" .++++@. \",
1215\" .++.. \",
1216\" .. \",
1217\" \",
1218\" \"};")
1219 "MH preferences icon.")
1220
1221;; This is the same icon as `mh-xemacs-toolbar-help-icon' so there is
1222;; no point in duplicating it here.
1223(defconst mh-xemacs-toolbar-letter-help-icon
1224 mh-xemacs-toolbar-help-icon
1225 "MH letter help icon.")
1226
1227;; Derived from mh-e/widen.xpm
1228(defconst mh-xemacs-toolbar-widen-icon
1229 (mh-funcall-if-exists toolbar-make-button-list
1230 "/* XPM */
1231static char * widen_xpm[] = {
1232/* columns rows colors chars-per-pixel */
1233\"24 24 3 1\",
1234\" c Gray75 s backgroundToolBarColor\",
1235\". c #8d4d97577838\",
1236\"X c black\",
1237/* pixels */
1238\" \",
1239\" \",
1240\" \",
1241\" . . \",
1242\" . . \",
1243\" . . \",
1244\" . . \",
1245\" . . \",
1246\" . XX XX . \",
1247\" . XX XX . \",
1248\" . XX XX . \",
1249\" .XXXXXXXX XXXXXXXX. \",
1250\" .XXXXXXXX XXXXXXXX. \",
1251\" . XX XX . \",
1252\" . XX XX . \",
1253\" . XX XX . \",
1254\" . . \",
1255\" . . \",
1256\" . . \",
1257\" . . \",
1258\" . . \",
1259\" \",
1260\" \",
1261\" \"};")
1262 "MH widen icon.")
1263
1264(defvar mh-xemacs-icon-map
1265 '((mail . mh-xemacs-toolbar-inc-folder-icon)
1266 (attach . mh-xemacs-toolbar-mime-save-parts-icon)
1267 (right_arrow . mh-xemacs-toolbar-next-undeleted-msg-icon)
1268 (page-down . mh-xemacs-toolbar-page-msg-icon)
1269 (left_arrow . mh-xemacs-toolbar-previous-undeleted-msg-icon)
1270 (close . mh-xemacs-toolbar-delete-msg-icon)
1271 (refile . mh-xemacs-toolbar-refile-msg-icon)
1272 (undo . mh-xemacs-toolbar-undo-icon)
1273 (execute . mh-xemacs-toolbar-execute-commands-icon)
1274 (highlight . mh-xemacs-toolbar-toggle-tick-icon)
1275 (show . mh-xemacs-toolbar-toggle-showing-icon)
1276 (reply-from . mh-xemacs-toolbar-reply-from-icon)
1277 (reply-to . mh-xemacs-toolbar-reply-to-icon)
1278 (reply-all . mh-xemacs-toolbar-reply-all-icon)
1279 (mail/reply2 . mh-xemacs-toolbar-reply-icon)
1280 (alias . mh-xemacs-toolbar-alias-grab-from-field-icon)
1281 (mail_compose . mh-xemacs-toolbar-send-icon)
1282 (rescan . mh-xemacs-toolbar-rescan-folder-icon)
1283 (repack . mh-xemacs-toolbar-pack-folder-icon)
1284 (search . mh-xemacs-toolbar-search-icon)
1285 (fld_open . mh-xemacs-toolbar-visit-folder-icon)
1286 (mail_send . mh-xemacs-toolbar-send-letter-icon)
1287 (spell . mh-xemacs-toolbar-ispell-message-icon)
1288 (save . mh-xemacs-toolbar-save-buffer-icon)
1289 (cut . mh-xemacs-toolbar-kill-region-icon)
1290 (copy . mh-xemacs-toolbar-kill-ring-save-icon)
1291 (paste . mh-xemacs-toolbar-yank-icon)
1292 (preferences . mh-xemacs-toolbar-preferences-icon)
1293 (help . mh-xemacs-toolbar-help-icon)
1294 (widen . mh-xemacs-toolbar-widen-icon))
1295 "Map GNU Emacs icon file names to XEmacs image constants.")
1296
1297
1298
1299(provide 'mh-xemacs-icons)
1300
1301;;; Local Variables:
1302;;; indent-tabs-mode: nil
1303;;; sentence-end-double-space: nil
1304;;; End:
1305
1306;;; arch-tag: 5b06d860-a468-4a0f-a61b-255a148985e4
1307;;; mh-xemacs-icons.el ends here
diff --git a/lisp/toolbar/alias.pbm b/lisp/toolbar/alias.pbm
index 239bd793002..cdd42c3632c 100644
--- a/lisp/toolbar/alias.pbm
+++ b/lisp/toolbar/alias.pbm
Binary files differ
diff --git a/lisp/toolbar/execute.pbm b/lisp/toolbar/execute.pbm
index 30a896ea61b..84bcbb38428 100644
--- a/lisp/toolbar/execute.pbm
+++ b/lisp/toolbar/execute.pbm
Binary files differ
diff --git a/lisp/toolbar/highlight.pbm b/lisp/toolbar/highlight.pbm
index 48b499325b1..23394f05e27 100644
--- a/lisp/toolbar/highlight.pbm
+++ b/lisp/toolbar/highlight.pbm
Binary files differ
diff --git a/lisp/toolbar/page-down.pbm b/lisp/toolbar/page-down.pbm
index 3ba647bc3ae..2f577146b63 100644
--- a/lisp/toolbar/page-down.pbm
+++ b/lisp/toolbar/page-down.pbm
Binary files differ
diff --git a/lisp/toolbar/refile.pbm b/lisp/toolbar/refile.pbm
index ce7be76a8f5..64e534ecc89 100644
--- a/lisp/toolbar/refile.pbm
+++ b/lisp/toolbar/refile.pbm
Binary files differ
diff --git a/lisp/toolbar/repack.pbm b/lisp/toolbar/repack.pbm
index 9586096a401..502b1179939 100644
--- a/lisp/toolbar/repack.pbm
+++ b/lisp/toolbar/repack.pbm
Binary files differ
diff --git a/lisp/toolbar/reply-all.pbm b/lisp/toolbar/reply-all.pbm
index 1097a824969..57503cbea7c 100644
--- a/lisp/toolbar/reply-all.pbm
+++ b/lisp/toolbar/reply-all.pbm
Binary files differ
diff --git a/lisp/toolbar/reply-from.pbm b/lisp/toolbar/reply-from.pbm
index 91459a56958..99fad608f30 100644
--- a/lisp/toolbar/reply-from.pbm
+++ b/lisp/toolbar/reply-from.pbm
Binary files differ
diff --git a/lisp/toolbar/reply-to.pbm b/lisp/toolbar/reply-to.pbm
index 95b474867ed..d7dc6391b69 100644
--- a/lisp/toolbar/reply-to.pbm
+++ b/lisp/toolbar/reply-to.pbm
Binary files differ
diff --git a/lisp/toolbar/rescan.pbm b/lisp/toolbar/rescan.pbm
index 2c983ecf65a..a373ee8819c 100644
--- a/lisp/toolbar/rescan.pbm
+++ b/lisp/toolbar/rescan.pbm
Binary files differ
diff --git a/lisp/toolbar/show.pbm b/lisp/toolbar/show.pbm
index 322f13b2c2c..d86b1e6fe77 100644
--- a/lisp/toolbar/show.pbm
+++ b/lisp/toolbar/show.pbm
Binary files differ
diff --git a/lisp/toolbar/widen.pbm b/lisp/toolbar/widen.pbm
index d20d10250dc..2d9780b9959 100644
--- a/lisp/toolbar/widen.pbm
+++ b/lisp/toolbar/widen.pbm
Binary files differ