aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2004-08-27 07:00:34 +0000
committerMiles Bader2004-08-27 07:00:34 +0000
commitb71f2b97d343dd5ec39b64b66de86051ee47eb3e (patch)
tree85e3d906c7ba13a3fd447ad054a430388386b748 /lisp
parent21b4a4fb21f6254fb37da88b0d5858575f953e22 (diff)
parent11d2e01ba3a82c41eec105df81260568f048e726 (diff)
downloademacs-b71f2b97d343dd5ec39b64b66de86051ee47eb3e.tar.gz
emacs-b71f2b97d343dd5ec39b64b66de86051ee47eb3e.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog381
-rw-r--r--lisp/avoid.el82
-rw-r--r--lisp/battery.el2
-rw-r--r--lisp/calendar/time-date.el1
-rw-r--r--lisp/cus-start.el3
-rw-r--r--lisp/cvs-status.el23
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/cl-indent.el2
-rw-r--r--lisp/emacs-lisp/copyright.el44
-rw-r--r--lisp/emacs-lisp/elp.el28
-rw-r--r--lisp/emacs-lisp/lisp-mode.el4
-rw-r--r--lisp/emacs-lisp/re-builder.el30
-rw-r--r--lisp/font-lock.el4
-rw-r--r--lisp/frame.el6
-rw-r--r--lisp/ido.el2
-rw-r--r--lisp/ielm.el6
-rw-r--r--lisp/imenu.el9
-rw-r--r--lisp/international/latin1-disp.el2
-rw-r--r--lisp/isearch.el234
-rw-r--r--lisp/iswitchb.el2
-rw-r--r--lisp/language/cyrillic.el1
-rw-r--r--lisp/log-edit.el14
-rw-r--r--lisp/mail/mail-extr.el1
-rw-r--r--lisp/mh-e/ChangeLog2080
-rw-r--r--lisp/mh-e/mh-acros.el144
-rw-r--r--lisp/mh-e/mh-alias.el207
-rw-r--r--lisp/mh-e/mh-comp.el450
-rw-r--r--lisp/mh-e/mh-customize.el2668
-rw-r--r--lisp/mh-e/mh-e.el529
-rw-r--r--lisp/mh-e/mh-funcs.el97
-rw-r--r--lisp/mh-e/mh-gnus.el36
-rw-r--r--lisp/mh-e/mh-identity.el296
-rw-r--r--lisp/mh-e/mh-inc.el8
-rw-r--r--lisp/mh-e/mh-index.el225
-rw-r--r--lisp/mh-e/mh-init.el308
-rw-r--r--lisp/mh-e/mh-junk.el454
-rw-r--r--lisp/mh-e/mh-loaddefs.el515
-rw-r--r--lisp/mh-e/mh-mime.el298
-rw-r--r--lisp/mh-e/mh-pick.el39
-rw-r--r--lisp/mh-e/mh-print.el279
-rw-r--r--lisp/mh-e/mh-seq.el212
-rw-r--r--lisp/mh-e/mh-speed.el33
-rw-r--r--lisp/mh-e/mh-utils.el743
-rw-r--r--lisp/net/ange-ftp.el25
-rw-r--r--lisp/net/tramp.el65
-rw-r--r--lisp/net/trampver.el2
-rw-r--r--lisp/pcvs-parse.el21
-rw-r--r--lisp/progmodes/ada-xref.el166
-rw-r--r--lisp/progmodes/cc-align.el35
-rw-r--r--lisp/progmodes/cc-cmds.el9
-rw-r--r--lisp/progmodes/cc-defs.el215
-rw-r--r--lisp/progmodes/cc-engine.el290
-rw-r--r--lisp/progmodes/cc-fonts.el114
-rw-r--r--lisp/progmodes/cc-langs.el6
-rw-r--r--lisp/progmodes/cc-styles.el2
-rw-r--r--lisp/progmodes/cc-vars.el146
-rw-r--r--lisp/progmodes/compile.el4
-rw-r--r--lisp/progmodes/meta-mode.el2
-rw-r--r--lisp/progmodes/sh-script.el7
-rw-r--r--lisp/progmodes/which-func.el2
-rw-r--r--lisp/ps-mule.el63
-rw-r--r--lisp/simple.el18
-rw-r--r--lisp/speedbar.el102
-rw-r--r--lisp/startup.el57
-rw-r--r--lisp/subr.el2
-rw-r--r--lisp/term.el9
-rw-r--r--lisp/term/x-win.el3
-rw-r--r--lisp/textmodes/flyspell.el11
-rw-r--r--lisp/textmodes/reftex-auc.el2
-rw-r--r--lisp/textmodes/tex-mode.el15
-rw-r--r--lisp/vc-svn.el13
-rw-r--r--lisp/whitespace.el3
72 files changed, 8019 insertions, 3894 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bf085a50aec..66ef44650d5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,368 @@
12004-08-27 Kenichi Handa <handa@m17n.org>
2
3 * international/utf-8.el (utf-8-post-read-conversion): If the
4 buffer is unibyte, temporarily make it multibyte.
5
62004-08-27 Masatake YAMATO <jet@gyve.org>
7
8 * calendar/time-date.el (time-to-seconds): Add autoload cookies.
9
102004-08-25 John Paul Wallington <jpw@gnu.org>
11
12 * textmodes/tex-mode.el (tex-validate-buffer): Distinguish between
13 0, 1, and many mismatches in message.
14 (tex-start-shell): Use `set-process-query-on-exit-flag'.
15
16 * ielm.el (ielm-tab, ielm-complete-symbol): Doc fix.
17 (inferior-emacs-lisp-mode): Use `set-process-query-on-exit-flag'.
18
192004-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
20
21 * vc-svn.el (vc-svn-diff): Treat options from vc-svn-diff-switches and
22 vc-diff-switches differently.
23
242004-08-22 Luc Teirlinck <teirllm@auburn.edu>
25
26 * speedbar.el (speedbar-file-regexp): Give it a phony defvar
27 before and a real defvar after
28 `speedbar-supported-extension-expressions'. This is to silence
29 the compiler without breaking bootstrapping.
30
312004-08-22 Richard M. Stallman <rms@gnu.org>
32
33 * textmodes/flyspell.el (flyspell-word):
34 Use set-process-query-on-exit-flag.
35 (flyspell-highlight-duplicate-region): Take POSS as arg.
36 (flyspell-word): Pass POSS as arg.
37
38 * progmodes/ada-xref.el: Many doc and style fixes.
39 (ada-find-any-references): Use compilation-start.
40 (ada-get-ali-file-name): Improve error msg.
41 (ada-get-ada-file-name): Likewise.
42
43 * net/ange-ftp.el (ange-ftp-gwp-start, ange-ftp-nslookup-host)
44 (ange-ftp-start-process): Use set-process-query-on-exit-flag.
45
46 * mail/mail-extr.el (mail-extr-all-top-level-domains):
47 Add forward defvar.
48
49 * whitespace.el (global-whitespace-mode): New alias
50 for whitespace-global-mode.
51
52 * speedbar.el (speedbar-file-regexp): Definition moved up.
53 (speedbar-mode, speedbar-set-mode-line-format):
54 Use with-no-warnings.
55 (speedbar-emacs-popup-kludge): Delete Emacs 19 alternative.
56
57 * simple.el (shell-command-on-region): New arg DISPLAY-ERROR-BUFFER
58 controls whether to display the error buffer.
59
60 * ps-mule.el: Delete compatibility code for old Emacses.
61 (ps-mule-find-wrappoint): Don't use chars-in-region.
62
63 * frame.el (display-mouse-p, display-selections-p):
64 Use with-no-warnings.
65
66 * font-lock.el (font-lock-set-defaults): Use with-no-warnings.
67
682004-08-22 David Kastrup <dak@gnu.org>
69
70 * textmodes/reftex-auc.el, progmodes/meta-mode.el: Update AUCTeX
71 information.
72
73 * speedbar.el, iswitchb.el, ido.el: Update AUCTeX information.
74
752004-08-22 Andreas Schwab <schwab@suse.de>
76
77 * cvs-status.el: Require pcvs during byte-compiling for defun-cvs-mode.
78
792004-08-22 Masatake YAMATO <jet@gyve.org>
80
81 * cvs-status.el (cvs-status-checkout): New function.
82 (cvs-status-mode-map): Add a key definition for `cvs-status-checkout'.
83
842004-08-21 David Kastrup <dak@gnu.org>
85
86 * net/ange-ftp.el (ange-ftp-hash-entry-exists-p)
87 (ange-ftp-file-entry-p, ange-ftp-file-symlink-p): Since the code
88 has been converted to use hashtables, the relation `nil=none' is
89 no longer valid, as `nil' is not a hashtable. This patch tries to
90 reduce the number of resulting errors.
91
922004-08-21 John Paul Wallington <jpw@gnu.org>
93
94 * subr.el (process-kill-without-query): Made obsolete in
95 version 21.4, not 21.5.
96
97 * log-edit.el (vc-comment-ring, vc-comment-ring-index)
98 (vc-previous-comment, vc-next-comment)
99 (vc-comment-search-reverse, vc-comment-search-forward)
100 (vc-comment-to-change-log): Likewise.
101
102 * international/latin1-disp.el (latin1-char-displayable-p): Likewise.
103
1042004-08-21 Peter Seibel <peter@javamonkey.com> (tiny patch)
105
106 * emacs-lisp/cl-indent.el (lisp-indent-defmethod):
107 Correct indentation of DEFMETHODS with non-standard method
108 combinations (e.g., PROGN, MIN, MAX).
109
1102004-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
111
112 * startup.el (normal-top-level-add-subdirs-to-load-path):
113 Avoid unnecessarily checking system-type.
114 (normal-top-level): Set TERM to "dumb". Simplify.
115
116 * avoid.el (mouse-avoidance-ignore-p): New fun.
117 Also ignore switch-frame, select-window, double, and triple clicks.
118 (mouse-avoidance-banish-hook, mouse-avoidance-exile-hook)
119 (mouse-avoidance-fancy-hook): Use it.
120
1212004-08-20 Zoran Milojevic <zoran@sipquest.com> (tiny change)
122
123 * avoid.el (mouse-avoidance-nudge-mouse)
124 (mouse-avoidance-banish-destination): Stay within the current window
125 to avoid problems with mouse-autoselect-window.
126
1272004-08-19 Stefan Monnier <monnier@iro.umontreal.ca>
128
129 * pcvs-parse.el (cvs-parse-table, cvs-parse-commit): Try to adapt to
130 the newer format of some messages in cvs-1.12.1.
131
1322004-08-19 Masatake YAMATO <jet@gyve.org>
133
134 * emacs-lisp/elp.el (elp-results-symname-map): New keymap.
135 (elp-results-jump-to-definition-by-mouse)
136 (elp-results-jump-to-definition, elp-output-insert-symname): New funs.
137 (elp-output-result): Use elp-output-insert-symname.
138
1392004-08-18 Kenichi Handa <handa@m17n.org>
140
141 * language/cyrillic.el: Register koi8-r in
142 ctext-non-standard-encodings-alist.
143 ("Cyrillic-KOI8"): Add ctext-non-standard-encoding.
144
1452004-08-17 Luc Teirlinck <teirllm@auburn.edu>
146
147 * emacs-lisp/copyright.el (copyright-update-year): Delete code
148 that replaces 20xy with xy.
149
1502004-08-17 John Paul Wallington <jpw@gnu.org>
151
152 * emacs-lisp/re-builder.el (reb-mode-map): Define within defvar.
153 (reb-force-update): Doc fix.
154
1552004-08-16 Richard M. Stallman <rms@gnu.org>
156
157 * progmodes/which-func.el (which-func-update-1): Doc fix.
158
159 * progmodes/sh-script.el (sh-set-shell): Use sh-mode-abbrev-table.
160 (sh-mode-abbrev-table): New variable.
161
162 * progmodes/compile.el (compilation-mode): Doc fix.
163
164 * emacs-lisp/lisp-mode.el (eval-last-sexp):
165 Don't cons a new symbol each time.
166 (eval-last-sexp-fake-value): New variable.
167
168 * emacs-lisp/copyright.el (copyright-years-regexp): New variable.
169 (copyright-update-year): Detect continuation of list of years.
170
171 * term.el (term-default-fg-color, term-default-bg-color)
172 (ansi-term-color-vector): Use `unspecified', not nil, as default.
173
174 * imenu.el: Several doc fixes: don't say variables are buffer-local.
175
1762004-08-16 Davis Herring <herring@lanl.gov>
177
178 * isearch.el (isearch-string, isearch-message-string, isearch-point)
179 (isearch-success, isearch-forward-flag, isearch-other-end)
180 (isearch-word, isearch-invalid-regexp, isearch-wrapped)
181 (isearch-barrier, isearch-within-brackets)
182 (isearch-case-fold-search): Fix broken `nth'-like calls to `aref'.
183
1842004-08-16 Kenichi Handa <handa@m17n.org>
185
186 * ps-mule.el (ps-mule-font-info-database): Fix docstring.
187
1882004-08-15 Kenichi Handa <handa@m17n.org>
189
190 * term/x-win.el (x-selection-value): If utf8 was successful but
191 ctext was not, use utf8 string.
192
1932004-08-14 Davis Herring <herring@lanl.gov>
194
195 * isearch.el: Remove accidental changes of March 4. Fix backing
196 up when a regexp isearch is made more general. Use symbolic
197 accessor functions for isearch stack frames to make usage clearer.
198 (search-whitespace-regexp): Made groups in documentation shy (as
199 is the group in the default value).
200 (isearch-fallback): New function, addresses problems with regexps
201 liberalized by `\|', adds support for liberalization by `\}' (the
202 general repetition construct), and incorporates behavior for
203 `*'/`?'.
204 (isearch-}-char): New command, calls `isearch-fallback' with
205 arguments appropriate to a typed `}'.
206 (isearch-*-char, isearch-|-char): Now just call `isearch-fallback'
207 appropriately.
208 (isearch-mode-map): Bind `}' to `isearch-}-char'.
209 (isearch-string, isearch-message,string, isearch-point)
210 (isearch-success, isearch-forward-flag, isearch-other-end)
211 (isearch-word, isearch-invalid-regexp, isearch-wrapped)
212 (isearch-barrier, isearch-within-brackets, isearch-case-fold-search):
213 New inline functions to read fields of a stack frame.
214
2152004-08-14 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> (tiny change)
216
217 * battery.el (battery-linux-proc-acpi): Look into battery
218 directories matching the literal string "CMB", too (required for
219 Linux kernel version 2.6.7).
220
2212004-08-14 John Paul Wallington <jpw@gnu.org>
222
223 * cus-start.el (read-file-name-completion-ignore-case): Add.
224 (blink-cursor-alist): Change version to "21.4".
225
226 * emacs-lisp/bytecomp.el (forward-word): Allow 0 args.
227
2282004-08-11 Daniel Pfeiffer <occitan@esperanto.org>
229
230 * speedbar.el (speedbar-scan-subdirs): New option.
231 (speedbar-file-lists): Don't ignore file-name case on Unix and use
232 dolist.
233 (speedbar-insert-files-at-point): Take an extra argument and use
234 it to optionally find out if a subdir is empty. Also unreadable
235 files don't get expand buttons.
236 (speedbar-directory): New image (unused pixmap already existed).
237 (speedbar-expand-image-button-alist): Use it.
238
2392004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org>
240
241 CC Mode update to 5.30.9:
242
243 * progmodes/cc-defs.el, progmodes/cc-vars.el (c-emacs-features):
244 Move from cc-vars to cc-defs for dependency reasons. Fix the
245 POSIX char class test to check that it works in
246 `skip-chars-(forward|backward)' too.
247
248 * progmodes/cc-align.el (c-lineup-arglist): Fix bug when the
249 first argument starts with a special brace list.
250
251 * progmodes/cc-engine.el (c-forward-type): Fix promotion bug
252 when `c-opt-type-concat-key' is used (i.e. in Pike).
253
254 * progmodes/cc-engine.el (c-looking-at-special-brace-list):
255 Fix bug when the inner char pair doesn't have paren syntax, i.e. "(<
256 >)".
257
258 * progmodes/cc-align.el (c-lineup-multi-inher): Made it syntactic
259 whitespace safe.
260
261 * progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchor
262 position for `arglist-intro', `arglist-cont-nonempty' and
263 `arglist-close' when there are two arglist open parens on the same
264 line and there's nothing in front of the first.
265
266 * progmodes/cc-fonts.el (c-basic-matchers-before): Fix font
267 locking of qualified names in Java, which previously could fontify
268 common indexing expressions in many cases. The standard Java
269 naming conventions are used to tell them apart.
270
271 * progmodes/cc-align.el (c-lineup-whitesmith-in-block):
272 Fix inconsistency wrt opening parens on the first line inside a paren
273 block.
274
275 * progmodes/cc-defs.el (c-langs-are-parametric): Must be known at
276 compile time for the sake of `c-major-mode-is'.
277
278 (c-mode-is-new-awk-p): Made it a macro to delay expansion of
279 `c-major-mode-is' in the event that this is used inside a
280 `c-lang-defconst'.
281
282 * progmodes/cc-defs.el (c-major-mode-is): Fix expansion inside
283 `c-lang-defconst' so that it works better with fallback languages.
284
285 * progmodes/cc-defs.el (c-add-language): Fix a typo that caused
286 it to fail to record the base mode.
287
288 * progmodes/cc-engine.el (c-syntactic-re-search-forward):
289 Fix bug so that it doesn't go past the closing paren when PAREN-LEVEL
290 is used. Reordered the syntax checks to get more efficient
291 skipping in some situations.
292
293 * progmodes/cc-cmds.el (c-electric-brace): Don't trip up on a line
294 continuation which might precede the newly inserted '{'.
295
296 * progmodes/cc-engine.el (c-syntactic-re-search-forward):
297 Fix cases where it could loop indefinitely.
298
299 * progmodes/cc-fonts.el (c-font-lock-declarators): Handle array
300 size specs correctly. Only fontify identifiers in front of '('
301 with as functions - don't accept any paren char. Tightened up
302 initializer skipping to stop before function and class blocks.
303
304 * progmodes/cc-engine.el (c-beginning-of-decl-1): Fix bug where
305 the point could be left directly after an open paren when finding
306 the beginning of the first decl in the block.
307
308 * progmodes/cc-engine.el (c-parse-state): Don't use the syntax
309 table when filtering out legitimate open parens to be recorded.
310 This could cause cache inconsistencies when e.g.
311 `c++-template-syntax-table' was temporarily in use.
312
313 * progmodes/cc-engine.el (c-on-identifier)
314 (c-simple-skip-symbol-backward): Small fix for handling "-"
315 correctly in `skip-chars-backward'. Affected the operator lfun
316 syntax in Pike.
317
318 * progmodes/cc-engine.el (c-invalidate-sws-region-after):
319 Fix bug that could cause an error from `after-change-functions' when
320 the changed region is at bob.
321
3222004-08-11 Alan Mackenzie <bug-cc-mode@gnu.org>
323
324 CC Mode update to 5.30.9:
325
326 * progmodes/cc-cmds.el, progmodes/cc-vars.el: Amend doc(-strings)
327 to say that <TAB> doesn't insert WS into a CPP line.
328 (c-indent-command, c-tab-always-indent): Amend doc strings.
329
330 * progmodes/cc-styles.el, progmodes/cc-engine.el: Add in two
331 checks for user errors, thus eliminating cryptic and unhelpful
332 Emacs error messages. (1) Check the arg to `c-set-style' is a
333 string. (2) Check that settings to `c-offsets-alist' are not
334 spuriously quoted.
335
336 * progmodes/cc-cmds.el: (c-electric-brace): Don't delete a comment
337 which precedes the newly inserted `{'.
338
3392004-08-10 Michael Albinus <michael.albinus@gmx.de>
340
341 Sync with Tramp 2.0.44.
342
343 * net/tramp.el (tramp-post-connection): Quote $1 and $2 of shell
344 function "tramp_file_attributes". Otherwise, file names
345 containing spaces are misinterpreted. Reported by Magnus Henoch
346 <mange@freemail.hu>.
347 (tramp-handle-file-truename): FILENAME must be expanded first.
348 Otherwise, parameters like "/ssh:deego@gnufans.net:~" will return
349 obscure results. Reported by D. Goel <deego@gnufans.org>.
350 (tramp-handle-verify-visited-file-modtime): If file does not
351 exist, say it is not modified if and only if that agrees with the
352 buffer's record. Check whether a file is visiting the buffer, or
353 the buffer has no recorded last modification time. Return t in
354 case the visiting file doesn't exist. Suggested by Luc Teirlinck
355 <teirllm@auburn.edu>.
356 (tramp-handle-write-region): Pass modtime explicitely to
357 `set-visited-file-modtime', because filename can be different
358 from (buffer-file-name) if `file-precious-flag' is set.
359 `set-visited-file-modtime' must be called always when `visit' is t
360 or a string. Suggested by Luc Teirlinck <teirllm@auburn.edu>.
361 (tramp-handle-set-visited-file-modtime): If `time-list' is not
362 nil, don't apply the whole body. If the file doesn't exists, set
363 modtime to '(-1 65535). Suggested by Luc Teirlinck
364 <teirllm@auburn.edu>.
365
12004-08-09 Luc Teirlinck <teirllm@auburn.edu> 3662004-08-09 Luc Teirlinck <teirllm@auburn.edu>
2 367
3 * help.el (describe-bindings): Doc fix. 368 * help.el (describe-bindings): Doc fix.
@@ -12,8 +377,7 @@
12 377
132004-08-08 Lars Hansen <larsh@math.ku.dk> 3782004-08-08 Lars Hansen <larsh@math.ku.dk>
14 379
15 * wid-edit.el (widget-sexp-validate): Allow whitespace after 380 * wid-edit.el (widget-sexp-validate): Allow whitespace after expression.
16 expression.
17 381
182004-08-08 Luc Teirlinck <teirllm@auburn.edu> 3822004-08-08 Luc Teirlinck <teirllm@auburn.edu>
19 383
@@ -38,10 +402,15 @@
38 (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax. 402 (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax.
39 (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'. 403 (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'.
40 404
4052004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change)
406
407 * mail/mail-extr.el (mail-extr-disable-voodoo): New variable.
408 (mail-extr-voodoo): Check mail-extr-disable-voodoo.
409
412004-08-04 Kenichi Handa <handa@m17n.org> 4102004-08-04 Kenichi Handa <handa@m17n.org>
42 411
43 * international/encoded-kb.el (encoded-kbd-setup-keymap): Fix 412 * international/encoded-kb.el (encoded-kbd-setup-keymap):
44 previous change. 413 Fix previous change.
45 414
462004-08-03 Kenichi Handa <handa@m17n.org> 4152004-08-03 Kenichi Handa <handa@m17n.org>
47 416
@@ -75,8 +444,8 @@
75 444
762004-08-01 David Kastrup <dak@gnu.org> 4452004-08-01 David Kastrup <dak@gnu.org>
77 446
78 * replace.el (query-replace-read-from): Use 447 * replace.el (query-replace-read-from):
79 `query-replace-compile-replacement'. 448 Use `query-replace-compile-replacement'.
80 (query-replace-compile-replacement): New function. 449 (query-replace-compile-replacement): New function.
81 (query-replace-read-to): Use `query-replace-compile-replacement' 450 (query-replace-read-to): Use `query-replace-compile-replacement'
82 for repeating the last command. 451 for repeating the last command.
diff --git a/lisp/avoid.el b/lisp/avoid.el
index 536b80abdbe..b5e7d1f9b62 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -1,6 +1,6 @@
1;;; avoid.el --- make mouse pointer stay out of the way of editing 1;;; avoid.el --- make mouse pointer stay out of the way of editing
2 2
3;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Boris Goldowsky <boris@gnu.org> 5;; Author: Boris Goldowsky <boris@gnu.org>
6;; Keywords: mouse 6;; Keywords: mouse
@@ -52,7 +52,7 @@
52;; 52;;
53;; Bugs / Warnings / To-Do: 53;; Bugs / Warnings / To-Do:
54;; 54;;
55;; - Using this code does slow emacs down. "banish" mode shouldn't 55;; - Using this code does slow Emacs down. "banish" mode shouldn't
56;; be too bad, and on my workstation even "animate" is reasonable. 56;; be too bad, and on my workstation even "animate" is reasonable.
57;; 57;;
58;; - It ought to find out where any overlapping frames are and avoid them, 58;; - It ought to find out where any overlapping frames are and avoid them,
@@ -96,7 +96,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'."
96 96
97(defcustom mouse-avoidance-nudge-dist 15 97(defcustom mouse-avoidance-nudge-dist 15
98 "*Average distance that mouse will be moved when approached by cursor. 98 "*Average distance that mouse will be moved when approached by cursor.
99Only applies in mouse-avoidance-mode `jump' and its derivatives. 99Only applies in Mouse-Avoidance mode `jump' and its derivatives.
100For best results make this larger than `mouse-avoidance-threshold'." 100For best results make this larger than `mouse-avoidance-threshold'."
101 :type 'integer 101 :type 'integer
102 :group 'avoid) 102 :group 'avoid)
@@ -137,7 +137,7 @@ Only applies in mouse-avoidance-modes `animate' and `jump'."
137 137
138(defun mouse-avoidance-point-position () 138(defun mouse-avoidance-point-position ()
139 "Return the position of point as (FRAME X . Y). 139 "Return the position of point as (FRAME X . Y).
140Analogous to mouse-position." 140Analogous to `mouse-position'."
141 (let* ((w (selected-window)) 141 (let* ((w (selected-window))
142 (edges (window-inside-edges w)) 142 (edges (window-inside-edges w))
143 (list 143 (list
@@ -194,10 +194,11 @@ Acceptable distance is defined by `mouse-avoidance-threshold'."
194 mouse-avoidance-threshold)))))) 194 mouse-avoidance-threshold))))))
195 195
196(defun mouse-avoidance-banish-destination () 196(defun mouse-avoidance-banish-destination ()
197 "The position to which mouse-avoidance-mode `banish' moves the mouse. 197 "The position to which Mouse-Avoidance mode `banish' moves the mouse.
198You can redefine this if you want the mouse banished to a different corner." 198You can redefine this if you want the mouse banished to a different corner."
199 (cons (1- (frame-width)) 199 (let* ((pos (window-edges)))
200 0)) 200 (cons (- (nth 2 pos) 2)
201 (nth 1 pos))))
201 202
202(defun mouse-avoidance-banish-mouse () 203(defun mouse-avoidance-banish-mouse ()
203 ;; Put the mouse pointer in the upper-right corner of the current frame. 204 ;; Put the mouse pointer in the upper-right corner of the current frame.
@@ -225,22 +226,27 @@ You can redefine this if you want the mouse banished to a different corner."
225 (t 0)))) 226 (t 0))))
226 227
227(defun mouse-avoidance-nudge-mouse () 228(defun mouse-avoidance-nudge-mouse ()
228 ;; Push the mouse a little way away, possibly animating the move 229 ;; Push the mouse a little way away, possibly animating the move.
229 ;; For these modes, state keeps track of the total offset that we've 230 ;; For these modes, state keeps track of the total offset that we've
230 ;; accumulated, and tries to keep it close to zero. 231 ;; accumulated, and tries to keep it close to zero.
231 (let* ((cur (mouse-position)) 232 (let* ((cur (mouse-position))
232 (cur-frame (car cur)) 233 (cur-frame (car cur))
233 (cur-pos (cdr cur)) 234 (cur-pos (cdr cur))
235 (pos (window-edges))
236 (wleft (pop pos))
237 (wtop (pop pos))
238 (wright (pop pos))
239 (wbot (pop pos))
234 (deltax (mouse-avoidance-delta 240 (deltax (mouse-avoidance-delta
235 (car cur-pos) (- (random mouse-avoidance-nudge-var) 241 (car cur-pos) (- (random mouse-avoidance-nudge-var)
236 (car mouse-avoidance-state)) 242 (car mouse-avoidance-state))
237 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 243 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
238 0 (frame-width))) 244 wleft (1- wright)))
239 (deltay (mouse-avoidance-delta 245 (deltay (mouse-avoidance-delta
240 (cdr cur-pos) (- (random mouse-avoidance-nudge-var) 246 (cdr cur-pos) (- (random mouse-avoidance-nudge-var)
241 (cdr mouse-avoidance-state)) 247 (cdr mouse-avoidance-state))
242 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 248 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
243 0 (frame-height)))) 249 wtop (1- wbot))))
244 (setq mouse-avoidance-state 250 (setq mouse-avoidance-state
245 (cons (+ (car mouse-avoidance-state) deltax) 251 (cons (+ (car mouse-avoidance-state) deltax)
246 (+ (cdr mouse-avoidance-state) deltay))) 252 (+ (cdr mouse-avoidance-state) deltay)))
@@ -277,33 +283,34 @@ redefine this function to suit your own tastes."
277 (nth (random mouse-avoidance-n-pointer-shapes) 283 (nth (random mouse-avoidance-n-pointer-shapes)
278 mouse-avoidance-pointer-shapes)) 284 mouse-avoidance-pointer-shapes))
279 285
286(defun mouse-avoidance-ignore-p ()
287 (let ((mp (mouse-position)))
288 (or executing-kbd-macro ; don't check inside macro
289 (null (cadr mp)) ; don't move unless in an Emacs frame
290 (not (eq (car mp) (selected-frame)))
291 ;; Don't do anything if last event was a mouse event.
292 ;; FIXME: this code fails in the case where the mouse was moved
293 ;; since the last key-press but without generating any event.
294 (and (consp last-input-event)
295 (symbolp (car last-input-event))
296 (let ((modifiers (event-modifiers (car last-input-event))))
297 (or (memq (car last-input-event)
298 '(mouse-movement scroll-bar-movement
299 select-window switch-frame))
300 (memq 'click modifiers)
301 (memq 'double modifiers)
302 (memq 'triple modifiers)
303 (memq 'drag modifiers)
304 (memq 'down modifiers)))))))
305
280(defun mouse-avoidance-banish-hook () 306(defun mouse-avoidance-banish-hook ()
281 (if (and (not executing-kbd-macro) ; don't check inside macro 307 (if (not (mouse-avoidance-ignore-p))
282 (cadr (mouse-position)) ; don't move unless in an Emacs frame
283 ;; Don't do anything if last event was a mouse event.
284 (not (and (consp last-input-event)
285 (symbolp (car last-input-event))
286 (let ((modifiers (event-modifiers (car last-input-event))))
287 (or (memq (car last-input-event)
288 '(mouse-movement scroll-bar-movement))
289 (memq 'click modifiers)
290 (memq 'drag modifiers)
291 (memq 'down modifiers))))))
292 (mouse-avoidance-banish-mouse))) 308 (mouse-avoidance-banish-mouse)))
293 309
294(defun mouse-avoidance-exile-hook () 310(defun mouse-avoidance-exile-hook ()
295 ;; For exile mode, the state is nil when the mouse is in its normal 311 ;; For exile mode, the state is nil when the mouse is in its normal
296 ;; position, and set to the old mouse-position when the mouse is in exile. 312 ;; position, and set to the old mouse-position when the mouse is in exile.
297 (if (and (not executing-kbd-macro) 313 (if (not (mouse-avoidance-ignore-p))
298 ;; Don't do anything if last event was a mouse event.
299 (not (and (consp last-input-event)
300 (symbolp (car last-input-event))
301 (let ((modifiers (event-modifiers (car last-input-event))))
302 (or (memq (car last-input-event)
303 '(mouse-movement scroll-bar-movement))
304 (memq 'click modifiers)
305 (memq 'drag modifiers)
306 (memq 'down modifiers))))))
307 (let ((mp (mouse-position))) 314 (let ((mp (mouse-position)))
308 (cond ((and (not mouse-avoidance-state) 315 (cond ((and (not mouse-avoidance-state)
309 (mouse-avoidance-too-close-p mp)) 316 (mouse-avoidance-too-close-p mp))
@@ -321,16 +328,7 @@ redefine this function to suit your own tastes."
321 328
322(defun mouse-avoidance-fancy-hook () 329(defun mouse-avoidance-fancy-hook ()
323 ;; Used for the "fancy" modes, ie jump et al. 330 ;; Used for the "fancy" modes, ie jump et al.
324 (if (and (not executing-kbd-macro) ; don't check inside macro 331 (if (and (not (mouse-avoidance-ignore-p))
325 ;; Don't do anything if last event was a mouse event.
326 (not (and (consp last-input-event)
327 (symbolp (car last-input-event))
328 (let ((modifiers (event-modifiers (car last-input-event))))
329 (or (memq (car last-input-event)
330 '(mouse-movement scroll-bar-movement))
331 (memq 'click modifiers)
332 (memq 'drag modifiers)
333 (memq 'down modifiers)))))
334 (mouse-avoidance-too-close-p (mouse-position))) 332 (mouse-avoidance-too-close-p (mouse-position)))
335 (let ((old-pos (mouse-position))) 333 (let ((old-pos (mouse-position)))
336 (mouse-avoidance-nudge-mouse) 334 (mouse-avoidance-nudge-mouse)
@@ -416,5 +414,5 @@ definition of \"random distance\".)"
416(if mouse-avoidance-mode 414(if mouse-avoidance-mode
417 (mouse-avoidance-mode mouse-avoidance-mode)) 415 (mouse-avoidance-mode mouse-avoidance-mode))
418 416
419;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 417;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800
420;;; avoid.el ends here 418;;; avoid.el ends here
diff --git a/lisp/battery.el b/lisp/battery.el
index 73d78067571..3b44ff891f9 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -290,7 +290,7 @@ The following %-sequences are provided:
290 nil t) 290 nil t)
291 (setq low (+ (or low 0) 291 (setq low (+ (or low 0)
292 (string-to-int (match-string 1)))))))) 292 (string-to-int (match-string 1))))))))
293 (directory-files "/proc/acpi/battery/" t "BAT"))) 293 (directory-files "/proc/acpi/battery/" t "\\(BAT\\|CMB\\)")))
294 (and capacity rate 294 (and capacity rate
295 (setq minutes (if (zerop rate) 0 295 (setq minutes (if (zerop rate) 0
296 (floor (* (/ (float (if (string= charging-state 296 (floor (* (/ (float (if (string= charging-state
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 846231befe6..6439089273a 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -45,6 +45,7 @@
45 (timezone-make-date-arpa-standard date))) 45 (timezone-make-date-arpa-standard date)))
46 (error (error "Invalid date: %s" date)))) 46 (error (error "Invalid date: %s" date))))
47 47
48;;;###autoload
48(defun time-to-seconds (time) 49(defun time-to-seconds (time)
49 "Convert time value TIME to a floating point number. 50 "Convert time value TIME to a floating point number.
50You can use `float-time' instead." 51You can use `float-time' instead."
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 1d1dc653b1f..bbb423ea425 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -124,6 +124,7 @@
124 (const :tag "always" t))) 124 (const :tag "always" t)))
125 ;; fileio.c 125 ;; fileio.c
126 (insert-default-directory minibuffer boolean) 126 (insert-default-directory minibuffer boolean)
127 (read-file-name-completion-ignore-case minibuffer boolean "21.4")
127 ;; fns.c 128 ;; fns.c
128 (use-dialog-box menu boolean "21.1") 129 (use-dialog-box menu boolean "21.1")
129 (use-file-dialog menu boolean "21.4") 130 (use-file-dialog menu boolean "21.4")
@@ -267,7 +268,7 @@
267 :format "%v") 268 :format "%v")
268 (other :tag "Unlimited" t))) 269 (other :tag "Unlimited" t)))
269 (unibyte-display-via-language-environment mule boolean) 270 (unibyte-display-via-language-environment mule boolean)
270 (blink-cursor-alist cursor alist "21.5") 271 (blink-cursor-alist cursor alist "21.4")
271 ;; xfaces.c 272 ;; xfaces.c
272 (scalable-fonts-allowed display boolean) 273 (scalable-fonts-allowed display boolean)
273 ;; xfns.c 274 ;; xfns.c
diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el
index b03182d87e4..419f8567a90 100644
--- a/lisp/cvs-status.el
+++ b/lisp/cvs-status.el
@@ -31,6 +31,7 @@
31;;; Code: 31;;; Code:
32 32
33(eval-when-compile (require 'cl)) 33(eval-when-compile (require 'cl))
34(eval-when-compile (require 'pcvs))
34(require 'pcvs-util) 35(require 'pcvs-util)
35 36
36;;; 37;;;
@@ -48,7 +49,8 @@
48 ("\M-n" . cvs-status-next) 49 ("\M-n" . cvs-status-next)
49 ("\M-p" . cvs-status-prev) 50 ("\M-p" . cvs-status-prev)
50 ("t" . cvs-status-cvstrees) 51 ("t" . cvs-status-cvstrees)
51 ("T" . cvs-status-trees)) 52 ("T" . cvs-status-trees)
53 (">" . cvs-status-checkout))
52 "CVS-Status' keymap." 54 "CVS-Status' keymap."
53 :group 'cvs-status 55 :group 'cvs-status
54 :inherit 'cvs-mode-map) 56 :inherit 'cvs-mode-map)
@@ -464,6 +466,25 @@ Optional prefix ARG chooses between two representations."
464 ;;(sit-for 0) 466 ;;(sit-for 0)
465 )))))) 467 ))))))
466 468
469(defun-cvs-mode (cvs-status-checkout . NOARGS) (dir)
470 "Run cvs-checkout against the tag under the point.
471The files are stored to DIR."
472 (interactive
473 (let* ((module (cvs-get-module))
474 (branch (cvs-prefix-get 'cvs-branch-prefix))
475 (prompt (format "CVS Checkout Directory for `%s%s': "
476 module
477 (if branch (format "(branch: %s)" branch)
478 ""))))
479 (list
480 (read-directory-name prompt
481 nil default-directory nil))))
482 (let ((modules (cvs-string->strings (cvs-get-module)))
483 (flags (cvs-add-branch-prefix
484 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
485 (cvs-cvsroot (cvs-get-cvsroot)))
486 (cvs-checkout modules dir flags)))
487
467(defun cvs-tree-tags-insert (tags prev) 488(defun cvs-tree-tags-insert (tags prev)
468 (when tags 489 (when tags
469 (let* ((tag (car tags)) 490 (let* ((tag (car tags))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c1a43722415..7eab041c515 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2900,7 +2900,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2900(byte-defop-compiler char-after 0-1) 2900(byte-defop-compiler char-after 0-1)
2901(byte-defop-compiler set-buffer 1) 2901(byte-defop-compiler set-buffer 1)
2902;;(byte-defop-compiler set-mark 1) ;; obsolete 2902;;(byte-defop-compiler set-mark 1) ;; obsolete
2903(byte-defop-compiler19 forward-word 1) 2903(byte-defop-compiler19 forward-word 0-1)
2904(byte-defop-compiler19 char-syntax 1) 2904(byte-defop-compiler19 char-syntax 1)
2905(byte-defop-compiler19 nreverse 1) 2905(byte-defop-compiler19 nreverse 1)
2906(byte-defop-compiler19 car-safe 1) 2906(byte-defop-compiler19 car-safe 1)
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index c5e13a4c00f..a203155673c 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -458,7 +458,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists."
458 (forward-char 1) 458 (forward-char 1)
459 (forward-sexp 3) 459 (forward-sexp 3)
460 (backward-sexp) 460 (backward-sexp)
461 (looking-at ":"))) 461 (looking-at ":\\|\\sw+")))
462 '(4 4 (&whole 4 &rest 4) &body) 462 '(4 4 (&whole 4 &rest 4) &body)
463 (get 'defun 'common-lisp-indent-function)) 463 (get 'defun 'common-lisp-indent-function))
464 path state indent-point sexp-column normal-indent)) 464 path state indent-point sexp-column normal-indent))
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 58ab919c2f9..a79e53b7dd4 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -52,6 +52,13 @@ The second \\( \\) construct must match the years."
52 :group 'copyright 52 :group 'copyright
53 :type 'regexp) 53 :type 'regexp)
54 54
55(defcustom copyright-years-regexp
56 "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
57 "*Match additional copyright notice years.
58The second \\( \\) construct must match the years."
59 :group 'copyright
60 :type 'regexp)
61
55 62
56(defcustom copyright-query 'function 63(defcustom copyright-query 'function
57 "*If non-nil, ask user before changing copyright. 64 "*If non-nil, ask user before changing copyright.
@@ -75,6 +82,23 @@ When this is `function', only ask when called non-interactively."
75 82
76(defun copyright-update-year (replace noquery) 83(defun copyright-update-year (replace noquery)
77 (when (re-search-forward copyright-regexp (+ (point) copyright-limit) t) 84 (when (re-search-forward copyright-regexp (+ (point) copyright-limit) t)
85 ;; If the years are continued onto multiple lined
86 ;; that are marked as comments, skip to the end of the years anyway.
87 (while (save-excursion
88 (and (eq (following-char) ?,)
89 (progn (forward-char 1) t)
90 (progn (skip-chars-forward " \t") (eolp))
91 comment-start-skip
92 (save-match-data
93 (forward-line 1)
94 (and (looking-at comment-start-skip)
95 (goto-char (match-end 0))))
96 (save-match-data
97 (looking-at copyright-years-regexp))))
98 (forward-line 1)
99 (re-search-forward comment-start-skip)
100 (re-search-forward copyright-years-regexp))
101
78 ;; Note that `current-time-string' isn't locale-sensitive. 102 ;; Note that `current-time-string' isn't locale-sensitive.
79 (setq copyright-current-year (substring (current-time-string) -4)) 103 (setq copyright-current-year (substring (current-time-string) -4))
80 (unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2)) 104 (unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
@@ -98,26 +122,6 @@ When this is `function', only ask when called non-interactively."
98 (eq (char-after (+ (point) size -2)) ?-))) 122 (eq (char-after (+ (point) size -2)) ?-)))
99 ;; This is a range so just replace the end part. 123 ;; This is a range so just replace the end part.
100 (delete-char size) 124 (delete-char size)
101 ;; Detect if this is using the following shorthand:
102 ;; (C) 1993, 94, 95, 1998, 2000, 01, 02, 2003
103 (if (and
104 ;; Check that the last year was 4-chars and same century.
105 (eq size -4)
106 (equal (buffer-substring (- (point) 4) (- (point) 2))
107 (substring copyright-current-year 0 2))
108 ;; Check that there are 2-char years as well.
109 (save-excursion
110 (re-search-backward "[^0-9][0-9][0-9][^0-9]"
111 (line-beginning-position) t))
112 ;; Make sure we don't remove the first century marker.
113 (save-excursion
114 (forward-char size)
115 (re-search-backward
116 (concat (buffer-substring (point) (+ (point) 2))
117 "[0-9][0-9]")
118 (line-beginning-position) t)))
119 ;; Remove the century marker of the last entry.
120 (delete-region (- (point) 4) (- (point) 2)))
121 ;; Insert a comma with the preferred number of spaces. 125 ;; Insert a comma with the preferred number of spaces.
122 (insert 126 (insert
123 (save-excursion 127 (save-excursion
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 44400dcaa2c..f8d41f200d2 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -513,7 +513,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
513 (numberp elp-report-limit) 513 (numberp elp-report-limit)
514 (< cc elp-report-limit)) 514 (< cc elp-report-limit))
515 nil 515 nil
516 (insert symname) 516 (elp-output-insert-symname symname)
517 (insert-char 32 (+ elp-field-len (- (length symname)) 2)) 517 (insert-char 32 (+ elp-field-len (- (length symname)) 2))
518 ;; print stuff out, formatting it nicely 518 ;; print stuff out, formatting it nicely
519 (insert callcnt) 519 (insert callcnt)
@@ -525,6 +525,32 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
525 (insert atstr)) 525 (insert atstr))
526 (insert "\n")))) 526 (insert "\n"))))
527 527
528(defvar elp-results-symname-map
529 (let ((map (make-sparse-keymap)))
530 (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse)
531 (define-key map "\C-m" 'elp-results-jump-to-definition)
532 map)
533 "Keymap used on the function name column." )
534
535(defun elp-results-jump-to-definition-by-mouse (event)
536 "Jump to the definition of the function under the place specified by EVENT."
537 (interactive "e")
538 (posn-set-point (event-end event))
539 (elp-results-jump-to-definition))
540
541(defun elp-results-jump-to-definition ()
542 "Jump to the definition of the function under the point."
543 (interactive)
544 (find-function (get-text-property (point) 'elp-symname)))
545
546(defun elp-output-insert-symname (symname)
547 ;; Insert SYMNAME with text properties.
548 (insert (propertize symname
549 'elp-symname (intern symname)
550 'keymap elp-results-symname-map
551 'mouse-face 'highlight
552 'help-echo (substitute-command-keys "\\{elp-results-symname-map}"))))
553
528;;;###autoload 554;;;###autoload
529(defun elp-results () 555(defun elp-results ()
530 "Display current profiling results. 556 "Display current profiling results.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index d471ad79538..df05555ae7b 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -555,13 +555,15 @@ With argument, print output into current buffer."
555 )))) 555 ))))
556 556
557 557
558(defvar eval-last-sexp-fake-value (make-symbol "t"))
559
558(defun eval-last-sexp (eval-last-sexp-arg-internal) 560(defun eval-last-sexp (eval-last-sexp-arg-internal)
559 "Evaluate sexp before point; print value in minibuffer. 561 "Evaluate sexp before point; print value in minibuffer.
560Interactively, with prefix argument, print output into current buffer." 562Interactively, with prefix argument, print output into current buffer."
561 (interactive "P") 563 (interactive "P")
562 (if (null eval-expression-debug-on-error) 564 (if (null eval-expression-debug-on-error)
563 (eval-last-sexp-1 eval-last-sexp-arg-internal) 565 (eval-last-sexp-1 eval-last-sexp-arg-internal)
564 (let ((old-value (make-symbol "t")) new-value value) 566 (let ((old-value eval-last-sexp-fake-value) new-value value)
565 (let ((debug-on-error old-value)) 567 (let ((debug-on-error old-value))
566 (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal)) 568 (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
567 (setq new-value debug-on-error)) 569 (setq new-value debug-on-error))
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 6eb1ffa2e54..77a12167c30 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -45,7 +45,7 @@
45;; call `reb-force-update' ("\C-c\C-u") which should reveal the error. 45;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
46 46
47;; The target buffer can be changed with `reb-change-target-buffer' 47;; The target buffer can be changed with `reb-change-target-buffer'
48;; ("\C-c\C-b"). Changing the target buffer automatically removes 48;; ("\C-c\C-b"). Changing the target buffer automatically removes
49;; the overlays from the old buffer and displays the new one in the 49;; the overlays from the old buffer and displays the new one in the
50;; target window. 50;; target window.
51 51
@@ -229,22 +229,20 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
229 "Buffer to use for the RE Builder.") 229 "Buffer to use for the RE Builder.")
230 230
231;; Define the local "\C-c" keymap 231;; Define the local "\C-c" keymap
232(defvar reb-mode-map nil 232(defvar reb-mode-map
233 (let ((map (make-sparse-keymap)))
234 (define-key map "\C-c\C-c" 'reb-toggle-case)
235 (define-key map "\C-c\C-q" 'reb-quit)
236 (define-key map "\C-c\C-w" 'reb-copy)
237 (define-key map "\C-c\C-s" 'reb-next-match)
238 (define-key map "\C-c\C-r" 'reb-prev-match)
239 (define-key map "\C-c\C-i" 'reb-change-syntax)
240 (define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
241 (define-key map "\C-c\C-b" 'reb-change-target-buffer)
242 (define-key map "\C-c\C-u" 'reb-force-update)
243 map)
233 "Keymap used by the RE Builder.") 244 "Keymap used by the RE Builder.")
234 245
235(if (not reb-mode-map)
236 (progn
237 (setq reb-mode-map (make-sparse-keymap))
238 (define-key reb-mode-map "\C-c\C-c" 'reb-toggle-case)
239 (define-key reb-mode-map "\C-c\C-q" 'reb-quit)
240 (define-key reb-mode-map "\C-c\C-w" 'reb-copy)
241 (define-key reb-mode-map "\C-c\C-s" 'reb-next-match)
242 (define-key reb-mode-map "\C-c\C-r" 'reb-prev-match)
243 (define-key reb-mode-map "\C-c\C-i" 'reb-change-syntax)
244 (define-key reb-mode-map "\C-c\C-e" 'reb-enter-subexp-mode)
245 (define-key reb-mode-map "\C-c\C-b" 'reb-change-target-buffer)
246 (define-key reb-mode-map "\C-c\C-u" 'reb-force-update)))
247
248(defun reb-mode () 246(defun reb-mode ()
249 "Major mode for interactively building Regular Expressions. 247 "Major mode for interactively building Regular Expressions.
250\\{reb-mode-map}" 248\\{reb-mode-map}"
@@ -367,7 +365,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
367 (reb-update-modestring)))) 365 (reb-update-modestring))))
368 366
369(defun reb-force-update () 367(defun reb-force-update ()
370 "Forces an update in the RE Builder target window without a match limit." 368 "Force an update in the RE Builder target window without a match limit."
371 (interactive) 369 (interactive)
372 370
373 (let ((reb-auto-match-limit nil)) 371 (let ((reb-auto-match-limit nil))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 04b22fd0280..f5b68a3c243 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1516,7 +1516,9 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
1516 (make-local-variable 'font-lock-fontified) 1516 (make-local-variable 'font-lock-fontified)
1517 (make-local-variable 'font-lock-multiline) 1517 (make-local-variable 'font-lock-multiline)
1518 (let* ((defaults (or font-lock-defaults 1518 (let* ((defaults (or font-lock-defaults
1519 (cdr (assq major-mode font-lock-defaults-alist)))) 1519 (cdr (assq major-mode
1520 (with-no-warnings
1521 font-lock-defaults-alist)))))
1520 (keywords 1522 (keywords
1521 (font-lock-choose-keywords (nth 0 defaults) 1523 (font-lock-choose-keywords (nth 0 defaults)
1522 (font-lock-value-in-major-mode font-lock-maximum-decoration))) 1524 (font-lock-value-in-major-mode font-lock-maximum-decoration)))
diff --git a/lisp/frame.el b/lisp/frame.el
index a364d7f491b..8d979cdaff4 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -987,7 +987,8 @@ frame's display)."
987 ((eq frame-type 'pc) 987 ((eq frame-type 'pc)
988 (msdos-mouse-p)) 988 (msdos-mouse-p))
989 ((eq system-type 'windows-nt) 989 ((eq system-type 'windows-nt)
990 (> w32-num-mouse-buttons 0)) 990 (with-no-warnings
991 (> w32-num-mouse-buttons 0)))
991 ((memq frame-type '(x mac)) 992 ((memq frame-type '(x mac))
992 t) ;; We assume X and Mac *always* have a pointing device 993 t) ;; We assume X and Mac *always* have a pointing device
993 (t 994 (t
@@ -1040,7 +1041,8 @@ frame's display)."
1040 ((eq frame-type 'pc) 1041 ((eq frame-type 'pc)
1041 ;; MS-DOG frames support selections when Emacs runs inside 1042 ;; MS-DOG frames support selections when Emacs runs inside
1042 ;; the Windows' DOS Box. 1043 ;; the Windows' DOS Box.
1043 (not (null dos-windows-version))) 1044 (with-no-warnings
1045 (not (null dos-windows-version))))
1044 ((memq frame-type '(x w32 mac)) 1046 ((memq frame-type '(x w32 mac))
1045 t) ;; FIXME? 1047 t) ;; FIXME?
1046 (t 1048 (t
diff --git a/lisp/ido.el b/lisp/ido.el
index 4cbc88cf037..ae376741f1b 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -291,7 +291,7 @@
291;; then all files matching "Summary" are moved to the end of the 291;; then all files matching "Summary" are moved to the end of the
292;; list. (I find this handy for keeping the INBOX Summary and so on 292;; list. (I find this handy for keeping the INBOX Summary and so on
293;; out of the way.) It also moves files matching "output\*$" to the 293;; out of the way.) It also moves files matching "output\*$" to the
294;; end of the list (these are created by AUC TeX when compiling.) 294;; end of the list (these are created by AUCTeX when compiling.)
295;; Other functions could be made available which alter the list of 295;; Other functions could be made available which alter the list of
296;; matching files (either deleting or rearranging elements.) 296;; matching files (either deleting or rearranging elements.)
297 297
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 944e2453cb9..96969bfc878 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -198,7 +198,7 @@ This variable is buffer-local.")
198;;; Completion stuff 198;;; Completion stuff
199 199
200(defun ielm-tab nil 200(defun ielm-tab nil
201 "Possibly indent the current line as lisp code." 201 "Possibly indent the current line as Lisp code."
202 (interactive) 202 (interactive)
203 (if (or (eq (preceding-char) ?\n) 203 (if (or (eq (preceding-char) ?\n)
204 (eq (char-syntax (preceding-char)) ? )) 204 (eq (char-syntax (preceding-char)) ? ))
@@ -207,7 +207,7 @@ This variable is buffer-local.")
207 t))) 207 t)))
208 208
209(defun ielm-complete-symbol nil 209(defun ielm-complete-symbol nil
210 "Complete the lisp symbol before point." 210 "Complete the Lisp symbol before point."
211 ;; A wrapper for lisp-complete symbol that returns non-nil if 211 ;; A wrapper for lisp-complete symbol that returns non-nil if
212 ;; completion has occurred 212 ;; completion has occurred
213 (let* ((btick (buffer-modified-tick)) 213 (let* ((btick (buffer-modified-tick))
@@ -528,7 +528,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
528 (condition-case nil 528 (condition-case nil
529 (start-process "ielm" (current-buffer) "hexl") 529 (start-process "ielm" (current-buffer) "hexl")
530 (file-error (start-process "ielm" (current-buffer) "cat"))) 530 (file-error (start-process "ielm" (current-buffer) "cat")))
531 (process-kill-without-query (ielm-process)) 531 (set-process-query-on-exit-flag (ielm-process) nil)
532 (goto-char (point-max)) 532 (goto-char (point-max))
533 533
534 ;; Lisp output can include raw characters that confuse comint's 534 ;; Lisp output can include raw characters that confuse comint's
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 238adfe9505..1c82fcacf34 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -211,8 +211,6 @@ menu. See the info section on Regexps for more information.
211INDEX points to the substring in REGEXP that contains the name (of the 211INDEX points to the substring in REGEXP that contains the name (of the
212function, variable or type) that is to appear in the menu. 212function, variable or type) that is to appear in the menu.
213 213
214The variable is buffer-local.
215
216The variable `imenu-case-fold-search' determines whether or not the 214The variable `imenu-case-fold-search' determines whether or not the
217regexp matches are case sensitive, and `imenu-syntax-alist' can be 215regexp matches are case sensitive, and `imenu-syntax-alist' can be
218used to alter the syntax table for the search. 216used to alter the syntax table for the search.
@@ -240,9 +238,7 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
240The function `imenu--subalist-p' tests an element and returns t 238The function `imenu--subalist-p' tests an element and returns t
241if it is a sub-alist. 239if it is a sub-alist.
242 240
243This function is called within a `save-excursion'. 241This function is called within a `save-excursion'.")
244
245The variable is buffer-local.")
246;;;###autoload 242;;;###autoload
247(make-variable-buffer-local 'imenu-create-index-function) 243(make-variable-buffer-local 'imenu-create-index-function)
248 244
@@ -977,8 +973,7 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
977(defvar imenu-buffer-menubar nil) 973(defvar imenu-buffer-menubar nil)
978 974
979(defvar imenu-menubar-modified-tick 0 975(defvar imenu-menubar-modified-tick 0
980 "The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'. 976 "The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'.")
981This value becomes local in every buffer when it is set.")
982(make-variable-buffer-local 'imenu-menubar-modified-tick) 977(make-variable-buffer-local 'imenu-menubar-modified-tick)
983 978
984(defun imenu-update-menubar () 979(defun imenu-update-menubar ()
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index a0be6db3d2f..132f11d485b 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -225,7 +225,7 @@ character set: `latin-2', `hebrew' etc."
225 225
226;; Backwards compatibility. 226;; Backwards compatibility.
227(defalias 'latin1-char-displayable-p 'char-displayable-p) 227(defalias 'latin1-char-displayable-p 'char-displayable-p)
228(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.5") 228(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.4")
229 229
230(defun latin1-display-setup (set &optional force) 230(defun latin1-display-setup (set &optional force)
231 "Set up Latin-1 display for characters in the given SET. 231 "Set up Latin-1 display for characters in the given SET.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index dcd5bdf9cca..ad6f6b21ebc 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -153,9 +153,9 @@ string, and RET terminates editing and does a nonincremental search."
153(defcustom search-whitespace-regexp "\\(?:\\s-+\\)" 153(defcustom search-whitespace-regexp "\\(?:\\s-+\\)"
154 "*If non-nil, regular expression to match a sequence of whitespace chars. 154 "*If non-nil, regular expression to match a sequence of whitespace chars.
155This applies to regular expression incremental search. 155This applies to regular expression incremental search.
156You might want to use something like \"[ \\t\\r\\n]+\" instead. 156You might want to use something like \"\\\\(?:[ \\t\\r\\n]+\\\\)\" instead.
157In the Customization buffer, that is `[' followed by a space, 157In the Customization buffer, that is `\\(?:[' followed by a space,
158a tab, a carriage return (control-M), a newline, and `]+'." 158a tab, a carriage return (control-M), a newline, and `]+\\)'."
159 :type 'regexp 159 :type 'regexp
160 :group 'isearch) 160 :group 'isearch)
161 161
@@ -294,11 +294,11 @@ Default value, nil, means edit the string instead."
294 (define-key map "\M-\C-y" 'isearch-yank-char) 294 (define-key map "\M-\C-y" 'isearch-yank-char)
295 (define-key map "\C-y" 'isearch-yank-line) 295 (define-key map "\C-y" 'isearch-yank-line)
296 296
297 ;; Define keys for regexp chars * ? |. 297 ;; Define keys for regexp chars * ? } |.
298 ;; Nothing special for + because it matches at least once. 298 ;; Nothing special for + because it matches at least once.
299 (define-key map "*" 'isearch-*-char) 299 (define-key map "*" 'isearch-*-char)
300 (define-key map "?" 'isearch-*-char) 300 (define-key map "?" 'isearch-*-char)
301 (define-key map "{" 'isearch-{-char) 301 (define-key map "}" 'isearch-}-char)
302 (define-key map "|" 'isearch-|-char) 302 (define-key map "|" 'isearch-|-char)
303 303
304 ;; Turned off because I find I expect to get the global definition--rms. 304 ;; Turned off because I find I expect to get the global definition--rms.
@@ -368,9 +368,9 @@ Default value, nil, means edit the string instead."
368 368
369(defvar isearch-cmds nil 369(defvar isearch-cmds nil
370 "Stack of search status sets. 370 "Stack of search status sets.
371Each set is a list of the form: 371Each set is a vector of the form:
372 (STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD 372 [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD
373 INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH)") 373 INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]")
374 374
375(defvar isearch-string "") ; The current search string. 375(defvar isearch-string "") ; The current search string.
376(defvar isearch-message "") ; text-char-description version of isearch-string 376(defvar isearch-message "") ; text-char-description version of isearch-string
@@ -770,6 +770,74 @@ REGEXP says which ring to use."
770;; (handle-switch-frame (car (cdr last-command-char)))) 770;; (handle-switch-frame (car (cdr last-command-char))))
771 771
772 772
773;; The search status structure and stack.
774
775(defsubst isearch-string (frame)
776 "Return the search string in FRAME."
777 (aref frame 0))
778(defsubst isearch-message-string (frame)
779 "Return the search string to display to the user in FRAME."
780 (aref frame 1))
781(defsubst isearch-point (frame)
782 "Return the point in FRAME."
783 (aref frame 2))
784(defsubst isearch-success (frame)
785 "Return the success flag in FRAME."
786 (aref frame 3))
787(defsubst isearch-forward-flag (frame)
788 "Return the searching-forward flag in FRAME."
789 (aref frame 4))
790(defsubst isearch-other-end (frame)
791 "Return the other end of the match in FRAME."
792 (aref frame 5))
793(defsubst isearch-word (frame)
794 "Return the search-by-word flag in FRAME."
795 (aref frame 6))
796(defsubst isearch-invalid-regexp (frame)
797 "Return the regexp error message in FRAME, or nil if its regexp is valid."
798 (aref frame 7))
799(defsubst isearch-wrapped (frame)
800 "Return the search-wrapped flag in FRAME."
801 (aref frame 8))
802(defsubst isearch-barrier (frame)
803 "Return the barrier value in FRAME."
804 (aref frame 9))
805(defsubst isearch-within-brackets (frame)
806 "Return the in-character-class flag in FRAME."
807 (aref frame 10))
808(defsubst isearch-case-fold-search (frame)
809 "Return the case-folding flag in FRAME."
810 (aref frame 11))
811
812(defun isearch-top-state ()
813 (let ((cmd (car isearch-cmds)))
814 (setq isearch-string (isearch-string cmd)
815 isearch-message (isearch-message-string cmd)
816 isearch-success (isearch-success cmd)
817 isearch-forward (isearch-forward-flag cmd)
818 isearch-other-end (isearch-other-end cmd)
819 isearch-word (isearch-word cmd)
820 isearch-invalid-regexp (isearch-invalid-regexp cmd)
821 isearch-wrapped (isearch-wrapped cmd)
822 isearch-barrier (isearch-barrier cmd)
823 isearch-within-brackets (isearch-within-brackets cmd)
824 isearch-case-fold-search (isearch-case-fold-search cmd))
825 (goto-char (isearch-point cmd))))
826
827(defun isearch-pop-state ()
828 (setq isearch-cmds (cdr isearch-cmds))
829 (isearch-top-state))
830
831(defun isearch-push-state ()
832 (setq isearch-cmds
833 (cons (vector isearch-string isearch-message (point)
834 isearch-success isearch-forward isearch-other-end
835 isearch-word
836 isearch-invalid-regexp isearch-wrapped isearch-barrier
837 isearch-within-brackets isearch-case-fold-search)
838 isearch-cmds)))
839
840
773;; Commands active while inside of the isearch minor mode. 841;; Commands active while inside of the isearch minor mode.
774 842
775(defun isearch-exit () 843(defun isearch-exit ()
@@ -1245,53 +1313,93 @@ might return the position of the end of the line."
1245 (isearch-update)) 1313 (isearch-update))
1246 1314
1247 1315
1248(defun isearch-{-char () 1316;; *, ?, }, and | chars can make a regexp more liberal.
1249 "Handle \{ specially in regexps."
1250 (interactive)
1251 (isearch-*-char t))
1252
1253;; *, ?, and | chars can make a regexp more liberal.
1254;; They can make a regexp match sooner or make it succeed instead of failing. 1317;; They can make a regexp match sooner or make it succeed instead of failing.
1255;; So go back to place last successful search started 1318;; So go back to place last successful search started
1256;; or to the last ^S/^R (barrier), whichever is nearer. 1319;; or to the last ^S/^R (barrier), whichever is nearer.
1257;; + needs no special handling because the string must match at least once. 1320;; + needs no special handling because the string must match at least once.
1258 1321
1259(defun isearch-*-char (&optional want-backslash) 1322(defun isearch-backslash (str)
1260 "Handle * and ? specially in regexps. 1323 "Return t if STR ends in an odd number of backslashes."
1261When WANT-BACKSLASH is non-nil, do special handling for \{." 1324 (= (mod (- (length str) (string-match "\\\\*\\'" str)) 2) 1))
1262 (interactive) 1325
1263 (if isearch-regexp 1326(defun isearch-fallback (want-backslash &optional allow-invalid to-barrier)
1264 (let ((idx (length isearch-string))) 1327 "Return point to previous successful match to allow regexp liberalization.
1265 (while (and (> idx 0) 1328\\<isearch-mode-map>
1266 (eq (aref isearch-string (1- idx)) ?\\)) 1329Respects \\[isearch-repeat-forward] and \\[isearch-repeat-backward] by
1267 (setq idx (1- idx))) 1330stopping at `isearch-barrier' as needed.
1268 ;; * and ? are special when not preceded by \. 1331
1269 ;; { is special when it is preceded by \. 1332Do nothing if a backslash is escaping the liberalizing character. If
1270 (when (= (mod (- (length isearch-string) idx) 2) 1333WANT-BACKSLASH is non-nil, invert this behavior (for \\} and \\|).
1271 (if want-backslash 1 0)) 1334
1272 (setq isearch-adjusted t) 1335Do nothing if regexp has recently been invalid unless optional ALLOW-INVALID
1273 ;; Get the isearch-other-end from before the last search. 1336non-nil.
1274 ;; We want to start from there, 1337
1275 ;; so that we don't retreat farther than that. 1338If optional TO-BARRIER non-nil, ignore previous matches and go exactly to the
1276 ;; (car isearch-cmds) is after last search; 1339barrier."
1277 ;; (car (cdr isearch-cmds)) is from before it. 1340 ;; (eq (not a) (not b)) makes all non-nil values equivalent
1278 (let ((cs (nth 5 (car (cdr isearch-cmds))))) 1341 (when (and isearch-regexp (eq (not (isearch-backslash isearch-string))
1279 (setq cs (or cs isearch-barrier)) 1342 (not want-backslash))
1280 (goto-char 1343 ;; We have to check 2 stack frames because the last might be
1281 (if isearch-forward 1344 ;; invalid just because of a backslash.
1282 (max cs isearch-barrier) 1345 (or (not isearch-invalid-regexp)
1283 (min cs isearch-barrier))))))) 1346 (not (isearch-invalid-regexp (cadr isearch-cmds)))
1347 allow-invalid))
1348 (if to-barrier
1349 (progn (goto-char isearch-barrier)
1350 (setq isearch-adjusted t))
1351 (let* ((stack isearch-cmds)
1352 (previous (cdr stack)) ; lookbelow in the stack
1353 (frame (car stack)))
1354 ;; Walk down the stack looking for a valid regexp (as of course only
1355 ;; they can be the previous successful match); this conveniently
1356 ;; removes all bracket-sets and groups that might be in the way, as
1357 ;; well as partial \{\} constructs that the code below leaves behind.
1358 ;; Also skip over postfix operators -- though horrid,
1359 ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal.
1360 (while (and previous
1361 (or (isearch-invalid-regexp frame)
1362 (let* ((string (isearch-string frame))
1363 (lchar (aref string (1- (length string)))))
1364 ;; The operators aren't always operators; check
1365 ;; backslashes. This doesn't handle the case of
1366 ;; operators at the beginning of the regexp not
1367 ;; being special, but then we should fall back to
1368 ;; the barrier anyway because it's all optional.
1369 (if (isearch-backslash
1370 (isearch-string (car previous)))
1371 (eq lchar ?\})
1372 (memq lchar '(?* ?? ?+))))))
1373 (setq stack previous previous (cdr previous) frame (car stack)))
1374 (when stack
1375 ;; `stack' now refers the most recent valid regexp that is not at
1376 ;; all optional in its last term. Now dig one level deeper and find
1377 ;; what matched before that.
1378 (let ((last-other-end (or (isearch-other-end (car previous))
1379 isearch-barrier)))
1380 (goto-char (if isearch-forward
1381 (max last-other-end isearch-barrier)
1382 (min last-other-end isearch-barrier)))
1383 (setq isearch-adjusted t))))))
1284 (isearch-process-search-char last-command-char)) 1384 (isearch-process-search-char last-command-char))
1285 1385
1386;; * and ? are special when not preceded by \.
1387(defun isearch-*-char ()
1388 "Maybe back up to handle * and ? specially in regexps."
1389 (interactive)
1390 (isearch-fallback nil))
1391
1392;; } is special when it is preceded by \.
1393(defun isearch-}-char ()
1394 "Handle \\} specially in regexps."
1395 (interactive)
1396 (isearch-fallback t t))
1286 1397
1398;; | is special when it is preceded by \.
1287(defun isearch-|-char () 1399(defun isearch-|-char ()
1288 "If in regexp search, jump to the barrier." 1400 "If in regexp search, jump to the barrier unless in a group."
1289 (interactive) 1401 (interactive)
1290 (if isearch-regexp 1402 (isearch-fallback t nil t))
1291 (progn
1292 (setq isearch-adjusted t)
1293 (goto-char isearch-barrier)))
1294 (isearch-process-search-char last-command-char))
1295 1403
1296(defun isearch-unread-key-sequence (keylist) 1404(defun isearch-unread-key-sequence (keylist)
1297 "Unread the given key-sequence KEYLIST. 1405 "Unread the given key-sequence KEYLIST.
@@ -1771,38 +1879,6 @@ If there is no completion possible, say so and continue searching."
1771 (insert isearch-string)))) 1879 (insert isearch-string))))
1772 1880
1773 1881
1774;; The search status stack (and isearch window-local variables, not used).
1775;; Need a structure for this.
1776
1777(defun isearch-top-state ()
1778 (let ((cmd (car isearch-cmds)))
1779 (setq isearch-string (car cmd)
1780 isearch-message (car (cdr cmd))
1781 isearch-success (nth 3 cmd)
1782 isearch-forward (nth 4 cmd)
1783 isearch-other-end (nth 5 cmd)
1784 isearch-word (nth 6 cmd)
1785 isearch-invalid-regexp (nth 7 cmd)
1786 isearch-wrapped (nth 8 cmd)
1787 isearch-barrier (nth 9 cmd)
1788 isearch-within-brackets (nth 10 cmd)
1789 isearch-case-fold-search (nth 11 cmd))
1790 (goto-char (car (cdr (cdr cmd))))))
1791
1792(defun isearch-pop-state ()
1793 (setq isearch-cmds (cdr isearch-cmds))
1794 (isearch-top-state))
1795
1796(defun isearch-push-state ()
1797 (setq isearch-cmds
1798 (cons (list isearch-string isearch-message (point)
1799 isearch-success isearch-forward isearch-other-end
1800 isearch-word
1801 isearch-invalid-regexp isearch-wrapped isearch-barrier
1802 isearch-within-brackets isearch-case-fold-search)
1803 isearch-cmds)))
1804
1805
1806;; Message string 1882;; Message string
1807 1883
1808(defun isearch-message (&optional c-q-hack ellipsis) 1884(defun isearch-message (&optional c-q-hack ellipsis)
@@ -1932,9 +2008,9 @@ Can be changed via `isearch-search-fun-function' for special needs."
1932 (if isearch-success 2008 (if isearch-success
1933 nil 2009 nil
1934 ;; Ding if failed this time after succeeding last time. 2010 ;; Ding if failed this time after succeeding last time.
1935 (and (nth 3 (car isearch-cmds)) 2011 (and (isearch-success (car isearch-cmds))
1936 (ding)) 2012 (ding))
1937 (goto-char (nth 2 (car isearch-cmds))))) 2013 (goto-char (isearch-point (car isearch-cmds)))))
1938 2014
1939 2015
1940;; Called when opening an overlay, and we are still in isearch. 2016;; Called when opening an overlay, and we are still in isearch.
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index bda0ce4fddc..52915c46950 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -159,7 +159,7 @@
159;; then all buffers matching "Summary" are moved to the end of the 159;; then all buffers matching "Summary" are moved to the end of the
160;; list. (I find this handy for keeping the INBOX Summary and so on 160;; list. (I find this handy for keeping the INBOX Summary and so on
161;; out of the way.) It also moves buffers matching "output\*$" to the 161;; out of the way.) It also moves buffers matching "output\*$" to the
162;; end of the list (these are created by AUC TeX when compiling.) 162;; end of the list (these are created by AUCTeX when compiling.)
163;; Other functions could be made available which alter the list of 163;; Other functions could be made available which alter the list of
164;; matching buffers (either deleting or rearranging elements.) 164;; matching buffers (either deleting or rearranging elements.)
165 165
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index e879b4d0b1a..b158f626d51 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -98,6 +98,7 @@
98 "Cyrillic-KOI8" `((charset koi8) 98 "Cyrillic-KOI8" `((charset koi8)
99 (coding-system cyrillic-koi8) 99 (coding-system cyrillic-koi8)
100 (coding-priority cyrillic-koi8 cyrillic-iso-8bit) 100 (coding-priority cyrillic-koi8 cyrillic-iso-8bit)
101 (ctext-non-standard-encodings "koi8-r")
101 (nonascii-translation . koi8) 102 (nonascii-translation . koi8)
102 (input-method . "russian-typewriter") 103 (input-method . "russian-typewriter")
103 (features cyril-util) 104 (features cyril-util)
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index 9a4521bbde9..e2d3762ff77 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -281,19 +281,19 @@ automatically."
281 281
282;; Compatibility with old names. 282;; Compatibility with old names.
283(defvaralias 'vc-comment-ring 'log-edit-comment-ring) 283(defvaralias 'vc-comment-ring 'log-edit-comment-ring)
284(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.5") 284(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.4")
285(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index) 285(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index)
286(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.5") 286(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.4")
287(defalias 'vc-previous-comment 'log-edit-previous-comment) 287(defalias 'vc-previous-comment 'log-edit-previous-comment)
288(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.5") 288(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.4")
289(defalias 'vc-next-comment 'log-edit-next-comment) 289(defalias 'vc-next-comment 'log-edit-next-comment)
290(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.5") 290(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.4")
291(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward) 291(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward)
292(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.5") 292(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.4")
293(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward) 293(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward)
294(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.5") 294(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.4")
295(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log) 295(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log)
296(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.5") 296(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.4")
297 297
298;;; 298;;;
299;;; Actual code 299;;; Actual code
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 7f2e6fef6b6..675444d7ba4 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -687,6 +687,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
687(defvar disable-initial-guessing-flag) ; dynamic assignment 687(defvar disable-initial-guessing-flag) ; dynamic assignment
688(defvar cbeg) ; dynamic assignment 688(defvar cbeg) ; dynamic assignment
689(defvar cend) ; dynamic assignment 689(defvar cend) ; dynamic assignment
690(defvar mail-extr-all-top-level-domains) ; Defined below.
690 691
691;;;###autoload 692;;;###autoload
692(defun mail-extract-address-components (address &optional all) 693(defun mail-extract-address-components (address &optional all)
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 3d19028b099..dd1062da816 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,311 @@
12004-08-21 Bill Wohler <wohler@newt.com>
2
3 * Released MH-E version 7.82.
4
5 * MH-E-NEWS, README: Updated for release 7.82.
6
7 * mh-e.el (Version, mh-version): Updated for release 7.82.
8
92004-08-24 Bill Wohler <wohler@newt.com>
10
11 * mh-init.el (mh-variant-set): Changed MH to mh as that's what is
12 emitted by `mh-variant-mh-info' (closes SF #1014781).
13 (mh-variant-p): Added mu-mh to docstring.
14
152004-08-23 Satyaki Das <satyaki@theforce.stanford.edu>
16
17 * mh-acros.el (mh-require-cl): Remove unneeded autoloads.
18 (require): Add an advice to the function so that at compile time
19 the uncompiled file is loaded. This avoids compilation problems
20 when built in the Emacs tree.
21
22 * mh-mime.el (mh-identity-pgg-default-user-id): Defvar the
23 variable, to avoid compiler warnings.
24
25 * mh-e.el (mh-seq): Load mh-seq since functions defined there are
26 used here. Without this, the state mh-seq.elc would be loaded.
27
28 * mh-customize.el (mh-init, mh-identity): Load mh-init and
29 mh-identity at compile time manually, before the corresponding
30 stale elc files get autoloaded.
31
322004-08-21 Bill Wohler <wohler@newt.com>
33
34 * mh-e.el (Version, mh-version): Added +cvs to release number.
35
362004-08-21 Bill Wohler <wohler@newt.com>
37
38 * Released MH-E version 7.81.
39
40 * MH-E-NEWS, README: Updated for release 7.81.
41
42 * mh-e.el (Version, mh-version): Updated for release 7.81.
43
442004-08-21 Bill Wohler <wohler@newt.com>
45
46 * release-utils (variable_changes): Check for checked-out
47 directory before proceeding. Remove temporary files. Renamed
48 --variable-update flag to --variable-changes.
49
502004-08-16 Mark D. Baushke <mdb@gnu.org>
51
52 * mh-mime.el (mh-toggle-mh-decode-mime-flag: New function.
53 * mh-e.el (mh-help-messages): Add [;] help string for it.
54 (mh-folder-mode-map): Add ";" key binding for it.
55
562004-08-15 Satyaki Das <satyaki@theforce.stanford.edu>
57
58 * mh-acros.el (mh-defstruct): Distinguishing structures created
59 by mh-defstruct just based on the number of fields is not
60 sufficient, since both the mh-thread-message and
61 mh-thread-container structures have the same length.
62
632004-08-15 Mark D. Baushke <mdb@gnu.org>
64
65 * mh-customize.el (mh-identity-handlers): Use ":default" instead of
66 "default" to avoid problems with "Default:" as a user defined field.
67 * mh-identity.el (mh-identity-field-handler): Ditto.
68
692004-08-15 Bill Wohler <wohler@newt.com>
70
71 * mh-e.el (Version, mh-version): Added +cvs to release number.
72
732004-08-15 Bill Wohler <wohler@newt.com>
74
75 * Released MH-E version 7.4.80.
76
77 * MH-E-NEWS, README: Updated for release 7.4.80.
78
79 * mh-e.el (Version, mh-version): Updated for release 7.4.80.
80
812004-08-15 Bill Wohler <wohler@newt.com>
82
83 * mh-funcs.el, mh-gnus.el, mh-inc.el, mh-init.el, mh-junk.el,
84 mh-pick.el, mh-print.el, mh-xemacs.el: Added 2004 to Copyright.
85
86 * mh-acros.el, mh-alias.el: Checkdoc fixes.
87
882004-08-12 Satyaki Das <satyaki@theforce.stanford.edu>
89
90 * mh-acros.el (cl): Load cl in this file. That is all right, since
91 this file is only used at compile time, and so cl doesn't get
92 loaded at run time. This avoids problems with stale *.elc files
93 present in the Emacs source tree during compilation.
94 (mh-defstruct): Modify it to make it more CL like and in the
95 process simplify it a bit. This makes the argument list of the
96 constructor compatible with the previous version, thereby avoiding
97 a compilation error when an old version of mh-seq.elc is present.
98
99 * mh-seq.el (mh-thread-id-container, mh-thread-get-message)
100 (mh-thread-get-message-container): Revert back to the CL style
101 of using keyword arguments, since the mh-defstruct now produces
102 code compatible to such usage.
103
1042004-08-11 Satyaki Das <satyaki@theforce.stanford.edu>
105
106 * mh-acros.el (mh-defstruct, mh-require-cl): Checkdoc fixes.
107
108 * mh-utils.el (message-tokenize-header, message-fetch-field): Add
109 autoloads.
110 (mh-folder-completing-read): Make the folder completion look
111 better with CVS Emacs.
112
113 * mh-init.el (mh-variant-set): Remove dead code.
114
1152004-08-11 Bill Wohler <wohler@newt.com>
116
117 * *.el: Use the following at the top of each file which seems to
118 do a good job of suppressing compilation warnings in 21.3 and CVS
119 Emacs (21.4). This replaces (require 'cl) or (require
120 'utils) (mh-require-cl) calls:
121
122 (eval-when-compile (require 'mh-acros))
123 (mh-require-cl)
124
1252004-08-10 Bill Wohler <wohler@newt.com>
126
127 * release-utils (DESCRIPTION): Added one.
128 (FILES, SEE ALSO, VERSION): Deleted empty and incorrect sections.
129
130 * mh-e.el (mh-colors-available-p): Call x-display-color-cells with
131 mh-funcall-if-exists since it no longer seems to be defined in
132 GNU Emacs 21.4.
133
1342004-08-10 Satyaki Das <satyaki@theforce.stanford.edu>
135
136 * mh-speed.el (mh-process-kill-without-query, mh-speed-flists):
137 Avoid a compiler warning in versions of Emacs where
138 process-kill-without-query is a deprecated function.
139
140 * mh-seq.el (mh-thread-message, mh-thread-container): Use
141 mh-defstruct instead of defstruct.
142 (mh-thread-id-container, mh-thread-get-message-container)
143 (mh-thread-get-message): Use the slightly different structure
144 constructor function.
145
146 * mh-acros.el (mh-defstruct): New macro which is a partial
147 replacement of the defstruct in CL.
148 (no-byte-compile): Don't compile the file since it isn't loaded at
149 run time, so efficiency isn't an issue.
150
151 * mh-utils.el (mh-buffer-data): Use mh-defstruct instead of
152 defstruct.
153
1542004-08-09 Satyaki Das <satyaki@theforce.stanford.edu>
155
156 * mh-funcs.el, mh-junk.el, mh-print.el: Use mh-require-cl to avoid
157 compilation warnings in Emacs-21.3.
158
159 * mh-acros.el (mh-require-cl): Add autoloads of CL functions used.
160
1612004-08-09 Bill Wohler <wohler@newt.com>
162
163 * mh-customize.el (mh-show-use-xface-flag): Mention that `fetch' and
164 `curl' are supported as well.
165
1662004-08-08 Bill Wohler <wohler@newt.com>
167
168 * mh-xemacs.el (mh-xemacs-has-toolbar-flag): Checkdoc fixes.
169
170 * mh-mime.el (mh-display-with-external-viewer): Checkdoc fixes.
171
172 * mh-identity.el: (mh-identity-attribution-verb-end): Stripped
173 trailing space; checkdoc fixes.
174
175 * mh-e.el (mh-restore-desktop-buffer): Checkdoc fixes.
176
177 * mh-customize.el: (mh-inc-spool-list,
178 mh-compose-forward-as-mime-flag, defcustom): Stripped trailing
179 space; checkdoc fixes.
180
181 * mh-comp.el (mh-reply): Stripped trailing space.
182
183 * mh-unit.el (mh-unit-files): Added mh-acros.el and mh-gnus.el.
184 (mh-unit): Don't lm-verify pre-21.4. Save buffers before killing
185 since we might have done some editing.
186
187 * import-emacs: Deleted. Functionality subsumed by release-utils.
188
189 * release-utils: New script. Performs import-emacs functionality
190 and displays new and deleted options.
191
192 * Makefile (import-emacs): Call release-utils instead of
193 import-emacs.
194
195 * mh-funcs.el (mh-undo-folder): Removed deprecated `ignore'
196 argument.
197
198 * mh-e.el (mh-scan-date-regexp): Deleted as Peter claims it is
199 obsolete.
200 (mh-folder-font-lock-keywords): Removed reference to deleted
201 variable `mh-scan-date-regexp'.
202
203 * mh-customize.el (mh-auto-fields-prompt-flag): Made reference to
204 `mh-auto-fileds-lists'.
205 (mh-forward-hook): Fixed docstring typo.
206
2072004-08-07 Bill Wohler <wohler@newt.com>
208
209 * mh-acros.el: New file. Currently holds macros needed by
210 mh-customize.el but is planned to hold all macros to avoid
211 dependency problems when compiling.
212
213 * mh-utils.el (mh-xemacs-flag): Defined in mh-customize.el now.
214 (mh-require-cl, mh-do-in-gnu-emacs, mh-do-in-xemacs)
215 (mh-funcall-if-exists, mh-make-local-hook, mh-mark-active-p):
216 Moved to new file mh-acros.el.
217
218 * mh-customize.el: Require mh-acros and cl only when compiling and
219 mh-loaddefs at runtime instead of mh-utils.
220 (mh-xemacs-flag): Define it here instead of mh-utils.el.
221
222 * Makefile (MH-E-SRC): Added mh-acros.el.
223
224 * mh-gnus.el (default-enable-multibyte-characters): Don't define
225 any more. It doesn't seem to be needed.
226
227 * mh-customize.el (mh-junk-background): New variable. If on, spam
228 programs are run in background. Running in foreground can be slow.
229 Defaults to nil to spare machines with little memory.
230
231 * mh-junk.el (mh-spamassassin-blacklist, mh-bogofilter-blacklist)
232 (mh-bogofilter-whitelist, mh-spamprobe-blacklist)
233 (mh-spamprobe-whitelist): Use new option mh-junk-background.
234
2352004-07-25 Satyaki Das <satyaki@theforce.stanford.edu>
236
237 * mh-utils.el (mh-folder-completing-read): In recent CVS Emacs,
238 the first letter of the possible choices in the completion buffer
239 is highlighted. The change is needed for this feature to work
240 during folder name completion. This is not entirely sufficient,
241 since the leading "+" in folder names is still mishandled. A patch
242 is required in Emacs itself to address that.
243
2442004-07-22 Mark D. Baushke <mdb@gnu.org>
245
246 * mh-e.el (recursive-load-depth-limit): Move
247 recursive-load-depth-limit code to ...
248 * mh-utils.el (recursive-load-depth-limit): ... here to avoid
249 problems compiling mh-utils.el and mh-alias.el with gnus-5.10.6
250 under emacs-21.1. Use eval-and-compile instead of eval-when.
251
2522004-07-20 Bill Wohler <wohler@newt.com>
253
254 * mh-customize.el (mh-invisible-header-fields-internal): Added
255 header fields emitted by T-Mobile picture phones (X-Mms-*, and
256 commented out X-Operator field saying it's like X-Mailer).
257
2582004-07-12 Bill Wohler <wohler@newt.com>
259
260 * mh-gnus.el: Set local variables indent-tabs-mode and
261 sentence-end-double-space to nil.
262
263 * mh-customize.el: Checkpoint from option docstring updates and
264 manual synchronization from last summer. For the options listed
265 below, docstring was usually completely rewritten. Use "on"
266 instead of "t" in docstring to match what is seen in customization
267 buffer. Use headline capitalization. Standardize on "Auto-detect"
268 text when option has that capibility.
269 (mh): Since we work on more than one type of Emacs, use Emacs
270 instead of GNU Emacs. Prefer GNU mailutils over GNU Mailutils.
271 (mh-variant): s/Autodetect at startup/Auto-detect/.
272 (mh-alias-insertion-location): s/Sorted
273 alphabetically/Alphabetical/. s/At the top of file/Top/. s/At the
274 bottom of file/Bottom/.
275 (mh-alias-local-users-prefix): s/Use login instead of real
276 name/Use Login/.
277 (mh-identity-list): Sorted values by fields, attribution,
278 signature, GPG key.
279 (mh-auto-fields-list): Missing quote.
280 (mh-compose-insertion): s/Use Gnus/Gnus/. s/Use mhn/mhn/.
281 (mh-compose-space-does-completion-flag): s/SPACE/<SPC>/.
282 (mh-extract-from-attribution-verb): Since we have French, added
283 German too ;-).
284 (mh-letter-complete-function): Mention default in docstring.
285 (mh-invisible-header-fields-internal): Added X-ELNK-Trace from
286 Earthlink.
287 (mh-alias-flash-on-comma, mh-alias-insert-file)
288 (mh-alias-passwd-gecos-comma-separator-flag)
289 (mh-recenter-summary-flag, mh-default-folder-for-message-function)
290 (mh-default-folder-must-exist-flag, mh-index-program)
291 (mh-index-ticked-messages-folders, mh-ins-buf-prefix)
292 (mh-delete-yanked-msg-window-flag, mh-identity-default): See
293 summary above.
294
295 * mh-init.el (mh-variant-set, mh-sys-path, mh-variant-mu-mh-info):
296 Prefer GNU mailutils over GNU Mailutils MH.
297
298 * mh-comp.el (sc-cite-original, mh-smail, mh-smail-batch)
299 (mh-edit-again, mh-extract-rejected-mail, mh-forward)
300 (mh-smail-other-window, mh-reply, mh-send, mh-send-other-window):
301 Use `mh-send' instead of \\[mh-send]] since links in the docstring
302 are more useful than a key sequence in these cases. Use "See also"
303 instead of "See also documentation for".
304
305 * Merged in 7.4.4 changes, described below.
306
307 * mh-e.el (Version, mh-version): Set to 7.4.4+cvs.
308
12004-07-10 Bill Wohler <wohler@newt.com> 3092004-07-10 Bill Wohler <wohler@newt.com>
2 310
3 * Released MH-E version 7.4.4. 311 * Released MH-E version 7.4.4.
@@ -66,7 +374,7 @@
66 require that the cl package not be required at runtime. However, 374 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 375 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 376 in their macro expansions. Use mh-require-cl to provide the cl
69 routines in the best way possible. 377 routines in the best way possible (closes SF #930012).
70 (require 'mouse): To shush compiler. 378 (require 'mouse): To shush compiler.
71 379
72 * Use new function mh-require-cl throughout. 380 * Use new function mh-require-cl throughout.
@@ -87,6 +395,128 @@
87 4. Run xbmtopbm < file.xbm > file.pbm. 395 4. Run xbmtopbm < file.xbm > file.pbm.
88 Thanks to jan.h.d@swipnet.se for the help. 396 Thanks to jan.h.d@swipnet.se for the help.
89 397
3982004-07-07 Stephen Gildea
399
400 * mh-customize.el (mh-invisible-header-fields-internal):
401 Add X-Greylist, X-Source*, and X-WebTV-Signature.
402 Replace specific X-Spam-* headers with general pattern.
403
4042004-06-15 Bill Wohler <wohler@newt.com>
405
406 * README: Vladimir Ivanovic reports that mh-rmail works with
407 XEmacs 21.5.17, so updated requirements text accordingly (closes
408 SF #644321).
409
4102004-05-12 Satyaki Das <satyaki@theforce.stanford.edu>
411
412 * mh-utils.el (mh-mail-header-end): Replace call to
413 rfc822-goto-eoh with something that allows From_ lines in the mail
414 header.
415
4162004-04-14 Bill Wohler <wohler@newt.com>
417
418 * mh-utils.el (mh-show-mouse): s/EVENT/event/. Thanks to John Paul
419 Wallington <jpw@gnu.org> for pointing this out.
420
4212004-04-12 Satyaki Das <satyaki@theforce.stanford.edu>
422
423 * mh-e.el (mh-folder-size-flist): Add -showzero option so that the
424 parsing code doesn't get confused by the presence of -noshowzero
425 in the user's .mh_profile (closes SF #933954).
426
4272004-04-07 Satyaki Das <satyaki@theforce.stanford.edu>
428
429 * mh-mime.el (mh-insert-mime-button)
430 (mh-insert-mime-security-button): Add evaporate property to
431 overlays used in MIME part buttons. This avoids problems with
432 CVS Emacs.
433
4342004-03-16 Satyaki Das <satyaki@theforce.stanford.edu>
435
436 * mh-e.el (mh-folder-from-address): Go to the end of buffer if the
437 re-search-forward fails (closes SF #917096).
438
4392004-02-02 Satyaki Das <satyaki@theforce.stanford.edu>
440
441 * mh-customize.el (mh-compose-forward-as-mime-flag): New user
442 customizable variable that controls whether messages are forwarded
443 as MIME attachments (closes SF #827203).
444
445 * mh-comp.el (mh-forward): Call forw with -mime option only if
446 mh-compose-forward-as-mime-flag is non-nil.
447
4482003-12-26 Jeffrey C Honig <jch@honig.net>
449
450 * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist)
451 (mh-spamassassin-blacklist, mh-spamassassin-blacklist)
452 (mh-spamassassin-blacklist, mh-spamassassin-whitelist)
453 (mh-spamassassin-whitelist, mh-bogofilter-blacklist)
454 (mh-spamprobe-blacklist): Add progress messages. Change "Couldn't"
455 to "Unable" in error messages. Run bogofilter and spamprobe in
456 the foreground to prevent a large number of processes from
457 swamping the system.
458
4592003-12-25 Satyaki Das <satyaki@theforce.stanford.edu>
460
461 * mh-e.el (mh-prompt-for-refile-folder): Marking the whole folder
462 and then refiling all messages throws an error, since this
463 function expects point to be on a valid scan line. The change
464 relaxes this requirement, thereby avoiding the above problem.
465
4662003-12-14 Satyaki Das <satyaki@theforce.stanford.edu>
467
468 * mh-comp.el (mh-ascii-buffer-p): New function that checks if a
469 buffer is entirely composed of ASCII.
470 (mh-send-letter): Encode the draft if it contains non-ASCII
471 characters.
472
4732003-12-12 Satyaki Das <satyaki@theforce.stanford.edu>
474
475 * mh-customize.el (mh-invisible-headers): Keep only unique fields
476 in list of header fields to hide. This avoids problems in XEmacs.
477
4782003-12-10 Satyaki Das <satyaki@theforce.stanford.edu>
479
480 * mh-seq.el (mh-thread-print-scan-lines): The imenu index was not
481 getting created for threaded index buffers. The change fixes this.
482
483 * mh-index.el (mh-index-insert-folder-headers): Always create the
484 imenu index.
485 (mh-index-create-imenu-index): Set which-func-mode to t. If
486 which-function-mode is turned on after the folder buffer has been
487 prepared, display of the folder info was being inhibited. The
488 change fixes that.
489
4902003-12-09 Satyaki Das <satyakid@stanford.edu>
491
492 * mh-comp.el (mh-letter-mode): Setup mh-mail-header-separator
493 based on draft contents.
494 (mh-letter-mode, mh-letter-mail-header-end-marker)
495 (mh-letter-header-end): Remove use of the variable
496 mh-letter-mail-header-end-marker. Instead use
497 mh-mail-header-separator. This avoids problems in font locking
498 draft buffers (closes SF #855479).
499
5002003-12-09 Satyaki Das <satyakid@stanford.edu>
501
502 * mh-index.el (mh-index-insert-folder-headers): Modified so that
503 imenu--index-alist is updated.
504 (mh-index-create-imenu-index): New function that generates an
505 index usable by imenu. This adds which-func-mode support to index
506 folders (closes SF #855520).
507
508 * mh-e.el (which-func, which-func-modes): Tell which-func that
509 mh-folder-mode supports it.
510 (mh-folder-mode): Add support for imenu.
511
5122003-11-22 Peter S Galbraith <psg@debian.org>
513
514 * Makefile: renamed mh-startup.el to mh-e-autoloads.el
515
516 * README: renamed mh-startup.el to mh-e-autoloads.el
517
518 * .cvsignore: Added mh-e-autoloads.el
519
902003-11-18 Bill Wohler <wohler@newt.com> 5202003-11-18 Bill Wohler <wohler@newt.com>
91 521
92 * Released MH-E version 7.4.3. 522 * Released MH-E version 7.4.3.
@@ -95,6 +525,8 @@
95 525
96 * mh-e.el (Version, mh-version): Updated for release 7.4.3. 526 * mh-e.el (Version, mh-version): Updated for release 7.4.3.
97 527
528 * This patch release contains the following two patches:
529
98 * mh-identity.el (mh-identity-make-menu): Removed condition on 530 * mh-identity.el (mh-identity-make-menu): Removed condition on
99 mh-auto-fields-list. Use it to enable or disable menu item 531 mh-auto-fields-list. Use it to enable or disable menu item
100 instead. 532 instead.
@@ -103,6 +535,810 @@
103 defcustom before mh-auto-fields-list so that defvar wouldn't 535 defcustom before mh-auto-fields-list so that defvar wouldn't
104 clobber user's customization settings. 536 clobber user's customization settings.
105 537
5382003-11-17 Jeffrey C Honig <jch@honig.net>
539
540 * mh-print.el (mh-print-msg): Do not print a message on deprecated
541 usage, the bindings have been removed.
542
543 * mh-e.el (mh-folder-mode-map): Remove "l" binding for
544 mh-print-msg.
545
546 * mh-utils.el (mh-show-mode-map): Remove "l" binding for
547 mh-print-msg.
548
5492003-11-16 Satyaki Das <satyakid@stanford.edu>
550
551 * mh-comp.el (mh-beginning-of-word): Use the function
552 mh-mail-abbrev-make-syntax-table instead of the function
553 mail-abbrev-make-syntax-table.
554
555 * mh-gnus.el (mh-mail-abbrev-make-syntax-table): Add a wrapper
556 function that calls mail-abbrev-make-syntax-table if available.
557 This is needed so that MH-E built with CVS Emacs will work with
558 released versions of Emacs21 and vice versa.
559
5602003-11-14 Peter S Galbraith <psg@debian.org>
561
562 * mh-customize.el (mh-invisible-header-fields-internal): Add
563 "X-NAI-Spam-" and "X-Spam-Report:".
564
5652003-11-14 Mark D. Baushke <mdb@gnu.org>
566
567 * mh-customize.el (mh-invisible-header-fields-internal):
568 Add X-AntiAbuse and X-MailScanner.
569 (Patch from Stephen Gildea.)
570
5712003-11-13 Peter S Galbraith <psg@debian.org>
572
573 * mh-identity.el (mh-identity-handler-attribution-verb): New
574 function. A new Identity handler for the attribution verb (e.g.
575 "wrote:") to allow for different identities to use different
576 languages.
577 (mh-identity-insert-attribution-verb): New function. Insert the
578 attribution verb, placing special markers so it can be deleted and
579 replaced later.
580 (mh-identity-attribution-verb-start): New variable. Holds the
581 marker for the start of the attribution verb.
582 (mh-identity-attribution-verb-end): New variable. Holds the
583 marker for the end of the attribution verb.
584
585 * mh-customize.el (mh-identity-handlers): Add new
586 ":attribution-verb" tag for the attribution-verb handler.
587 (mh-identity-list): Idem.
588
589 * mh-comp.el (mh-yank-cur-msg): Insert attribution verb using
590 mh-identity-insert-attribution-verb.
591 (mh-extract-from-attribution): Extract only the name from the From
592 line, without appending `mh-extract-from-attribution-verb' since
593 markers need to be inserted around that now.
594
5952003-11-12 Bill Wohler <wohler@newt.com>
596
597 * mh-e.el (mh-rmail, mh-nmail): Well, actually, we run in both GNU
598 Emacs and XEmacs, so removed the "GNU" in the docstrings unless
599 one is strictly talking about GNU Emacs.
600
601 * mh-comp.el (mh-smail, mh-smail-batch, mh-smail-other-window):
602 Ditto.
603
6042003-11-11 Bill Wohler <wohler@newt.com>
605
606 * mh-customize.el (mh-customize): Minor docstring change.
607 (mh, mh-e): The short description for MH-E is: The GNU Emacs
608 Interface to the MH Mail System. Therefore, updated docstrings
609 accordingly.
610
611 * mh-comp.el (mh-smail, mh-smail-batch, mh-smail-other-window):
612 Ditto.
613
614 * mh-e.el (mh-rmail, mh-nmail): Ditto.
615
6162003-11-10 Satyaki Das <satyakid@stanford.edu>
617
618 * mh-mime.el (mh-mml-to-mime): In case errors happen in
619 mml-to-mime, restore contents of the draft buffer (closes SF
620 #839303).
621
6222003-11-07 Bill Wohler <wohler@newt.com>
623
624 * mh-customize.el (mh-letter-mode-hook): Moved to mh-sending-mail
625 group (where it is now documented in the manual).
626 (mh-pick-mode-hook): Moved to mh-index group (where it is now
627 documented in the manual).
628
629 * mh-loaddefs.el: Deleted per our discussion on mh-e-devel. No
630 more conflicts! No more check-ins! Anyone pulling CVS MH-E is
631 expected to compile. This file shall be added to the tarball so
632 that users of the distribution are not.
633
6342003-11-07 Mark D. Baushke <mdb@gnu.org>
635
636 * mh-loaddefs.el: Regenerated.
637
638 * mh-customize.el (mh-forward-hook): Define new hook.
639 * mh-comp.el (mh-forward): Use it.
640
6412003-11-07 Satyaki Das <satyakid@stanford.edu>
642
643 * mh-loaddefs.el: Regenerated.
644
645 * mh-utils.el (mh-show-toggle-mime-buttons)
646 (mh-show-display-with-external-viewer): New interactive functions
647 callable from the show buffer.
648 (mh-show-mime-map): Add bindings for "K t" and "K e".
649 (mh-show-msg): Propagate change to
650 mh-display-buttons-for-inline-parts-flag to the show buffer.
651
652 * mh-mime.el (mh-display-with-external-viewer): New interactive
653 function to display MIME parts with external viewer (closes SF
654 #839318).
655
656 * mh-e.el (mh-folder-mode): Make the variable
657 mh-display-buttons-for-inline-parts-flag buffer-local so that
658 display of MIME buttons can be toggled.
659 (mh-toggle-mime-buttons): New interactive function to toggle
660 display of MIME buttons.
661 (mh-mime-map): Modified to add bindings for "K t" and "K e".
662
6632003-11-04 Steve Youngs <sryoungs@bigpond.net.au>
664
665 * Makefile (XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el
666 in XEmacs.
667 (XEMACS_LOADDEFS_COOKIE): Ditto.
668 (XEMACS_LOADDEFS_PKG_NAME): Ditto.
669 (xemacs): Add target to build mh-loaddefs.el in XEmacs
670 (clean-xemacs): Remove `mh-loaddefs.el*'
671 (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs.
672
6732003-11-02 Peter S Galbraith <psg@debian.org>
674
675 * mh-init.el (mh-variant-set-variant): Reset `mh-x-mailer-string'
676 when we select an MH variant.
677
6782003-11-02 Jeffrey C Honig <jch@honig.net>
679
680 * mh-loaddefs.el: Regenerated.
681
682 * mh-funcs.el (mh-print-msg): Move to mh-print.el.
683
684 * mh-e.el (mh-folder-mode-map): Add mh-print-msg ("l") back, it
685 will print a message that this usage is deprecated.
686
687 * mh-print.el (require, mh-ps-print-msg, mh-ps-print-msg-file):
688 Require mh-funcs for mh-note-printed. PS print functions were not
689 setting the printed notation. Move mh-print-msg here for
690 consistency. Print message if mh-print-msg invoked via deprecated
691 key binding.
692
6932003-11-01 Peter S Galbraith <psg@debian.org>
694
695 * Makefile: Add target to make `mh-startup.el', a file containg
696 usual entry commands into MH-E to be used for users installing
697 MH-E separately from Emacs.
698
699 * README: Document the above for users.
700
7012003-10-29 Jeffrey C Honig <jch@honig.net>
702
703 * mh-utils.el (mh-show-ps-print-map): Add "?" and "l" to
704 mh-show-ps-print-map.
705
706 * mh-e.el (mh-ps-print-map, mh-help-messages): Add "?" and "l" to
707 mh-ps-print-map. Add "l" to help message.
708
7092003-10-27 Bill Wohler <wohler@newt.com>
710
711 * Makefile (MH-E-SRC): Moved mh-xemacs.el to new variable
712 MH-E-XEMACS-SRC.
713 (MH-E-XEMACS-SRC): New variable to hold XEmacs source files.
714 (MH-E-XEMACS-OBJ): New variable to hold XEmacs object files.
715 (clean): Moved XEmacs-specific code to clean-xemacs.
716 (xemacs): Added clean-xemacs prerequisite. Moved down to
717 XEmacs section of file.
718 (clean-xemacs): New target to remove XEmacs-specific files.
719 (compile-xemacs): Added $(MH-E-XEMACS-SRC) prerequisite.
720 (dist): Added $(MH-E-XEMACS-SRC) to tarball.
721
7222003-10-27 Satyaki Das <satyakid@stanford.edu>
723
724 * mh-loaddefs.el: Regenerated.
725
726 * mh-index.el (mh-indexer-choices): Remove option for the non-free
727 glimpse indexer (closes SF #831276).
728 (mh-glimpse-binary, mh-glimpse-directory)
729 (mh-glimpse-execute-search, mh-glimpse-next-result): Functions
730 and variables to implement glimpse support are removed.
731
732 * mh-customize.el (mh-index-program): Remove option for glimpse.
733
7342003-10-24 Satyaki Das <satyakid@stanford.edu>
735
736 * mh-customize.el: Remove top-level test for toolbar enabled
737 XEmacs since it is not needed.
738 (mh-tool-bar-define): Add test for XEmacs toolbar in the functions
739 mh-toolbar-init, mh-tool-bar-letter-buttons-set and
740 mh-tool-bar-folder-buttons-set. This enables proper compilation
741 irrespective of whether the XEmacs was built with toolbar support
742 or not.
743
744 * mh-comp.el (mh-letter-mode): Remove conditional since it is not
745 needed.
746
747 * mh-e.el (mh-folder-mode): Same as above.
748
749 * mh-utils.el (mh-show-mode): Same as above.
750
751 * mh-xemacs.el (mh-xemacs-icon-map): Remove condition on toolbar
752 presence since we want the build to work if XEmacs without
753 toolbars is used during compilation.
754
7552003-10-23 Bill Wohler <wohler@newt.com>
756
757 * mh-customize.el: The Great Reorganization. Sorted groups
758 alphabetically. Aligned variables in customization groups with
759 manual sections. Group docstrings changed to match manual chapter
760 titles.
761
7622003-10-22 Satyaki Das <satyakid@stanford.edu>
763
764 * mh-speed.el (timer): Avoid compiler warning in XEmacs.
765
7662003-10-22 Steve Youngs <sryoungs@bigpond.net.au>
767
768 * Makefile (XEMACS_OPTIONS): Add '-no-autoloads' to give a cleaner
769 build environment.
770 (AUTO_PRELOADS): Removed, in favour of 'AUTOLOAD_PACKAGE_NAME' and
771 'AUTOLOAD_FILE'.
772 (AUTOLOAD_PACKAGE_NAME): New.
773 (AUTOLOAD_FILE): New.
774 (all): Don't set $EMACS_HOME if building with XEmacs.
775 (xemacs): Use 'compile-xemacs' instead of 'compile'.
776 (auto-autoloads.elc): Use new $AUTOLOAD_* vars and allow for
777 '-no-autoloads'.
778 (custom-load.elc): Allow for '-no-autoloads'.
779 (compile-xemacs): New. It allows for the '-no-autoloads' option
780 and byte-compiles all the source files with a single instance of
781 XEmacs.
782
783 * mh-e.el (mh-folder-mode): Only load the toolbar in XEmacs if
784 toolbar support is available.
785
786 * mh-comp.el (mh-letter-mode): Only load the toolbar in XEmacs if
787 toolbar support is available.
788
789 * mh-customize.el: Require 'mh-xemacs' at toplevel when
790 'mh-xemacs-flag' is non-nil.
791 Wrap all the toolbar code in a test that is true if using
792 GNU/Emacs or a toolbar-enabled XEmacs.
793
794 * mh-print.el (mh-ps-spool-a-msg): Comment out
795 `clean-message-header-flag' because it isn't used anywhere.
796
797 * mh-utils.el (mh-show-mode): Only load the toolbar in XEmacs if
798 toolbar support is available.
799
800 * mh-xemacs.el: Autoload `regexp-opt', `customize-group',
801 `view-mode', `with-electric-help', `pp', `sort-numeric-fields',
802 `reverse-region', and `goto-address' at compile time.
803 (mh-xemacs-has-toolbar-flag): New. This is non-nil when XEmacs
804 has toolbar support.
805 (mh-xemacs-toolbar-*-icon): Use it.
806
8072003-10-21 Mark D. Baushke <mdb@gnu.org>
808
809 * mh-identity.el (mh-identity-field-handler): Fields that begin
810 with ":" must have an mh-identity-handler defined or the user
811 gets an error.
812
8132003-10-17 Peter S Galbraith <psg@debian.org>
814
815 * mh-customize.el (mh-identity-list): This change affects users!
816 The keyword "signature" becomes ":signature". The recently added
817 keyword "pgg-default-user-id" becomes ":pgg-default-user-id".
818 (mh-auto-fields-list): The keyword "Identity" becomes ":identity".
819 (mh-identity-handlers): Idem for signature and pgg-default-user-id.
820
821 * mh-comp.el (mh-insert-auto-fields): Idem for Identity.
822
8232003-10-17 Peter S Galbraith <psg@debian.org>
824
825 * mh-xemacs.el: Add eval-and-compile call to (load "toolbar" t t) to
826 make sure `toolbar-make-button-list' is defined. We can't use
827 require because Emacs doesn't have this library.
828
8292003-10-16 Bill Wohler <wohler@newt.com>
830
831 * mh-customize.el (mh-signature-file-name)
832 (mh-letter-insert-signature-hook): Merge docstring with manual.
833
834 * mh-comp.el (mh-file-is-vcard-p): Checkdoc fix.
835 (mh-insert-signature): Merge docstring with manual.
836
837 * mh-customize.el (mh-junk): Changed manual link in defgroup from
838 Customizing mh-e to Junk.
839 (mh-junk-function-alist): Moved SpamAssassin to first in list on
840 the hunch that it is the most popular and should be chosen if
841 other anti-spam programs exist.
842 (mh-junk-mail-folder): Since the variable can accept values other
843 than folder names, renamed to mh-junk-disposition to more
844 accurately reflect the content. Merge docstring with manual.
845 (mh-junk-program): Moved SpamAssassin to the top of the menu for
846 the same reason presented in mh-junk-function-alist. Also, fixed
847 case of spam programs to match official usage. Merge docstring
848 with manual.
849
850 * mh-junk.el (mh-junk-blacklist):
851 s/mh-junk-mail-folder/mh-junk-disposition/. Merge docstring with
852 manual.
853 (mh-junk-whitelist): Merge docstring with manual.
854 (mh-bogofilter-blacklist): No longer suggest using automatic
855 classification so use -s instead of -Ns.
856 (mh-bogofilter-whitelist): No longer suggest using automatic
857 classification so use -n instead of -Sn.
858 (mh-spamassassin-blacklist, mh-spamassassin-whitelist): Merge
859 docstring with manual. Moved spamassassin functions to top of file
860 so functions appear in same order that they are presented in menu.
861
8622003-10-09 Peter S Galbraith <psg@debian.org>
863
864 * mh-customize.el (mail-citation-hook): Moved from mh-comp.el and
865 made into a defcustom.
866
8672003-10-09 Satyaki Das <satyakid@stanford.edu>
868
869 * mh-loaddefs.el: Regenerated.
870
871 * mh-comp.el (mh-get-header-field): Add autoload cookie.
872
873 * mh-utils.el (mh-show-ps-print-toggle-mime)
874 (mh-show-ps-print-toggle-color, mh-show-ps-print-toggle-faces)
875 (mh-show-ps-print-msg-file, mh-show-ps-print-msg)
876 (mh-show-ps-print-msg-show): New interactive functions callable
877 from the show buffer.
878 (mh-show-ps-print-map): New key map for printing.
879
880 * mh-e.el (mh-folder-mode-map): Remove key binding for
881 mh-print-msg.
882 (mh-ps-print-map): Add new key map for printing.
883
884 * Makefile (MH-E-SRC): Add mh-print.el.
885
8862003-10-07 Satyaki Das <satyakid@stanford.edu>
887
888 * mh-utils.el (mh-x-image-url-fetch-image): In XEmacs,
889 make-temp-file is not present. So to avoid security problems, use
890 a temporary file in the user's home directory. This avoids issues
891 in creating files in a world-writable directory.
892
893 * mh-mime.el (mh-signature-highlight): In Emacs, arrange for the
894 overlay to be freed when it is no longer needed. Also, implement
895 signature highlighting in XEmacs.
896
8972003-10-05 Satyaki Das <satyakid@stanford.edu>
898
899 * mh-mime.el (mh-mime-display, mh-mm-inline-message): Respect the
900 value of `mm-verify-option' and `mm-decrypt-option'.
901 (mh-mime-display-security): Rearrange code a bit to avoid too many
902 new lines being inserted when message verification/decryption is
903 carried out while the message is being read. Also use the
904 point-m{in|ax}-marker functions to make the function easier to read.
905 (mh-mime-security-press-button): Extend the function so that the
906 user can verify/decrypt messages while reading them.
907
908 * mh-gnus.el (mm-possibly-verify-or-decrypt): Added to avoid
909 compiler warning with old Gnus.
910
911 * mh-utils.el (mh-x-image-url-sane-p): New function which checks
912 if the URL in X-Image-URL is something we can handle.
913 (mh-x-image-url-display): Don't display image if the URL looks
914 malformed.
915
9162003-10-04 Mark D Baushke <mdb@gnu.org>
917
918 * mh-comp.el (mh-letter-menu): Simplify menu heading.
919
9202003-10-03 Mark D Baushke <mdb@gnu.org>
921
922 * mh-mime.el (mh-mml-query-cryptographic-method): Avoid
923 revisionist history and still provide a good default.
924
925 * mh-comp.el (mh-letter-menu): Remove the Disable Security
926 parenthetical comment.
927
928 * mh-loaddefs.el: Regenerated.
929
930 * mh-customize.el (mh-mml-method-default): What method should be
931 used in secure directives.
932
933 * mh-mime.el (mh-secure-message): New function used to generate
934 the mml security tags.
935 (mh-mml-unsecure-message): New wrapper function around
936 mml-unsecure-messages.
937 (mh-mml-secure-message-sign-pgpmime): Remove function.
938 (mh-mml-secure-message-encrypt-pgpmime): Ditto.
939 (mh-mml-cryptographic-method-history): New variable.
940 (mh-mml-query-cryptographic-method): New function.
941 (mh-mml-secure-message-encrypt): Ditto.
942 (mh-mml-secure-message-signencrypt): Ditto.
943 (mh-mml-secure-message-sign): Ditto.
944
945 * mh-comp.el (mh-letter-menu, mh-letter-mode-help-messages,
946 (mh-letter-mode-map): Update to use new functions.
947
9482003-09-26 Satyaki Das <satyakid@stanford.edu>
949
950 * mh-seq.el (mh-interactive-range): The function has been
951 extended so that it now takes a default result to return if no
952 interactive prefix arg is given and no region is active.
953
954 * mh-e.el (mh-add-sequence-notation): If transient-mark-mode is
955 on, then the active region is deactivated based on whether a user
956 sequence or a internal sequence is being notated. The change
957 removes this inconsistency.
958 (mh-catchup, mh-folder-map): A new interactive function to mark
959 messages as read has been added and bound to "F c" in the folder
960 mode.
961
962 * mh-utils.el (mh-show-catchup, mh-show-folder-map): New
963 interactive function callable from show mode buffers has been
964 bound to "F c".
965
9662003-09-24 Bill Wohler <wohler@newt.com>
967
968 * mh-customize.el (mh-clean-message-header-flag)
969 (mh-invisible-header-fields-default, mh-invisible-header-fields):
970 Merge docstring with manual.
971
9722003-09-24 Mark D. Baushke <mdb@gnu.org>
973
974 * mh-junk.el (mh-junk-blacklist): Junked messages should be put
975 into the mh-seen-list to avoid propagating the unseen sequence
976 into the spam folder.
977
978 * mh-loaddefs.el: Regenerated.
979
980 * mh-mime.el (mh-mml-secure-message-sign-pgpmime): Add an optional
981 dontsign argument to remove an existing secure message directive.
982 Update the docstring -- this fuction does not allow for
983 encrypt/sign, just sign directives.
984
985 * mh-mime.el (mh-mml-secure-message-sign-pgpmime): Use
986 mml-insert-tag directly to provide a sender if
987 mh-identity-pgg-default-user-id is set.
988 (mh-mml-secure-message-encrypt-pgpmime): Use mml-insert-tag
989 directly to provide a sender if this message is to be both signed
990 and encrypted and mh-identity-pgg-default-user-id is set.
991
9922003-09-23 Bill Wohler <wohler@newt.com>
993
994 * mh-alias.el (Commentary): Removed as it is now in the manual.
995 (mh-alias-system-aliases): Moved here from mh-customize.el. By
996 definition, "system" definitions are not user-visible, and user
997 filenames are in the the Aliasfile: profile component, so this
998 variable really shouldn't be a defcustom
999 (mh-alias-tstamp, mh-alias-filenames, mh-alias-reload)
1000 (mh-alias-add-alias, mh-alias-grab-from-field)
1001 (mh-alias-add-address-under-point, mh-alias-apropos): Merge
1002 docstring with manual.
1003 (mh-alias-reload-maybe): Minor comment update.
1004 (mh-alias-insert-file): Merge docstring with manual. Removed
1005 "[press TAB]" from prompt since users should know about completion
1006 and space can be used as well.
1007 (mh-alias-for-from-p): No longer returns a surprising result (t if
1008 there was **not** an alias for the From field) if the From header
1009 field is missing. This function now returns what you would expect
1010 a function of this name to return. Renamed from
1011 mh-alias-from-has-no-alias-p since negatives in the function name
1012 make logic harder to follow.
1013 (mh-alias-add-alias-to-file): Merge docstring with manual.
1014 Improved verbiage of prompt. Aliases are now inserted "[b]efore"
1015 or "[a]fter" the existing alias instead of "[i]nsert" or
1016 "[a]ppend." Note how the new usage flows better.
1017
1018 * mh-customize.el (mh-alias): Changed manual link in defgroup from
1019 Customizing mh-e to Aliases.
1020 (mh-alias-grab-from-field button): mh-alias-from-has-no-alias-p
1021 renamed to mh-alias-for-from-p and no longer returns surprising
1022 value if there isn't a From field. Therefore, enable button if
1023 there is a From header field and mh-alias-for-from-p returns nil.
1024 (mh-letter-complete-function)
1025 (mh-alias-completion-ignore-case-flag, mh-alias-flash-on-comma)
1026 (mh-alias-insert-file, mh-alias-insertion-location)
1027 (mh-alias-local-users, mh-alias-local-users-prefix)
1028 (mh-alias-passwd-gecos-comma-separator-flag): Merge docstring with
1029 manual.
1030 (mh-alias-system-aliases): Moved to mh-alias.el.
1031
1032 * mh-comp.el (mh-letter-complete-function-alist): Removed comment
1033 about making this customizable since I didn't think it seemed
1034 appropriate in the manual.
1035 (mh-letter-complete): Merge docstring with manual.
1036
10372003-09-23 Satyaki Das <satyakid@stanford.edu>
1038
1039 * mh-speed.el (mh-speed-flists): When exiting emacs, don't ask if
1040 the flists process should be killed.
1041
1042 * mh-e.el (mh-folder-message-menu): Enable undo menu entry only
1043 if something can be undone.
1044
1045 * mh-customize.el (undo): Enable undo button only if something
1046 can be undone.
1047
10482003-09-22 Peter S Galbraith <psg@debian.org>
1049
1050 * mh-customize.el (mh-identity-handlers): New defcustom. Alist of
1051 Handler functions for mh-identity (downcased) fields.
1052 (mh-identity-list): Add support for pgg-default-user-id.
1053
1054 * mh-identity.el (mh-insert-identity): Modified to use
1055 `mh-identity-handlers', adding hacking flexibility for those who
1056 might need it.
1057 (mh-identity-field-handler): New function. Return the handler for
1058 a FIELD or nil if none set. The field name is downcased.
1059 (mh-identity-handler-gpg-identity): New function; handler for pgg
1060 pgp identities. It sets a buffer-local value for
1061 `mh-pgg-default-user-id' which must be handled by mh-send-letter.
1062 (mh-identity-pgg-default-user-id): New buffer-local variable to
1063 hold the requested key ID.
1064 (mh-identity-handler-signature): New function; handler t insert
1065 and remove signature files.
1066 (mh-identity-handler-default): New function; the default handler
1067 to insert or remove generic field.
1068 (mh-identity-handler-top): Insert a field at the top of the
1069 header.
1070 (mh-identity-handler-bottom): Insert a field at the bottom of the
1071 header.
1072 (mh-header-field-delete): Make more robust wrt the field having a
1073 trailing colon or not.
1074 (mh-identity-make-menu): Add a "Customize Identities" menu entry.
1075
1076 * mh-loaddefs.el: Regenerated.
1077
10782003-09-21 Peter S Galbraith <psg@debian.org>
1079
1080 * mh-init.el (mh-variant-set): Bug fix for mh-variant long names
1081 with version numbers.
1082
1083 * mh-e.el (mh-scan-format): patch from Sergey Poznyakoff.
1084 GNU mailutils now supports the %(decode) format
1085
10862003-09-20 Satyaki Das <satyakid@stanford.edu>
1087
1088 * mh-gnus.el (mh-mm-text-html-renderer): New function to query
1089 which HTML renderer is being used by Gnus.
1090
1091 * mh-mime.el (mh-signature-highlight): Renderers used to display
1092 HTML parts garble the signature separator in various ways. The
1093 function has been modified to take that into account.
1094 (mh-mime-display-single, mh-mm-display-part): Pass the new
1095 optional argument to `mh-signature-highlight'.
1096
10972003-09-19 Mark D. Baushke <mdb@gnu.org>
1098
1099 * mh-mime.el (mh-have-file-command, mh-file-mime-type): Made an
1100 mh-autoload as they are used in mh-comp.el.
1101
1102 * mh-loaddefs.el: Regenerated.
1103
11042003-09-18 Peter S Galbraith <psg@debian.org>
1105
1106 * mh-comp.el (mh-insert-fields): Make sure field has a colon.
1107
11082003-09-18 Satyaki Das <satyakid@stanford.edu>
1109
1110 * mh-seq.el (mh-toggle-tick): Don't hardcode the name of the tick
1111 sequencence in the function. This would have caused improper
1112 highlighting of the tick sequence if the user had changed its
1113 name.
1114
11152003-09-15 Satyaki Das <satyakid@stanford.edu>
1116
1117 * mh-e.el (mh-folder-message-menu): Fix a little bug which shows
1118 up as a problem during compilation (closes SF #806577).
1119
11202003-09-15 Mark D. Baushke <mdb@gnu.org>
1121
1122 * mh-customize.el (mh-invisible-header-fields-internal): Added
1123 a new field for GNU mailutils per Sergey Poznyakoff.
1124
11252003-09-09 Satyaki Das <satyakid@stanford.edu>
1126
1127 * mh-utils.el (vcard): Unconditionally load vcard.el, if
1128 available, so that vcards are always inlined.
1129
11302003-09-09 Peter S Galbraith <psg@debian.org>
1131
1132 * mh-mime.el (mh-file-mime-type-substitutions): Add entry to
1133 convert text/plain .vcf files to text/x-vcard.
1134 (mh-mime-content-types): Add text/x-vcard.
1135
11362003-09-09 Bill Wohler <wohler@newt.com>
1137
1138 * mh-comp.el (mh-rejected-letter-start): Added strings for qmail
1139 and exim (addresses SF #404965).
1140
11412003-09-09 Satyaki Das <satyakid@stanford.edu>
1142
1143 * mh-gnus.el (mm-inline-text-vcard): Make vcard display work with
1144 Gnus-5.9. The extra file vcard.el is still needed.
1145
1146 * mh-mime.el (mh-signature-highlight): New function that
1147 highlights message signatures.
1148 (mh-mm-display-part, mh-mime-display-single): Highlight signatures
1149 using `mh-signature-highlight' (closes SF #802722). More work is
1150 needed for XEmacs.
1151 (mh-mime-display): Highlight signature in non-MIME email too.
1152
1153 * mh-customize.el (mh-show-signature-face): New face used to
1154 display message signature.
1155
11562003-09-08 Peter S Galbraith <psg@debian.org>
1157
1158 * mh-e.el (mh-version): Do something sensible when
1159 mh-variant-in-use is undefined.
1160 * mh-junk.el (mh-spamassassin-blacklist)
1161 (mh-spamassassin-whitelist): Change options to be compatoble with
1162 old version of spamassassin (V2.20).
1163
11642003-09-07 Mark D. Baushke <mdb@gnu.org>
1165
1166 * mh-mime.el (mh-access-types): Per RFC 2049, the "afs"
1167 access-type for message/external-body has been removed.
1168 Update the comments to reference the current MIME RFCs
1169 2045, 2046 and 2049 rather than the obsolete RFC 1521.
1170
11712003-09-05 Peter S Galbraith <psg@debian.org>
1172
1173 * mh-e.el (mh-version): Bumped version number to 7.4.2+cvs.
1174
11752003-09-04 Satyaki Das <satyakid@stanford.edu>
1176
1177 * mh-utils.el (mh-picon-directory-list, mh-picon-directory): The
1178 mh-picon-directory-list variable supersedes mh-picon-directory.
1179 (mh-picon-existing-directory-list): New variable that contains
1180 the list of picon directories that actually exist.
1181 (mh-picon-set-directory-list): New function to update
1182 mh-picon-existing-directory-list from mh-picon-directory-list.
1183 (mh-picon-get-image): The function has been modified to search a
1184 list of possible picon source directories. The regexp to extract
1185 the username from the email address has been made smarter so that
1186 it can recognize email addresses of the form user+random@foo.net
1187 and extract "user" from there.
1188 (mh-picon-file-contents): The file type recognition code has been
1189 moved from mh-picon-get-image into this function.
1190 (mh-picon-generate-path): The function has been generalized so
1191 that searching multiple paths is now feasible.
1192
1193 * mh-pick.el, mh-e.el: Checkdoc fixes.
1194
11952003-09-02 Satyaki Das <satyakid@stanford.edu>
1196
1197 * mh-identity.el (eval-when): It seems that the mh-comp-loaded
1198 code isn't required any more.
1199
12002003-08-30 Satyaki Das <satyakid@stanford.edu>
1201
1202 * mh-init.el (mh-variant-set): Replace `error' with `message' so
1203 that Emacs CVS will compile without errors if no MH variant is
1204 present.
1205
12062003-08-29 Satyaki Das <satyakid@stanford.edu>
1207
1208 * mh-init.el (mh-variant-set): Add interactive spec to the
1209 function.
1210
1211 * mh-mime.el (mh-mhn-compose-external-type): Optional arguments
1212 are prompted for only if prefix arg is given.
1213
12142003-08-29 Mark D. Baushke <mdb@gnu.org>
1215
1216 * mh-mime.el (mh-mhn-compose-external-type): Modified to be
1217 interactive and prompts for many of the fields. Made an
1218 mh-autoload.
1219 (mh-access-types): New table derived from RFC2017, RFC1521 and
1220 RFC1738, used in a completing-read in
1221 mh-mhn-compose-external-type.
1222
1223 * mh-loaddefs.el: Regenerated.
1224
12252003-08-26 Satyaki Das <satyakid@stanford.edu>
1226
1227 * mh-utils.el (mh-picon-image-types, mh-picon-get-image): Avoid
1228 compiler warnings.
1229 (mh-sub-folders-actual): Parsing of the output from folders has
1230 been modified, so that it also works for MH (closes SF #792300).
1231
1232 * mh-junk.el (mh-spamassassin-whitelist): Avoid calling
1233 ietf-drums-parse-address if it isn't present.
1234 (mh-spamassassin-identify-spammers): Avoid use of puthash so that
1235 Emacs20 doesn't complain.
1236
1237 * mh-e.el (mh-colors-available-p): Wrap call to
1238 display-color-cells in a mh-funcall-if-exists to avoid compiler
1239 warning in Emacs20.
1240
12412003-08-25 Satyaki Das <satyakid@stanford.edu>
1242
1243 * mh-e.el (mh-colors-available-flag, mh-folder-mode): New
1244 variable to track if colors are available and it is set
1245 appropriately in mh-folder-mode.
1246 (mh-colors-available-p, mh-colors-in-use-p): Two functions to
1247 check whether colors are available and if they are actually being
1248 used.
1249 (mh-add-sequence-notation): Just changing a scan line doesn't
1250 make font-lock refontify the line in Emacs20. So explicitly
1251 refontify the scan line in such a situation.
1252 (mh-internal-seq): If colors aren't being used then treat the
1253 tick sequence like a normal user sequence.
1254
1255 * mh-seq.el (mh-put-msg-in-seq): Do font-lock highlighting after
1256 the messages have been added to the sequence.
1257 (mh-toggle-tick): Modified so that highlighting of the ticked
1258 messages will be properly done. If font-lock isn't being used or
1259 if colors aren't supported by the Emacs where MH-E is running,
1260 then the `%' character is used to annotate ticked messages.
1261
1262 * mh-utils.el (mh-picon-image-types): Since Emacs20 doesn't have
1263 image-type-available-p, wrap calls to that function in
1264 ignore-errors.
1265 (mh-add-msgs-to-seq): Do the font-lock highlighting after the
1266 messages have been added.
1267
12682003-08-24 Bill Wohler <wohler@newt.com>
1269
1270 * Makefile (MH-E-SRC): Replaced mh-xemacs-compat.el and
1271 mh-xemacs-icons.el with mh-xemacs.el.
1272
1273 * mh-e.el: Don't require mh-xemacs-compat which no longer exists.
1274 The XEmacs stuff gets required by mh-customize.el which is
1275 required by mh-utils.el which is required by mh-e.el. This all
1276 happens before mh-xemacs-compat was required, so all should be
1277 well.
1278
1279 * mh-unit.el (mh-unit-files): Replaced mh-xemacs-compat.el and
1280 mh-xemacs-icons.el with mh-xemacs.el.
1281
1282 * mh-xemacs.el: New file from concatenation of mh-xemacs-compat.el
1283 and mh-xemacs-icons.el which were removed since their names
1284 exceeded DOS 8+3 limits.
1285
1286 * mh-customize.el (mh-compose-skipped-header-fields): Use
1287 uppercase for field names.
1288
12892003-08-21 Bill Wohler <wohler@newt.com>
1290
1291 * mh-customize.el (mh-sequences): Introduced new customization
1292 group for sequences.
1293 (mh-refile-preserves-sequences-flag, mh-tick-seq)
1294 (mh-update-sequences-after-mh-show-flag): Moved option from
1295 mh-folder to mh-sequences group. Synced docstring with manual.
1296 (mh-index-ticked-messages-folders): Since mh-tick-seq is
1297 customizable, use it instead of tick in the docstring.
1298
1299 * mh-index.el (mh-index-ticked-messages): Since mh-tick-seq is
1300 customizable, use it instead of tick in the docstring.
1301
1302 * mh-seq.el (mh-msg-is-in-seq): Can now specify an alternate
1303 message number with a prefix argument.
1304 (mh-narrow-to-tick): Since mh-tick-seq is customizable, use it
1305 instead of tick in the docstring. Also, use mh-tick-seq instead of
1306 tick in warning message.
1307
13082003-08-20 Peter S Galbraith <psg@debian.org>
1309
1310 * mh-customize.el: setq mh-variant to 'none when byte-compiling,
1311 since we don't care what MH variant (if any) is on the system at
1312 that point.
1313
1314 * mh-init.el (mh-variant-set): Don't probe for MH variant when
1315 mh-variant is set to'none (during byte-compilation).
1316
13172003-08-19 Peter S Galbraith <psg@debian.org>
1318
1319 * mh-pick.el (mh-pick-single-dash): New defconst. Search
1320 components that are supported by single-dash option in
1321 pick.
1322 (mh-pick-regexp-builder): Use `mh-pick-single-dash' and adapt
1323 patch from Sergey Poznyakoff.
1324
1325 * mh-comp.el (mh-reply): mu-mh supports `repl -group', thanks to
1326 Sergey Poznyakof.
1327
1328 * mh-init.el: checkdoc fixes.
1329
13302003-08-19 Bill Wohler <wohler@newt.com>
1331
1332 * mh-seq.el: (mh-edit-pick-expr): Renamed from mh-read-pick-regexp
1333 since the new name is more indicative of what the function does.
1334 Prompt now says "Pick expression" instead of "Pick regexp".
1335 (mh-narrow-to-subject): Rewrote function to behave like other
1336 similar functions.
1337 (mh-narrow-to-header-field, mh-narrow-to-range)
1338 (mh-narrow-to-tick): s/regexp/pick-expr/.
1339 (mh-widen, mh-narrow-to-from, mh-narrow-to-cc, mh-narrow-to-to):
1340 Synced docstrings with manual
1341
1062003-08-19 Bill Wohler <wohler@newt.com> 13422003-08-19 Bill Wohler <wohler@newt.com>
107 1343
108 * Released MH-E version 7.4.2. 1344 * Released MH-E version 7.4.2.
@@ -131,6 +1367,848 @@
131 (patches from 1.307 and 1.309 and branched for 7.4.2, closes SF 1367 (patches from 1.307 and 1.309 and branched for 7.4.2, closes SF
132 #791021). 1368 #791021).
133 1369
13702003-08-18 Bill Wohler <wohler@newt.com>
1371
1372 * mh-index.el (mh-index-sequenced-messages)
1373 (mh-index-new-messages, mh-index-ticked-messages): Updated
1374 docstrings from manual (closes SF #718833).
1375
1376 * mh-customize.el (mh-variant): Checkdoc fix.
1377 (mh-index-new-messages-folders): Don't mention defvar in
1378 docstring, use `+inbox' instead.
1379 (mh-index-ticked-messages-folders): Don't mention defvar in
1380 docstring, use `tick' instead.
1381
1382 * mh-comp.el (mh-repl-group-formfile): Checkdoc fix.
1383
13842003-08-18 Peter S Galbraith <psg@debian.org>
1385
1386 * mh-init.el (mh-variant-set, mh-sys-path, mh-variant-info): Add
1387 support for GNU mailutils.
1388 (mh-variant-mu-mh-info): New function to detect mu-mh and return
1389 info about it for `mh-variants'.
1390
1391 * mh-e.el (mh-regenerate-headers): mu-mh has different error
1392 message for a invalid mesage list.
1393
13942003-08-18 Peter S Galbraith <psg@debian.org>
1395
1396 * mh-customize.el (mh-e): New defgroup. Sort of an alias for the
1397 'mh group that a user might be more likely to find.
1398
13992003-08-18 Bill Wohler <wohler@newt.com>
1400
1401 * mh-comp.el (mh-insert-auto-fields-done-local): Docstring tweak.
1402 (mh-compose-and-send-mail): Do not call mh-insert-auto-fields.
1403 This should be done only once in mh-send-letter.
1404
14052003-08-18 Peter S Galbraith <psg@debian.org>
1406
1407 * mh-comp.el (mh-letter-mode): Call `mh-find-path unconditionally,
1408 like elsewehere in MH-E.
1409
1410 * mh-utils.el (mh-find-path): Run setup code only if
1411 `mh-find-path-run' is nil such that this is only done once.
1412 Also remove the `setq' for `read-mail-command' and `mail-user-agent'.
1413
14142003-08-18 Peter S Galbraith <psg@debian.org>
1415
1416 * mh-e.el: require 'mh-utils first
1417
1418 * mh-customize.el (mh-variant): defcustom moved here.
1419
1420 * mh-init.el (mh-variants): Made an mh-autoload.
1421
14222003-08-18 Peter S Galbraith <psg@debian.org>
1423
1424 * Makefile (MH-E-SRC): Added mh-init.el to MH-E-SRC.
1425
1426 * mh-utils.el (mh-find-progs): Deleted. Make obsolete by mh-init.el.
1427 (mh-find-path): Call `mh-variants' instead of now obsolete
1428 `mh-find-progs'.
1429 (mh-path-search): Deleted. Was only used by `mh-find-progs'.
1430
1431 * mh-e.el: require mh-init.el.
1432 (mh-version): Use simpler `mh-variant-in-use'.
1433 (mh-scan-format): Use (mh-variant-p 'nmh) instead of mh-nmh-flag.
1434
1435 * mh-comp.el (mh-insert-x-mailer): Use simpler `mh-variant-in-use'.
1436
1437 * mh-utils.el (mh-progs, mh-lib, mh-lib-progs)
1438 (mh-flists-present-flag): Moved to mh-init.el.
1439 (mh-nmh-flag): Deleted. Use (mh-variant-p 'nmh) instead.
1440
1441 * mh-comp.el (mh-repl-group-formfile, mh-forward, mh-reply)
1442 (mh-send-letter): Use (mh-variant-p 'nmh) instead of mh-nmh-flag.
1443
1444 * mh-mime.el (mh-edit-mhn, mh-mime-save-parts): Use (mh-variant-p
1445 'nmh) instead of mh-nmh-flag.
1446
14472003-08-16 Bill Wohler <wohler@newt.com>
1448
1449 * mh-customize.el (mh-folder-selection): New group to hold
1450 variables described in Folder Selection section in manual.
1451 (mh-default-folder-list, mh-default-folder-must-exist-flag,
1452 mh-default-folder-prefix): Moved to mh-folder-selection group.
1453 Updated docstrings per manual update.
1454 (mh-default-folder-for-message-function): New defcustom. Was a
1455 defvar in mh-utils.el. Updated docstring per manual update.
1456
1457 * mh-utils.el (mh-default-folder-for-message-function): Moved to
1458 mh-customize.el.
1459
1460 * mh-e.el (mh-folder-from-address, mh-prompt-for-refile-folder):
1461 Updated docstrings per manual update.
1462
1463 * mh-unit.el (mh-unit-files): Added mh-init.el.
1464
14652003-08-16 Peter S Galbraith <psg@debian.org>
1466
1467 * mh-init.el: New file. Code to initialize the MH-E back-end.
1468 Highlights:
1469 (mh-variant): New defcustom. Users may customize `mh-variant' to
1470 switch between available variants.
1471 (mh-variants): Available MH variants are described in this variable.
1472 (mh-variant-in-use, mh-variant-p): Developers may check which
1473 variant is currently in use with the variable `mh-variant-in-use'
1474 or the function `mh-variant-p'.
1475
14762003-08-15 Bill Wohler <wohler@newt.com>
1477
1478 * mh-customize.el (mh-auto-fields-list): The manual uses Fcc
1479 instead of fcc, so I've changed the user-visible text
1480 accordingly. I've left the const alone for backwards
1481 compatibility.
1482
14832003-08-14 Bill Wohler <wohler@newt.com>
1484
1485 * mh-identity.el (mh-insert-identity): Changed signature deletion
1486 test to test for both markers, rather than testing to see if the
1487 start marker is bound. Since the start marker is defined in this
1488 file, it should always be bound. Suggestion by Satyaki.
1489
1490 * mh-comp.el (mh-send-letter): Go to the top of the draft so that
1491 the user can see which header fields have been inserted. I think
1492 this is more important than leaving point alone or going to the
1493 end to see the signature since Mail-Followup-To or Bcc or cc could
1494 have some deleterious effects.
1495
1496 * mh-customize.el (mh-auto-fields-prompt-flag): New variable.
1497 Non-nil means to prompt before sending if fields inserted.
1498
1499 * mh-comp.el (mh-insert-auto-fields): Now return t if fields
1500 inserted; otherwise nil.
1501 (mh-send-letter): Deleted obsolete documentation about adding
1502 X-Mailer and X-Face. Prompt before sending if auto fields added
1503 and mh-auto-fields-prompt-flag is t.
1504
1505 * mh-customize.el (mh-identity-list): Allow signature to come from
1506 mh-signature-file-name. In this case, the "signature" value is set
1507 to nil. This might not be the best implementation. Suggestions
1508 welcome.
1509
1510 * mh-identity.el (mh-insert-identity): Now that the signature can
1511 be a nil value, moved test higher up in cond so that the test for
1512 a nil value would not be executed first prevening signature
1513 handling. Handle nil signature value by calling
1514 mh-insert-signature with no arguments which means to use
1515 mh-signature-file-name.
1516
1517 * mh-comp.el (mh-insert-signature): Changed text of message if no
1518 signature inserted.
1519
1520 * mh-customize.el (mh-identity-list): Changed "Signature" constant
1521 back to "signature" so it *won't* be backwards-incompatible any
1522 more. I discovered one could use the :tag keyword to get headline
1523 captalization in the menu.
1524
1525 * mh-identity.el (mh-insert-identity): Ditto.
1526
1527 * mh-identity.el (mh-identity-make-menu): Always build menu.
1528 Always create Insert Auto Fields menu item. Just don't enable it
1529 if mh-auto-fields-list is nil. Enable radio buttons always. Make
1530 None a radio button choice with the other identities.
1531
1532 * mh-comp.el (mh-letter-menu): Removed cond on fboundp
1533 'easy-menu-define. We don't do this elsewhere.
1534
15352003-08-13 Bill Wohler <wohler@newt.com>
1536
1537 * mh-identity.el (mh-identity-make-menu, mh-insert-identity): Use
1538 headline capitalization in menu items. Even the internal names are
1539 exposed in the customize interface, so they need to be uppercase
1540 too.
1541 (mh-insert-identity): Rather than goto-char to
1542 mh-identity-signature-start before deleting, simply pass it to
1543 delete-region. When setting markers, use point-min-marker and
1544 point-max-marker instead of moving point. Set marker type of
1545 mh-identity-signature-start to t to fix a bug where changing
1546 identity deleted user's text.
1547
1548 * mh-customize.el (mh-identity-list, mh-auto-fields-list):
1549 Reworked docstring. Use headline capitalization. Commented out
1550 implementation details for later deletion or resurrection upon
1551 popular demand. N.B. If your mh-identity-list contains "signature"
1552 then you will need to either edit your .emacs file manually, or
1553 delete your existing "signature" which will become a regular field
1554 with this change and create a new signature. I figured I could get
1555 away with this since 8.0 is a major release, and coinciding with
1556 the manual update will be a MAJOR release. I apologize profusely
1557 that I didn't catch this before it was released.
1558 (mh-identity-default): Use headline capitalization in example.
1559
15602003-08-12 Jeffrey C Honig <jch@honig.net>
1561
1562 * mh-customize.el (mh-alias-reloaded-hook): Define
1563 `mh-alias-reloaded-hook'.
1564
1565 * mh-alias.el (mh-alias-reload): Run `mh-alias-reloaded-hook'
1566 after reloading the aliases.
1567
15682003-08-12 Mark D. Baushke <mdb@gnu.org>
1569
1570 * mh-comp.el (mh-insert-signature): Use functionp to avoid
1571 the possibility of doing a funcall on a void function.
1572
15732003-08-12 Bill Wohler <wohler@newt.com>
1574
1575 * mh-customize.el (mh-identity): Point group manual link to new
1576 Identities section.
1577 (mh-signature-separator-flag): New variable which can be used to
1578 suppress the output of the signature separator.
1579
1580 * mh-comp.el (mh-insert-signature): Use
1581 mh-signature-separator-flag.
1582
1583 * mh-identity.el (mh-insert-identity): If the identity's signature
1584 file didn't exist, an fboundp error was thrown. This was fixed by
1585 removing signature tests that were redundant and out of date with
1586 the tests in mh-insert-signature. Removed second signature
1587 condition as it is now handled in the first signature condition.
1588
15892003-08-12 Peter S Galbraith <psg@debian.org>
1590
1591 * mh-identity.el (mh-insert-identity): Don't insert new lines on
1592 signatures anymore.
1593
1594 * mh-comp.el (mh-insert-signature): Make sure signature file is
1595 readable before trying to insert it.
1596
15972003-08-11 Bill Wohler <wohler@newt.com>
1598
1599 * mh-comp.el (mh-insert-signature): Unconditionally insert a
1600 newline so that signatures are inserted consistently, and so that
1601 there isn't any text after the cursor so that the user can start
1602 typing his message immediately. Use new variable and function
1603 mh-signature-separator and mh-signature-separator-p.
1604
1605 * mh-customize.el (mh-delete-yanked-msg-window-flag): Checkdoc
1606 fix.
1607 (mh-signature-file-name): Updated docstring now that this variable
1608 can be a function. Added cross-references to
1609 mh-signature-separator, mh-signature-separator-regexp, and
1610 mh-signature-separator-p which might be used in such functions.
1611
1612 * mh-identity.el (mh-insert-identity): Don't include signature if
1613 signature separator already present. Useful when running
1614 mh-edit-again.
1615
1616 * mh-mime.el (mh-inline-vcard-p): Use mh-signature-separator-p.
1617
1618 * mh-utils.el (mh-signature-separator-regexp): New variable
1619 containing "^-- $" which should be used when looking for the
1620 signature separator.
1621 (mh-signature-separator): New variable containing "-- \n" which
1622 should be used when inserting the signature separator.
1623 (mh-signature-separator-p): New function that returns non-nil if
1624 mh-signature-separator-regexp is found in the buffer.
1625
16262003-08-09 Satyaki Das <satyakid@stanford.edu>
1627
1628 * mh-utils.el (mh-x-image-scaling-function): Variable that
1629 contains function used to scale images. Possible choices are
1630 mh-x-image-scale-with-convert and mh-x-image-scale-with-pnm.
1631 (mh-convert-executable): Removed.
1632 (mh-x-image-scale-with-pnm, mh-x-image-scale-with-convert): New
1633 functions that scale images using pnm tools or ImageMagick.
1634 (mh-x-image-scale-and-display, mh-x-image-url-display): Use
1635 mh-x-image-scaling-function instead of mh-convert-executable.
1636
16372003-08-08 Peter S Galbraith <psg@debian.org>
1638
1639 * mh-comp.el (mh-insert-signature): Bug fix. Handle case of nil
1640 `mh-signature-file-name' and hooks correctly.
1641
1642 * mh-identity.el (mh-insert-identity): Refactor to use
1643 mh-insert-signature
1644
1645 * mh-comp.el (mh-signature-separator-p): Removed.
1646
1647 * mh-comp.el (mh-insert-signature): Merge MIME awareness from
1648 mh-insert-identity into this command. Allow
1649 `mh-signature-file-name' to be a function to call. See if "-- "
1650 needs to be inserted only after hooks have run.
1651
16522003-08-07 Bill Wohler <wohler@newt.com>
1653
1654 * mh-customize.el (mh-compose-skipped-header-fields): Added
1655 X-Image-URL.
1656 (mh-autoload): Removed cookies. They aren't necessary in
1657 mh-e.el, mh-utils.el, or mh-customize.el.
1658
1659 * mh-e.el (mh-autoload): Removed cookies. They aren't necessary in
1660 mh-e.el, mh-utils.el, or mh-customize.el.
1661
1662 * mh-identity.el (mh-insert-identity): Made regexp for signature
1663 separator more explicit. Hmmm, maybe we should create
1664 mh-signature-separator-regexp...
1665
1666 * mh-index.el (mh-replace-string): Moved to mh-utils.el.
1667
1668 * mh-utils.el (mh-replace-string): Moved here from mh-index.el.
1669 (mh-autoload): Removed cookies. They aren't necessary in mh-e.el,
1670 mh-utils.el, or mh-customize.el.
1671
1672 * mh-comp.el (mh-insert-signature): Added file argument to insert
1673 a file other than mh-signature-file-name. Insert signature
1674 separator, unless file already contains one.
1675
16762003-08-06 Satyaki Das <satyakid@stanford.edu>
1677
1678 * mh-e.el (mh-folder-size, mh-folder-size-folder)
1679 (mh-folder-size-flist): If flist is not present use folder to
1680 find the number of messages in the folder. Also the .mh_sequences
1681 file is read to find the number of unseen messages.
1682
1683 * mh-utils.el (mh-flists-present-flag, mh-find-progs): Introduce
1684 a new variable to test for the presence of the flists program and
1685 set it in mh-find-progs.
1686
16872003-08-06 Peter S Galbraith <psg@debian.org>
1688
1689 * mh-customize.el: Change the order of `mh-identity-list' and
1690 `mh-auto-fields-list' and remove byte-compilation defvar for
1691 `mh-identity-list'. This fixes a customization bug for
1692 `mh-identity-list', where it wasn't set correctly.
1693
1694 * mh-identity.el (mh-identity-make-menu): mh-auto-fields-list may
1695 not be bound yet when initially loaded.
1696
16972003-08-06 Bill Wohler <wohler@newt.com>
1698
1699 * mh-alias.el (mh-alias-add-address-under-point): Removed trailing
1700 period from messages. The conventions say that errors should not
1701 end with a period and that "Foo...done" messages should not end in
1702 a period, but they aren't explicit about messages in general.
1703 Given what the conventions *do* say, and because most of our
1704 messages don't end with a period, let's just say that messages in
1705 general don't end in a period, just like error messages.
1706
1707 * mh-comp.el (mh-extract-rejected-mail, mh-letter-mode-message):
1708 Ditto.
1709
1710 * mh-e.el (mh-refile-a-msg): Ditto.
1711
1712 * mh-funcs.el (mh-undo-folder): Ditto.
1713
1714 * mh-mime.el (mh-mime-save-parts): Ditto.
1715
1716 * mh-seq.el (mh-subject-to-sequence-unthreaded)
1717 (mh-narrow-to-subject, mh-delete-subject): Ditto.
1718
1719 * mh-index.el (mh-index-sequenced-messages)
1720 (mh-index-new-messages, mh-index-ticked-messages): Discovered that
1721 in general we should only use question marks in yes-or-no-p or
1722 y-or-n-p prompts, but not in other prompts that use
1723 completing-read and offer defaults. In these cases, use colons
1724 instead (closes SF #730470).
1725
1726 * mh-mime.el (mh-mime-save-parts): Ditto.
1727
1728 * mh-utils.el (mh-prompt-for-folder): Ditto.
1729
1730 * mh-alias.el (mh-alias-apropos): Multiple messages are usually
1731 shown one at a time rather than appended. Send output to
1732 mh-aliases-buffer instead of *Help*.
1733 (mh-alias-local-users): Checkdoc fix.
1734
1735 * mh-funcs.el (mh-undo-folder): Removed commented-out code since
1736 its deadline had expired.
1737
1738 * mh-utils.el (mh-aliases-buffer): New buffer name, used in
1739 mh-aliases.el.
1740
17412003-08-06 Satyaki Das <satyakid@stanford.edu>
1742
1743 * mh-utils.el (mh-x-image-url-cache-canonicalize): Make this
1744 function work for XEmacs too.
1745 (mh-collect-folder-names): Use folders instead of flists. One
1746 advantage is that folders is available on MH while flists is not.
1747 Another is that if an explicit -sequence argument isn't given and
1748 Unseen-Sequence profile is not present then flists croaks while
1749 folders doesn't.
1750 (mh-collect-folder-names-filter): Don't consider folder names that
1751 start with a `.' character. This is needed since the folders
1752 command doesn't filter them out like flists does.
1753
1754 * mh-index.el (mh-replace-string): Add autoload for it.
1755
17562003-08-05 Satyaki Das <satyakid@stanford.edu>
1757
1758 * mh-mime.el (mh-compose-forward, mh-mhn-compose-forw)
1759 (mh-mml-forward-message): The variable mh-sent-from-msg can be a
1760 list. So check that the value is really a number before using it
1761 like one.
1762
1763 * mh-comp.el (mh-insert-letter): Same as above.
1764
1765 * mh-utils.el (mh-picon-get-image): Make the code that finds the
1766 address of the sender more robust.
1767 (mh-face-display-function): Make it work with XEmacs.
1768 (mh-picon-image-types): A new variable that stores what image
1769 types can be used.
1770
17712003-08-05 Satyaki Das <satyakid@stanford.edu>
1772
1773 * mh-customize.el (mh-tool-bar-define): Make the save button such
1774 that is activated only if the buffer needs to saved.
1775
1776 * mh-utils.el (mh-face-display-function, mh-picon-get-image): Some
1777 domains, for instance cs.cmu.edu, don't have xpm files. So we need
1778 to search for all three files. The change does that.
1779 (mh-picon-file-contents): A utility function to return the
1780 contents of a file as a string.
1781 (mh-picon-get-image): Write it as a loop to make it simpler.
1782 (mh-x-image-set-download-state): Make the link simpler.
1783
17842003-08-04 Satyaki Das <satyakid@stanford.edu>
1785
1786 * mh-utils.el (mh-x-image-url-display): Don't bother to try to
1787 download image if we don't have the necessary tools to display
1788 it.
1789 (mh-face-display-function): Add preliminary support for "domain"
1790 picons.
1791 (mh-picon-get-image, mh-picon-generate-path): Functions to find
1792 best match for domain in the From header field.
1793
1794 * mh-e.el (mh-previous-unread-msg): If some of the messages in the
1795 unseen sequence are not present in the folder buffer then calling
1796 this function gets stuck and can't skip over them. The change
1797 fixes this.
1798 (mh-next-unread-msg): Same as above.
1799
18002003-08-04 Bill Wohler <wohler@newt.com>
1801
1802 * mh-utils.el (mh-show-mode): Added cross reference to
1803 mh-folder-mode in docstring (closes SF #728638). Added
1804 \\{mh-show-mode-map} to show keymap.
1805
1806 * mh-e.el (mh-folder-mode): Added information about ranges to
1807 docstring (closes SF #728638).
1808
1809 * mh-speed.el (mh-speed-refresh): New function that calls
1810 mh-speed-flists and mh-invalidate-map.
1811 (mh-folder-speedbar-key-map): Replaced keybindings for
1812 mh-speed-invalidate-map and mh-speed-flists with a single binding
1813 for mh-speed-refresh.
1814 (mh-folder-speedbar-menu-items): Replaced menu items for Run
1815 Flists and Invalidate Cached Folders with the single menu item
1816 Refresh Speedbar in order to simplify the UI.
1817
1818 * mh-customize.el (mh-fetch-x-image-url): Added DOS as another
1819 reason not to set this to t.
1820
18212003-08-04 Satyaki Das <satyakid@stanford.edu>
1822
1823 * mh-e.el (mh-scan-folder): Handle ranges from user input properly.
1824
18252003-08-03 Satyaki Das <satyakid@stanford.edu>
1826
1827 * mh-utils.el (mh-find-msg-get-num): Removed. If threading isn't
1828 present, the messages are sorted by index. So `mh-goto-msg' was
1829 implemented as a binary search and this function was used in that
1830 implementation. So this isn't needed any more.
1831 (mh-msg-search-pat): Removed. Before the advent of message
1832 threading, this function was used to generate a regexp used to
1833 search for a particular message. It isn't used anymore. The
1834 variable `mh-scan-msg-number-regexp' should be updated and used in
1835 `mh-goto-msg' instead of hardcoding the regexp in the code. Then
1836 we might be able to better support other scan line formats in the
1837 future.
1838
1839 * mh-seq.el (mh-map-to-seq-msgs, mh-notate-seq): Removed. These
1840 functions were used to notate user sequences. But calling
1841 `mh-goto-msg' inside of a loop is inefficient. So the sequence
1842 notation code was rewritten thereby making these functions
1843 redundant.
1844 (mh-copy-line-to-point): Removed. This function was used in the
1845 implementation the now removed function `mh-copy-seq-to-point'.
1846 That function was problematic and was replaced by the less general
1847 `mh-copy-seq-to-eob'. This makes `mh-copy-line-to-point'
1848 redundant.
1849 (mh-region-to-msg-list): Removed since this is a special case of
1850 the more general `mh-range-to-msg-list'.
1851
1852 * mh-loaddefs.el: Regenerated.
1853
18542003-08-03 Jeffrey C Honig <jch@honig.net>
1855
1856 * mh-customize.el (mh-invisible-header-fields-default): Added
1857 several new fields to hide. Sorted the list with sort-lines.
1858
18592003-08-03 Peter S Galbraith <psg@debian.org>
1860
1861 * mh-customize.el (mh-invisible-headers): Variable renamed to
1862 `mh-invisible-header-fields-compiled'.
1863 (mh-invisible-headers): Implement above change.
1864
1865 * mh-utils.el (mh-display-msg): Idem.
1866
1867 * mh-mime.el (mh-mm-inline-message): Idem.
1868
1869 * mh-comp.el (mh-insert-letter): Idem.
1870
18712003-08-03 Bill Wohler <wohler@newt.com>
1872
1873 * mh-speed.el (mh-folder-speedbar-menu-items): Added separator
1874 between standard and MH-E menu items. Use headline capitalization
1875 in menu items.
1876
1877 * mh-utils.el (mh-temp-fetch-buffer): New constant to hold
1878 buffer name for wget output.
1879 (mh-x-image-url-fetch-image): Use mh-temp-fetch-buffer instead
1880 of hard-coded buffer name. Use make-temp-file to avoid race
1881 conditions and subsequent security issues raised in make-temp-name
1882 docstring.
1883
18842003-08-03 Satyaki Das <satyakid@stanford.edu>
1885
1886 * mh-utils.el (mh-wget-executable, mh-wget-choice, mh-wget-option)
1887 (mh-x-image-url-fetch-image): Support the use of `curl' and
1888 `fetch' as alternatives to `wget'.
1889 (mh-wget-choice): Change order of search.
1890 (mh-x-image-url-fetch-image): Rename buffer.
1891
18922003-08-03 Satyaki Das <satyakid@stanford.edu>
1893
1894 * mh-utils.el (mh-x-image-set-download-state)
1895 (mh-x-image-get-download-state): Specially named symbolic links
1896 are used to keep track of whether a X-Image-URL header field needs
1897 to downloaded the next time it is seen. These functions get and
1898 set the symlinks appropriately.
1899 (mh-x-image-url-fetch-image): Simplified since the query has been
1900 moved to `mh-x-image-url-display'. Also if wget isn't present then
1901 try again next time since the user might install wget before
1902 trying once more.
1903 (mh-x-image-scale-and-display): Handle absence of the `convert'
1904 program better. If it isn't present then we will try to display
1905 the image the next time it is encountered. Also use the -geometry
1906 option to convert since the -resize option isn't present in older
1907 versions.
1908 (mh-x-image-url-display): Move all the code that decides whether
1909 an X-Image-URL header field will be fetched in this function. Also
1910 remember the user's decision so that if the image couldn't be
1911 fetched the first time, we will try to fetch it later on without
1912 asking again.
1913
19142003-08-02 Peter S Galbraith <psg@debian.org>
1915
1916 * mh-alias.el (mh-alias-local-users): Exclude all aliases already
1917 in mh-alias-alist from `ali' (closes SF #772595).
1918
19192003-08-01 Satyaki Das <satyakid@stanford.edu>
1920
1921 * mh-utils.el (mh-x-image-display, mh-x-image-url-display): Avoid
1922 a race. The X-Image-URL is displayed asynchronously. Suppose a
1923 message with a image is shown with `mh-show'. If a different
1924 message is displayed before the image can be fetched, then the new
1925 message will have the image displayed. With this change the race
1926 is less likely to happen.
1927
19282003-08-01 Peter S Galbraith <psg@debian.org>
1929
1930 * mh-inc.el (mh-inc-spool-map): Fix what `mh-inc-spool-map-help'
1931 must look like as a fake `mh-help-messages' in order to work
1932 correctly in mh-help.
1933
19342003-07-31 Bill Wohler <wohler@newt.com>
1935
1936 * mh-inc.el (mh-inc-spool-map): Use mh-help instead of
1937 mh-ephem-message in order to display help in its own buffer
1938 instead of minibuffer.
1939
1940 * mh-utils.el (mh-help-buffer): New variable to hold the name of
1941 the MH-E help buffer name.
1942
1943 * mh-funcs.el (mh-help, mh-prefix-help): Use with-electric-help to
1944 display help messages. I observed a friend with a vision
1945 disability and the 5 seconds the help appeared on the screen was
1946 not long enough for him to lock on it. I've therefore changed the
1947 help function to display the help in its own buffer called *MH-E
1948 Help* (closes SF #493740 and SF #656631).
1949
1950 * mh-customize.el (mh-fetch-x-image-url): Changed default from nil
1951 to 'ask. Updated docstring from manual.
1952 (mh-invisible-header-fields-internal): Added X-Image-URL.
1953 (mh-show-use-xface-flag): Updated docstring from manual.
1954 (mh-x-face-file): Ditto.
1955
1956 * mh-mime.el (mh-mhn-compose-external-type): Don't insert the
1957 directory parameter if it's nil. The mhbuild man page indicates
1958 that this parameter is optional, so this should be fine.
1959
1960 * mh-comp.el (mh-letter-mode-map): Added keybindings for
1961 mh-mhn-compose-anon-ftp and
1962 mh-mhn-compose-external-compressed-tar.
1963 (mh-letter-menu): Uncommented menu items for same.
1964
19652003-07-30 Satyaki Das <satyakid@stanford.edu>
1966
1967 * mh-loaddefs.el: Regenerated.
1968
1969 * mh-pick.el (mh-do-pick-search): Removed since the function
1970 `mh-pick-do-search' performs the same action as this function.
1971
1972 * mh-index.el (mh-index-update-unseen): Removed since the
1973 generalized sequence synchronization code that keeps sequences in
1974 index folders in sync with the sequences in the source folders
1975 makes this function redundant.
1976
1977 * mh-e.el (mh-folder-unseen-seq-name, mh-folder-unseen-seq-list):
1978 Removed. These two functions were used in the unseen sequence
1979 highlighting before the sequence highlighting code was
1980 generalized. In any event calls to the function
1981 `mh-folder-unseen-seq-name' can be replaced by the variable
1982 `mh-unseen-seq' and calls to `mh-folder-unseen-seq-list' can be
1983 replaced with (cdr (assoc mh-unseen-seq mh-seq-list)).
1984 (mh-unmark-all-headers): Removed since this function has been
1985 superseded by mh-remove-all-notation.
1986 (mh-map-over-seqs): Removed since we now have the generalized
1987 iteration over message ranges (the `mh-iterate-on-range' macro)
1988 that can be used instead.
1989 (mh-notate-if-in-one-seq): Removed. This function was used for
1990 changing the `%' notation for user sequences. It can't be used for
1991 that purpose any more, since we have a different scheme now.
1992
1993 * mh-unit.el (mh-unit-tests): Removed since it isn't needed any
1994 more.
1995 (mh-unit): Run all function that start with the string
1996 "mh-unit-test-".
1997
19982003-07-30 Bill Wohler <wohler@newt.com>
1999
2000 * mh-customize.el (mh-invisible-header-fields): Checkdoc fix.
2001
2002 * mh-utils.el (mh-x-image-url-cache-canonicalize): Shortened using
2003 example in files.el:make-backup-file-name-1.
2004 (mh-face-display-function): Added X-Image-URL to docstring.
2005
2006 * mh-unit.el (mh-unit-x-image-url-cache-canonicalize): New
2007 function to test mh-x-image-url-cache-canonicalize since it lent
2008 itself well to unit testing. Had to start somewhere!
2009 (mh-unit-equal): New function that throws an error if RESULT
2010 doesn't equal EXPECTED.
2011 (mh-unit): Call mh-unit-x-image-url-cache-canonicalize.
2012
20132003-07-29 Satyaki Das <satyakid@stanford.edu>
2014
2015 * mh-unit.el (mh-unit-update-call-graph): Make the function work
2016 better with dotted lists, that is lists of the form (a b c . d)
2017 where `d' isn't nil. With this we are able to avoid marking some
2018 functions as unused even though they are actually used in alists.
2019
20202003-07-28 Peter S Galbraith <psg@debian.org>
2021
2022 * mh-comp.el (mh-insert-letter): Remove `mh-visible-headers'
2023 operation.
2024
2025 * mh-mime.el (mh-mm-inline-message): Same.
2026
2027 * mh-utils.el (mh-display-msg): Same.
2028 (mh-clean-msg-header): Make a note of above change.
2029
2030 * mh-customize.el (mh-invisible-header-fields-internal): Renamed
2031 from prior `mh-invisible-header-fields-default'.
2032 (mh-invisible-header-fields-default): Renamed from prior
2033 `mh-invisible-header-fields-default-override'.
2034 (mh-invisible-header-fields): Renamed from prior
2035 `mh-invisible-header-fields-user'.
2036 (mh-visible-headers): Removed! We use invisible fields only now.
2037 (mh-visible-header-fields): Removed!
2038
20392003-07-28 Peter S Galbraith <psg@debian.org>
2040
2041 * mh-customize.el (mh-invisible-header-fields-default): Added 3
2042 new fields to hide.
2043
20442003-07-28 Satyaki Das <satyakid@stanford.edu>
2045
2046 * mh-utils.el (mh-show): Add an extra argument to the function so
2047 that interactive use will always force redisplay of the message.
2048
2049 * mh-mime.el (mh-mime-display, mh-mm-inline-message): Bind the
2050 variables `mm-verify-option' and `mm-decrypt-option' so that
2051 verification and decryption of mail can happen without any
2052 additional tinkering.
2053
20542003-07-25 Peter S Galbraith <psg@debian.org>
2055
2056 * mh-customize.el (mh-invisible-header-fields-default): New defvar
2057 holding default fields to hide. This replaces the old
2058 `mh-invisible-header-fields' defcustom.
2059 (mh-invisible-header-fields-user): New defcustom. Users add
2060 fields to suppress that we didn't include in
2061 `mh-invisible-header-fields-default'. This could be named simply
2062 `mh-invisible-header-fields' and it wouldn't really break anything
2063 for users who have customized it to a long list now redundant with
2064 `mh-invisible-header-fields-default'.
2065 (mh-invisible-header-fields-default-override): New defcustom.
2066 Users check off the fields they want displyed from what we
2067 included in `mh-invisible-header-fields-default'.
2068 (mh-invisible-headers): Function adapted to new variables.
2069
20702003-07-25 Satyaki Das <satyakid@stanford.edu>
2071
2072 * mh-e.el (mh-inc-folder): If the user is in a different folder
2073 displaying a message and runs mh-inc-folder, then the folder
2074 changes to +inbox but the show window continues to display the
2075 message in the old folder. The change fixes this.
2076 (mh-visit-folder): Make the handling of the show window similar to
2077 that of mh-inc-folder.
2078
20792003-07-24 Satyaki Das <satyakid@stanford.edu>
2080
2081 * mh-e.el (mh-folder-message-menu, mh-folder-folder-menu): Use the
2082 predicate mh-outstanding-commands-p instead of its exapansion.
2083 Also use the same label in both menus.
2084 (mh-outstanding-commands-p): Generalized so that it will work in
2085 mh-show-mode buffers as well.
2086
2087 * mh-customize.el (mh-tool-bar-define): Enable tool-bar button for
2088 mh-execute-commands only if there are pending deletes or refiles.
2089
20902003-07-19 Satyaki Das <satyakid@stanford.edu>
2091
2092 * mh-utils.el (mh-show-msg): If a unseen message is first marked
2093 for deletion/refiling and then displayed, the bold highlighting
2094 does not go away. This change fixes that.
2095
2096 * mh-seq.el (mh-msg-is-in-seq): Fix a bug in the function. If any
2097 message was marked for refiling, then the function would have you
2098 believe that every message in the folder is being refiled.
2099
21002003-07-17 Bill Wohler <wohler@newt.com>
2101
2102 * mh-e.el: Removed email address for Stephen Gildea's in Change
2103 Log at his request (damn spammers). Removed other email addresses
2104 while I was at it since the SourceForge URL should be sufficient
2105 contact information.
2106
2107 (mh-scan-format-*mh): Fixed typo in comment above these variables.
2108 These variables are used if mh-scan-format-file is t, not nil.
2109 Also mh-scan-format-file is no longer "above" (courtesy Stephen
2110 Gildea).
2111
21122003-07-17 Satyaki Das <satyakid@stanford.edu>
2113
2114 * mh-mime.el (mh-mhn-quote-unescaped-sharp): New function that
2115 quotes `#' characters in the first column that aren't part of a
2116 MHN directive.
2117 (mh-mhn-directive-present-p): Generalized to allow the function
2118 to search for MHN directives in a part of the buffer.
2119 (mh-edit-mhn): Quote unescaped `#' characters in the draft (closes
2120 SF #762464).
2121
21222003-07-16 Satyaki Das <satyakid@stanford.edu>
2123
2124 * mh-alias.el (mh-alias-read-address-map): If
2125 mh-alias-flash-on-comma is nil when mh-alias is loaded, then
2126 setting mh-alias-flash-on-comma to t later on doesn't turn on
2127 address completion display till Emacs is restarted. The change
2128 fixes this.
2129
21302003-07-15 Bill Wohler <wohler@newt.com>
2131
2132 * mh-utils.el (mh-cmd-note): Cleaned up docstring (changed phrase
2133 to sentences). Moved to Scan Line Formats section.
2134 (mh-scan-msg-number-regexp)
2135 (mh-scan-msg-overflow-regexp, mh-scan-msg-format-regexp)
2136 (mh-scan-msg-format-string, mh-scan-msg-search-regexp): Cleaned up
2137 docstrings (changed phrases to sentences).
2138 (mh-note-seq): Cleaned up docstring (changed phrase to sentences).
2139 Also, this variable is now a character and not a string. Moved to
2140 Scan Line Formats section.
2141
2142 * mh-funcs.el (mh-note-copied, mh-note-printed): Cleaned up
2143 docstrings (changed phrases to sentences). Also, these variables
2144 are now characters and not strings.
2145
2146 * mh-e.el (mh-scan-format-mh, mh-scan-format-nmh): Filled. I was
2147 hoping to quote the hint `t' but checkdoc wouldn't let me.
2148 (mh-note-deleted, mh-note-refiled, mh-note-cur): Moved to Scan
2149 Line Formats section.
2150 (mh-scan-good-msg-regexp, mh-scan-deleted-msg-regexp)
2151 (mh-scan-refiled-msg-regexp, mh-scan-valid-regexp)
2152 (mh-scan-cur-msg-number-regexp, mh-scan-date-regexp)
2153 (mh-scan-rcpt-regexp, mh-scan-body-regexp)
2154 (mh-scan-subject-regexp, mh-scan-format-regexp): Cleaned
2155 up docstrings (changed phrases to sentences).
2156 (mh-scan-cur-msg-regexp): Marked this variable as obsolete; it
2157 should be removed for 8.0.
2158
2159 * mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Cleaned
2160 up docstrings (changed phrases to sentences). Also, these
2161 variables are now characters and not strings.
2162
21632003-07-15 Satyaki Das <satyakid@stanford.edu>
2164
2165 * mh-index.el (mh-index-update-single-msg)
2166 (mh-index-create-sequences): Handle the situation where there are
2167 copies of the exact same message correctly.
2168
21692003-07-15 Satyaki Das <satyakid@stanford.edu>
2170
2171 * mh-seq.el (mh-thread-update-scan-line-map): Modified since
2172 notation is already a character.
2173
2174 * mh-utils.el (mh-note-seq): Convert from string to character.
2175 (mh-notate): Modified since characters are used to notate instead
2176 of strings of length one.
2177
2178 * mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Convert
2179 from string to characters.
2180
2181 * mh-e.el (mh-note-deleted, mh-note-refiled, mh-note-cur): Same as
2182 above (closes SF #770772).
2183 (mh-unmark-all-headers): Modified since mh-note-* variables are
2184 now characters.
2185 (mh-remove-sequence-notation): The mh-notate function remembers
2186 the previous notation. Before the change to the mh-note-*
2187 variables, mh-notate would only remember the change if a string
2188 was used to notate the message. Now mh-notate is always called
2189 with a character notation. So the deletion has to take place
2190 explicitly.
2191
21922003-06-28 Bill Wohler <wohler@newt.com>
2193
2194 * mh-mime.el (mh-mhn-directive-present-p): If shell comments are
2195 present that have a space after the # but no content, then this
2196 function would throw an error. This has been fixed (closes SF
2197 #762458).
2198
21992003-06-27 Satyaki Das <satyakid@stanford.edu>
2200
2201 * mh-index.el (mh-index-search): Use the new and improved
2202 mh-index-new-folder.
2203 (mh-index-new-folder): Improved so that redoing the same search
2204 will reuse the old index folder.
2205 (mh-index-folder-search-regexp): New function which that extracts
2206 out the search expression that produced the index folder.
2207
22082003-06-24 Bill Wohler <wohler@newt.com>
2209
2210 * mh-e.el (Version, mh-version): Set to 7.4.1+cvs.
2211
1342003-06-25 Bill Wohler <wohler@newt.com> 22122003-06-25 Bill Wohler <wohler@newt.com>
135 2213
136 * Released MH-E version 7.4.1. 2214 * Released MH-E version 7.4.1.
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
new file mode 100644
index 00000000000..16383304503
--- /dev/null
+++ b/lisp/mh-e/mh-acros.el
@@ -0,0 +1,144 @@
1;;; mh-acros.el --- Macros used in MH-E
2
3;; Copyright (C) 2004 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;; This file contains macros that would normally be in mh-utils.el except that
30;; their presence there would cause a dependency loop with mh-customize.el.
31;; This file must always be included like this:
32;;
33;; (eval-when-compile (require 'mh-acros))
34;;
35;; It is so named with a silent `m' so that it is compiled first. Otherwise,
36;; "make recompile" in Emacs 21.4 fails.
37
38;;; Change Log:
39
40;;; Code:
41
42(require 'cl)
43
44;; The Emacs coding conventions require that the cl package not be required at
45;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
46;; routines in their macro expansions. Use mh-require-cl to provide the cl
47;; routines in the best way possible.
48(defmacro mh-require-cl ()
49 "Macro to load `cl' if needed.
50Some versions of `cl' produce code for the expansion of
51\(setf (gethash ...) ...) that uses functions in `cl' at run time. This macro
52recognizes that and loads `cl' where appropriate."
53 (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
54 `(require 'cl)
55 `(eval-when-compile (require 'cl))))
56
57;;; Macros to generate correct code for different emacs variants
58
59(defmacro mh-do-in-gnu-emacs (&rest body)
60 "Execute BODY if in GNU Emacs."
61 (unless (featurep 'xemacs) `(progn ,@body)))
62(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
63
64(defmacro mh-do-in-xemacs (&rest body)
65 "Execute BODY if in GNU Emacs."
66 (when (featurep 'xemacs) `(progn ,@body)))
67(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
68
69(defmacro mh-funcall-if-exists (function &rest args)
70 "Call FUNCTION with ARGS as parameters if it exists."
71 (if (fboundp function)
72 `(funcall ',function ,@args)))
73
74(defmacro mh-make-local-hook (hook)
75 "Make HOOK local if needed.
76XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
77called."
78 (when (and (fboundp 'make-local-hook)
79 (not (get 'make-local-hook 'byte-obsolete-info)))
80 `(make-local-hook ,hook)))
81
82(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
83 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
84In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
85variable `transient-mark-mode' is active."
86 (cond ((featurep 'xemacs) ;XEmacs
87 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
88 ((not check-transient-mark-mode-flag) ;GNU Emacs
89 `(and (boundp 'mark-active) mark-active))
90 (t ;GNU Emacs
91 `(and (boundp 'transient-mark-mode) transient-mark-mode
92 (boundp 'mark-active) mark-active))))
93
94(defmacro mh-defstruct (name-spec &rest fields)
95 "Replacement for `defstruct' from the `cl' package.
96The `defstruct' in the `cl' library produces compiler warnings, and generates
97code that uses functions present in `cl' at run-time. This is a partial
98replacement, that avoids these issues.
99
100NAME-SPEC declares the name of the structure, while FIELDS describes the
101various structure fields. Lookup `defstruct' for more details."
102 (let* ((struct-name (if (atom name-spec) name-spec (car name-spec)))
103 (conc-name (or (and (consp name-spec)
104 (cadr (assoc :conc-name (cdr name-spec))))
105 (format "%s-" struct-name)))
106 (predicate (intern (format "%s-p" struct-name)))
107 (constructor (or (and (consp name-spec)
108 (cadr (assoc :constructor (cdr name-spec))))
109 (intern (format "make-%s" struct-name))))
110 (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields))
111 (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x)))
112 fields))
113 (struct (gensym "S"))
114 (x (gensym "X"))
115 (y (gensym "Y")))
116 `(progn
117 (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y))
118 field-names field-init-forms))
119 (list (quote ,struct-name) ,@field-names))
120 (defun ,predicate (arg)
121 (and (consp arg) (eq (car arg) (quote ,struct-name))))
122 ,@(loop for x from 1
123 for y in field-names
124 collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z)
125 (list 'nth ,x z)))
126 (quote ,struct-name))))
127
128(defadvice require (around mh-prefer-el activate)
129 "Modify `require' to load uncompiled MH-E files."
130 (or (featurep (ad-get-arg 0))
131 (and (string-match "^mh-" (symbol-name (ad-get-arg 0)))
132 (load (format "%s.el" (ad-get-arg 0)) t t))
133 ad-do-it))
134
135(provide 'mh-acros)
136
137;;; Local Variables:
138;;; no-byte-compile: t
139;;; indent-tabs-mode: nil
140;;; sentence-end-double-space: nil
141;;; End:
142
143;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff
144;;; mh-acros.el ends here
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index bd20b9118b0..1356e2c8b95 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -27,75 +27,12 @@
27 27
28;;; Commentary: 28;;; Commentary:
29 29
30;; [To be deleted when documented in MH-E manual.]
31;;
32;; This module provides mail alias completion when entering addresses.
33;;
34;; Use the TAB key to complete aliases (and optionally local usernames) when
35;; initially composing a message in the To: and Cc: minibuffer prompts. You
36;; may enter multiple addressees separated with a comma (but do *not* add any
37;; space after the comma).
38;;
39;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
40;; complete aliases. This is useful when you want to add an addressee as an
41;; afterthought when creating a message, or when adding an additional
42;; addressee to a reply.
43;;
44;; By default, completion is case-insensitive. This can be changed by
45;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
46;; useful, for example, to differentiate between people aliases in lowercase
47;; such as:
48;;
49;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
50;;
51;; and lists in uppercase such as:
52;;
53;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
54;;
55;; Note that this variable affects minibuffer completion only. If you have an
56;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
57;; be expanded in the letter buffer because MH is case-insensitive.
58;;
59;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
60;; the minibuffer, the expansion for the previous mail alias appears briefly.
61;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
62;;
63;; The addresses and aliases entered in the minibuffer are added to the
64;; message draft. To expand the aliases before they are added to the draft,
65;; customize the variable `mh-alias-expand-aliases-flag'.
66;;
67;; Completion is also performed on usernames extracted from the /etc/passwd
68;; file. This can be a handy tool on a machine where you and co-workers
69;; exchange messages, but should probably be disabled on a system with
70;; thousands of users you don't know. This is done by customizing the
71;; variable `mh-alias-local-users'. This variable also takes a string which
72;; is executed to generate the password file. For example, you'd use "ypcat
73;; passwd" for NIS.
74;;
75;; Aliases are loaded the first time you send mail and get the "To:" prompt
76;; and whenever a source of aliases changes. Sources of system aliases are
77;; defined in the customization variable `mh-alias-system-aliases' and
78;; include:
79;;
80;; /etc/nmh/MailAliases
81;; /usr/lib/mh/MailAliases
82;; /etc/passwd
83;;
84;; Sources of personal aliases are read from the files listed in your MH
85;; profile component Aliasfile. Multiple files are separated by white space
86;; and are relative to your mail directory.
87;;
88;; Alias Insertions
89;; ~~~~~~~~~~~~~~~~
90;; There are commands to insert new aliases into your alias file(s) (defined
91;; by the `Aliasfile' component in the .mh_profile file or by the variable
92;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
93;; an alias from the From line of the current message.
94
95;;; Change Log: 30;;; Change Log:
96 31
97;;; Code: 32;;; Code:
98 33
34(eval-when-compile (require 'mh-acros))
35(mh-require-cl)
99(require 'mh-e) 36(require 'mh-e)
100(load "cmr" t t) ; Non-fatal dependency for 37(load "cmr" t t) ; Non-fatal dependency for
101 ; completing-read-multiple. 38 ; completing-read-multiple.
@@ -116,15 +53,23 @@
116(defvar mh-alias-tstamp nil 53(defvar mh-alias-tstamp nil
117 "Time aliases were last loaded.") 54 "Time aliases were last loaded.")
118(defvar mh-alias-read-address-map nil) 55(defvar mh-alias-read-address-map nil)
119(if mh-alias-read-address-map 56(unless mh-alias-read-address-map
120 ()
121 (setq mh-alias-read-address-map 57 (setq mh-alias-read-address-map
122 (copy-keymap minibuffer-local-completion-map)) 58 (copy-keymap minibuffer-local-completion-map))
123 (if mh-alias-flash-on-comma 59 (define-key mh-alias-read-address-map
124 (define-key mh-alias-read-address-map 60 "," 'mh-alias-minibuffer-confirm-address)
125 "," 'mh-alias-minibuffer-confirm-address))
126 (define-key mh-alias-read-address-map " " 'self-insert-command)) 61 (define-key mh-alias-read-address-map " " 'self-insert-command))
127 62
63(defvar mh-alias-system-aliases
64 '("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
65 "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
66 "/etc/passwd")
67 "*A list of system files which are a source of aliases.
68If these files are modified, they are automatically reread. This list need
69include only system aliases and the passwd file, since personal alias files
70listed in your `Aliasfile:' MH profile component are automatically included.
71You can update the alias list manually using \\[mh-alias-reload].")
72
128 73
129;;; Alias Loading 74;;; Alias Loading
130 75
@@ -138,7 +83,7 @@ This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid
138 83
139(defun mh-alias-tstamp (arg) 84(defun mh-alias-tstamp (arg)
140 "Check whether alias files have been modified. 85 "Check whether alias files have been modified.
141Return t if any file listed in the MH profile component Aliasfile has been 86Return t if any file listed in the Aliasfile MH profile component has been
142modified since the timestamp. 87modified since the timestamp.
143If ARG is non-nil, set timestamp with the current time." 88If ARG is non-nil, set timestamp with the current time."
144 (if arg 89 (if arg
@@ -157,7 +102,7 @@ If ARG is non-nil, set timestamp with the current time."
157 102
158(defun mh-alias-filenames (arg) 103(defun mh-alias-filenames (arg)
159 "Return list of filenames that contain aliases. 104 "Return list of filenames that contain aliases.
160The filenames come from the MH profile component Aliasfile and are expanded. 105The filenames come from the Aliasfile profile component and are expanded.
161If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended." 106If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
162 (or mh-progs (mh-find-path)) 107 (or mh-progs (mh-find-path))
163 (save-excursion 108 (save-excursion
@@ -201,7 +146,8 @@ non-nil."
201 res)) 146 res))
202 147
203(defun mh-alias-local-users () 148(defun mh-alias-local-users ()
204 "Return an alist of local users from /etc/passwd." 149 "Return an alist of local users from /etc/passwd.
150Exclude all aliases already in `mh-alias-alist' from `ali'"
205 (let (passwd-alist) 151 (let (passwd-alist)
206 (save-excursion 152 (save-excursion
207 (set-buffer (get-buffer-create mh-temp-buffer)) 153 (set-buffer (get-buffer-create mh-temp-buffer))
@@ -222,23 +168,33 @@ non-nil."
222 (gecos-name (match-string 3)) 168 (gecos-name (match-string 3))
223 (realname (mh-alias-gecos-name 169 (realname (mh-alias-gecos-name
224 gecos-name username 170 gecos-name username
225 mh-alias-passwd-gecos-comma-separator-flag))) 171 mh-alias-passwd-gecos-comma-separator-flag))
226 (setq passwd-alist 172 (alias-name (if mh-alias-local-users-prefix
227 (cons 173 (concat mh-alias-local-users-prefix
228 (list (if mh-alias-local-users-prefix 174 (mh-alias-suggest-alias realname t))
229 (concat mh-alias-local-users-prefix 175 username))
230 (mh-alias-suggest-alias realname t)) 176 (alias-translation
231 username) 177 (if (string-equal username realname)
232 (if (string-equal username realname) 178 (concat "<" username ">")
233 (concat "<" username ">") 179 (concat realname " <" username ">"))))
234 (concat realname " <" username ">"))) 180 (when (not (mh-assoc-ignore-case alias-name mh-alias-alist))
235 passwd-alist)))))) 181 (setq passwd-alist (cons (list alias-name alias-translation)
182 passwd-alist)))))))
236 (forward-line 1))) 183 (forward-line 1)))
237 passwd-alist)) 184 passwd-alist))
238 185
239;;;###mh-autoload 186;;;###mh-autoload
240(defun mh-alias-reload () 187(defun mh-alias-reload ()
241 "Load MH aliases into `mh-alias-alist'." 188 "Reload MH aliases.
189
190Since aliases are updated frequently, MH-E will reload aliases automatically
191whenever an alias lookup occurs if an alias source (a file listed in your
192`Aliasfile:' profile component and your password file if variable
193`mh-alias-local-users' is non-nil) has changed. However, you can reload your
194aliases manually by calling this command directly.
195
196The value of `mh-alias-reloaded-hook' is a list of functions to be called,
197with no arguments, after the aliases have been loaded."
242 (interactive) 198 (interactive)
243 (save-excursion 199 (save-excursion
244 (message "Loading MH aliases...") 200 (message "Loading MH aliases...")
@@ -269,13 +225,14 @@ non-nil."
269 (if (not (mh-assoc-ignore-case (car user) mh-alias-alist)) 225 (if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
270 (setq mh-alias-alist (append mh-alias-alist (list user)))) 226 (setq mh-alias-alist (append mh-alias-alist (list user))))
271 (setq local-users (cdr local-users))))) 227 (setq local-users (cdr local-users)))))
228 (run-hooks 'mh-alias-reloaded-hook)
272 (message "Loading MH aliases...done")) 229 (message "Loading MH aliases...done"))
273 230
274;;;###mh-autoload 231;;;###mh-autoload
275(defun mh-alias-reload-maybe () 232(defun mh-alias-reload-maybe ()
276 "Load new MH aliases." 233 "Load new MH aliases."
277 (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it. 234 (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
278 (mh-alias-tstamp nil)) ; Out of date, so recreate it. 235 (mh-alias-tstamp nil)) ; Out of date?
279 (mh-alias-reload))) 236 (mh-alias-reload)))
280 237
281 238
@@ -461,21 +418,21 @@ is converted to lower case."
461 found))) 418 found)))
462 419
463(defun mh-alias-insert-file (&optional alias) 420(defun mh-alias-insert-file (&optional alias)
464 "Return the alias file to write a new entry for ALIAS in. 421 "Return filename which should be used to add ALIAS.
465Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component 422The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise
466value. 423the value of the `Aliasfile:' profile component is used.
467If ALIAS is specified and it already exists, try to return the file that 424If the alias already exists, try to return the name of the file that contains
468contains it." 425it."
469 (cond 426 (cond
470 ((and mh-alias-insert-file (listp mh-alias-insert-file)) 427 ((and mh-alias-insert-file (listp mh-alias-insert-file))
471 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it 428 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
472 (car mh-alias-insert-file) 429 (car mh-alias-insert-file)
473 (if (or (not alias) 430 (if (or (not alias)
474 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist 431 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
475 (completing-read "Alias file [press Tab]: " 432 (completing-read "Alias file: "
476 (mapcar 'list mh-alias-insert-file) nil t) 433 (mapcar 'list mh-alias-insert-file) nil t)
477 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) 434 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
478 (completing-read "Alias file [press Tab]: " 435 (completing-read "Alias file: "
479 (mapcar 'list mh-alias-insert-file) nil t))))) 436 (mapcar 'list mh-alias-insert-file) nil t)))))
480 ((and mh-alias-insert-file (stringp mh-alias-insert-file)) 437 ((and mh-alias-insert-file (stringp mh-alias-insert-file))
481 mh-alias-insert-file) 438 mh-alias-insert-file)
@@ -490,16 +447,15 @@ contains it."
490 (cond 447 (cond
491 ((not autolist) 448 ((not autolist)
492 (error "No writable alias file. 449 (error "No writable alias file.
493Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file")) 450Set `mh-alias-insert-file' or the Aliasfile profile component"))
494 ((not (elt autolist 1)) ; Only one entry, use it 451 ((not (elt autolist 1)) ; Only one entry, use it
495 (car autolist)) 452 (car autolist))
496 ((or (not alias) 453 ((or (not alias)
497 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist 454 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
498 (completing-read "Alias file [press Tab]: " 455 (completing-read "Alias file: " (mapcar 'list autolist) nil t))
499 (mapcar 'list autolist) nil t))
500 (t 456 (t
501 (or (mh-alias-which-file-has-alias alias autolist) 457 (or (mh-alias-which-file-has-alias alias autolist)
502 (completing-read "Alias file [press Tab]: " 458 (completing-read "Alias file: "
503 (mapcar 'list autolist) nil t)))))))) 459 (mapcar 'list autolist) nil t))))))))
504 460
505;;;###mh-autoload 461;;;###mh-autoload
@@ -520,10 +476,8 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
520 (split-string aliases ", +"))))))) 476 (split-string aliases ", +")))))))
521 477
522;;;###mh-autoload 478;;;###mh-autoload
523(defun mh-alias-from-has-no-alias-p () 479(defun mh-alias-for-from-p ()
524 "Return t is From has no current alias set. 480 "Return t if sender's address has a corresponding alias."
525In the exceptional situation where there isn't a From header in the message the
526function returns nil."
527 (mh-alias-reload-maybe) 481 (mh-alias-reload-maybe)
528 (save-excursion 482 (save-excursion
529 (if (not (mh-folder-line-matches-show-buffer-p)) 483 (if (not (mh-folder-line-matches-show-buffer-p))
@@ -532,13 +486,16 @@ function returns nil."
532 (set-buffer mh-show-buffer)) 486 (set-buffer mh-show-buffer))
533 (let ((from-header (mh-extract-from-header-value))) 487 (let ((from-header (mh-extract-from-header-value)))
534 (and from-header 488 (and from-header
535 (not (mh-alias-address-to-alias from-header))))))) 489 (mh-alias-address-to-alias from-header))))))
536 490
537(defun mh-alias-add-alias-to-file (alias address &optional file) 491(defun mh-alias-add-alias-to-file (alias address &optional file)
538 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts. 492 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
539Prompt for alias file if not provided and there is more than one candidate. 493Prompt for alias file if not provided and there is more than one candidate.
540If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend 494
541after it." 495If the alias exists already, you will have the choice of inserting the new
496alias before or after the old alias. In the former case, this alias will be
497used when sending mail to this alias. In the latter case, the alias serves as
498an additional folder name hint when filing messages."
542 (if (not file) 499 (if (not file)
543 (setq file (mh-alias-insert-file alias))) 500 (setq file (mh-alias-insert-file alias)))
544 (save-excursion 501 (save-excursion
@@ -552,14 +509,15 @@ after it."
552 ((re-search-forward 509 ((re-search-forward
553 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t) 510 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
554 (let ((answer (read-string 511 (let ((answer (read-string
555 (format "Exists for %s; [i]nsert, [a]ppend: " 512 (format (concat "Alias %s exists; insert new address "
513 "[b]efore or [a]fter: ")
556 (match-string 1)))) 514 (match-string 1))))
557 (case-fold-search t)) 515 (case-fold-search t))
558 (cond ((string-match "^i" answer)) 516 (cond ((string-match "^b" answer))
559 ((string-match "^a" answer) 517 ((string-match "^a" answer)
560 (forward-line 1)) 518 (forward-line 1))
561 (t 519 (t
562 (error "Quitting"))))) 520 (error "Unrecognized response")))))
563 ;; No, so sort-in at the right place 521 ;; No, so sort-in at the right place
564 ;; search for "^alias", then "^alia", etc. 522 ;; search for "^alias", then "^alia", etc.
565 ((eq mh-alias-insertion-location 'sorted) 523 ((eq mh-alias-insertion-location 'sorted)
@@ -587,8 +545,11 @@ after it."
587;;;###mh-autoload 545;;;###mh-autoload
588(defun mh-alias-add-alias (alias address) 546(defun mh-alias-add-alias (alias address)
589 "*Add ALIAS for ADDRESS in personal alias file. 547 "*Add ALIAS for ADDRESS in personal alias file.
590Prompts for confirmation if the address already has an alias. 548This function prompts you for an alias and address. If the alias exists
591If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." 549already, you will have the choice of inserting the new alias before or after
550the old alias. In the former case, this alias will be used when sending mail
551to this alias. In the latter case, the alias serves as an additional folder
552name hint when filing messages."
592 (interactive "P\nP") 553 (interactive "P\nP")
593 (mh-alias-reload-maybe) 554 (mh-alias-reload-maybe)
594 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias)) 555 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
@@ -614,9 +575,7 @@ If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
614 575
615;;;###mh-autoload 576;;;###mh-autoload
616(defun mh-alias-grab-from-field () 577(defun mh-alias-grab-from-field ()
617 "*Add ALIAS for ADDRESS in personal alias file. 578 "*Add alias for the sender of the current message."
618Prompts for confirmation if the alias is already in use or if the address
619already has an alias."
620 (interactive) 579 (interactive)
621 (mh-alias-reload-maybe) 580 (mh-alias-reload-maybe)
622 (save-excursion 581 (save-excursion
@@ -636,24 +595,26 @@ already has an alias."
636 595
637;;;###mh-autoload 596;;;###mh-autoload
638(defun mh-alias-add-address-under-point () 597(defun mh-alias-add-address-under-point ()
639 "Insert an alias for email address under point." 598 "Insert an alias for address under point."
640 (interactive) 599 (interactive)
641 (let ((address (mh-goto-address-find-address-at-point))) 600 (let ((address (mh-goto-address-find-address-at-point)))
642 (if address 601 (if address
643 (mh-alias-add-alias nil address) 602 (mh-alias-add-alias nil address)
644 (message "No email address found under point.")))) 603 (message "No email address found under point"))))
645 604
646;;;###mh-autoload 605;;;###mh-autoload
647(defun mh-alias-apropos (regexp) 606(defun mh-alias-apropos (regexp)
648 "Show all aliases that match REGEXP either in name or content." 607 "Show all aliases or addresses that match REGEXP."
649 (interactive "sAlias regexp: ") 608 (interactive "sAlias regexp: ")
650 (if mh-alias-local-users 609 (if mh-alias-local-users
651 (mh-alias-reload-maybe)) 610 (mh-alias-reload-maybe))
652 (let ((matches "")(group-matches "")(passwd-matches)) 611 (let ((matches "")
612 (group-matches "")
613 (passwd-matches))
653 (save-excursion 614 (save-excursion
654 (message "Reading MH aliases...") 615 (message "Reading MH aliases...")
655 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") 616 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
656 (message "Reading MH aliases...done. Parsing...") 617 (message "Parsing MH aliases...")
657 (while (re-search-forward regexp nil t) 618 (while (re-search-forward regexp nil t)
658 (beginning-of-line) 619 (beginning-of-line)
659 (cond 620 (cond
@@ -673,10 +634,9 @@ already has an alias."
673 (concat matches 634 (concat matches
674 (buffer-substring (point)(progn (end-of-line)(point))) 635 (buffer-substring (point)(progn (end-of-line)(point)))
675 "\n"))))) 636 "\n")))))
676 (message "Reading MH aliases...done. Parsing...done.") 637 (message "Parsing MH aliases...done")
677 (when mh-alias-local-users 638 (when mh-alias-local-users
678 (message 639 (message "Making passwd aliases...")
679 "Reading MH aliases...done. Parsing...done. Passwd aliases...")
680 (setq passwd-matches 640 (setq passwd-matches
681 (mapconcat 641 (mapconcat
682 '(lambda (elem) 642 '(lambda (elem)
@@ -684,13 +644,12 @@ already has an alias."
684 (string-match regexp (cadr elem))) 644 (string-match regexp (cadr elem)))
685 (format "%s: %s\n" (car elem) (cadr elem)))) 645 (format "%s: %s\n" (car elem) (cadr elem))))
686 mh-alias-passwd-alist "")) 646 mh-alias-passwd-alist ""))
687 (message 647 (message "Making passwd aliases...done")))
688 "Reading MH aliases...done. Parsing...done. Passwd aliases...done.")))
689 (if (and (string-equal "" matches) 648 (if (and (string-equal "" matches)
690 (string-equal "" group-matches) 649 (string-equal "" group-matches)
691 (string-equal "" passwd-matches)) 650 (string-equal "" passwd-matches))
692 (message "No matches") 651 (message "No matches")
693 (with-output-to-temp-buffer "*Help*" 652 (with-output-to-temp-buffer mh-aliases-buffer
694 (if (not (string-equal "" matches)) 653 (if (not (string-equal "" matches))
695 (princ matches)) 654 (princ matches))
696 (when (not (string-equal group-matches "")) 655 (when (not (string-equal group-matches ""))
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 489b6690bc7..cde52c65043 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -33,11 +33,12 @@
33 33
34;;; Code: 34;;; Code:
35 35
36(eval-when-compile (require 'mh-acros))
37(mh-require-cl)
36(require 'mh-e) 38(require 'mh-e)
37(require 'gnus-util) 39(require 'gnus-util)
38(require 'easymenu) 40(require 'easymenu)
39(require 'mh-utils) 41(require 'mh-gnus)
40(mh-require-cl)
41(eval-when (compile load eval) 42(eval-when (compile load eval)
42 (ignore-errors (require 'mailabbrev))) 43 (ignore-errors (require 'mailabbrev)))
43 44
@@ -48,6 +49,7 @@
48(defvar sendmail-coding-system) 49(defvar sendmail-coding-system)
49(defvar mh-identity-list) 50(defvar mh-identity-list)
50(defvar mh-identity-default) 51(defvar mh-identity-default)
52(defvar mh-mml-mode-default)
51(defvar mh-identity-menu) 53(defvar mh-identity-menu)
52 54
53;;; Autoloads 55;;; Autoloads
@@ -58,7 +60,7 @@
58(autoload 'sc-cite-original "sc" 60(autoload 'sc-cite-original "sc"
59 "Workhorse citing function which performs the initial citation. 61 "Workhorse citing function which performs the initial citation.
60This is callable from the various mail and news readers' reply 62This is callable from the various mail and news readers' reply
61function according to the agreed upon standard. See `\\[sc-describe]' 63function according to the agreed upon standard. See `sc-describe'
62for more details. `sc-cite-original' does not do any yanking of the 64for more details. `sc-cite-original' does not do any yanking of the
63original message but it does require a few things: 65original message but it does require a few things:
64 66
@@ -95,14 +97,16 @@ If MH will not allow you to redist a previously redist'd msg, set to nil.")
95This allows transaction log to be visible if -watch, -verbose or -snoop are 97This allows transaction log to be visible if -watch, -verbose or -snoop are
96used.") 98used.")
97 99
98(defvar mh-note-repl "-" 100;;; Scan Line Formats
99 "String whose first character is used to notate replied to messages.") 101
102(defvar mh-note-repl ?-
103 "Messages that have been replied to are marked by this character.")
100 104
101(defvar mh-note-forw "F" 105(defvar mh-note-forw ?F
102 "String whose first character is used to notate forwarded messages.") 106 "Messages that have been forwarded are marked by this character.")
103 107
104(defvar mh-note-dist "R" 108(defvar mh-note-dist ?R
105 "String whose first character is used to notate redistributed messages.") 109 "Messages that have been redistributed are marked by this character.")
106 110
107(defvar mh-yank-hooks nil 111(defvar mh-yank-hooks nil
108 "Obsolete hook for modifying a citation just inserted in the mail buffer. 112 "Obsolete hook for modifying a citation just inserted in the mail buffer.
@@ -113,23 +117,6 @@ text as modified.
113This is a normal hook, misnamed for historical reasons. 117This is a normal hook, misnamed for historical reasons.
114It is semi-obsolete and is only used if `mail-citation-hook' is nil.") 118It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
115 119
116(defvar mail-citation-hook nil
117 "*Hook for modifying a citation just inserted in the mail buffer.
118Each hook function can find the citation between point and mark.
119And each hook function should leave point and mark around the citation
120text as modified.
121
122If this hook is entirely empty (nil), the text of the message is inserted
123with `mh-ins-buf-prefix' prefixed to each line.
124
125See also the variable `mh-yank-from-start-of-msg', which controls how
126much of the message passed to the hook.
127
128This hook was historically provided to set up supercite. You may now leave
129this nil and set up supercite by setting the variable
130`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
131to 'autosupercite.")
132
133(defvar mh-comp-formfile "components" 120(defvar mh-comp-formfile "components"
134 "Name of file to be used as a skeleton for composing messages. 121 "Name of file to be used as a skeleton for composing messages.
135Default is \"components\". If not an absolute file name, the file 122Default is \"components\". If not an absolute file name, the file
@@ -145,7 +132,8 @@ system MH lib directory.")
145(defvar mh-repl-group-formfile "replgroupcomps" 132(defvar mh-repl-group-formfile "replgroupcomps"
146 "Name of file to be used as a skeleton for replying to messages. 133 "Name of file to be used as a skeleton for replying to messages.
147This file is used to form replies to the sender and all recipients of a 134This file is used to form replies to the sender and all recipients of a
148message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\". 135message. Only used if `(mh-variant-p 'nmh)' is non-nil.
136Default is \"replgroupcomps\".
149If not an absolute file name, the file is searched for first in the user's MH 137If not an absolute file name, the file is searched for first in the user's MH
150directory, then in the system MH lib directory.") 138directory, then in the system MH lib directory.")
151 139
@@ -153,6 +141,8 @@ directory, then in the system MH lib directory.")
153 (format "^%s$" 141 (format "^%s$"
154 (regexp-opt 142 (regexp-opt
155 '("Content-Type: message/rfc822" ;MIME MDN 143 '("Content-Type: message/rfc822" ;MIME MDN
144 "------ This is a copy of the message, including all the headers. ------";from exim
145 "--- Below this line is a copy of the message."; from qmail
156 " ----- Unsent message follows -----" ;from sendmail V5 146 " ----- Unsent message follows -----" ;from sendmail V5
157 " --------Unsent Message below:" ; from sendmail at BU 147 " --------Unsent Message below:" ; from sendmail at BU
158 " ----- Original message follows -----" ;from sendmail V8 148 " ----- Original message follows -----" ;from sendmail V8
@@ -201,16 +191,16 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte
201 "Field name for message annotation.") 191 "Field name for message annotation.")
202 192
203(defvar mh-insert-auto-fields-done-local nil 193(defvar mh-insert-auto-fields-done-local nil
204 "Buffer-local variable set when `mh-insert-auto-fields' successfully called.") 194 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
205(make-variable-buffer-local 'mh-insert-auto-fields-done-local) 195(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
206 196
207;;;###autoload 197;;;###autoload
208(defun mh-smail () 198(defun mh-smail ()
209 "Compose and send mail with the MH mail system. 199 "Compose and send mail with the MH mail system.
210This function is an entry point to MH-E, the Emacs front end 200This function is an entry point to MH-E, the Emacs interface to the MH mail
211to the MH mail system. 201system.
212 202
213See documentation of `\\[mh-send]' for more details on composing mail." 203See `mh-send' for more details on composing mail."
214 (interactive) 204 (interactive)
215 (mh-find-path) 205 (mh-find-path)
216 (call-interactively 'mh-send)) 206 (call-interactively 'mh-send))
@@ -220,11 +210,11 @@ See documentation of `\\[mh-send]' for more details on composing mail."
220;;;###autoload 210;;;###autoload
221(defun mh-smail-batch (&optional to subject other-headers &rest ignored) 211(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
222 "Set up a mail composition draft with the MH mail system. 212 "Set up a mail composition draft with the MH mail system.
223This function is an entry point to MH-E, the Emacs front end 213This function is an entry point to MH-E, the Emacs interface to the MH mail
224to the MH mail system. This function does not prompt the user 214system. This function does not prompt the user for any header fields, and thus
225for any header fields, and thus is suitable for use by programs 215is suitable for use by programs that want to create a mail buffer. Users
226that want to create a mail buffer. 216should use `mh-smail' to compose mail.
227Users should use `\\[mh-smail]' to compose mail. 217
228Optional arguments for setting certain fields include TO, SUBJECT, and 218Optional arguments for setting certain fields include TO, SUBJECT, and
229OTHER-HEADERS. Additional arguments are IGNORED." 219OTHER-HEADERS. Additional arguments are IGNORED."
230 (mh-find-path) 220 (mh-find-path)
@@ -260,7 +250,8 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
260 "Clean up a draft or a message MSG previously sent and make it resendable. 250 "Clean up a draft or a message MSG previously sent and make it resendable.
261Default is the current message. 251Default is the current message.
262The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. 252The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
263See also documentation for `\\[mh-send]' function." 253
254See also `mh-send'."
264 (interactive (list (mh-get-msg-num t))) 255 (interactive (list (mh-get-msg-num t)))
265 (let* ((from-folder mh-current-folder) 256 (let* ((from-folder mh-current-folder)
266 (config (current-window-configuration)) 257 (config (current-window-configuration))
@@ -292,7 +283,8 @@ See also documentation for `\\[mh-send]' function."
292 "Extract message MSG returned by the mail system and make it resendable. 283 "Extract message MSG returned by the mail system and make it resendable.
293Default is the current message. The variable `mh-new-draft-cleaned-headers' 284Default is the current message. The variable `mh-new-draft-cleaned-headers'
294gives the headers to clean out of the original message. 285gives the headers to clean out of the original message.
295See also documentation for `\\[mh-send]' function." 286
287See also `mh-send'."
296 (interactive (list (mh-get-msg-num t))) 288 (interactive (list (mh-get-msg-num t)))
297 (let ((from-folder mh-current-folder) 289 (let ((from-folder mh-current-folder)
298 (config (current-window-configuration)) 290 (config (current-window-configuration))
@@ -303,7 +295,7 @@ See also documentation for `\\[mh-send]' function."
303 (delete-region (point-min) (point)) 295 (delete-region (point-min) (point))
304 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) 296 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
305 (t 297 (t
306 (message "Does not appear to be a rejected letter."))) 298 (message "Does not appear to be a rejected letter")))
307 (mh-insert-header-separator) 299 (mh-insert-header-separator)
308 (goto-char (point-min)) 300 (goto-char (point-min))
309 (save-buffer) 301 (save-buffer)
@@ -323,7 +315,7 @@ Default is the displayed message.
323Check the documentation of `mh-interactive-range' to see how RANGE is read in 315Check the documentation of `mh-interactive-range' to see how RANGE is read in
324interactive use. 316interactive use.
325 317
326See also documentation for `\\[mh-send]' function." 318See also `mh-send'."
327 (interactive (list (mh-interactive-read-address "To: ") 319 (interactive (list (mh-interactive-read-address "To: ")
328 (mh-interactive-read-address "Cc: ") 320 (mh-interactive-read-address "Cc: ")
329 (mh-interactive-range "Forward"))) 321 (mh-interactive-range "Forward")))
@@ -335,7 +327,10 @@ See also documentation for `\\[mh-send]' function."
335 (draft-name (expand-file-name "draft" mh-user-path)) 327 (draft-name (expand-file-name "draft" mh-user-path))
336 (draft (cond ((or (not (file-exists-p draft-name)) 328 (draft (cond ((or (not (file-exists-p draft-name))
337 (y-or-n-p "The file 'draft' exists. Discard it? ")) 329 (y-or-n-p "The file 'draft' exists. Discard it? "))
338 (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") 330 (mh-exec-cmd "forw" "-build"
331 (if (and (mh-variant-p 'nmh)
332 mh-compose-forward-as-mime-flag)
333 "-mime")
339 mh-current-folder 334 mh-current-folder
340 (mh-coalesce-msg-list msgs)) 335 (mh-coalesce-msg-list msgs))
341 (prog1 336 (prog1
@@ -388,7 +383,8 @@ See also documentation for `\\[mh-send]' function."
388 mh-note-forw "Forwarded:" 383 mh-note-forw "Forwarded:"
389 config) 384 config)
390 (mh-letter-mode-message) 385 (mh-letter-mode-message)
391 (mh-letter-adjust-point))))) 386 (mh-letter-adjust-point)
387 (run-hooks 'mh-forward-hook)))))
392 388
393(defun mh-forwarded-letter-subject (from subject) 389(defun mh-forwarded-letter-subject (from subject)
394 "Return a Subject suitable for a forwarded message. 390 "Return a Subject suitable for a forwarded message.
@@ -406,10 +402,10 @@ Original message has headers FROM and SUBJECT."
406;;;###autoload 402;;;###autoload
407(defun mh-smail-other-window () 403(defun mh-smail-other-window ()
408 "Compose and send mail in other window with the MH mail system. 404 "Compose and send mail in other window with the MH mail system.
409This function is an entry point to MH-E, the Emacs front end 405This function is an entry point to MH-E, the Emacs interface to the MH mail
410to the MH mail system. 406system.
411 407
412See documentation of `\\[mh-send]' for more details on composing mail." 408See `mh-send' for more details on composing mail."
413 (interactive) 409 (interactive)
414 (mh-find-path) 410 (mh-find-path)
415 (call-interactively 'mh-send-other-window)) 411 (call-interactively 'mh-send-other-window))
@@ -496,13 +492,15 @@ to reply to:
496If optional prefix argument INCLUDEP provided, then include the message 492If optional prefix argument INCLUDEP provided, then include the message
497in the reply using filter `mhl.reply' in your MH directory. 493in the reply using filter `mhl.reply' in your MH directory.
498If the file named by `mh-repl-formfile' exists, it is used as a skeleton 494If the file named by `mh-repl-formfile' exists, it is used as a skeleton
499for the reply. See also documentation for `\\[mh-send]' function." 495for the reply.
496
497See also `mh-send'."
500 (interactive (list 498 (interactive (list
501 (mh-get-msg-num t) 499 (mh-get-msg-num t)
502 (let ((minibuffer-help-form 500 (let ((minibuffer-help-form
503 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) 501 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
504 (or mh-reply-default-reply-to 502 (or mh-reply-default-reply-to
505 (completing-read "Reply to whom? (from, to, all) [from]: " 503 (completing-read "Reply to whom: [from] "
506 '(("from") ("to") ("cc") ("all")) 504 '(("from") ("to") ("cc") ("all"))
507 nil 505 nil
508 t))) 506 t)))
@@ -511,7 +509,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
511 (show-buffer mh-show-buffer) 509 (show-buffer mh-show-buffer)
512 (config (current-window-configuration)) 510 (config (current-window-configuration))
513 (group-reply (or (equal reply-to "cc") (equal reply-to "all"))) 511 (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
514 (form-file (cond ((and mh-nmh-flag group-reply 512 (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
515 (stringp mh-repl-group-formfile)) 513 (stringp mh-repl-group-formfile))
516 mh-repl-group-formfile) 514 mh-repl-group-formfile)
517 ((stringp mh-repl-formfile) mh-repl-formfile) 515 ((stringp mh-repl-formfile) mh-repl-formfile)
@@ -525,7 +523,7 @@ for the reply. See also documentation for `\\[mh-send]' function."
525 '("-nocc" "all")) 523 '("-nocc" "all"))
526 ((equal reply-to "to") 524 ((equal reply-to "to")
527 '("-cc" "to")) 525 '("-cc" "to"))
528 (group-reply (if mh-nmh-flag 526 (group-reply (if (mh-variant-p 'nmh 'mu-mh)
529 '("-group" "-nocc" "me") 527 '("-group" "-nocc" "me")
530 '("-cc" "all" "-nocc" "me")))) 528 '("-cc" "all" "-nocc" "me"))))
531 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) 529 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
@@ -562,7 +560,6 @@ for the reply. See also documentation for `\\[mh-send]' function."
562;;;###mh-autoload 560;;;###mh-autoload
563(defun mh-send (to cc subject) 561(defun mh-send (to cc subject)
564 "Compose and send a letter. 562 "Compose and send a letter.
565
566Do not call this function from outside MH-E; use \\[mh-smail] instead. 563Do not call this function from outside MH-E; use \\[mh-smail] instead.
567 564
568The file named by `mh-comp-formfile' will be used as the form. 565The file named by `mh-comp-formfile' will be used as the form.
@@ -581,7 +578,6 @@ passed three arguments: TO, CC, and SUBJECT."
581;;;###mh-autoload 578;;;###mh-autoload
582(defun mh-send-other-window (to cc subject) 579(defun mh-send-other-window (to cc subject)
583 "Compose and send a letter in another window. 580 "Compose and send a letter in another window.
584
585Do not call this function from outside MH-E; use \\[mh-smail-other-window] 581Do not call this function from outside MH-E; use \\[mh-smail-other-window]
586instead. 582instead.
587 583
@@ -711,6 +707,8 @@ Do not insert any pairs whose value is the empty string."
711 (while name-values 707 (while name-values
712 (let ((field-name (car name-values)) 708 (let ((field-name (car name-values))
713 (value (car (cdr name-values)))) 709 (value (car (cdr name-values))))
710 (if (not (string-match "^.*:$" field-name))
711 (setq field-name (concat field-name ":")))
714 (cond ((equal value "") 712 (cond ((equal value "")
715 nil) 713 nil)
716 ((mh-position-on-field field-name) 714 ((mh-position-on-field field-name)
@@ -730,6 +728,7 @@ The optional second arg is for pre-version 4 compatibility and is IGNORED."
730 ((mh-goto-header-end 0) 728 ((mh-goto-header-end 0)
731 nil))) 729 nil)))
732 730
731;;;###mh-autoload
733(defun mh-get-header-field (field) 732(defun mh-get-header-field (field)
734 "Find and return the body of FIELD in the mail header. 733 "Find and return the body of FIELD in the mail header.
735Returns the empty string if the field is not in the header of the 734Returns the empty string if the field is not in the header of the
@@ -777,35 +776,53 @@ Returns t if found, nil if not."
777 776
778;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) 777;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
779(eval-when-compile (defvar mh-letter-menu nil)) 778(eval-when-compile (defvar mh-letter-menu nil))
780(cond 779(easy-menu-define
781 ((fboundp 'easy-menu-define) 780 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
782 (easy-menu-define 781 '("Letter"
783 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." 782 ["Send This Draft" mh-send-letter t]
784 '("Letter" 783 ["Split Current Line" mh-open-line t]
785 ["Send This Draft" mh-send-letter t] 784 ["Check Recipient" mh-check-whom t]
786 ["Split Current Line" mh-open-line t] 785 ["Yank Current Message" mh-yank-cur-msg t]
787 ["Check Recipient" mh-check-whom t] 786 ["Insert a Message..." mh-insert-letter t]
788 ["Yank Current Message" mh-yank-cur-msg t] 787 ["Insert Signature" mh-insert-signature t]
789 ["Insert a Message..." mh-insert-letter t] 788 ("Encrypt/Sign Message"
790 ["Insert Signature" mh-insert-signature t] 789 ["Sign Message"
791 ["GPG Sign message" 790 mh-mml-secure-message-sign mh-gnus-pgp-support-flag]
792 mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] 791 ["Encrypt Message"
793 ["GPG Encrypt message" 792 mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag]
794 mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] 793 ["Sign+Encrypt Message"
795 ["Compose Insertion (MIME)..." mh-compose-insertion t] 794 mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag]
796 ;; ["Compose Compressed tar (MIME)..." 795 ["Disable Security"
797 ;;mh-mhn-compose-external-compressed-tar t] 796 mh-mml-unsecure-message mh-gnus-pgp-support-flag]
798 ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] 797 "--"
799 ["Compose Forward (MIME)..." mh-compose-forward t] 798 "Security Method"
800 ;; The next two will have to be merged. But I also need to make sure the 799 ["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
801 ;; user can't mix directives of both types. 800 :style radio
802 ["Pull in All Compositions (mhn)" 801 :selected (equal mh-mml-method-default "pgpmime")]
803 mh-edit-mhn (mh-mhn-directive-present-p)] 802 ["PGP" (setq mh-mml-method-default "pgp")
804 ["Pull in All Compositions (gnus)" 803 :style radio
805 mh-mml-to-mime (mh-mml-directive-present-p)] 804 :selected (equal mh-mml-method-default "pgp")]
806 ["Revert to Non-MIME Edit (mhn)" 805 ["S/MIME" (setq mh-mml-method-default "smime")
807 mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] 806 :style radio
808 ["Kill This Draft" mh-fully-kill-draft t])))) 807 :selected (equal mh-mml-method-default "smime")]
808 "--"
809 ["Save Method as Default"
810 (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
811 )
812 ["Compose Insertion (MIME)..." mh-compose-insertion t]
813 ["Compose Compressed tar (MIME)..."
814 mh-mhn-compose-external-compressed-tar t]
815 ["Compose Get File (MIME)..." mh-mhn-compose-anon-ftp t]
816 ["Compose Forward (MIME)..." mh-compose-forward t]
817 ;; The next two will have to be merged. But I also need to make sure the
818 ;; user can't mix directives of both types.
819 ["Pull in All Compositions (mhn)"
820 mh-edit-mhn (mh-mhn-directive-present-p)]
821 ["Pull in All Compositions (gnus)"
822 mh-mml-to-mime (mh-mml-directive-present-p)]
823 ["Revert to Non-MIME Edit (mhn)"
824 mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
825 ["Kill This Draft" mh-fully-kill-draft t]))
809 826
810;;; Help Messages 827;;; Help Messages
811;;; Group messages logically, more or less. 828;;; Group messages logically, more or less.
@@ -817,12 +834,15 @@ Returns t if found, nil if not."
817 "\t\tInsert:\n" 834 "\t\tInsert:\n"
818 "Check recipients: \\[mh-check-whom]" 835 "Check recipients: \\[mh-check-whom]"
819 "\t\t Current message: \\[mh-yank-cur-msg]\n" 836 "\t\t Current message: \\[mh-yank-cur-msg]\n"
820 "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]" 837 "\t\t Attachment: \\[mh-compose-insertion]\n"
821 "\t\t Attachment: \\[mh-compose-insertion]\n" 838 "\t\t Message to forward: \\[mh-compose-forward]\n"
822 "Sign message: \\[mh-mml-secure-message-sign-pgpmime]" 839 " "
823 "\t\t Message to forward: \\[mh-compose-forward]\n" 840 "Security:"
841 "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
842 "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
843 "\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
824 " " 844 " "
825 "\t\t Signature: \\[mh-insert-signature]")) 845 "\t\t Signature: \\[mh-insert-signature]"))
826 "Key binding cheat sheet. 846 "Key binding cheat sheet.
827 847
828This is an associative array which is used to show the most common commands. 848This is an associative array which is used to show the most common commands.
@@ -872,13 +892,19 @@ When a message is composed, the hooks `text-mode-hook' and
872`mh-letter-mode-hook' are run. 892`mh-letter-mode-hook' are run.
873 893
874\\{mh-letter-mode-map}" 894\\{mh-letter-mode-map}"
875 (or mh-user-path (mh-find-path)) 895 (mh-find-path)
876 (make-local-variable 'mh-send-args) 896 (make-local-variable 'mh-send-args)
877 (make-local-variable 'mh-annotate-char) 897 (make-local-variable 'mh-annotate-char)
878 (make-local-variable 'mh-annotate-field) 898 (make-local-variable 'mh-annotate-field)
879 (make-local-variable 'mh-previous-window-config) 899 (make-local-variable 'mh-previous-window-config)
880 (make-local-variable 'mh-sent-from-folder) 900 (make-local-variable 'mh-sent-from-folder)
881 (make-local-variable 'mh-sent-from-msg) 901 (make-local-variable 'mh-sent-from-msg)
902 ;; Set the local value of mh-mail-header-separator according to what is
903 ;; present in the buffer...
904 (set (make-local-variable 'mh-mail-header-separator)
905 (save-excursion
906 (goto-char (mh-mail-header-end))
907 (buffer-substring-no-properties (point) (line-end-position))))
882 (make-local-variable 'mail-header-separator) 908 (make-local-variable 'mail-header-separator)
883 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el 909 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
884 (make-local-variable 'mh-help-messages) 910 (make-local-variable 'mh-help-messages)
@@ -886,12 +912,6 @@ When a message is composed, the hooks `text-mode-hook' and
886 (setq buffer-invisibility-spec '((vanish . t) t)) 912 (setq buffer-invisibility-spec '((vanish . t) t))
887 (set (make-local-variable 'line-move-ignore-invisible) t) 913 (set (make-local-variable 'line-move-ignore-invisible) t)
888 914
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))))
894
895 ;; From sendmail.el for proper paragraph fill 915 ;; From sendmail.el for proper paragraph fill
896 ;; sendmail.el also sets a normal-auto-fill-function (not done here) 916 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
897 (make-local-variable 'paragraph-separate) 917 (make-local-variable 'paragraph-separate)
@@ -965,11 +985,15 @@ When a message is composed, the hooks `text-mode-hook' and
965 t))) 985 t)))
966 986
967(defun mh-letter-header-end () 987(defun mh-letter-header-end ()
968 "Find the end of header from `mh-letter-mail-header-end-marker'." 988 "Find the end of the message header.
989This function is to be used only for font locking. It works by searching for
990`mh-mail-header-separator' in the buffer."
969 (save-excursion 991 (save-excursion
970 (goto-char (marker-position mh-letter-mail-header-end-marker)) 992 (goto-char (point-min))
971 (forward-line -1) 993 (cond ((equal mh-mail-header-separator "") (point-min))
972 (point))) 994 ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
995 (line-beginning-position 0))
996 (t (point-min)))))
973 997
974(defun mh-auto-fill-for-letter () 998(defun mh-auto-fill-for-letter ()
975 "Perform auto-fill for message. 999 "Perform auto-fill for message.
@@ -1041,16 +1065,69 @@ Prompt for the field name with a completion list of the current folders."
1041 (substring folder 1) 1065 (substring folder 1)
1042 folder))))) 1066 folder)))))
1043 1067
1068(defun mh-file-is-vcard-p (file)
1069 "Return t if FILE is a .vcf vcard."
1070 (let ((case-fold-search t))
1071 (and (stringp file)
1072 (file-exists-p file)
1073 (or (and (not (mh-have-file-command))
1074 (not (null (string-match "\.vcf$" file))))
1075 (and (mh-have-file-command)
1076 (string-equal "text/x-vcard" (mh-file-mime-type file)))))))
1077
1044;;;###mh-autoload 1078;;;###mh-autoload
1045(defun mh-insert-signature () 1079(defun mh-insert-signature (&optional file)
1046 "Insert the file named by `mh-signature-file-name' at point. 1080 "Insert the signature specified by `mh-signature-file-name' or FILE at point.
1081A signature separator (`-- ') will be added if the signature block does not
1082contain one and `mh-signature-separator-flag' is on.
1047The value of `mh-letter-insert-signature-hook' is a list of functions to be 1083The value of `mh-letter-insert-signature-hook' is a list of functions to be
1048called, with no arguments, before the signature is actually inserted." 1084called, with no arguments, after the signature is inserted.
1049 (interactive) 1085The signature can also be inserted with `mh-identity-list'."
1050 (let ((mh-signature-file-name mh-signature-file-name)) 1086(interactive)
1051 (run-hooks 'mh-letter-insert-signature-hook) 1087 (save-excursion
1052 (if mh-signature-file-name 1088 (insert "\n")
1053 (insert-file-contents mh-signature-file-name))) 1089 (let ((mh-signature-file-name (or file mh-signature-file-name))
1090 (mh-mhn-p (mh-mhn-directive-present-p))
1091 (mh-mml-p (mh-mml-directive-present-p)))
1092 (save-restriction
1093 (narrow-to-region (point) (point))
1094 (cond
1095 ((mh-file-is-vcard-p mh-signature-file-name)
1096 (if (equal mh-compose-insertion 'gnus)
1097 (insert "<#part type=\"text/x-vcard\" filename=\""
1098 mh-signature-file-name
1099 "\" disposition=inline description=VCard>\n<#/part>")
1100 (insert "#text/x-vcard; name=\""
1101 (file-name-nondirectory mh-signature-file-name)
1102 "\" [VCard] " (expand-file-name mh-signature-file-name))))
1103 (t
1104 (cond
1105 (mh-mhn-p
1106 (insert "#\n" "Content-Description: Signature\n"))
1107 (mh-mml-p
1108 (mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
1109 'description "Signature")))
1110 (cond ((null mh-signature-file-name))
1111 ((and (stringp mh-signature-file-name)
1112 (file-readable-p mh-signature-file-name))
1113 (insert-file-contents mh-signature-file-name))
1114 ((functionp mh-signature-file-name)
1115 (funcall mh-signature-file-name)))))
1116 (save-restriction
1117 (widen)
1118 (run-hooks 'mh-letter-insert-signature-hook))
1119 (goto-char (point-min))
1120 (when (and (not (mh-file-is-vcard-p mh-signature-file-name))
1121 mh-signature-separator-flag
1122 (> (point-max) (point-min))
1123 (not (mh-signature-separator-p)))
1124 (cond (mh-mhn-p
1125 (forward-line 2))
1126 (mh-mml-p
1127 (forward-line 1)))
1128 (insert mh-signature-separator))
1129 (if (not (> (point-max) (point-min)))
1130 (message "No signature found")))))
1054 (force-mode-line-update)) 1131 (force-mode-line-update))
1055 1132
1056;;;###mh-autoload 1133;;;###mh-autoload
@@ -1100,33 +1177,18 @@ MH the first time a message is composed.")
1100(defun mh-insert-x-mailer () 1177(defun mh-insert-x-mailer ()
1101 "Append an X-Mailer field to the header. 1178 "Append an X-Mailer field to the header.
1102The versions of MH-E, Emacs, and MH are shown." 1179The versions of MH-E, Emacs, and MH are shown."
1103
1104 ;; Lazily initialize mh-x-mailer-string. 1180 ;; Lazily initialize mh-x-mailer-string.
1105 (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string)) 1181 (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
1106 (save-window-excursion 1182 (setq mh-x-mailer-string
1107 ;; User would be confused if version info buffer disappeared magically, 1183 (format "MH-E %s; %s; %sEmacs %s"
1108 ;; so don't delete buffer if it already existed. 1184 mh-version mh-variant-in-use
1109 (let ((info-buffer-exists-p (get-buffer mh-info-buffer))) 1185 (if mh-xemacs-flag "X" "GNU ")
1110 (mh-version) 1186 (cond ((not mh-xemacs-flag) emacs-version)
1111 (set-buffer mh-info-buffer) 1187 ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
1112 (if mh-nmh-flag 1188 emacs-version)
1113 (search-forward-regexp "^nmh-\\(\\S +\\)") 1189 (match-string 0 emacs-version))
1114 (search-forward-regexp "^MH \\(\\S +\\)" nil t)) 1190 (t (format "%s.%s" emacs-major-version
1115 (let ((x-mailer-mh (buffer-substring (match-beginning 1) 1191 emacs-minor-version))))))
1116 (match-end 1))))
1117 (setq mh-x-mailer-string
1118 (format "MH-E %s; %s %s; %sEmacs %s"
1119 mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
1120 (if mh-xemacs-flag "X" "GNU ")
1121 (cond ((not mh-xemacs-flag) emacs-version)
1122 ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
1123 emacs-version)
1124 (match-string 0 emacs-version))
1125 (t (format "%s.%s"
1126 emacs-major-version
1127 emacs-minor-version))))))
1128 (if (not info-buffer-exists-p)
1129 (kill-buffer mh-info-buffer)))))
1130 ;; Insert X-Mailer, but only if it doesn't already exist. 1192 ;; Insert X-Mailer, but only if it doesn't already exist.
1131 (save-excursion 1193 (save-excursion
1132 (when (and mh-insert-x-mailer-flag 1194 (when (and mh-insert-x-mailer-flag
@@ -1155,25 +1217,31 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
1155something. If NON-INTERACTIVE is non-nil, do not be verbose and only 1217something. If NON-INTERACTIVE is non-nil, do not be verbose and only
1156attempt matches if `mh-insert-auto-fields-done-local' is nil. 1218attempt matches if `mh-insert-auto-fields-done-local' is nil.
1157 1219
1158An `identity' entry is skipped if one was already entered manually." 1220An `identity' entry is skipped if one was already entered manually.
1221
1222Return t if fields added; otherwise return nil."
1159 (interactive) 1223 (interactive)
1160 (when (or (not non-interactive) (not mh-insert-auto-fields-done-local)) 1224 (when (or (not non-interactive)
1225 (not mh-insert-auto-fields-done-local))
1161 (save-excursion 1226 (save-excursion
1162 (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) 1227 (when (and (or (mh-goto-header-field "To:")
1163 (let ((list mh-auto-fields-list)) 1228 (mh-goto-header-field "cc:")))
1229 (let ((list mh-auto-fields-list)
1230 (fields-inserted nil))
1164 (while list 1231 (while list
1165 (let ((regexp (nth 0 (car list))) 1232 (let ((regexp (nth 0 (car list)))
1166 (entries (nth 1 (car list)))) 1233 (entries (nth 1 (car list))))
1167 (when (mh-regexp-in-field-p regexp "To:" "cc:") 1234 (when (mh-regexp-in-field-p regexp "To:" "cc:")
1168 (setq mh-insert-auto-fields-done-local t) 1235 (setq mh-insert-auto-fields-done-local t)
1236 (setq fields-inserted t)
1169 (if (not non-interactive) 1237 (if (not non-interactive)
1170 (message "Matched for regexp %s" regexp)) 1238 (message "Fields for %s added" regexp))
1171 (let ((entry-list entries)) 1239 (let ((entry-list entries))
1172 (while entry-list 1240 (while entry-list
1173 (let ((field (caar entry-list)) 1241 (let ((field (caar entry-list))
1174 (value (cdar entry-list))) 1242 (value (cdar entry-list)))
1175 (cond 1243 (cond
1176 ((equal "identity" field) 1244 ((equal ":identity" field)
1177 (when (and (not mh-identity-local) 1245 (when (and (not mh-identity-local)
1178 (assoc value mh-identity-list)) 1246 (assoc value mh-identity-list))
1179 (mh-insert-identity value))) 1247 (mh-insert-identity value)))
@@ -1181,7 +1249,8 @@ An `identity' entry is skipped if one was already entered manually."
1181 (mh-modify-header-field field value 1249 (mh-modify-header-field field value
1182 (equal field "From"))))) 1250 (equal field "From")))))
1183 (setq entry-list (cdr entry-list)))))) 1251 (setq entry-list (cdr entry-list))))))
1184 (setq list (cdr list)))))))) 1252 (setq list (cdr list)))
1253 fields-inserted)))))
1185 1254
1186(defun mh-modify-header-field (field value &optional overwrite-flag) 1255(defun mh-modify-header-field (field value &optional overwrite-flag)
1187 "To header FIELD add VALUE. 1256 "To header FIELD add VALUE.
@@ -1201,8 +1270,6 @@ If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
1201 (mh-goto-header-end 0) 1270 (mh-goto-header-end 0)
1202 (insert field ": " value "\n")))) 1271 (insert field ": " value "\n"))))
1203 1272
1204(defvar mh-letter-mail-header-end-marker nil)
1205
1206(defun mh-compose-and-send-mail (draft send-args 1273(defun mh-compose-and-send-mail (draft send-args
1207 sent-from-folder sent-from-msg 1274 sent-from-folder sent-from-msg
1208 to subject cc 1275 to subject cc
@@ -1221,22 +1288,19 @@ for `mh-annotate-msg'.
1221CONFIG is the window configuration to restore after sending the letter." 1288CONFIG is the window configuration to restore after sending the letter."
1222 (pop-to-buffer draft) 1289 (pop-to-buffer draft)
1223 (mh-letter-mode) 1290 (mh-letter-mode)
1224 (mh-insert-auto-fields t)
1225 1291
1226 ;; mh-identity support 1292 ;; Insert identity.
1227 (if (and (boundp 'mh-identity-default) 1293 (if (and (boundp 'mh-identity-default)
1228 mh-identity-default 1294 mh-identity-default
1229 (not mh-identity-local)) 1295 (not mh-identity-local))
1230 (mh-insert-identity mh-identity-default)) 1296 (mh-insert-identity mh-identity-default))
1231 (when (and (boundp 'mh-identity-list) 1297 (mh-identity-make-menu)
1232 mh-identity-list) 1298 (easy-menu-add mh-identity-menu)
1233 (mh-identity-make-menu)
1234 (easy-menu-add mh-identity-menu))
1235 1299
1236 ;; Extra fields 1300 ;; Insert extra fields.
1237 (mh-insert-x-mailer) 1301 (mh-insert-x-mailer)
1238 (mh-insert-x-face) 1302 (mh-insert-x-face)
1239 ;; Hide skipped fields 1303
1240 (mh-letter-hide-all-skipped-fields) 1304 (mh-letter-hide-all-skipped-fields)
1241 1305
1242 (setq mh-sent-from-folder sent-from-folder) 1306 (setq mh-sent-from-folder sent-from-folder)
@@ -1264,7 +1328,16 @@ CONFIG is the window configuration to restore after sending the letter."
1264This should be the last function called when composing the draft." 1328This should be the last function called when composing the draft."
1265 (message "%s" (substitute-command-keys 1329 (message "%s" (substitute-command-keys
1266 (concat "Type \\[mh-send-letter] to send message, " 1330 (concat "Type \\[mh-send-letter] to send message, "
1267 "\\[mh-help] for help.")))) 1331 "\\[mh-help] for help"))))
1332
1333(defun mh-ascii-buffer-p ()
1334 "Check if current buffer is entirely composed of ASCII.
1335The function doesn't work for XEmacs since `find-charset-region' doesn't exist
1336there."
1337 (loop for charset in (mh-funcall-if-exists
1338 find-charset-region (point-min) (point-max))
1339 unless (eq charset 'ascii) return nil
1340 finally return t))
1268 1341
1269;;;###mh-autoload 1342;;;###mh-autoload
1270(defun mh-send-letter (&optional arg) 1343(defun mh-send-letter (&optional arg)
@@ -1273,15 +1346,17 @@ If optional prefix argument ARG is provided, monitor delivery.
1273The value of `mh-before-send-letter-hook' is a list of functions to be called, 1346The value of `mh-before-send-letter-hook' is a list of functions to be called,
1274with no arguments, before doing anything. 1347with no arguments, before doing anything.
1275Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise 1348Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise
1276run `\\[mh-mml-to-mime]' if mml directives are present. 1349run `\\[mh-mml-to-mime]' if mml directives are present."
1277Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
1278Insert X-Face field if the file specified by `mh-x-face-file' exists."
1279 (interactive "P") 1350 (interactive "P")
1280 (run-hooks 'mh-before-send-letter-hook) 1351 (run-hooks 'mh-before-send-letter-hook)
1281 (mh-insert-auto-fields t) 1352 (if (and (mh-insert-auto-fields t)
1353 mh-auto-fields-prompt-flag
1354 (goto-char (point-min)))
1355 (if (not (y-or-n-p "Auto fields inserted, send? "))
1356 (error "Send aborted")))
1282 (cond ((mh-mhn-directive-present-p) 1357 (cond ((mh-mhn-directive-present-p)
1283 (mh-edit-mhn)) 1358 (mh-edit-mhn))
1284 ((mh-mml-directive-present-p) 1359 ((or (mh-mml-directive-present-p) (not (mh-ascii-buffer-p)))
1285 (mh-mml-to-mime))) 1360 (mh-mml-to-mime)))
1286 (save-buffer) 1361 (save-buffer)
1287 (message "Sending...") 1362 (message "Sending...")
@@ -1302,7 +1377,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
1302 'iso-latin-1)))) 1377 'iso-latin-1))))
1303 ;; The default BCC encapsulation will make a MIME message unreadable. 1378 ;; The default BCC encapsulation will make a MIME message unreadable.
1304 ;; With nmh use the -mime arg to prevent this. 1379 ;; With nmh use the -mime arg to prevent this.
1305 (if (and mh-nmh-flag 1380 (if (and (mh-variant-p 'nmh)
1306 (mh-goto-header-field "Bcc:") 1381 (mh-goto-header-field "Bcc:")
1307 (mh-goto-header-field "Content-Type:")) 1382 (mh-goto-header-field "Content-Type:"))
1308 (setq mh-send-args (format "-mime %s" mh-send-args))) 1383 (setq mh-send-args (format "-mime %s" mh-send-args)))
@@ -1338,7 +1413,8 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists."
1338;;;###mh-autoload 1413;;;###mh-autoload
1339(defun mh-insert-letter (folder message verbatim) 1414(defun mh-insert-letter (folder message verbatim)
1340 "Insert a message into the current letter. 1415 "Insert a message into the current letter.
1341Removes the header fields according to the variable `mh-invisible-headers'. 1416Removes the header fields according to the variable
1417`mh-invisible-header-fields-compiled'.
1342Prefixes each non-blank line with `mh-ins-buf-prefix', unless 1418Prefixes each non-blank line with `mh-ins-buf-prefix', unless
1343`mh-yank-from-start-of-msg' is set for supercite in which case supercite is 1419`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
1344used to format the message. 1420used to format the message.
@@ -1355,11 +1431,12 @@ and point after it."
1355 (save-restriction 1431 (save-restriction
1356 (narrow-to-region (point) (point)) 1432 (narrow-to-region (point) (point))
1357 (let ((start (point-min))) 1433 (let ((start (point-min)))
1358 (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) 1434 (if (and (equal message "") (numberp mh-sent-from-msg))
1435 (setq message (int-to-string mh-sent-from-msg)))
1359 (insert-file-contents 1436 (insert-file-contents
1360 (expand-file-name message (mh-expand-file-name folder))) 1437 (expand-file-name message (mh-expand-file-name folder)))
1361 (when (not verbatim) 1438 (when (not verbatim)
1362 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) 1439 (mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
1363 (goto-char (point-max)) ;Needed for sc-cite-original 1440 (goto-char (point-max)) ;Needed for sc-cite-original
1364 (push-mark) ;Needed for sc-cite-original 1441 (push-mark) ;Needed for sc-cite-original
1365 (goto-char (point-min)) ;Needed for sc-cite-original 1442 (goto-char (point-min)) ;Needed for sc-cite-original
@@ -1373,15 +1450,13 @@ and point after it."
1373 (skip-chars-forward " ") 1450 (skip-chars-forward " ")
1374 (cond 1451 (cond
1375 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)") 1452 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1376 (format "%s %s %s" (match-string 1)(match-string 2) 1453 (format "%s %s " (match-string 1)(match-string 2)))
1377 mh-extract-from-attribution-verb))
1378 ((looking-at "\\([^<\n]+<.+>\\)$") 1454 ((looking-at "\\([^<\n]+<.+>\\)$")
1379 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)) 1455 (format "%s " (match-string 1)))
1380 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$") 1456 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1381 (format "%s <%s> %s" (match-string 2)(match-string 1) 1457 (format "%s <%s> " (match-string 2)(match-string 1)))
1382 mh-extract-from-attribution-verb))
1383 ((looking-at " *\\(.+\\)$") 1458 ((looking-at " *\\(.+\\)$")
1384 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) 1459 (format "%s " (match-string 1)))))))
1385 1460
1386;;;###mh-autoload 1461;;;###mh-autoload
1387(defun mh-yank-cur-msg () 1462(defun mh-yank-cur-msg ()
@@ -1444,9 +1519,11 @@ yanked message will be deleted."
1444 (push-mark) ;Needed for sc-cite-original 1519 (push-mark) ;Needed for sc-cite-original
1445 (goto-char (point-min)) ;Needed for sc-cite-original 1520 (goto-char (point-min)) ;Needed for sc-cite-original
1446 (mh-insert-prefix-string mh-ins-buf-prefix) 1521 (mh-insert-prefix-string mh-ins-buf-prefix)
1447 (if (or (eq 'attribution mh-yank-from-start-of-msg) 1522 (when (or (eq 'attribution mh-yank-from-start-of-msg)
1448 (eq 'autoattrib mh-yank-from-start-of-msg)) 1523 (eq 'autoattrib mh-yank-from-start-of-msg))
1449 (insert from-attr "\n\n")) 1524 (insert from-attr)
1525 (mh-identity-insert-attribution-verb nil)
1526 (insert "\n\n"))
1450 ;; If the user has selected a region, he has already "edited" the 1527 ;; If the user has selected a region, he has already "edited" the
1451 ;; text, so leave the cursor at the end of the yanked text. In 1528 ;; text, so leave the cursor at the end of the yanked text. In
1452 ;; either case, leave a mark at the opposite end of the included 1529 ;; either case, leave a mark at the opposite end of the included
@@ -1572,7 +1649,7 @@ Any match found replaces the text from BEGIN to END."
1572 (let ((syntax-table (syntax-table))) 1649 (let ((syntax-table (syntax-table)))
1573 (unwind-protect 1650 (unwind-protect
1574 (save-excursion 1651 (save-excursion
1575 (mh-funcall-if-exists mail-abbrev-make-syntax-table) 1652 (mh-mail-abbrev-make-syntax-table)
1576 (set-syntax-table mail-abbrev-syntax-table) 1653 (set-syntax-table mail-abbrev-syntax-table)
1577 (backward-word n) 1654 (backward-word n)
1578 (point)) 1655 (point))
@@ -1593,7 +1670,6 @@ Any match found replaces the text from BEGIN to END."
1593 (mh-folder-completion-function folder nil t)))) 1670 (mh-folder-completion-function folder nil t))))
1594 (mh-complete-word folder choices beg end))) 1671 (mh-complete-word folder choices beg end)))
1595 1672
1596;; XXX: This should probably be customizable
1597(defvar mh-letter-complete-function-alist 1673(defvar mh-letter-complete-function-alist
1598 '((cc . mh-alias-letter-expand-alias) 1674 '((cc . mh-alias-letter-expand-alias)
1599 (bcc . mh-alias-letter-expand-alias) 1675 (bcc . mh-alias-letter-expand-alias)
@@ -1607,10 +1683,10 @@ Any match found replaces the text from BEGIN to END."
1607 1683
1608(defun mh-letter-complete (arg) 1684(defun mh-letter-complete (arg)
1609 "Perform completion on header field or word preceding point. 1685 "Perform completion on header field or word preceding point.
1610Alias completion is done within the mail header on selected fields based on 1686If the field contains addresses (for example, `To:' or `Cc:') or folders (for
1611the matches in `mh-letter-complete-function-alist'. Elsewhere the function 1687example, `Fcc:') then this function will provide alias completion. Elsewhere,
1612designated by `mh-letter-complete-function' is used and given the prefix ARG, 1688this function runs `mh-letter-complete-function' instead and passes the prefix
1613if present." 1689ARG, if present."
1614 (interactive "P") 1690 (interactive "P")
1615 (let ((func nil)) 1691 (let ((func nil))
1616 (cond ((not (mh-in-header-p)) 1692 (cond ((not (mh-in-header-p))
@@ -1832,10 +1908,13 @@ Otherwise return the empty string."
1832;;; Build the letter-mode keymap: 1908;;; Build the letter-mode keymap:
1833;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. 1909;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
1834(gnus-define-keys mh-letter-mode-map 1910(gnus-define-keys mh-letter-mode-map
1911 " " mh-letter-complete-or-space
1912 "," mh-letter-confirm-address
1835 "\C-c?" mh-help 1913 "\C-c?" mh-help
1914 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
1915 "\C-c\C-^" mh-insert-signature ;if no C-s
1836 "\C-c\C-c" mh-send-letter 1916 "\C-c\C-c" mh-send-letter
1837 "\C-c\C-d" mh-insert-identity 1917 "\C-c\C-d" mh-insert-identity
1838 "\C-c\M-d" mh-insert-auto-fields
1839 "\C-c\C-e" mh-edit-mhn 1918 "\C-c\C-e" mh-edit-mhn
1840 "\C-c\C-f\C-b" mh-to-field 1919 "\C-c\C-f\C-b" mh-to-field
1841 "\C-c\C-f\C-c" mh-to-field 1920 "\C-c\C-f\C-c" mh-to-field
@@ -1852,31 +1931,38 @@ Otherwise return the empty string."
1852 "\C-c\C-fs" mh-to-field 1931 "\C-c\C-fs" mh-to-field
1853 "\C-c\C-ft" mh-to-field 1932 "\C-c\C-ft" mh-to-field
1854 "\C-c\C-i" mh-insert-letter 1933 "\C-c\C-i" mh-insert-letter
1855 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime 1934 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
1856 "\C-c\C-m\C-f" mh-compose-forward 1935 "\C-c\C-m\C-f" mh-compose-forward
1936 "\C-c\C-m\C-g" mh-mhn-compose-anon-ftp
1857 "\C-c\C-m\C-i" mh-compose-insertion 1937 "\C-c\C-m\C-i" mh-compose-insertion
1858 "\C-c\C-m\C-m" mh-mml-to-mime 1938 "\C-c\C-m\C-m" mh-mml-to-mime
1859 "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime 1939 "\C-c\C-m\C-n" mh-mml-unsecure-message
1940 "\C-c\C-m\C-s" mh-mml-secure-message-sign
1941 "\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar
1860 "\C-c\C-m\C-u" mh-revert-mhn-edit 1942 "\C-c\C-m\C-u" mh-revert-mhn-edit
1861 "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime 1943 "\C-c\C-m\C-x" mh-mhn-compose-external-type
1944 "\C-c\C-mee" mh-mml-secure-message-encrypt
1945 "\C-c\C-mes" mh-mml-secure-message-signencrypt
1862 "\C-c\C-mf" mh-compose-forward 1946 "\C-c\C-mf" mh-compose-forward
1947 "\C-c\C-mg" mh-mhn-compose-anon-ftp
1863 "\C-c\C-mi" mh-compose-insertion 1948 "\C-c\C-mi" mh-compose-insertion
1864 "\C-c\C-mm" mh-mml-to-mime 1949 "\C-c\C-mm" mh-mml-to-mime
1865 "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime 1950 "\C-c\C-mn" mh-mml-unsecure-message
1951 "\C-c\C-mse" mh-mml-secure-message-signencrypt
1952 "\C-c\C-mss" mh-mml-secure-message-sign
1953 "\C-c\C-mt" mh-mhn-compose-external-compressed-tar
1866 "\C-c\C-mu" mh-revert-mhn-edit 1954 "\C-c\C-mu" mh-revert-mhn-edit
1955 "\C-c\C-mx" mh-mhn-compose-external-type
1867 "\C-c\C-o" mh-open-line 1956 "\C-c\C-o" mh-open-line
1868 "\C-c\C-q" mh-fully-kill-draft 1957 "\C-c\C-q" mh-fully-kill-draft
1869 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
1870 "\C-c\C-s" mh-insert-signature 1958 "\C-c\C-s" mh-insert-signature
1871 "\C-c\C-^" mh-insert-signature ;if no C-s 1959 "\C-c\C-t" mh-letter-toggle-header-field-display
1872 "\C-c\C-w" mh-check-whom 1960 "\C-c\C-w" mh-check-whom
1873 "\C-c\C-y" mh-yank-cur-msg 1961 "\C-c\C-y" mh-yank-cur-msg
1874 "\C-c\C-t" mh-letter-toggle-header-field-display 1962 "\C-c\M-d" mh-insert-auto-fields
1875 " " mh-letter-complete-or-space
1876 "\M-\t" mh-letter-complete 1963 "\M-\t" mh-letter-complete
1877 "\t" mh-letter-next-header-field-or-indent 1964 "\t" mh-letter-next-header-field-or-indent
1878 [backtab] mh-letter-previous-header-field 1965 [backtab] mh-letter-previous-header-field)
1879 "," mh-letter-confirm-address)
1880 1966
1881;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. 1967;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1882 1968
diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el
index 2ce36c88726..622c457897f 100644
--- a/lisp/mh-e/mh-customize.el
+++ b/lisp/mh-e/mh-customize.el
@@ -34,814 +34,591 @@
34;; 34;;
35;; 1. MH-E Customization Groups 35;; 1. MH-E Customization Groups
36;; 36;;
37;; These are the customization group definitions. These are organized in a 37;; These are the customization group definitions. Every group has a
38;; logical order. High-level, windows and toolbar, folder, message, 38;; associated manual node. The ordering is alphabetical, except for the
39;; composing and hooks. 39;; groups mh-faces and mh-hooks which are last .
40;; 40;;
41;; 2. MH-E Customization 41;; 2. MH-E Customization
42;; 42;;
43;; Here are the actual customization variables. There is a sub-section for 43;; These are the actual customization variables. There is a sub-section for
44;; each group in the MH-E Customization Groups section. Within each 44;; each group in the MH-E Customization Groups section, in the same order,
45;; section, variables are sorted alphabetically. The manual section 45;; separated by page breaks. Within each section, variables are sorted
46;; dictates which group a variable should be placed. New variables should 46;; alphabetically.
47;; be placed in the section where they would most likely be defined.
48;; 47;;
49;; All hooks should be placed in the 'mh-hook group; in addition, add the 48;; 3. Hooks
50;; group in which the hook is defined in the manual (or, if it is new, 49;;
51;; where it would be defined). These two actions insures that the hooks 50;; All hooks must be placed in the mh-hook group; in addition, add the
52;; appear last in each group. 51;; group associated with the manual node in which the hook is described.
52;; Since the mh-hook group appears near the end of this file, the hooks
53;; will appear at the end of these other groups.
54;;
55;; 4. Faces
56;;
57;; Create a new face group if necessary; in this case, add the group
58;; associated with the manual node in which the faces are described to the
59;; faces' group definition. Since the face groups appear last, the face
60;; groups will appear at the end of these other groups.
53;; 61;;
54;; 3. Faces
55
56;;; Change Log: 62;;; Change Log:
57 63
58;;; Code: 64;;; Code:
65
59(provide 'mh-customize) 66(provide 'mh-customize)
60(require 'mh-utils) 67
68(eval-when-compile (require 'mh-acros))
69(mh-require-cl)
70(require 'mh-loaddefs)
71
72(autoload 'Info-goto-node "info")
73
74(eval-and-compile
75 (defvar mh-xemacs-flag (featurep 'xemacs)
76 "Non-nil means the current Emacs is XEmacs."))
61 77
62(when mh-xemacs-flag 78(when mh-xemacs-flag
63 (require 'mh-xemacs)) 79 (require 'mh-xemacs))
64 80
65;;;###mh-autoload 81;; XXX: Functions autoloaded from the following files are used to initialize
82;; customizable variables. They are require'd here, since otherwise the
83;; corresponding .elc would be loaded at compile time.
84(eval-when-compile
85 (require 'mh-init)
86 (require 'mh-identity))
87
66(defun mh-customize (&optional delete-other-windows-flag) 88(defun mh-customize (&optional delete-other-windows-flag)
67 "Customize MH-E variables. 89 "Customize MH-E variables.
68With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame 90If optional argument DELETE-OTHER-WINDOWS-FLAG is non-nil, other windows in
69are removed." 91the frame are removed."
70 (interactive "P") 92 (interactive "P")
71 (customize-group 'mh) 93 (customize-group 'mh)
72 (when delete-other-windows-flag 94 (when delete-other-windows-flag
73 (delete-other-windows))) 95 (delete-other-windows)))
74 96
97
98
99;;; For compiler warnings...
100(defvar mh-show-buffer)
101(defvar mh-show-folder-buffer)
102
75;;; MH-E Customization Groups 103;;; MH-E Customization Groups
76 104
77(defgroup mh nil 105(defgroup mh nil
78 "GNU Emacs interface to the MH mail system." 106 "Emacs interface to the MH mail system.
107MH is the Rand Mail Handler. Other implementations include nmh and GNU
108mailutils."
79 :link '(custom-manual "(mh-e)Top") 109 :link '(custom-manual "(mh-e)Top")
80 :group 'mail) 110 :group 'mail)
81 111
82(defgroup mh-toolbar nil 112(defgroup mh-e '((mh custom-group)) ; Sort of an alias for 'mh group
83 "Toolbar configuration." 113 "Emacs interface to the MH mail system.
84 :prefix "mh-" 114MH is the Rand Mail Handler. Other implementations include nmh and GNU
115mailutils."
116 :link '(custom-manual "(mh-e)Top"))
117
118(defgroup mh-alias nil
119 "Aliases."
120 :link '(custom-manual "(mh-e)Aliases")
121 :prefix "mh-alias-"
85 :group 'mh) 122 :group 'mh)
86 123
87(defgroup mh-speed nil 124(defgroup mh-folder nil
88 "Speedbar and folder configuration." 125 "Organizing your mail with folders."
89 :prefix "mh-" 126 :prefix "mh-"
90 :link '(custom-manual "(mh-e)Customizing Moving Mail") 127 :link '(custom-manual "(mh-e)Organizing")
91 :group 'mh) 128 :group 'mh)
92 129
93(defgroup mh-folder nil 130(defgroup mh-folder-selection nil
94 "Options for controlling scan listing." 131 "Folder selection."
95 :prefix "mh-" 132 :prefix "mh-"
96 :link '(custom-manual "(mh-e)Customizing Moving Mail") 133 :link '(custom-manual "(mh-e)Folder Selection")
134 :group 'mh)
135
136(defgroup mh-identity nil
137 "Identities."
138 :link '(custom-manual "(mh-e)Identities")
139 :prefix "mh-identity-"
140 :group 'mh)
141
142(defgroup mh-inc nil
143 "Incorporating your mail."
144 :prefix "mh-inc-"
145 :link '(custom-manual "(mh-e)Incorporating Mail")
97 :group 'mh) 146 :group 'mh)
98 147
99(defgroup mh-index nil 148(defgroup mh-index nil
100 "Indexed searching." 149 "Searching."
101 :link '(custom-manual "(mh-e)Customizing mh-e") 150 :link '(custom-manual "(mh-e)Searching")
102 :prefix "mh-" 151 :prefix "mh-index-"
103 :group 'mh) 152 :group 'mh)
104 153
105(defgroup mh-junk nil 154(defgroup mh-junk nil
106 "Spam handling." 155 "Dealing with junk mail."
107 :link '(custom-manual "(mh-e)Customizing mh-e") 156 :link '(custom-manual "(mh-e)Junk")
108 :prefix "mh-junk-" 157 :prefix "mh-junk-"
109 :group 'mh) 158 :group 'mh)
110 159
111(defgroup mh-show nil 160(defgroup mh-letter nil
112 "Message display." 161 "Editing a draft."
113 :prefix "mh-" 162 :prefix "mh-"
114 :link '(custom-manual "(mh-e)Customizing Reading") 163 :link '(custom-manual "(mh-e)Editing Drafts")
115 :group 'mh) 164 :group 'mh)
116 165
117(defgroup mh-faces nil 166(defgroup mh-ranges nil
118 "Faces used in MH-E." 167 "Ranges."
119 :link '(custom-manual "(mh-e)Customizing mh-e")
120 :prefix "mh-" 168 :prefix "mh-"
121 :group 'faces 169 :link '(custom-manual "(mh-e)Ranges")
122 :group 'mh) 170 :group 'mh)
123 171
124(defgroup mh-letter nil 172(defgroup mh-scan-line-formats nil
125 "Composing messages." 173 "Scan line formats."
174 :link '(custom-manual "(mh-e)Scan Line Formats")
126 :prefix "mh-" 175 :prefix "mh-"
127 :link '(custom-manual "(mh-e)Customizing Sending")
128 :group 'mh) 176 :group 'mh)
129 177
130(defgroup mh-alias nil 178(defgroup mh-sending-mail nil
131 "Alias handling." 179 "Sending mail."
132 :link '(custom-manual "(mh-e)Customizing mh-e") 180 :prefix "mh-"
133 :prefix "mh-alias-" 181 :link '(custom-manual "(mh-e)Sending Mail")
134 :group 'mh) 182 :group 'mh)
135 183
136(defgroup mh-identity nil 184(defgroup mh-sequences nil
137 "Multiple personalities." 185 "Sequences."
138 :link '(custom-manual "(mh-e)Customizing mh-e")
139 :prefix "mh-" 186 :prefix "mh-"
187 :link '(custom-manual "(mh-e)Sequences")
188 :group 'mh)
189
190(defgroup mh-show nil
191 "Reading your mail."
192 :prefix "mh-"
193 :link '(custom-manual "(mh-e)Reading Mail")
194 :group 'mh)
195
196(defgroup mh-speed nil
197 "The speedbar."
198 :prefix "mh-speed-"
199 :link '(custom-manual "(mh-e)Speedbar")
200 :group 'mh)
201
202(defgroup mh-toolbar nil
203 "The toolbar"
204 :link '(custom-manual "(mh-e)Toolbar")
205 :prefix "mh-"
206 :group 'mh)
207
208(defgroup mh-faces nil
209 "Faces used in MH-E."
210 :link '(custom-manual "(mh-e)Top")
211 :prefix "mh-"
212 :group 'faces
140 :group 'mh) 213 :group 'mh)
141 214
142(defgroup mh-hooks nil 215(defgroup mh-hooks nil
143 "MH-E hooks." 216 "MH-E hooks."
144 :link '(custom-manual "(mh-e)Customizing mh-e") 217 :link '(custom-manual "(mh-e)Top")
145 :prefix "mh-" 218 :prefix "mh-"
146 :group 'mh) 219 :group 'mh)
147 220
148;;; Faces 221;;; Faces
149 222
150(defgroup mh-speed-faces nil
151 "Faces used in speedbar."
152 :link '(custom-manual "(mh-e)Customizing mh-e")
153 :prefix "mh-"
154 :group 'mh-faces
155 :group 'mh-speed)
156
157(defgroup mh-folder-faces nil 223(defgroup mh-folder-faces nil
158 "Faces used in scan listing." 224 "Faces used in scan listing."
159 :link '(custom-manual "(mh-e)Customizing mh-e") 225 :link '(custom-manual "(mh-e)Organizing")
160 :prefix "mh-" 226 :prefix "mh-"
161 :group 'mh-faces 227 :group 'mh-faces
162 :group 'mh-folder) 228 :group 'mh-show)
163 229
164(defgroup mh-index-faces nil 230(defgroup mh-index-faces nil
165 "Faces used in indexed searches." 231 "Faces used in searching."
166 :link '(custom-manual "(mh-e)Customizing mh-e") 232 :link '(custom-manual "(mh-e)Searching")
167 :prefix "mh-" 233 :prefix "mh-"
168 :group 'mh-faces 234 :group 'mh-faces
169 :group 'mh-index) 235 :group 'mh-index)
170 236
237(defgroup mh-letter-faces nil
238 "Faces used in message drafts."
239 :link '(custom-manual "(mh-e)Sending Mail")
240 :prefix "mh-"
241 :group 'mh-faces
242 :group 'mh-letter)
243
171(defgroup mh-show-faces nil 244(defgroup mh-show-faces nil
172 "Faces used in message display." 245 "Faces used in message display."
173 :link '(custom-manual "(mh-e)Customizing mh-e") 246 :link '(custom-manual "(mh-e)Reading Mail")
174 :prefix "mh-" 247 :prefix "mh-"
175 :group 'mh-faces 248 :group 'mh-faces
176 :group 'mh-show) 249 :group 'mh-show)
177 250
178(defgroup mh-letter-faces nil 251(defgroup mh-speed-faces nil
179 "Faces used when composing messages." 252 "Faces used in speedbar."
180 :link '(custom-manual "(mh-e)Customizing mh-e") 253 :link '(custom-manual "(mh-e)Speedbar")
181 :prefix "mh-" 254 :prefix "mh-"
182 :group 'mh-faces 255 :group 'mh-faces
183 :group 'mh-letter) 256 :group 'mh-speed)
184 257
185 258
186 259
187;;; MH-E Customization (:group mh) 260;;; Emacs interface to the MH mail system (:group mh)
188 261(eval-when (compile)
189;;; Toolbar configuration (:group 'mh-toolbar) 262 (setq mh-variant 'none))
190 263
191(defcustom mh-tool-bar-search-function 'mh-search-folder 264(defcustom mh-variant 'autodetect
192 "*Function called by the tool-bar search button. 265 "*Specifies the variant used by MH-E.
193See `mh-search-folder' and `mh-index-search' for details." 266
194 :type '(choice (const mh-search-folder) 267The default setting of this option is `Auto-detect' which means that MH-E will
195 (const mh-index-search) 268automatically choose the first of nmh, MH, or GNU mailutils that it finds in
196 (function :tag "Other function")) 269the directories listed in `mh-path', `mh-sys-path', and `exec-path'. If, for
197 :group 'mh-toolbar) 270example, you have both nmh and mailutils installed and `mh-variant-in-use' was
198 271initialized to nmh but you want to use mailutils, then you can set this option
199;; Functions called from the tool bar 272to `mailutils'.
200(defun mh-tool-bar-search (&optional arg) 273
201 "Interactively call `mh-tool-bar-search-function'. 274When this variable is changed, MH-E resets `mh-progs', `mh-lib',
202Optional argument ARG is not used." 275`mh-lib-progs', `mh-flists-present-flag', and `mh-variant-in-use'
203 (interactive "P") 276accordingly."
204 (call-interactively mh-tool-bar-search-function)) 277 :type `(radio
205 278 (const :tag "Auto-detect" autodetect)
206(defun mh-tool-bar-customize () 279 ,@(mapcar (lambda (x) `(const ,(car x))) (mh-variants)))
207 "Call `mh-customize' from the toolbar." 280 :set (lambda (symbol value)
208 (interactive) 281 (set-default symbol value) ;Done in mh-variant-set-variant!
209 (mh-customize t)) 282 (mh-variant-set value))
210 283 :group 'mh)
211(defun mh-tool-bar-folder-help ()
212 "Visit \"(mh-e)Top\"."
213 (interactive)
214 (Info-goto-node "(mh-e)Top")
215 (delete-other-windows))
216
217(defun mh-tool-bar-letter-help ()
218 "Visit \"(mh-e)Draft Editing\"."
219 (interactive)
220 (Info-goto-node "(mh-e)Draft Editing")
221 (delete-other-windows))
222
223(defmacro mh-tool-bar-reply-generator (function recipient folder-buffer-flag)
224 "Generate FUNCTION that replies to RECIPIENT.
225If FOLDER-BUFFER-FLAG is nil then the function generated
226When INCLUDE-FLAG is non-nil, include message body being replied to."
227 `(defun ,function (&optional arg)
228 ,(format "Reply to \"%s\".\nWhen ARG is non-nil include message in reply."
229 recipient)
230 (interactive "P")
231 ,(if folder-buffer-flag nil '(set-buffer mh-show-folder-buffer))
232 (mh-reply (mh-get-msg-num nil) ,recipient arg)))
233
234(mh-tool-bar-reply-generator mh-tool-bar-reply-from "from" t)
235(mh-tool-bar-reply-generator mh-show-tool-bar-reply-from "from" nil)
236(mh-tool-bar-reply-generator mh-tool-bar-reply-to "to" t)
237(mh-tool-bar-reply-generator mh-show-tool-bar-reply-to "to" nil)
238(mh-tool-bar-reply-generator mh-tool-bar-reply-all "all" t)
239(mh-tool-bar-reply-generator mh-show-tool-bar-reply-all "all" nil)
240 284
241;; XEmacs has a couple of extra customizations... 285
242(mh-do-in-xemacs
243 (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar)
244 (featurep 'xpm)
245 (device-on-window-system-p))
246 t
247 nil)
248 "*If non-nil, use toolbar.
249 286
250This will default to t if you are in an environment that supports 287;;; Aliases (:group 'mh-alias)
251toolbars and xpm."
252 :type 'boolean
253 :group 'mh-toolbar)
254 288
255 (defcustom mh-xemacs-toolbar-position (if mh-xemacs-use-toolbar-flag 289(defcustom mh-alias-completion-ignore-case-flag t
256 'default 290 "*Non-nil means don't consider case significant in MH alias completion.
257 nil) 291As MH ignores case in the aliases, so too does MH-E. However, you may turn
258 "*Where to put the toolbar. 292this option off to make case significant which can be used to segregate
293completion of your aliases. You might use lowercase for mailing lists and
294uppercase for people."
295 :type 'boolean
296 :group 'mh-alias)
259 297
260Valid non-nil values are \"default\", \"top\", \"bottom\", \"left\", 298(defcustom mh-alias-expand-aliases-flag nil
261\"right\". These match the four edges of the frame, with \"default\" 299 "*Non-nil means to expand aliases entered in the minibuffer.
262meaning \"use the same position as the default-toolbar\". 300In other words, aliases entered in the minibuffer will be expanded to the full
301address in the message draft. By default, this expansion is not performed."
302 :type 'boolean
303 :group 'mh-alias)
263 304
264A nil value means do not use a toolbar. 305(defcustom mh-alias-flash-on-comma t
306 "*Specify whether to flash address or warn on translation.
307This option controls the behavior when a [comma] is pressed while entering
308aliases or addresses. The default setting flashes the address associated with
309an address in the minibuffer briefly, but does not display a warning if the
310alias is not found."
311 :type '(choice (const :tag "Flash but Don't Warn If No Alias" t)
312 (const :tag "Flash and Warn If No Alias" 1)
313 (const :tag "Don't Flash Nor Warn If No Alias" nil))
314 :group 'mh-alias)
265 315
266If this variable is set to anything other than \"default\" and the 316(defcustom mh-alias-insert-file nil
267default-toolbar has a different positional setting from the value of 317 "*Filename used to store a new MH-E alias.
268this variable, then two toolbars will be displayed. The MH-E toolbar 318The default setting of this option is `Use Aliasfile Profile Component'. This
269and the default-toolbar." 319option can also hold the name of a file or a list a file names. If this option
270 :type '(radio (const :tag "Same position as the \"default-toolbar\"" 320is set to a list of file names, or the `Aliasfile:' profile component contains
271 :value default) 321more than one file name, MH-E will prompt for one of them when MH-E adds an
272 (const :tag "Along the top edge of the frame" 322alias."
273 :value top) 323 :type '(choice (const :tag "Use Aliasfile Profile Component" nil)
274 (const :tag "Along the bottom edge of the frame" 324 (file :tag "Alias File")
275 :value bottom) 325 (repeat :tag "List of Alias Files" file))
276 (const :tag "Along the left edge of the frame" 326 :group 'mh-alias)
277 :value left)
278 (const :tag "Along the right edge of the frame"
279 :value right)
280 (const :tag "Don't use a toolbar" nil))
281 :group 'mh-toolbar))
282 327
283(defmacro mh-tool-bar-define (defaults &rest buttons) 328(defcustom mh-alias-insertion-location 'sorted
284 "Define a tool bar for MH-E. 329 "Specifies where new aliases are entered in alias files.
285DEFAULTS is the list of buttons that are present by default. It is a list of 330This option is set to `Alphabetical' by default. If you organize your alias
286lists where the sublists are of the following form: 331file in other ways, then adding aliases to the `Top' or `Bottom' of your alias
332file might be more appropriate."
333 :type '(choice (const :tag "Alphabetical" sorted)
334 (const :tag "Top" top)
335 (const :tag "Bottom" bottom))
336 :group 'mh-alias)
287 337
288 (:KEYWORD FUNC1 FUNC2 FUNC3 ...) 338(defcustom mh-alias-local-users t
339 "*If on, local users are added to alias completion.
289 340
290Here :KEYWORD is one of :folder or :letter. If it is :folder then the default 341Aliases are created from `/etc/passwd' entries with a user ID larger than
291buttons in the folder and show mode buffers are being specified. If it is 342a magical number, typically 200. This can be a handy tool on a machine where
292:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2, 343you and co-workers exchange messages. These aliases have the form
293FUNC3, ... are the names of the functions that the buttons would execute. 344`local.first.last' if a real name is present in the password file.
345Otherwise, the alias will have the form `local.login'.
294 346
295Each element of BUTTONS is a list consisting of four mandatory items and one 347If you're on a system with thousands of users you don't know, and the loading
296optional item as follows: 348of local aliases slows MH-E down noticeably, then turn this option off.
297 349
298 (FUNCTION MODES ICON DOC &optional ENABLE-EXPR) 350This option also takes a string which is executed to generate the password
351file. For example, use \"ypcat passwd\" to obtain the NIS password file."
352 :type '(choice (boolean) (string))
353 :group 'mh-alias)
299 354
300where, 355(defcustom mh-alias-local-users-prefix "local."
356 "*String prepended to the real names of users from the password file.
357This option can also be set to `Use Login'.
301 358
302 FUNCTION is the name of the function that will be executed when the button 359For example, consider the following password file entry:
303 is clicked.
304 360
305 MODES is a list of symbols. List elements must be from `folder', `letter' and 361 psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh
306 `sequence'. If `folder' is present then the button is available in the
307 folder and show buffer. If the name of FUNCTION is of the form \"mh-foo\",
308 where foo is some arbitrary string, then we check if the function
309 `mh-show-foo' exists. If it exists then that function is used in the show
310 buffer. Otherwise the original function `mh-foo' is used in the show buffer
311 as well. Presence of `sequence' is handled similar to the above. The only
312 difference is that the button is shown only when the folder is narrowed to a
313 sequence. If `letter' is present in MODES, then the button is available
314 during draft editing and runs FUNCTION when clicked.
315 362
316 ICON is the icon that is drawn in the button. 363The following settings of this option will produce the associated aliases:
317 364
318 DOC is the documentation for the button. It is used in tool-tips and in 365 \"local.\" local.peter.galbraith
319 providing other help to the user. GNU Emacs uses only the first line of the 366 \"\" peter.galbraith
320 string. So the DOC should be formatted such that the first line is useful and 367 Use Login psg
321 complete without the rest of the string.
322 368
323 Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates 369This option has no effect if variable `mh-alias-local-users' is turned off."
324 to nil, then the button is deactivated, otherwise it is active. If is in't 370 :type '(choice (const :tag "Use Login" nil)
325 present then the button is always active." 371 (string))
326 ;; The following variable names have been carefully chosen to make code 372 :group 'mh-alias)
327 ;; generation easier. Modifying the names should be done carefully.
328 (let (folder-buttons folder-docs folder-button-setter sequence-button-setter
329 show-buttons show-button-setter show-seq-button-setter
330 letter-buttons letter-docs letter-button-setter
331 folder-defaults letter-defaults
332 folder-vectors show-vectors letter-vectors)
333 (dolist (x defaults)
334 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
335 ((eq (car x) :letter) (setq letter-defaults (cdr x)))))
336 (dolist (button buttons)
337 (unless (and (listp button)
338 (or (equal (length button) 4) (equal (length button) 5)))
339 (error "Incorrect MH-E tool-bar button specification: %s" button))
340 (let* ((name (nth 0 button))
341 (name-str (symbol-name name))
342 (icon (nth 2 button))
343 (xemacs-icon (mh-do-in-xemacs
344 (cdr (assoc (intern icon) mh-xemacs-icon-map))))
345 (full-doc (nth 3 button))
346 (doc (if (string-match "\\(.*\\)\n" full-doc)
347 (match-string 1 full-doc)
348 full-doc))
349 (enable-expr (or (nth 4 button) t))
350 (modes (nth 1 button))
351 functions show-sym)
352 (when (memq 'letter modes) (setq functions `(:letter ,name)))
353 (when (or (memq 'folder modes) (memq 'sequence modes))
354 (setq functions
355 (append `(,(if (memq 'folder modes) :folder :sequence) ,name)
356 functions))
357 (setq show-sym
358 (if (string-match "^mh-\\(.*\\)$" name-str)
359 (intern (concat "mh-show-" (match-string 1 name-str)))
360 name))
361 (setq functions
362 (append `(,(if (memq 'folder modes) :show :show-seq)
363 ,(if (fboundp show-sym) show-sym name))
364 functions)))
365 (do ((functions functions (cddr functions)))
366 ((null functions))
367 (let* ((type (car functions))
368 (function (cadr functions))
369 (type1 (substring (symbol-name type) 1))
370 (vector-list (cond ((eq type :show) 'show-vectors)
371 ((eq type :show-seq) 'show-vectors)
372 ((eq type :letter) 'letter-vectors)
373 (t 'folder-vectors)))
374 (list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons)
375 (t 'mh-tool-bar-folder-buttons)))
376 (key (intern (concat "mh-" type1 "toolbar-" name-str)))
377 (setter (intern (concat type1 "-button-setter")))
378 (mbuttons (cond ((eq type :letter) 'letter-buttons)
379 ((eq type :show) 'show-buttons)
380 ((eq type :show-seq) 'show-buttons)
381 (t 'folder-buttons)))
382 (docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
383 ((eq mbuttons 'folder-buttons) 'folder-docs))))
384 (add-to-list vector-list `[,xemacs-icon ,function t ,full-doc])
385 (add-to-list
386 setter `(when (member ',name ,list)
387 (mh-funcall-if-exists
388 tool-bar-add-item ,icon ',function ',key
389 :help ,doc :enable ',enable-expr)))
390 (add-to-list mbuttons name)
391 (if docs (add-to-list docs doc))))))
392 (setq folder-buttons (nreverse folder-buttons)
393 letter-buttons (nreverse letter-buttons)
394 show-buttons (nreverse show-buttons)
395 letter-docs (nreverse letter-docs)
396 folder-docs (nreverse folder-docs)
397 folder-vectors (nreverse folder-vectors)
398 show-vectors (nreverse show-vectors)
399 letter-vectors (nreverse letter-vectors))
400 (dolist (x folder-defaults)
401 (unless (memq x folder-buttons)
402 (error "Folder defaults contains unknown button '%s'" x)))
403 (dolist (x letter-defaults)
404 (unless (memq x letter-buttons)
405 (error "Letter defaults contains unknown button '%s'" x)))
406 `(eval-when (compile load eval)
407 (defvar mh-folder-tool-bar-map nil)
408 (defvar mh-folder-seq-tool-bar-map nil)
409 (defvar mh-show-tool-bar-map nil)
410 (defvar mh-show-seq-tool-bar-map nil)
411 (defvar mh-letter-tool-bar-map nil)
412 ;; GNU Emacs tool bar specific code
413 (mh-do-in-gnu-emacs
414 ;; Custom setter functions
415 (defun mh-tool-bar-folder-buttons-set (symbol value)
416 "Construct toolbar for `mh-folder-mode' and `mh-show-mode'."
417 (set-default symbol value)
418 (setq mh-folder-tool-bar-map
419 (let ((tool-bar-map (make-sparse-keymap)))
420 ,@(nreverse folder-button-setter)
421 tool-bar-map))
422 (setq mh-show-tool-bar-map
423 (let ((tool-bar-map (make-sparse-keymap)))
424 ,@(nreverse show-button-setter)
425 tool-bar-map))
426 (setq mh-show-seq-tool-bar-map
427 (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
428 ,@(nreverse show-seq-button-setter)
429 tool-bar-map))
430 (setq mh-folder-seq-tool-bar-map
431 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
432 ,@(nreverse sequence-button-setter)
433 tool-bar-map)))
434 (defun mh-tool-bar-letter-buttons-set (symbol value)
435 "Construct toolbar for `mh-letter-mode'."
436 (set-default symbol value)
437 (setq mh-letter-tool-bar-map
438 (let ((tool-bar-map (make-sparse-keymap)))
439 ,@(nreverse letter-button-setter)
440 tool-bar-map))))
441 ;; XEmacs specific code
442 (mh-do-in-xemacs
443 (defvar mh-toolbar-folder-vector-map
444 ',(loop for button in folder-buttons
445 for vector in folder-vectors
446 collect (cons button vector)))
447 (defvar mh-toolbar-show-vector-map
448 ',(loop for button in show-buttons
449 for vector in show-vectors
450 collect (cons button vector)))
451 (defvar mh-toolbar-letter-vector-map
452 ',(loop for button in letter-buttons
453 for vector in letter-vectors
454 collect (cons button vector)))
455 (defvar mh-toolbar-folder-buttons nil)
456 (defvar mh-toolbar-show-buttons nil)
457 (defvar mh-toolbar-letter-buttons nil)
458 ;; Custom setter functions
459 (defun mh-tool-bar-letter-buttons-set (symbol value)
460 (set-default symbol value)
461 (setq mh-toolbar-letter-buttons
462 (loop for b in value
463 collect (cdr (assoc b mh-toolbar-letter-vector-map)))))
464 (defun mh-tool-bar-folder-buttons-set (symbol value)
465 (set-default symbol value)
466 (setq mh-toolbar-folder-buttons
467 (loop for b in value
468 collect (cdr (assoc b mh-toolbar-folder-vector-map))))
469 (setq mh-toolbar-show-buttons
470 (loop for b in value
471 collect (cdr (assoc b mh-toolbar-show-vector-map)))))
472 ;; Initialize toolbar
473 (defun mh-toolbar-init (mode)
474 "Install toolbar in MODE."
475 (let ((toolbar (cond ((eq mode :folder) mh-toolbar-folder-buttons)
476 ((eq mode :letter) mh-toolbar-letter-buttons)
477 ((eq mode :show) mh-toolbar-show-buttons)))
478 (height 37)
479 (width 40)
480 (buffer (current-buffer)))
481 (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag)
482 (cond
483 ((eq mh-xemacs-toolbar-position 'top)
484 (set-specifier top-toolbar toolbar buffer)
485 (set-specifier top-toolbar-visible-p t)
486 (set-specifier top-toolbar-height height))
487 ((eq mh-xemacs-toolbar-position 'bottom)
488 (set-specifier bottom-toolbar toolbar buffer)
489 (set-specifier bottom-toolbar-visible-p t)
490 (set-specifier bottom-toolbar-height height))
491 ((eq mh-xemacs-toolbar-position 'left)
492 (set-specifier left-toolbar toolbar buffer)
493 (set-specifier left-toolbar-visible-p t)
494 (set-specifier left-toolbar-width width))
495 ((eq mh-xemacs-toolbar-position 'right)
496 (set-specifier right-toolbar toolbar buffer)
497 (set-specifier right-toolbar-visible-p t)
498 (set-specifier right-toolbar-width width))
499 (t (set-specifier default-toolbar toolbar buffer)))))))
500 ;; Declare customizable toolbars
501 (custom-declare-variable
502 'mh-tool-bar-folder-buttons
503 '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults))
504 "Choose buttons to include in MH-E folder/show toolbar."
505 :group 'mh-toolbar :set 'mh-tool-bar-folder-buttons-set
506 :type '(set ,@(loop for x in folder-buttons
507 for y in folder-docs
508 collect `(const :tag ,y ,x))))
509 (custom-declare-variable
510 'mh-tool-bar-letter-buttons
511 '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults))
512 "Choose buttons to include in MH-E letter toolbar."
513 :group 'mh-toolbar :set 'mh-tool-bar-letter-buttons-set
514 :type '(set ,@(loop for x in letter-buttons
515 for y in letter-docs
516 collect `(const :tag ,y ,x)))))))
517 373
518(mh-tool-bar-define 374(defcustom mh-alias-passwd-gecos-comma-separator-flag t
519 ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg 375 "*Non-nil means the gecos field in the password file uses a comma separator.
520 mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg 376In the example in `mh-alias-local-users-prefix', commas are used to separate
521 mh-undo mh-execute-commands mh-toggle-tick mh-reply 377different values within the so-called gecos field. This is a fairly common
522 mh-alias-grab-from-field mh-send mh-rescan-folder 378usage. However, in the rare case that the gecos field in your password file is
523 mh-tool-bar-search mh-visit-folder 379not separated by commas and whose contents may contain commas, you can turn
524 mh-tool-bar-customize mh-tool-bar-folder-help mh-widen) 380this option off."
525 (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer 381 :type 'boolean
526 undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft 382 :group 'mh-alias)
527 mh-tool-bar-customize mh-tool-bar-letter-help))
528 ;; Folder/Show buffer buttons
529 (mh-inc-folder (folder) "mail"
530 "Incorporate new mail in Inbox
531This button runs `mh-inc-folder' which drags any
532new mail into your Inbox folder.")
533 (mh-mime-save-parts (folder) "attach"
534 "Save MIME parts from this message
535This button runs `mh-mime-save-parts' which saves a message's
536different parts into separate files.")
537 (mh-previous-undeleted-msg (folder) "left_arrow"
538 "Go to the previous undeleted message
539This button runs `mh-previous-undeleted-msg'")
540 (mh-page-msg (folder) "page-down"
541 "Page the current message forwards\nThis button runs `mh-page-msg'")
542 (mh-next-undeleted-msg (folder) "right_arrow"
543 "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'")
544 (mh-delete-msg (folder) "close"
545 "Mark this message for deletion\nThis button runs `mh-delete-msg'")
546 (mh-refile-msg (folder) "refile"
547 "Refile this message\nThis button runs `mh-refile-msg'")
548 (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'")
549 (mh-execute-commands (folder) "execute"
550 "Perform moves and deletes\nThis button runs `mh-execute-commands'")
551 (mh-toggle-tick (folder) "highlight"
552 "Toggle tick mark\nThis button runs `mh-toggle-tick'")
553 (mh-toggle-showing (folder) "show"
554 "Toggle showing message\nThis button runs `mh-toggle-showing'")
555 (mh-tool-bar-reply-from (folder) "reply-from" "Reply to \"from\"")
556 (mh-tool-bar-reply-to (folder) "reply-to" "Reply to \"to\"")
557 (mh-tool-bar-reply-all (folder) "reply-all" "Reply to \"all\"")
558 (mh-reply (folder) "mail/reply2"
559 "Reply to this message\nThis button runs `mh-reply'")
560 (mh-alias-grab-from-field (folder) "alias"
561 "Grab From alias\nThis button runs `mh-alias-grab-from-field'"
562 (mh-alias-from-has-no-alias-p))
563 (mh-send (folder) "mail_compose"
564 "Compose new message\nThis button runs `mh-send'")
565 (mh-rescan-folder (folder) "rescan"
566 "Rescan this folder\nThis button runs `mh-rescan-folder'")
567 (mh-pack-folder (folder) "repack"
568 "Repack this folder\nThis button runs `mh-pack-folder'")
569 (mh-tool-bar-search (folder) "search"
570 "Search\nThis button runs `mh-tool-bar-search-function'")
571 (mh-visit-folder (folder) "fld_open"
572 "Visit other folder\nThis button runs `mh-visit-folder'")
573 ;; Letter buffer buttons
574 (mh-send-letter (letter) "mail_send" "Send this letter")
575 (mh-compose-insertion (letter) "attach" "Insert attachment")
576 (ispell-message (letter) "spell" "Check spelling")
577 (save-buffer (letter) "save" "Save current buffer to its file")
578 (undo (letter) "undo" "Undo last operation")
579 (kill-region (letter) "cut"
580 "Cut (kill) text in region between mark and current position")
581 (menu-bar-kill-ring-save (letter) "copy"
582 "Copy text in region between mark and current position")
583 (yank (letter) "paste" "Paste (yank) text cut or copied earlier")
584 (mh-fully-kill-draft (letter) "close" "Kill this draft")
585 ;; Common buttons
586 (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
587 (mh-tool-bar-folder-help (folder) "help"
588 "Help! (general help)\nThis button runs `Info-goto-node'")
589 (mh-tool-bar-letter-help (letter) "help"
590 "Help! (general help)\nThis button runs `Info-goto-node'")
591 ;; Folder narrowed to sequence buttons
592 (mh-widen (sequence) "widen"
593 "Widen from the sequence\nThis button runs `mh-widen'"))
594 383
595 384
596 385
597;;; Speedbar and folder configuration (:group 'mh-speed) 386;;; Organizing Your Mail with Folders (:group 'mh-folder)
598
599(defcustom mh-large-folder 200
600 "The number of messages that indicates a large folder.
601If a folder is deemed to be large, that is the number of messages in it exceed
602this value, then confirmation is needed when it is visited. Even when
603`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
604it is large. If set to nil all folders are treated as if they are small."
605 :type '(choice (const :tag "No limit") integer)
606 :group 'mh-speed)
607
608(defcustom mh-speed-flists-interval 60
609 "Time between calls to flists in seconds.
610If 0, flists is not called repeatedly."
611 :type 'integer
612 :group 'mh-speed)
613 387
614(defcustom mh-speed-run-flists-flag t 388(defcustom mh-recenter-summary-flag nil
615 "Non-nil means flists is used. 389 "*Non-nil means to recenter the summary window.
616If non-nil, flists is executed every `mh-speed-flists-interval' seconds to 390If this option is turned on, recenter the summary window when the show window
617update the display of the number of unseen and total messages in each folder. 391is toggled off."
618If resources are limited, this can be set to nil and the speedbar display can
619be updated manually with the \\[mh-speed-flists] command."
620 :type 'boolean 392 :type 'boolean
621 :group 'mh-speed) 393 :group 'mh-folder)
622 394
623 395
624 396
625;;; Options for controlling scan listing (:group 'mh-folder) 397;;; Folder Selection (:group 'mh-folder-selection)
626
627(defcustom mh-adaptive-cmd-note-flag t
628 "*Non-nil means that the message number width is determined dynamically.
629This is done once when a folder is first opened by running scan on the last
630message of the folder. The message number for the last message is extracted
631and its width calculated. This width is used when calling `mh-set-cmd-note'.
632 398
633If you prefer fixed-width message numbers, set this variable to nil and call 399(defcustom mh-default-folder-for-message-function nil
634`mh-set-cmd-note' with the width specified by the scan format in 400 "Function to select a default folder for refiling or `Fcc'.
635`mh-scan-format-file'. For example, the default width is 4, so you would use 401The current buffer is set to the message being refiled with point at the start
636\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil." 402of the message. This function should return the default folder as a string
637 :type 'boolean 403with a leading `+' sign. It can also return nil so that the last folder name
638 :group 'mh-folder) 404is used as the default, or an empty string to suppress the default entirely."
405 :type 'function
406 :group 'mh-folder-selection)
639 407
640(defcustom mh-default-folder-list nil 408(defcustom mh-default-folder-list nil
641 "*Alist of addresses and folders. 409 "*List of addresses and folders.
642When refiling messages, these folders are the default that is provided if the 410The folder name associated with the first address found in this list is used
643sender (or recipient if the Check Recipient checkbox has been selected) has 411as the default for `mh-refile-msg' and similar functions. Each element in this
644the associated address, a regexp. The first entry to match will be used, so 412list contains a `Check Recipient' item. If this item is turned on, then the
645order them according to the wanted priority. You do not need to list your 413address is checked against the recipient instead of the sender. This is useful
646aliases here as that lookup is already performed. 414for mailing lists.
647 415
648See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more 416See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
649information." 417information."
650 :type '(repeat (list (regexp :tag "Address") 418 :type '(repeat (list (regexp :tag "Address")
651 (string :tag "Folder") 419 (string :tag "Folder")
652 (boolean :tag "Check Recipient"))) 420 (boolean :tag "Check Recipient")))
653 :group 'mh-folder) 421 :group 'mh-folder-selection)
654 422
655(defcustom mh-default-folder-must-exist-flag t 423(defcustom mh-default-folder-must-exist-flag t
656 "*Non-nil means guessed folder name must exist to be used. 424 "*Non-nil means guessed folder name must exist to be used.
657If this variable is t, then the guessed name is only used if the folder 425If the derived folder does not exist, and this option is on, then the last
658already exists\; if the folder doesn't exist, then the last folder name used 426folder name used is suggested. This is useful if you get mail from various
659is suggested. This is useful if you get mail from various people for whom you 427people for whom you have an alias, but file them all in the same project
660have an alias, but file them all in the same project folder. 428folder.
429
661See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more 430See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
662information." 431information."
663 :type 'boolean 432 :type 'boolean
664 :group 'mh-folder) 433 :group 'mh-folder-selection)
665 434
666(defcustom mh-default-folder-prefix "" 435(defcustom mh-default-folder-prefix ""
667 "*Prefix used for guessed folder names. 436 "*Prefix used for folder names generated from aliases.
668This can be used to put folders associated with your aliases in a sub-folder 437The prefix is used to prevent clutter in your mail directory.
669so as to not clutter your mail directory. 438
670See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more 439See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more
671information." 440information."
672 :type 'string 441 :type 'string
673 :group 'mh-folder) 442 :group 'mh-folder-selection)
674
675(defcustom mh-inc-prog "inc"
676 "*Program to run to incorporate new mail into a folder.
677Normally \"inc\". This file is searched for relative to
678the `mh-progs' directory unless it is an absolute pathname."
679 :type 'string
680 :group 'mh-folder)
681
682(defcustom mh-inc-spool-list nil
683 "*Alist of alternate spool files, corresponding folders and keybindings.
684Here's an example. Suppose you have subscribed to the MH-E devel mailing
685list. You could filter its mail into a separate spool file named
686~/mail/mh-e using Procmail and a .procmailrc entry like:
687
688MAILDIR=$HOME/mail #you'd better make sure it exists
689:0:
690* ^From mh-e-devel-admin@lists.sourceforge.net
691mh-e
692
693If you wanted to incorporate that spool file into an MH folder called
694mh-e by pressing \"I m\" in folder-mode or by `M-x mh-inc-spool-mh-e',
695you would setup `mh-inc-spool-list' with an entry:
696
697 Spool file: ~/mail/mh-e
698 Folder: mh-e
699 Key binding: m
700
701Then, you could also install `xbuffy' and configure an extra mailbox like so:
702
703box ~/mail/mh-e
704 title mh-e
705 origMode
706 polltime 10
707 headertime 0
708 command gnudoit -q '(mh-inc-spool-mh-e)'
709
710Note that the entry above uses the gnuserv package to communicate the
711command `mh-inc-spool-mh-e' to Emacs. It will incorporate the spool file
712when clicking the xbuffy box with the middle mouse button."
713 :type '(repeat (list (file :tag "Spool file")
714 (string :tag "Folder")
715 (character :tag "Key binding")))
716 :set 'mh-inc-spool-list-set
717 :group 'mh-folder)
718 443
719(defcustom mh-interpret-number-as-range-flag t 444
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
726(defcustom mh-lpr-command-format "lpr -J '%s'"
727 "*Format for Unix command that prints a message.
728The string should be a Unix command line, with the string '%s' where
729the job's name (folder and message number) should appear. The formatted
730message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
731 :type 'string
732 :group 'mh-folder)
733 445
734(defcustom mh-mime-save-parts-default-directory t 446;;; Identities (:group 'mh-identity)
735 "Default directory to use for `mh-mime-save-parts'.
736If nil, prompt and set for next time the command is used during same session.
737If t, prompt always"
738 :type '(choice (const :tag "Prompt the first time" nil)
739 (const :tag "Prompt always" t)
740 directory)
741 :group 'mh-folder)
742 447
743(defcustom mh-print-background-flag nil 448(defcustom mh-identity-list nil
744 "*Non-nil means messages should be printed in the background. 449 "*List of identities.
745WARNING: do not delete the messages until printing is finished; 450
746otherwise, your output may be truncated." 451Each element consists of an identity label, and a collection of header fields
747 :type 'boolean 452and a signature to insert if the identity is selected (see
748 :group 'mh-folder) 453`mh-identity-default', `mh-insert-identity' and the `Identity' menu in a
454MH-Letter buffer). The `Value Menu' contains the common header fields `From'
455and `Organization'. Other header fields may be added using the `Other Field'
456menu item. The `Signature' menu item is used to insert a signature with
457`mh-insert-signature'. The `GPG Key ID' menu item is used to specify a
458different key to sign or encrypt messages."
459 :type '(repeat (list :tag ""
460 (string :tag "Label")
461 (repeat :tag "Add at least one item below"
462 (choice
463 (cons :tag "From Field"
464 (const "From")
465 (string :tag "Value"))
466 (cons :tag "Organization Field"
467 (const "Organization")
468 (string :tag "Value"))
469 (cons :tag "Other Field"
470 (string :tag "Field")
471 (string :tag "Value"))
472 (cons :tag "Attribution Verb"
473 (const ":attribution-verb")
474 (string :tag "Value"))
475 (cons :tag "Signature"
476 (const :tag "Signature"
477 ":signature")
478 (choice
479 (const :tag "mh-signature-file-name"
480 nil)
481 (file)
482 (function)))
483 (cons :tag "GPG Key ID"
484 (const :tag "GPG Key ID"
485 ":pgg-default-user-id")
486 (string :tag "Value"))))))
487 :set 'mh-identity-list-set
488 :group 'mh-identity)
749 489
750(defcustom mh-recenter-summary-flag nil 490(defcustom mh-auto-fields-list nil
751 "*Non-nil means to recenter the summary window. 491 "List of recipients for which header lines are automatically inserted.
752Recenter the summary window when the show window is toggled off if non-nil." 492Each element consists of the recipient, which is a regular expression, and a
753 :type 'boolean 493collection of header fields and identities to insert if the message is sent to
754 :group 'mh-folder) 494this recipient. The `Value Menu' contains the common header fields `Fcc' and
495`Mail-Followup-To'. Other header fields may be added using the `Other Field'
496menu item. The `Identity' menu item is used to insert entire identities with
497`mh-insert-identity'."
498 :type `(repeat
499 (list :tag ""
500 (string :tag "Recipient")
501 (repeat :tag "Add at least one item below"
502 (choice
503 (cons :tag "Identity"
504 (const ":identity")
505 ,(append
506 '(radio)
507 (mapcar
508 (function (lambda (arg) `(const ,arg)))
509 (mapcar 'car mh-identity-list))))
510 (cons :tag "Fcc Field"
511 (const "fcc")
512 (string :tag "Value"))
513 (cons :tag "Mail-Followup-To Field"
514 (const "Mail-Followup-To")
515 (string :tag "Value"))
516 (cons :tag "Other Field"
517 (string :tag "Field")
518 (string :tag "Value"))))))
519 :group 'mh-identity)
755 520
756(defcustom mh-recursive-folders-flag nil 521(defcustom mh-auto-fields-prompt-flag t
757 "*Non-nil means that commands which operate on folders do so recursively." 522 "*Non-nil means to prompt before sending if fields inserted.
523See `mh-auto-fields-list'."
758 :type 'boolean 524 :type 'boolean
759 :group 'mh-folder) 525 :group 'mh-identity)
760 526
761;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following tot 527(defcustom mh-identity-default nil
762;;; he docstring: "Additional sequences that should not to be preserved can be 528 "Default identity to use when `mh-letter-mode' is called."
763;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX 529 :type (append
530 '(radio)
531 (cons '(const :tag "None" nil)
532 (mapcar (function (lambda (arg) `(const ,arg)))
533 (mapcar 'car mh-identity-list))))
534 :group 'mh-identity)
764 535
765(defcustom mh-refile-preserves-sequences-flag t 536(defcustom mh-identity-handlers
766 "*Non-nil means that sequences are preserved when messages are refiled. 537 '((":default" . mh-identity-handler-bottom)
767If this variable is non-nil and a message belonging to a sequence other than 538 ("from" . mh-identity-handler-top)
768cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the 539 (":attribution-verb" . mh-identity-handler-attribution-verb)
769same sequence in the destination folder." 540 (":signature" . mh-identity-handler-signature)
770 :type 'boolean 541 (":pgg-default-user-id" . mh-identity-handler-gpg-identity))
771 :group 'mh-folder) 542 "Handler functions for fields in `mh-identity-list'.
543This is an alist of fields (strings) and handlers (functions). Strings are
544lowercase. Use \":signature\" for Signature and \":pgg-default-user-id\" for
545GPG Key ID. The function associated with the string \":default\" is used if no
546other functions are appropriate."
547 :type '(repeat (cons (string :tag "Field") function))
548 :group 'mh-identity)
772 549
773(defcustom mh-scan-format-file t 550
774 "Specifies the format file to pass to the scan program.
775If t, the format string will be taken from the either `mh-scan-format-mh'
776or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
777If nil, the default scan output will be used.
778 551
779If you customize the scan format, you may need to modify a few variables 552;;; Incorporating Your Mail (:group 'mh-inc)
780containing regexps that MH-E uses to identify specific portions of the output.
781Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
782may also have to call `mh-set-cmd-note' with the width of your message
783numbers. See also `mh-adaptive-cmd-note-flag'."
784 :type '(choice (const :tag "Use MH-E scan format" t)
785 (const :tag "Use default scan format" nil)
786 (file :tag "Specify a scan format file"))
787 :group 'mh-folder)
788 553
789(defcustom mh-scan-prog "scan" 554(defcustom mh-inc-prog "inc"
790 "*Program to run to generate one-line-per-message listing of a folder. 555 "*Program to run to incorporate new mail into a folder.
791Normally \"scan\" or a file name linked to scan. This file is searched 556Normally \"inc\". This program is relative to the `mh-progs' directory unless
792for relative to the `mh-progs' directory unless it is an absolute pathname." 557it is an absolute pathname."
793 :type 'string 558 :type 'string
794 :group 'mh-folder) 559 :group 'mh-inc)
795(make-variable-buffer-local 'mh-scan-prog)
796
797(defcustom mh-show-threads-flag nil
798 "Non-nil means new folders start in threaded mode.
799Threading large number of messages can be time consuming. So if the flag is
800non-nil then threading will be done only if the number of messages being
801threaded is less than `mh-large-folder'."
802 :type 'boolean
803 :group 'mh-folder)
804 560
805(defcustom mh-store-default-directory nil 561(defcustom mh-inc-spool-list nil
806 "*Last directory used by \\[mh-store-msg]; default for next store. 562 "*Alist of alternate spool files, corresponding folders and keybindings.
807A directory name string, or nil to use current directory." 563This option will be described by example.
808 :type '(choice (const :tag "Current" nil) 564
809 directory) 565Suppose you have subscribed to the mh-e-devel mailing list and you use
810 :group 'mh-folder) 566procmail to filter its mail into `~/mail/mh-e' with the following
811 567`.procmailrc' recipe:
812(defcustom mh-tick-seq 'tick 568
813 "The name of the MH tick sequence." 569 MAILDIR=$HOME/mail
814 :type '(choice (const :tag "Disable ticking" nil) 570 :0:
815 symbol) 571 * ^From mh-e-devel-admin@lists.sourceforge.net
816 :group 'mh-folder) 572 mh-e
817 573
818(defcustom mh-update-sequences-after-mh-show-flag t 574If you wanted to incorporate that spool file into an MH folder called mh-e
819 "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'. 575with the \"I m\" or \\[mh-inc-spool-mh-e] commands, you would use the
820If set, `mh-update-sequence' is run every time a message is shown, telling 576following:
821MH or nmh that this is your current message. It's useful, for example, to 577
822display MIME content using \"M-! mhshow RET\"" 578 Spool File: ~/mail/mh-e
823 :type 'boolean 579 Folder: mh-e
824 :group 'mh-folder) 580 Key Binding: m
581
582Then, you could also install `xbuffy' and configure an extra mailbox using the
583gnuserv package to run the `mh-inc-spool-mh-e' command in Emacs:
584
585 box ~/mail/mh-e
586 title mh-e
587 origMode
588 polltime 10
589 headertime 0
590 command gnudoit -q '(mh-inc-spool-mh-e)'
591
592To incorporate the spool file, click the xbuffy box with the middle mouse
593button."
594 :type '(repeat (list (file :tag "Spool File")
595 (string :tag "Folder")
596 (character :tag "Key Binding")))
597 :set 'mh-inc-spool-list-set
598 :group 'mh-inc)
825 599
826 600
827 601
828;;; Indexed searching (:group 'mh-index) 602;;; Searching (:group 'mh-index)
829 603
830(defcustom mh-index-new-messages-folders t 604(defcustom mh-index-new-messages-folders t
831 "Folders searched for `mh-unseen-seq'. 605 "Folders searched for the `unseen' sequence.
832If t, then `mh-inbox' is searched. If nil, all the top level folders are 606This option can be set to `Inbox' to search the `+inbox' folder or `All' to
833searched. Otherwise the list of folders specified as strings are searched. 607search all of the top level folders. Otherwise, list the folders that should
608be searched with the `Choose Folders' menu item.
609
834See also `mh-recursive-folders-flag'." 610See also `mh-recursive-folders-flag'."
835 :group 'mh-index 611 :group 'mh-index
836 :type '(choice (const :tag "Inbox" t) 612 :type '(choice (const :tag "Inbox" t)
837 (const :tag "All" nil) 613 (const :tag "All" nil)
838 (repeat :tag "Choose folders" (string :tag "Folder")))) 614 (repeat :tag "Choose Folders" (string :tag "Folder"))))
839 615
840(defcustom mh-index-program nil 616(defcustom mh-index-program nil
841 "Indexing program that MH-E shall use. 617 "Indexing program that MH-E shall use.
842The possible choices are swish++, swish-e, mairix, namazu, glimpse, pick and 618The default setting of this option is `Auto-detect' which means that MH-E will
843grep. By default this variable is nil which means that the programs are tried 619automatically choose one of swish++, swish-e, mairix, namazu, pick and grep in
844in order and the first one found is used. 620that order. If, for example, you have both swish++ and mairix installed and
621you want to use mairix, then you can set this option to `mairix'.
845 622
846More information about setting up an indexing program to use with MH-E can be 623More information about setting up an indexing program to use with MH-E can be
847found in the documentation of `mh-index-search'." 624found in the documentation of `mh-index-search'."
@@ -850,33 +627,34 @@ found in the documentation of `mh-index-search'."
850 (const :tag "swish-e" swish) 627 (const :tag "swish-e" swish)
851 (const :tag "mairix" mairix) 628 (const :tag "mairix" mairix)
852 (const :tag "namazu" namazu) 629 (const :tag "namazu" namazu)
853 (const :tag "glimpse" glimpse)
854 (const :tag "pick" pick) 630 (const :tag "pick" pick)
855 (const :tag "grep" grep)) 631 (const :tag "grep" grep))
856 :group 'mh-index) 632 :group 'mh-index)
857 633
858(defcustom mh-index-ticked-messages-folders t 634(defcustom mh-index-ticked-messages-folders t
859 "Folders searched for `mh-tick-seq'. 635 "Folders searched for `mh-tick-seq'.
860If t, then `mh-inbox' is searched. If nil, all the top level folders are 636This option can be set to `Inbox' to search the `+inbox' folder or `All' to
861searched. Otherwise the list of folders specified as strings are searched. 637search all of the top level folders. Otherwise, list the folders that should
638be searched with the `Choose Folders' menu item.
639
862See also `mh-recursive-folders-flag'." 640See also `mh-recursive-folders-flag'."
863 :group 'mh-index 641 :group 'mh-index
864 :type '(choice (const :tag "Inbox" t) 642 :type '(choice (const :tag "Inbox" t)
865 (const :tag "All" nil) 643 (const :tag "All" nil)
866 (repeat :tag "Choose folders" (string :tag "Folder")))) 644 (repeat :tag "Choose Folders" (string :tag "Folder"))))
867 645
868 646
869 647
870;;; Spam Handling (:group 'mh-junk) 648;;; Dealing with Junk Mail (:group 'mh-junk)
871 649
872;; Spam fighting program chosen 650;; Spam fighting program chosen
873(defvar mh-junk-choice nil) 651(defvar mh-junk-choice nil)
874 652
875;; Available spam filter interfaces 653;; Available spam filter interfaces
876(defvar mh-junk-function-alist 654(defvar mh-junk-function-alist
877 '((bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist) 655 '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)
878 (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist) 656 (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist)
879 (spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)) 657 (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist))
880 "Available choices of spam programs to use. 658 "Available choices of spam programs to use.
881This is an alist. For each element there are functions that blacklist a message 659This is an alist. For each element there are functions that blacklist a message
882as spam and whitelist a message incorrectly classified as spam.") 660as spam and whitelist a message incorrectly classified as spam.")
@@ -894,28 +672,348 @@ bound to the new value of `mh-junk-program'. The function sets the variable
894 finally return (car element))))) 672 finally return (car element)))))
895 673
896;; User customizable variables 674;; User customizable variables
897(defcustom mh-junk-mail-folder nil 675(defcustom mh-junk-disposition nil
898 "Folder to put spam mail in. 676 "Disposition of junk mail."
899If nil then the spam is deleted." 677 :type '(choice (const :tag "Delete Spam" nil)
900 :type '(choice (const :tag "Delete spam" nil) 678 (string :tag "Spam Folder"))
901 (string :tag "Spam folder"))
902 :group 'mh-junk) 679 :group 'mh-junk)
903 680
904(defcustom mh-junk-program nil 681(defcustom mh-junk-program nil
905 "Spam program that MH-E shall use. 682 "Spam program that MH-E should use.
906The possible choices are bogofilter, spamprobe, and spamassassin. By default 683The default setting of this option is `Auto-detect' which means that MH-E will
907this variable is nil which means that the programs are tried in order and the 684automatically choose one of SpamAssassin, Bogofilter, or SpamProbe in that
908first one found is used." 685order. If, for example, you have both SpamAssassin and Bogofilter installed
909 :type '(choice (const :tag "auto-detect" nil) 686and you want to use BogoFilter, then you can set this option to `Bogofilter'."
910 (const :tag "bogofilter" bogofilter) 687 :type '(choice (const :tag "Auto-detect" nil)
911 (const :tag "spamprobe" spamprobe) 688 (const :tag "SpamAssassin" spamassassin)
912 (const :tag "spamassassin" spamassassin)) 689 (const :tag "Bogofilter" bogofilter)
690 (const :tag "SpamProbe" spamprobe))
913 :set 'mh-junk-choose 691 :set 'mh-junk-choose
914 :group 'mh-junk) 692 :group 'mh-junk)
915 693
694(defcustom mh-junk-background nil
695 "If on, spam programs are run in background.
696By default, the programs are run in the foreground, but this can be slow when
697junking large numbers of messages. If you have enough memory or don't junk
698that many messages at the same time, you might try turning on this option."
699 :type '(choice (const :tag "Off" nil)
700 (const :tag "On" 0))
701 :group 'mh-junk)
702
703
704
705;;; Editing a Draft (:group 'mh-letter)
706
707(defcustom mh-mml-method-default (if mh-gnus-pgp-support-flag "pgpmime" "none")
708 "Default method to use in security directives."
709 :type '(choice (const :tag "PGP (MIME)" "pgpmime")
710 (const :tag "PGP" "pgp")
711 (const :tag "S/MIME" "smime")
712 (const :tag "None" "none"))
713 :group 'mh-letter)
714
715(defcustom mh-compose-forward-as-mime-flag t
716 "Non-nil means that messages are forwarded as a MIME part."
717 :type 'boolean
718 :group 'mh-letter)
719
720(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
721 "Type of MIME message directives in messages.
722
723By default, this option is set to `Gnus' if it is supported. This option can
724also be set manually to `mhn' if mhn directives are preferred."
725 :type '(choice (const :tag "Gnus" gnus)
726 (const :tag "mhn" mhn))
727 :group 'mh-letter)
728
729(defcustom mh-compose-skipped-header-fields
730 '("From" "Organization" "References" "In-Reply-To"
731 "X-Face" "Face" "X-Image-URL" "X-Mailer")
732 "List of header fields to skip over when navigating in draft."
733 :type '(repeat (string :tag "Field"))
734 :group 'mh-letter)
735
736(defcustom mh-compose-space-does-completion-flag nil
737 "*Non-nil means that <SPC> does completion in message header."
738 :type 'boolean
739 :group 'mh-letter)
740
741(defcustom mh-delete-yanked-msg-window-flag nil
742 "*Non-nil means delete any window displaying the message.
743If this option is on, yanking the current message into a draft letter with
744\\<mh-letter-mode-map>\\[mh-yank-cur-msg] deletes any windows displaying the
745message."
746 :type 'boolean
747 :group 'mh-letter)
748
749(defcustom mh-extract-from-attribution-verb "wrote:"
750 "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
751 :type '(choice (const "wrote:")
752 (const "a écrit:")
753 (const "schrieb:")
754 (string :tag "Custom String"))
755 :group 'mh-letter)
756
757(defcustom mh-ins-buf-prefix "> "
758 "*String to put before each non-blank line of a yanked or inserted message.
759Used when the message is inserted into an outgoing letter
760by \\<mh-letter-mode-map>\\[mh-insert-letter] or \\[mh-yank-cur-msg]."
761 :type 'string
762 :group 'mh-letter)
763
764(defcustom mh-insert-x-mailer-flag t
765 "*Non-nil means append an X-Mailer field to the header."
766 :type 'boolean
767 :group 'mh-letter)
768
769(defcustom mh-letter-complete-function 'ispell-complete-word
770 "*Function to call when completing outside of address or folder fields.
771By default, this is set to `ispell-complete-word'."
772 :type '(choice function (const nil))
773 :group 'mh-letter)
774
775(defcustom mh-letter-fill-column 72
776 "*Fill column to use in `mh-letter-mode'.
777This is usually less than in other text modes because email messages get
778quoted by some prefix (sometimes many times) when they are replied to,
779and it's best to avoid quoted lines that span more than 80 columns."
780 :type 'integer
781 :group 'mh-letter)
782
783(defcustom mh-reply-show-message-flag t
784 "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
785
786The setting of this variable determines whether the MH `show-buffer' is
787displayed with the current message when using `mh-reply' without a prefix
788argument. Set it to nil if you already include the message automatically
789in your draft using
790 repl: -filter repl.filter
791in your ~/.mh_profile file."
792 :type 'boolean
793 :group 'mh-letter)
794
795(defcustom mh-signature-file-name "~/.signature"
796 "*Source of user's signature.
797
798By default, the text of your signature is taken from the file `~/.signature'.
799You can read from other files by changing this option. This file may contain a
800vCard in which case an attachment is added with the vCard.
801
802This option may also be a symbol, in which case that function is called. You
803may not want a signature separator to be added for you; instead you may want
804to insert one yourself. Variables that you may find useful to do this include
805`mh-signature-separator' (when inserting a signature separator) and
806`mh-signature-separator-regexp' (for finding said separator). The function
807`mh-signature-separator-p', which reports t if the buffer contains a
808separator, may be useful as well.
809
810The signature is inserted into your message with the command
811\\<mh-letter-mode-map>\\[mh-insert-signature] or with the `mh-identity-list'
812option."
813 :type 'file
814 :group 'mh-letter)
815
816(defcustom mh-signature-separator-flag t
817 "*Non-nil means a signature separator should be inserted.
818It is not recommended that you change this option since various mail user
819agents, including MH-E, use the separator to present the signature
820differently, and to suppress the signature when replying or yanking a letter
821into a draft."
822 :type 'boolean
823 :group 'mh-letter)
824
825(defcustom mh-x-face-file "~/.face"
826 "*File containing face header field to insert in outgoing mail.
827
828If the file starts with either of the strings `X-Face:', `Face:' or
829`X-Image-URL:' then the contents are added to the message header verbatim.
830Otherwise it is assumed that the file contains the value of the `X-Face:'
831header field.
832
833The `X-Face:' header field, which is a low-resolution, black and white image,
834can be generated using the `compface' command, which can be obtained from
835ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. The \"Online
836X-Face Convertor\" at http://www.dairiki.org/xface/ is a useful resource for
837quick conversion of images into `X-Face:' header fields.
838
839Use the `make-face' script (http://quimby.gnus.org/circus/face/make-face) to
840convert a JPEG image to the higher resolution, color, `Face:' header field.
841
842The URL of any image can be used for the `X-Image-URL:' field and no
843processing of the image is required.
844
845To prevent the setting of any of these header fields, either set
846`mh-x-face-file' to nil, or simply ensure that the file defined by this option
847doesn't exist."
848 :type 'file
849 :group 'mh-letter)
850
851(defcustom mh-yank-from-start-of-msg 'attribution
852 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
853If t, include the entire message, with full headers. This is historically
854here for use with supercite, but is now deprecated in favor of the setting
855`supercite' below.
856
857If the symbol `body', then yank the message minus the header.
858
859If the symbol `supercite', include the entire message, with full headers.
860This also causes the invocation of `sc-cite-original' without the setting
861of `mail-citation-hook', now deprecated practice.
862
863If the symbol `autosupercite', do as for `supercite' automatically when
864show buffer matches the message being replied-to. When this option is used,
865the -noformat switch is passed to the repl program to override a -filter or
866-format switch.
867
868If the symbol `attribution', then yank the message minus the header and add
869a simple attribution line at the top.
870
871If the symbol `autoattrib', do as for `attribution' automatically when show
872buffer matches the message being replied-to. You can make sure this is
873always the case by setting `mh-reply-show-message-flag' to t (which is the
874default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
875that the show window is never displayed. When the `autoattrib' option is
876used, the -noformat switch is passed to the repl program to override a
877-filter or -format switch.
878
879If nil, yank only the portion of the message following the point.
880
881If the show buffer has a region, this variable is ignored unless its value is
882one of `attribution' or `autoattrib' in which case the attribution is added
883to the yanked region."
884 :type '(choice (const :tag "Below point" nil)
885 (const :tag "Without header" body)
886 (const :tag "Invoke supercite" supercite)
887 (const :tag "Invoke supercite, automatically" autosupercite)
888 (const :tag "Without header, with attribution" attribution)
889 (const :tag "Without header, with attribution, automatically"
890 autoattrib)
891 (const :tag "Entire message with headers" t))
892 :group 'mh-letter)
893
894
895
896;;; Ranges (:group 'mh-ranges)
897
898(defcustom mh-interpret-number-as-range-flag t
899 "Non-nil means interpret a number as a range.
900If the variable is non-nil, and you use an integer, N, when asked for a
901range to scan, then MH-E uses the range \"last:N\"."
902 :type 'boolean
903 :group 'mh-ranges)
904
905
906
907;;; Scan Line Formats (:group 'mh-scan-line-formats)
908
909(defcustom mh-adaptive-cmd-note-flag t
910 "*Non-nil means that the message number width is determined dynamically.
911This is done once when a folder is first opened by running scan on the last
912message of the folder. The message number for the last message is extracted
913and its width calculated. This width is used when calling `mh-set-cmd-note'.
914
915If you prefer fixed-width message numbers, set this variable to nil and call
916`mh-set-cmd-note' with the width specified by the scan format in
917`mh-scan-format-file'. For example, the default width is 4, so you would use
918\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
919 :type 'boolean
920 :group 'mh-scan-line-formats)
921
922(defcustom mh-scan-format-file t
923 "Specifies the format file to pass to the scan program.
924If t, the format string will be taken from the either `mh-scan-format-mh'
925or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
926If nil, the default scan output will be used.
927
928If you customize the scan format, you may need to modify a few variables
929containing regexps that MH-E uses to identify specific portions of the output.
930Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
931may also have to call `mh-set-cmd-note' with the width of your message
932numbers. See also `mh-adaptive-cmd-note-flag'."
933 :type '(choice (const :tag "Use MH-E scan Format" t)
934 (const :tag "Use Default scan Format" nil)
935 (file :tag "Specify a scan Format File"))
936 :group 'mh-scan-line-formats)
937
938(defcustom mh-scan-prog "scan"
939 "*Program to run to generate one-line-per-message listing of a folder.
940Normally \"scan\" or a file name linked to scan. This file is searched
941for relative to the `mh-progs' directory unless it is an absolute pathname."
942 :type 'string
943 :group 'mh-scan-line-formats)
944(make-variable-buffer-local 'mh-scan-prog)
945
916 946
917 947
918;;; Message display (:group 'mh-show) 948;;; Sending Mail (:group 'mh-sending-mail)
949
950(defcustom mh-compose-letter-function nil
951 "Invoked when setting up a letter draft.
952It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
953 :type '(choice (const nil) function)
954 :group 'mh-sending-mail)
955
956(defcustom mh-compose-prompt-flag nil
957 "*Non-nil means prompt for header fields when composing a new draft."
958 :type 'boolean
959 :group 'mh-sending-mail)
960
961(defcustom mh-forward-subject-format "%s: %s"
962 "*Format to generate the Subject: line contents for a forwarded message.
963The two string arguments to the format are the sender of the original
964message and the original subject line."
965 :type 'string
966 :group 'mh-sending-mail)
967
968(defcustom mh-reply-default-reply-to nil
969 "*Sets the person or persons to whom a reply will be sent.
970If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
971value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
972The values \"cc\" and \"all\" do the same thing."
973 :type '(choice (const :tag "Prompt" nil)
974 (const "from") (const "to")
975 (const "cc") (const "all"))
976 :group 'mh-sending-mail)
977
978
979
980;;; Sequences (:group 'mh-sequences)
981
982;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following to
983;;; the docstring: "Additional sequences that should not to be preserved can be
984;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX
985
986(defcustom mh-refile-preserves-sequences-flag t
987 "*Non-nil means that sequences are preserved when messages are refiled.
988If this variable is non-nil and a message belonging to a sequence other than
989cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the
990same sequence in the destination folder."
991 :type 'boolean
992 :group 'mh-sequences)
993
994(defcustom mh-tick-seq 'tick
995 "The name of the MH sequence for ticked messages.
996You would change this option if you already use the `tick' sequence for your
997own use. You can also disable all of the ticking functions by choosing the
998`Disable Ticking' item but there isn't much advantage to that."
999 :type '(choice (const :tag "Disable Ticking" nil)
1000 symbol)
1001 :group 'mh-sequences)
1002
1003(defcustom mh-update-sequences-after-mh-show-flag t
1004 "*Non-nil means flush MH sequences to disk after message is shown.
1005Three sequences are maintained internally by MH-E and pushed out to MH when a
1006message is shown. They include the sequence specified by your
1007`Unseen-Sequence:' profile entry, `cur', and the sequence listed by
1008the `mh-tick-seq' option which is `tick' by default.
1009If you do not like this behavior, set this option to nil. You can then update
1010the state manually with the \\<mh-folder-mode-map>`\\[mh-execute-commands]', `\\[mh-quit]', or `\\[mh-update-sequences]' commands."
1011 :type 'boolean
1012 :group 'mh-sequences)
1013
1014
1015
1016;;; Reading Your Mail (:group 'mh-show)
919 1017
920(defcustom mh-bury-show-buffer-flag t 1018(defcustom mh-bury-show-buffer-flag t
921 "*Non-nil means that the displayed show buffer for a folder is buried." 1019 "*Non-nil means that the displayed show buffer for a folder is buried."
@@ -923,10 +1021,11 @@ first one found is used."
923 :group 'mh-show) 1021 :group 'mh-show)
924 1022
925(defcustom mh-clean-message-header-flag t 1023(defcustom mh-clean-message-header-flag t
926 "*Non-nil means clean headers of messages that are displayed or inserted. 1024 "*Non-nil means remove extraneous header fields.
927The variable `mh-invisible-headers' if set determines the header fields that 1025The header fields listed in the `mh-invisible-header-fields-default' option
928are displayed. If it isn't set, then the variable `mh-invisible-headers' 1026are hidden, although you can check off any field that you would like to see.
929determines the header fields that are removed." 1027Header fields that you would like to hide that aren't listed can be added to
1028the `mh-invisible-header-fields' option."
930 :type 'boolean 1029 :type 'boolean
931 :group 'mh-show) 1030 :group 'mh-show)
932 1031
@@ -960,19 +1059,28 @@ question."
960 :type 'boolean 1059 :type 'boolean
961 :group 'mh-show) 1060 :group 'mh-show)
962 1061
963(defcustom mh-fetch-x-image-url nil 1062(defcustom mh-fetch-x-image-url 'ask
964 "Control fetching of X-Image-URL header field image. 1063 "*Control fetching of `X-Image-URL:' header field image.
965This setting only has effect if `mh-show-use-xface-flag' is non-nil. 1064If set to \"Always fetch\" (t), the image is always fetched. You probably want
1065to avoid this setting for privacy and DOS (denial of service) reasons. For
1066example, fetching a URL can tip off a spammer that you've read his email.
1067Someone may also flood your network and fill your disk drive by sending a
1068torrent of messages, each specifying a unique URL to a very large file.
1069
1070If set to \"Ask before fetching\" ('ask), you are prompted before the image is
1071fetched. MH-E will remember your reply and will either use the already fetched
1072image the next time the same URL is encountered or silently skip it if you
1073didn't fetch it the first time. This is the default.
966 1074
967If set to t, the image is fetched. 1075If set to \"Never fetch\" (nil), images are never fetched and only displayed
1076if they are already present in the cache.
968 1077
969If set to 'ask, the user is prompted before the image is fetched. MH-E will 1078The cache of images is found in the directory `.mhe-x-image-cache' within your
970remember your reply and will either use the already fetched image the next time 1079MH directory. To see how you can add your own face to the `From:' field, see
971the same URL is encountered or silently skip it if you didn't fetch it the 1080`mh-x-face-file'.
972first time. 1081
1082This setting only has effect if `mh-show-use-xface-flag' is non-nil."
973 1083
974If set to nil, the default, images are not fetched and only displayed if they
975are already present in the cache."
976 :type '(choice (const :tag "Always fetch" t) 1084 :type '(choice (const :tag "Always fetch" t)
977 (const :tag "Ask before fetching" ask) 1085 (const :tag "Ask before fetching" ask)
978 (const :tag "Never fetch" nil)) 1086 (const :tag "Never fetch" nil))
@@ -1002,28 +1110,8 @@ The gnus method uses a different color for each indentation."
1002 (const :tag "Don't fontify" nil)) 1110 (const :tag "Don't fontify" nil))
1003 :group 'mh-show) 1111 :group 'mh-show)
1004 1112
1005(defvar mh-invisible-headers nil
1006 "*Regexp matching lines in a message header that are not to be shown.
1007Customize the variable `mh-invisible-header-fields' to generate this variable;
1008It will in turn automatically use the function `mh-invisible-headers' to
1009generate this variable.
1010If the variable `mh-visible-headers' is non-nil, it is used instead to specify
1011what to keep.")
1012
1013(defun mh-invisible-headers ()
1014 "Make or remake the variable `mh-invisible-headers'.
1015Done using `mh-invisible-header-fields' as input."
1016 (if mh-invisible-header-fields
1017 (setq mh-invisible-headers
1018 (concat
1019 "^"
1020 (let ((max-specpdl-size 1000) ;workaround for insufficient default
1021 (fields mh-invisible-header-fields))
1022 (regexp-opt fields t))))
1023 (setq mh-invisible-headers nil)))
1024
1025;; Keep fields alphabetized. Mention source, if known. 1113;; Keep fields alphabetized. Mention source, if known.
1026(defcustom mh-invisible-header-fields 1114(defvar mh-invisible-header-fields-internal
1027 '("Approved:" 1115 '("Approved:"
1028 "Autoforwarded:" 1116 "Autoforwarded:"
1029 "Bestservhost:" 1117 "Bestservhost:"
@@ -1053,12 +1141,13 @@ Done using `mh-invisible-header-fields' as input."
1053 "Old-Return-Path:" 1141 "Old-Return-Path:"
1054 "Original-Encoded-Information-Types:" ; X400 1142 "Original-Encoded-Information-Types:" ; X400
1055 "Original-Lines:" ; mail to news 1143 "Original-Lines:" ; mail to news
1056 "Original-Newsgroups:" ; mail to news
1057 "Original-NNTP-" ; mail to news 1144 "Original-NNTP-" ; mail to news
1145 "Original-Newsgroups:" ; mail to news
1058 "Original-Path:" ; mail to news 1146 "Original-Path:" ; mail to news
1059 "Original-Received:" ; mail to news 1147 "Original-Received:" ; mail to news
1060 "Original-To:" ; mail to news 1148 "Original-To:" ; mail to news
1061 "Original-X-" ; mail to news 1149 "Original-X-" ; mail to news
1150 "Originator:"
1062 "P1-Content-Type:" ; X400 1151 "P1-Content-Type:" ; X400
1063 "P1-Message-Id:" ; X400 1152 "P1-Message-Id:" ; X400
1064 "P1-Recipient:" ; X400 1153 "P1-Recipient:" ; X400
@@ -1074,13 +1163,17 @@ Done using `mh-invisible-header-fields' as input."
1074 "Return-Path:" ; RFC 822 1163 "Return-Path:" ; RFC 822
1075 "Sensitivity:" ; MS Outlook 1164 "Sensitivity:" ; MS Outlook
1076 "Status:" ; sendmail 1165 "Status:" ; sendmail
1166 "Thread-"
1077 "Ua-Content-Id:" ; X400 1167 "Ua-Content-Id:" ; X400
1078;; "User-Agent:" ; Similar to X-Mailer, so display it. 1168;; "User-Agent:" ; Similar to X-Mailer, so display it.
1079 "Via:" ; MH 1169 "Via:" ; MH
1080 "X-Abuse-Info:" 1170 "X-Abuse-Info:"
1171 "X-Abuse-and-DMCA-"
1081 "X-Accept-Language:" 1172 "X-Accept-Language:"
1082 "X-Accept-Language:" ; Netscape/Mozilla 1173 "X-Accept-Language:" ; Netscape/Mozilla
1083 "X-Ack:" 1174 "X-Ack:"
1175 "X-Administrivia-To:"
1176 "X-AntiAbuse:" ; cPanel
1084 "X-Apparently-From:" ; MS Outlook 1177 "X-Apparently-From:" ; MS Outlook
1085 "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager 1178 "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager
1086 "X-Authentication-Warning:" ; sendmail 1179 "X-Authentication-Warning:" ; sendmail
@@ -1088,13 +1181,18 @@ Done using `mh-invisible-header-fields' as input."
1088 "X-Bogosity:" ; bogofilter 1181 "X-Bogosity:" ; bogofilter
1089 "X-Complaints-To:" 1182 "X-Complaints-To:"
1090 "X-Cron-Env:" 1183 "X-Cron-Env:"
1184 "X-DMCA"
1091 "X-Delivered" 1185 "X-Delivered"
1186 "X-ELNK-Trace:" ; Earthlink mailer
1187 "X-Envelope-Date:" ; GNU mailutils
1188 "X-Envelope-From:"
1092 "X-Envelope-Sender:" 1189 "X-Envelope-Sender:"
1093 "X-Envelope-To:" 1190 "X-Envelope-To:"
1094 "X-Face:" 1191 "X-Face:"
1095 "X-Folder:" ; Spam 1192 "X-Folder:" ; Spam
1096 "X-From-Line" 1193 "X-From-Line"
1097 "X-Gnus-Mail-Source:" ; gnus 1194 "X-Gnus-Mail-Source:" ; gnus
1195 "X-Greylist:" ; milter-greylist-1.2.1
1098 "X-Habeas-SWE-1:" ; Spam 1196 "X-Habeas-SWE-1:" ; Spam
1099 "X-Habeas-SWE-2:" ; Spam 1197 "X-Habeas-SWE-2:" ; Spam
1100 "X-Habeas-SWE-3:" ; Spam 1198 "X-Habeas-SWE-3:" ; Spam
@@ -1104,27 +1202,35 @@ Done using `mh-invisible-header-fields' as input."
1104 "X-Habeas-SWE-7:" ; Spam 1202 "X-Habeas-SWE-7:" ; Spam
1105 "X-Habeas-SWE-8:" ; Spam 1203 "X-Habeas-SWE-8:" ; Spam
1106 "X-Habeas-SWE-9:" ; Spam 1204 "X-Habeas-SWE-9:" ; Spam
1205 "X-Image-URL:" ; URL equivalent of X-Face and Face
1107 "X-Info:" ; NTMail 1206 "X-Info:" ; NTMail
1108 "X-Juno-" ; Juno 1207 "X-Juno-" ; Juno
1109 "X-List-Host:" ; Unknown mailing list managers 1208 "X-List-Host:" ; Unknown mailing list managers
1110 "X-List-Subscribe:" ; Unknown mailing list managers 1209 "X-List-Subscribe:" ; Unknown mailing list managers
1111 "X-List-Unsubscribe:" ; Unknown mailing list managers 1210 "X-List-Unsubscribe:" ; Unknown mailing list managers
1211 "X-Listprocessor-" ; ListProc(tm) by CREN
1112 "X-Listserver:" ; Unknown mailing list managers 1212 "X-Listserver:" ; Unknown mailing list managers
1113 "X-Loop:" ; Unknown mailing list managers 1213 "X-Loop:" ; Unknown mailing list managers
1214 "X-MHE-Checksum" ; Checksum added during index search
1114 "X-MIME-Autoconverted:" ; sendmail 1215 "X-MIME-Autoconverted:" ; sendmail
1115 "X-MIMETrack:" 1216 "X-MIMETrack:"
1116 "X-MS-TNEF-Correlator:" ; MS Outlook 1217 "X-Mms-" ; T-Mobile pictures
1218 "X-MS-" ; MS Outlook
1219 "X-MailScanner" ; ListProc(tm) by CREN
1117 "X-Mailing-List:" ; Unknown mailing list managers 1220 "X-Mailing-List:" ; Unknown mailing list managers
1118 "X-Mailman-Version:" ; Mailman mailing list manager 1221 "X-Mailman-Version:" ; Mailman mailing list manager
1119 "X-Majordomo:" ; Majordomo mailing list manager 1222 "X-Majordomo:" ; Majordomo mailing list manager
1120 "X-Message-Id" 1223 "X-Message-Id"
1121 "X-MHE-Checksum" ; Checksum added during index search 1224 "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
1122 "X-MimeOLE:" ; MS Outlook 1225 "X-MimeOLE:" ; MS Outlook
1123 "X-Mozilla-Status:" ; Netscape/Mozilla 1226 "X-Mozilla-Status:" ; Netscape/Mozilla
1124 "X-Msmail-" ; MS Outlook 1227 "X-Msmail-" ; MS Outlook
1228 "X-NAI-Spam-" ; Network Associates Inc. SpamKiller
1125 "X-News:" ; News 1229 "X-News:" ; News
1126 "X-No-Archive:" 1230 "X-No-Archive:"
1127 "X-Notes-Item:" ; Lotus Notes Domino structured header 1231 "X-Notes-Item:" ; Lotus Notes Domino structured header
1232 "X-OperatingSystem:"
1233 ;;"X-Operator:" ; Similar to X-Mailer, so display it
1128 "X-Orcl-Content-Type:" 1234 "X-Orcl-Content-Type:"
1129 "X-Original-Complaints-To:" 1235 "X-Original-Complaints-To:"
1130 "X-Original-Date:" ; SourceForge mailing list manager 1236 "X-Original-Date:" ; SourceForge mailing list manager
@@ -1132,8 +1238,10 @@ Done using `mh-invisible-header-fields' as input."
1132 "X-Original-Trace:" 1238 "X-Original-Trace:"
1133 "X-OriginalArrivalTime:" ; Hotmail 1239 "X-OriginalArrivalTime:" ; Hotmail
1134 "X-Originating-IP:" ; Hotmail 1240 "X-Originating-IP:" ; Hotmail
1241 "X-Postfilter:"
1135 "X-Priority:" ; MS Outlook 1242 "X-Priority:" ; MS Outlook
1136 "X-Qotd-" ; User added 1243 "X-Qotd-" ; User added
1244 "X-RM"
1137 "X-Received-Date:" 1245 "X-Received-Date:"
1138 "X-Received:" 1246 "X-Received:"
1139 "X-Request-" 1247 "X-Request-"
@@ -1141,38 +1249,108 @@ Done using `mh-invisible-header-fields' as input."
1141 "X-SBNote:" ; Spam 1249 "X-SBNote:" ; Spam
1142 "X-SBPass:" ; Spam 1250 "X-SBPass:" ; Spam
1143 "X-SBRule:" ; Spam 1251 "X-SBRule:" ; Spam
1252 "X-SMTP-"
1144 "X-Scanned-By" 1253 "X-Scanned-By"
1145 "X-Sender:" 1254 "X-Sender:"
1146 "X-Server-Date:" 1255 "X-Server-Date:"
1147 "X-Server-Uuid:" 1256 "X-Server-Uuid:"
1148 "X-Sieve:" ; Sieve filtering 1257 "X-Sieve:" ; Sieve filtering
1149 "X-Spam-Checker-Version:" ; Spamassassin 1258 "X-Source"
1150 "X-Spam-Level:" ; Spamassassin 1259 "X-Spam-" ; Spamassassin
1151 "X-Spam-Score:" ; Spamassassin
1152 "X-Spam-Status:" ; Spamassassin
1153 "X-SpamBouncer:" ; Spam 1260 "X-SpamBouncer:" ; Spam
1261 "X-Status"
1262 "X-Submissions-To:"
1263 "X-Telecom-Digest"
1154 "X-Trace:" 1264 "X-Trace:"
1265 "X-UID"
1155 "X-UIDL:" 1266 "X-UIDL:"
1156 "X-UserInfo1:" 1267 "X-UserInfo1:"
1157 "X-VSMLoop:" ; NTMail 1268 "X-VSMLoop:" ; NTMail
1158 "X-Vms-To:" 1269 "X-Vms-To:"
1270 "X-WebTV-Signature:"
1159 "X-Wss-Id:" ; Worldtalk gateways 1271 "X-Wss-Id:" ; Worldtalk gateways
1272 "X-Yahoo"
1160 "X-eGroups-" ; Egroups/yahoogroups mailing list manager 1273 "X-eGroups-" ; Egroups/yahoogroups mailing list manager
1161 "X-pgp:" 1274 "X-pgp:"
1162 "X-submission-address:" 1275 "X-submission-address:"
1163 "X400-" ; X400 1276 "X400-" ; X400
1164 "Xref:") 1277 "Xref:")
1165"*List of header fields that are not to be shown. 1278 "List of default header fields that are not to be shown.
1166Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, 1279Do not alter this variable directly. Instead, add entries from here that you
1167the element can be used to render invisible an entire class of fields that 1280would like to be displayed in `mh-invisible-header-fields-default'
1168start with the same prefix. 1281and add entries to hide in `mh-invisible-header-fields'.")
1169This variable is ignored if the variable `mh-visible-headers' is set." 1282
1283(defvar mh-invisible-header-fields-compiled nil
1284 "*Regexp matching lines in a message header that are not to be shown.
1285Do not alter this variable directly. Instead, customize
1286`mh-invisible-header-fields-default' checking for fields normally
1287hidden that you wish to display, and add extra entries to hide in
1288`mh-invisible-header-fields'.")
1289
1290(defun mh-invisible-headers ()
1291 "Make or remake the variable `mh-invisible-header-fields-compiled'.
1292Done using `mh-invisible-header-fields-internal' as input, from which entries
1293from `mh-invisible-header-fields-default' are removed and entries
1294from `mh-invisible-header-fields' are added."
1295 (let ((fields mh-invisible-header-fields-internal))
1296 (when mh-invisible-header-fields-default
1297 ;; Remove entries from `mh-invisible-header-fields-default'
1298 (setq fields
1299 (loop for x in fields
1300 unless (member x mh-invisible-header-fields-default)
1301 collect x)))
1302 (when (and (boundp 'mh-invisible-header-fields)
1303 mh-invisible-header-fields)
1304 (dolist (x mh-invisible-header-fields)
1305 (unless (member x fields) (setq fields (cons x fields)))))
1306 (if fields
1307 (setq mh-invisible-header-fields-compiled
1308 (concat
1309 "^"
1310 ;; workaround for insufficient default
1311 (let ((max-specpdl-size 1000))
1312 (regexp-opt fields t))))
1313 (setq mh-invisible-header-fields-compiled nil))))
1314
1315(defcustom mh-invisible-header-fields-default nil
1316 "*List of hidden header fields.
1317The header fields listed in this option are hidden, although you can check off
1318any field that you would like to see. Header fields that you would like to
1319hide that aren't listed can be added to the `mh-invisible-header-fields'
1320option.
1321
1322See also `mh-clean-message-header-flag'."
1323 :type `(set ,@(mapcar (lambda (x) `(const ,x))
1324 mh-invisible-header-fields-internal))
1325 :set (lambda (symbol value)
1326 (set-default symbol value)
1327 (mh-invisible-headers))
1328 :group 'mh-show)
1329
1330(defcustom mh-invisible-header-fields nil
1331 "*Additional header fields to hide.
1332Header fields that you would like to hide that aren't listed in
1333`mh-invisible-header-fields-default' can be added to this option with a couple
1334of caveats. Regular expressions are not allowed. Unique fields should have a
1335`:' suffix; otherwise, the element can be used to render invisible an entire
1336class of fields that start with the same prefix.
1337
1338See also `mh-clean-message-header-flag'."
1339
1170 :type '(repeat (string :tag "Header field")) 1340 :type '(repeat (string :tag "Header field"))
1171 :set (lambda (symbol value) 1341 :set (lambda (symbol value)
1172 (set-default symbol value) 1342 (set-default symbol value)
1173 (mh-invisible-headers)) 1343 (mh-invisible-headers))
1174 :group 'mh-show) 1344 :group 'mh-show)
1175 1345
1346(defcustom mh-lpr-command-format "lpr -J '%s'"
1347 "*Format for Unix command that prints a message.
1348The string should be a Unix command line, with the string '%s' where
1349the job's name (folder and message number) should appear. The formatted
1350message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
1351 :type 'string
1352 :group 'mh-show)
1353
1176(defcustom mh-max-inline-image-height nil 1354(defcustom mh-max-inline-image-height nil
1177 "*Maximum inline image height if Content-Disposition is not present. 1355 "*Maximum inline image height if Content-Disposition is not present.
1178If nil, image will be displayed if its height is smaller than the height of 1356If nil, image will be displayed if its height is smaller than the height of
@@ -1187,6 +1365,27 @@ window."
1187 :type '(choice (const nil) integer) 1365 :type '(choice (const nil) integer)
1188 :group 'mh-show) 1366 :group 'mh-show)
1189 1367
1368(defcustom mh-mime-save-parts-default-directory t
1369 "Default directory to use for `mh-mime-save-parts'.
1370If nil, prompt and set for next time the command is used during same session.
1371If t, prompt always"
1372 :type '(choice (const :tag "Prompt the first time" nil)
1373 (const :tag "Prompt always" t)
1374 directory)
1375 :group 'mh-show)
1376
1377(defcustom mh-print-background-flag nil
1378 "*Non-nil means messages should be printed in the background.
1379WARNING: do not delete the messages until printing is finished;
1380otherwise, your output may be truncated."
1381 :type 'boolean
1382 :group 'mh-show)
1383
1384(defcustom mh-recursive-folders-flag nil
1385 "*Non-nil means that commands which operate on folders do so recursively."
1386 :type 'boolean
1387 :group 'mh-show)
1388
1190(defcustom mh-show-maximum-size 0 1389(defcustom mh-show-maximum-size 0
1191 "*Maximum size of message (in bytes) to display automatically. 1390 "*Maximum size of message (in bytes) to display automatically.
1192Provides an opportunity to skip over large messages which may be slow to load. 1391Provides an opportunity to skip over large messages which may be slow to load.
@@ -1194,6 +1393,14 @@ Use a value of 0 to display all messages automatically regardless of size."
1194 :type 'integer 1393 :type 'integer
1195 :group 'mh-show) 1394 :group 'mh-show)
1196 1395
1396(defcustom mh-show-threads-flag nil
1397 "Non-nil means new folders start in threaded mode.
1398Threading large number of messages can be time consuming. So if the flag is
1399non-nil then threading will be done only if the number of messages being
1400threaded is less than `mh-large-folder'."
1401 :type 'boolean
1402 :group 'mh-show)
1403
1197;; Use goto-addr if it was already loaded (which probably sets this 1404;; Use goto-addr if it was already loaded (which probably sets this
1198;; variable to t), or if this variable is otherwise set to t. 1405;; variable to t), or if this variable is otherwise set to t.
1199(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p) 1406(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
@@ -1205,80 +1412,55 @@ The `goto-addr' module is used."
1205 1412
1206(defcustom mh-show-use-xface-flag (>= emacs-major-version 21) 1413(defcustom mh-show-use-xface-flag (>= emacs-major-version 21)
1207 "*Non-nil means display face images in `mh-show-mode'. 1414 "*Non-nil means display face images in `mh-show-mode'.
1208This flag controls the display of three kinds of faces. 1415
1209 1416MH-E can display the content of `Face:', `X-Face:', and `X-Image-URL:' header
1210The first is the traditional X-Face header field. For GNU Emacs 21 1417fields. If any of these fields occur in the header of your message, the
1211and above, the `uncompface' binary is required to be in the execute 1418sender's face will appear in the `From:' header field. If more than one of
1212PATH for the display of X-Face images. It can be obtained from 1419these fields appear, then the first field found in the order `Face:',
1213ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. 1420`X-Face:', and `X-Image-URL:' will be used. Note that versions of GNU Emacs
1214 1421prior to 21.1 don't support the display of inline images, so face images are
1215If the XEmacs you are using has internal support for X-Face images, then MH-E 1422not displayed in these versions.
1216will display X-Face images in XEmacs \"out of the box\". Even if you don't have 1423
1217X-Face support compiled into your XEmacs, you can still see the X-Face images 1424The option `mh-show-use-xface-flag' is used to turn this feature on and off.
1218in MH-E with the aid of an external x-face package and `uncompface'. It is 1425This feature will be turned on by default if your system supports it.
1219available from ftp://ftp.jpl.org/pub/elisp/. Download it, put its files in the 1426
1220`load-path' and MH-E will invoke it automatically. 1427The first header field used, if present, is the Gnus-specific `Face:' field.
1221 1428The `Face:' field appeared in GNU Emacs 21 and XEmacs. For more information,
1222Second, MH-E supports the display of the Gnus-specific Face 1429see http://quimby.gnus.org/circus/face/. Next is the traditional `X-Face:'
1223header field in GNU Emacs >= 21 and XEmacs. No external packages 1430header field. The display of this field requires the `uncompface' program
1224are required. More information about the Face header can be found 1431which can be obtained from
1225at: http://quimby.gnus.org/circus/face/. 1432ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. Recent versions of
1226 1433XEmacs have internal support for `X-Face:' images. If your version of XEmacs
1227Finally, MH-E can also display images from the X-Image-URL header field. The 1434does not, then you'll need both `uncompface' and the x-face package which is
1228display of the images requires the `wget' program, available from 1435available at ftp://ftp.jpl.org/pub/elisp/.
1229http://www.gnu.org/software/wget/wget.html, to fetch the image and the 1436
1230`convert' program from the ImageMagick suite, available from 1437Finally, MH-E will display images referenced by the `X-Image-URL:' header
1438field if neither the `Face:' nor the `X-Face:' fields are present. The display
1439of the images requires `wget' (available from
1440http://www.gnu.org/software/wget/wget.html), `fetch', or `curl' to fetch the
1441image and the `convert' program from the ImageMagick suite, available from
1231http://www.imagemagick.org/. Of the three header fields this is the most 1442http://www.imagemagick.org/. Of the three header fields this is the most
1232efficient in terms of network usage since the image doesn't need to be 1443efficient in terms of network usage since the image doesn't need to be
1233transmitted with every single mail. However its display needs the recipient to 1444transmitted with every single mail.
1234fetch a URL and this can be misused. So it is disabled by default. It can be
1235enabled by customizing `mh-fetch-x-image-url'. Setting that to ask for
1236confirmation before fetching seems like a good choice.
1237 1445
1238Versions of GNU Emacs prior to 21.1 don't support the display of 1446The option `mh-fetch-x-image-url' controls the fetching of the `X-Image-URL:'
1239inline images. So face images are not displayed in these versions." 1447header field image."
1240 :type 'boolean 1448 :type 'boolean
1241 :group 'mh-show) 1449 :group 'mh-show)
1242 1450
1451(defcustom mh-store-default-directory nil
1452 "*Last directory used by \\[mh-store-msg]; default for next store.
1453A directory name string, or nil to use current directory."
1454 :type '(choice (const :tag "Current" nil)
1455 directory)
1456 :group 'mh-show)
1457
1243(defcustom mh-summary-height nil 1458(defcustom mh-summary-height nil
1244 "*Number of lines in MH-Folder window (including the mode line)." 1459 "*Number of lines in MH-Folder window (including the mode line)."
1245 :type '(choice (const :tag "Automatic" nil) 1460 :type '(choice (const :tag "Automatic" nil)
1246 (integer :tag "Fixed sized")) 1461 (integer :tag "Fixed sized"))
1247 :group 'mh-show) 1462 :group 'mh-show)
1248 1463
1249(defvar mh-visible-headers nil
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.
1254Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
1255the variable `mh-invisible-headers'.")
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))
1280 :group 'mh-show)
1281
1282(defcustom mhl-formfile nil 1464(defcustom mhl-formfile nil
1283 "*Name of format file to be used by mhl to show and print messages. 1465 "*Name of format file to be used by mhl to show and print messages.
1284A value of t means use the default format file. 1466A value of t means use the default format file.
@@ -1292,387 +1474,489 @@ the message continues to conform to RFC 822 and MH-E can parse the headers."
1292 1474
1293 1475
1294 1476
1295;;; Composing messages (:group 'mh-letter) 1477;;; The Speedbar (:group 'mh-speed)
1296
1297(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
1298 "Use either 'gnus or 'mhn to insert MIME message directives in messages."
1299 :type '(choice (const :tag "Use Gnus" gnus)
1300 (const :tag "Use mhn" mhn))
1301 :group 'mh-letter)
1302
1303(defcustom mh-compose-letter-function nil
1304 "Invoked when setting up a letter draft.
1305It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
1306 :type '(choice (const nil) function)
1307 :group 'mh-letter)
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
1326(defcustom mh-delete-yanked-msg-window-flag nil
1327 "*Non-nil means delete any window displaying the message.
1328Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1329If non-nil, yanking the current message into a draft letter deletes any
1330windows displaying the message."
1331 :type 'boolean
1332 :group 'mh-letter)
1333
1334(defcustom mh-extract-from-attribution-verb "wrote:"
1335 "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
1336 :type '(choice (const "wrote:")
1337 (const "a écrit :")
1338 (string :tag "Custom string"))
1339 :group 'mh-letter)
1340 1478
1341(defcustom mh-forward-subject-format "%s: %s" 1479(defcustom mh-large-folder 200
1342 "*Format to generate the Subject: line contents for a forwarded message. 1480 "The number of messages that indicates a large folder.
1343The two string arguments to the format are the sender of the original 1481If a folder is deemed to be large, that is the number of messages in it exceed
1344message and the original subject line." 1482this value, then confirmation is needed when it is visited. Even when
1345 :type 'string 1483`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
1346 :group 'mh-letter) 1484it is large. If set to nil all folders are treated as if they are small."
1347 1485 :type '(choice (const :tag "No limit") integer)
1348(defcustom mh-ins-buf-prefix "> " 1486 :group 'mh-speed)
1349 "*String to put before each non-blank line of a yanked or inserted message.
1350\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
1351by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
1352 :type 'string
1353 :group 'mh-letter)
1354
1355(defcustom mh-insert-x-mailer-flag t
1356 "*Non-nil means append an X-Mailer field to the header."
1357 :type 'boolean
1358 :group 'mh-letter)
1359
1360(defcustom mh-letter-complete-function 'ispell-complete-word
1361 "*Function to call when completing outside of fields specific to aliases."
1362 :type '(choice function (const nil))
1363 :group 'mh-letter)
1364 1487
1365(defcustom mh-letter-fill-column 72 1488(defcustom mh-speed-flists-interval 60
1366 "*Fill column to use in `mh-letter-mode'. 1489 "Time between calls to flists in seconds.
1367This is usually less than in other text modes because email messages get 1490If 0, flists is not called repeatedly."
1368quoted by some prefix (sometimes many times) when they are replied to,
1369and it's best to avoid quoted lines that span more than 80 columns."
1370 :type 'integer 1491 :type 'integer
1371 :group 'mh-letter) 1492 :group 'mh-speed)
1372
1373(defcustom mh-reply-default-reply-to nil
1374 "*Sets the person or persons to whom a reply will be sent.
1375If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
1376value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
1377The values \"cc\" and \"all\" do the same thing."
1378 :type '(choice (const :tag "Prompt" nil)
1379 (const "from") (const "to")
1380 (const "cc") (const "all"))
1381 :group 'mh-letter)
1382
1383(defcustom mh-reply-show-message-flag t
1384 "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
1385 1493
1386The setting of this variable determines whether the MH `show-buffer' is 1494(defcustom mh-speed-run-flists-flag t
1387displayed with the current message when using `mh-reply' without a prefix 1495 "Non-nil means flists is used.
1388argument. Set it to nil if you already include the message automatically 1496If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
1389in your draft using 1497update the display of the number of unseen and total messages in each folder.
1390 repl: -filter repl.filter 1498If resources are limited, this can be set to nil and the speedbar display can
1391in your ~/.mh_profile file." 1499be updated manually with the \\[mh-speed-flists] command."
1392 :type 'boolean 1500 :type 'boolean
1393 :group 'mh-letter) 1501 :group 'mh-speed)
1394
1395(defcustom mh-signature-file-name "~/.signature"
1396 "*Name of file containing the user's signature.
1397Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
1398 :type 'file
1399 :group 'mh-letter)
1400
1401(defcustom mh-x-face-file "~/.face"
1402 "*File containing X-Face or Face header field to insert in outgoing mail.
1403
1404If the file starts with either of the strings \"X-Face: \", \"Face: \" or
1405\"X-Image-URL: \" then it is assumed to contain the whole field and is added to
1406the message header verbatim. Otherwise it is assumed that the file contains the
1407value of the X-Face header field.
1408
1409X-Face header fields can be generated using `compface', which can be obtained
1410from ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. The \"Online
1411X-Face Convertor\" at http://www.dairiki.org/xface/ is a useful resource for
1412quick conversion of images into X-Face header fields.
1413
1414There is a `make-face' script that converts a jpeg image to a Face header
1415field at http://quimby.gnus.org/circus/face/make-face.
1416
1417The URL of any image can be used for the X-Image-URL field and no processing
1418of the image is required.
1419 1502
1420If nil, or the file does not exist, nothing is added to the message header." 1503
1421 :type 'file
1422 :group 'mh-letter)
1423 1504
1424(defcustom mh-yank-from-start-of-msg 'attribution 1505;;; The Toolbar (:group 'mh-toolbar)
1425 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1426If t, include the entire message, with full headers. This is historically
1427here for use with supercite, but is now deprecated in favor of the setting
1428`supercite' below.
1429 1506
1430If the symbol `body', then yank the message minus the header. 1507(defcustom mh-tool-bar-search-function 'mh-search-folder
1508 "*Function called by the tool-bar search button.
1509See `mh-search-folder' and `mh-index-search' for details."
1510 :type '(choice (const mh-search-folder)
1511 (const mh-index-search)
1512 (function :tag "Other function"))
1513 :group 'mh-toolbar)
1431 1514
1432If the symbol `supercite', include the entire message, with full headers. 1515;; Functions called from the tool bar
1433This also causes the invocation of `sc-cite-original' without the setting 1516(defun mh-tool-bar-search (&optional arg)
1434of `mail-citation-hook', now deprecated practice. 1517 "Interactively call `mh-tool-bar-search-function'.
1518Optional argument ARG is not used."
1519 (interactive "P")
1520 (call-interactively mh-tool-bar-search-function))
1435 1521
1436If the symbol `autosupercite', do as for `supercite' automatically when 1522(defun mh-tool-bar-customize ()
1437show buffer matches the message being replied-to. When this option is used, 1523 "Call `mh-customize' from the toolbar."
1438the -noformat switch is passed to the repl program to override a -filter or 1524 (interactive)
1439-format switch. 1525 (mh-customize t))
1440 1526
1441If the symbol `attribution', then yank the message minus the header and add 1527(defun mh-tool-bar-folder-help ()
1442a simple attribution line at the top. 1528 "Visit \"(mh-e)Top\"."
1529 (interactive)
1530 (Info-goto-node "(mh-e)Top")
1531 (delete-other-windows))
1443 1532
1444If the symbol `autoattrib', do as for `attribution' automatically when show 1533(defun mh-tool-bar-letter-help ()
1445buffer matches the message being replied-to. You can make sure this is 1534 "Visit \"(mh-e)Draft Editing\"."
1446always the case by setting `mh-reply-show-message-flag' to t (which is the 1535 (interactive)
1447default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such 1536 (Info-goto-node "(mh-e)Draft Editing")
1448that the show window is never displayed. When the `autoattrib' option is 1537 (delete-other-windows))
1449used, the -noformat switch is passed to the repl program to override a
1450-filter or -format switch.
1451 1538
1452If nil, yank only the portion of the message following the point. 1539(defmacro mh-tool-bar-reply-generator (function recipient folder-buffer-flag)
1540 "Generate FUNCTION that replies to RECIPIENT.
1541If FOLDER-BUFFER-FLAG is nil then the function generated
1542When INCLUDE-FLAG is non-nil, include message body being replied to."
1543 `(defun ,function (&optional arg)
1544 ,(format "Reply to \"%s\".\nWhen ARG is non-nil include message in reply."
1545 recipient)
1546 (interactive "P")
1547 ,(if folder-buffer-flag nil '(set-buffer mh-show-folder-buffer))
1548 (mh-reply (mh-get-msg-num nil) ,recipient arg)))
1453 1549
1454If the show buffer has a region, this variable is ignored unless its value is 1550(mh-tool-bar-reply-generator mh-tool-bar-reply-from "from" t)
1455one of `attribution' or `autoattrib' in which case the attribution is added 1551(mh-tool-bar-reply-generator mh-show-tool-bar-reply-from "from" nil)
1456to the yanked region." 1552(mh-tool-bar-reply-generator mh-tool-bar-reply-to "to" t)
1457 :type '(choice (const :tag "Below point" nil) 1553(mh-tool-bar-reply-generator mh-show-tool-bar-reply-to "to" nil)
1458 (const :tag "Without header" body) 1554(mh-tool-bar-reply-generator mh-tool-bar-reply-all "all" t)
1459 (const :tag "Invoke supercite" supercite) 1555(mh-tool-bar-reply-generator mh-show-tool-bar-reply-all "all" nil)
1460 (const :tag "Invoke supercite, automatically" autosupercite)
1461 (const :tag "Without header, with attribution" attribution)
1462 (const :tag "Without header, with attribution, automatically"
1463 autoattrib)
1464 (const :tag "Entire message with headers" t))
1465 :group 'mh-letter)
1466 1556
1467 1557;; XEmacs has a couple of extra customizations...
1558(mh-do-in-xemacs
1559 (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar)
1560 (featurep 'xpm)
1561 (device-on-window-system-p))
1562 t
1563 nil)
1564 "*If non-nil, use toolbar.
1468 1565
1469;;; Alias handling (:group 'mh-alias) 1566This will default to t if you are in an environment that supports
1567toolbars and xpm."
1568 :type 'boolean
1569 :group 'mh-toolbar)
1470 1570
1471(defcustom mh-alias-completion-ignore-case-flag t 1571 (defcustom mh-xemacs-toolbar-position (if mh-xemacs-use-toolbar-flag
1472 "*Non-nil means don't consider case significant in MH alias completion. 1572 'default
1473This is the default in plain MH, so it is the default here as well. It 1573 nil)
1474can be useful to set this to t if, for example, you use lowercase 1574 "*Where to put the toolbar.
1475aliases for people and uppercase for mailing lists."
1476 :type 'boolean
1477 :group 'mh-alias)
1478 1575
1479(defcustom mh-alias-expand-aliases-flag nil 1576Valid non-nil values are \"default\", \"top\", \"bottom\", \"left\",
1480 "*Non-nil means to expand aliases entered in the minibuffer. 1577\"right\". These match the four edges of the frame, with \"default\"
1481In other words, aliases entered in the minibuffer will be expanded to the full 1578meaning \"use the same position as the default-toolbar\".
1482address in the message draft. By default, this expansion is not performed."
1483 :type 'boolean
1484 :group 'mh-alias)
1485 1579
1486(defcustom mh-alias-flash-on-comma t 1580A nil value means do not use a toolbar.
1487 "*Specify whether to flash or warn on translation.
1488When a [comma] is pressed while entering aliases or addresses, setting this
1489variable to the following values has the listed effects:
1490t Flash alias translation but don't warn if there is no translation.
14911 Flash alias translation and warn if there is no translation.
1492nil Do not flash alias translation nor warn if there is no translation."
1493 :type '(choice (const :tag "Flash but don't warn if no translation" t)
1494 (const :tag "Flash and warn if no translation" 1)
1495 (const :tag "Don't flash nor warn if no translation" nil))
1496 :group 'mh-alias)
1497 1581
1498(defcustom mh-alias-insert-file nil 1582If this variable is set to anything other than \"default\" and the
1499 "*Filename to use to store new MH-E aliases. 1583default-toolbar has a different positional setting from the value of
1500This variable can also be a list of filenames, in which case MH-E will prompt 1584this variable, then two toolbars will be displayed. The MH-E toolbar
1501for one of them. If nil, the default, then MH-E will use the first file found 1585and the default-toolbar."
1502in the \"AliasFile\" component of the MH profile." 1586 :type '(radio (const :tag "Same position as the \"default-toolbar\""
1503 :type '(choice (const :tag "Use AliasFile MH profile component" nil) 1587 :value default)
1504 (file :tag "Alias file") 1588 (const :tag "Along the top edge of the frame"
1505 (repeat :tag "List of alias files" file)) 1589 :value top)
1506 :group 'mh-alias) 1590 (const :tag "Along the bottom edge of the frame"
1591 :value bottom)
1592 (const :tag "Along the left edge of the frame"
1593 :value left)
1594 (const :tag "Along the right edge of the frame"
1595 :value right)
1596 (const :tag "Don't use a toolbar" nil))
1597 :group 'mh-toolbar))
1507 1598
1508(defcustom mh-alias-insertion-location 'sorted 1599(defmacro mh-tool-bar-define (defaults &rest buttons)
1509 "Specifies where new aliases are entered in alias files. 1600 "Define a tool bar for MH-E.
1510Options are sorted alphabetically, at the top of the file or at the bottom." 1601DEFAULTS is the list of buttons that are present by default. It is a list of
1511 :type '(choice (const :tag "Sorted alphabetically" sorted) 1602lists where the sublists are of the following form:
1512 (const :tag "At the top of file" top)
1513 (const :tag "At the bottom of file" bottom))
1514 :group 'mh-alias)
1515 1603
1516(defcustom mh-alias-local-users t 1604 (:KEYWORD FUNC1 FUNC2 FUNC3 ...)
1517 "*If t, local users are completed in MH-E To: and Cc: prompts.
1518 1605
1519Users with a userid greater than some magic number (usually 200) are available 1606Here :KEYWORD is one of :folder or :letter. If it is :folder then the default
1520for completion. 1607buttons in the folder and show mode buffers are being specified. If it is
1608:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2,
1609FUNC3, ... are the names of the functions that the buttons would execute.
1521 1610
1522If you set this variable to a string, it will be executed to generate a 1611Each element of BUTTONS is a list consisting of four mandatory items and one
1523password file. A value of \"ypcat passwd\" is helpful if NIS is in use." 1612optional item as follows:
1524 :type '(choice (boolean) (string))
1525 :group 'mh-alias)
1526 1613
1527(defcustom mh-alias-local-users-prefix "local." 1614 (FUNCTION MODES ICON DOC &optional ENABLE-EXPR)
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 1615
1532For example, given the following passwd file line: 1616where,
1533 1617
1534 psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh 1618 FUNCTION is the name of the function that will be executed when the button
1619 is clicked.
1535 1620
1536here are the derived aliases for different values of this variable: 1621 MODES is a list of symbols. List elements must be from `folder', `letter' and
1622 `sequence'. If `folder' is present then the button is available in the
1623 folder and show buffer. If the name of FUNCTION is of the form \"mh-foo\",
1624 where foo is some arbitrary string, then we check if the function
1625 `mh-show-foo' exists. If it exists then that function is used in the show
1626 buffer. Otherwise the original function `mh-foo' is used in the show buffer
1627 as well. Presence of `sequence' is handled similar to the above. The only
1628 difference is that the button is shown only when the folder is narrowed to a
1629 sequence. If `letter' is present in MODES, then the button is available
1630 during draft editing and runs FUNCTION when clicked.
1537 1631
1538 \"local.\" -> local.peter.galbraith 1632 ICON is the icon that is drawn in the button.
1539 \"\" -> peter.galbraith
1540 nii -> psg
1541 1633
1542This variable is only meaningful if the variable `mh-alias-local-users' is 1634 DOC is the documentation for the button. It is used in tool-tips and in
1543non-nil." 1635 providing other help to the user. GNU Emacs uses only the first line of the
1544 :type '(choice (const :tag "Use username instead of real name" nil) 1636 string. So the DOC should be formatted such that the first line is useful and
1545 (string)) 1637 complete without the rest of the string.
1546 :group 'mh-alias)
1547 1638
1548(defcustom mh-alias-passwd-gecos-comma-separator-flag t 1639 Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates
1549 "*Non-nil means the gecos field in the passwd file uses comma as a separator. 1640 to nil, then the button is deactivated, otherwise it is active. If is in't
1550Used to construct aliases for users in the passwd file." 1641 present then the button is always active."
1551 :type 'boolean 1642 ;; The following variable names have been carefully chosen to make code
1552 :group 'mh-alias) 1643 ;; generation easier. Modifying the names should be done carefully.
1644 (let (folder-buttons folder-docs folder-button-setter sequence-button-setter
1645 show-buttons show-button-setter show-seq-button-setter
1646 letter-buttons letter-docs letter-button-setter
1647 folder-defaults letter-defaults
1648 folder-vectors show-vectors letter-vectors)
1649 (dolist (x defaults)
1650 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
1651 ((eq (car x) :letter) (setq letter-defaults (cdr x)))))
1652 (dolist (button buttons)
1653 (unless (and (listp button)
1654 (or (equal (length button) 4) (equal (length button) 5)))
1655 (error "Incorrect MH-E tool-bar button specification: %s" button))
1656 (let* ((name (nth 0 button))
1657 (name-str (symbol-name name))
1658 (icon (nth 2 button))
1659 (xemacs-icon (mh-do-in-xemacs
1660 (cdr (assoc (intern icon) mh-xemacs-icon-map))))
1661 (full-doc (nth 3 button))
1662 (doc (if (string-match "\\(.*\\)\n" full-doc)
1663 (match-string 1 full-doc)
1664 full-doc))
1665 (enable-expr (or (nth 4 button) t))
1666 (modes (nth 1 button))
1667 functions show-sym)
1668 (when (memq 'letter modes) (setq functions `(:letter ,name)))
1669 (when (or (memq 'folder modes) (memq 'sequence modes))
1670 (setq functions
1671 (append `(,(if (memq 'folder modes) :folder :sequence) ,name)
1672 functions))
1673 (setq show-sym
1674 (if (string-match "^mh-\\(.*\\)$" name-str)
1675 (intern (concat "mh-show-" (match-string 1 name-str)))
1676 name))
1677 (setq functions
1678 (append `(,(if (memq 'folder modes) :show :show-seq)
1679 ,(if (fboundp show-sym) show-sym name))
1680 functions)))
1681 (do ((functions functions (cddr functions)))
1682 ((null functions))
1683 (let* ((type (car functions))
1684 (function (cadr functions))
1685 (type1 (substring (symbol-name type) 1))
1686 (vector-list (cond ((eq type :show) 'show-vectors)
1687 ((eq type :show-seq) 'show-vectors)
1688 ((eq type :letter) 'letter-vectors)
1689 (t 'folder-vectors)))
1690 (list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons)
1691 (t 'mh-tool-bar-folder-buttons)))
1692 (key (intern (concat "mh-" type1 "toolbar-" name-str)))
1693 (setter (intern (concat type1 "-button-setter")))
1694 (mbuttons (cond ((eq type :letter) 'letter-buttons)
1695 ((eq type :show) 'show-buttons)
1696 ((eq type :show-seq) 'show-buttons)
1697 (t 'folder-buttons)))
1698 (docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
1699 ((eq mbuttons 'folder-buttons) 'folder-docs))))
1700 (add-to-list vector-list `[,xemacs-icon ,function t ,full-doc])
1701 (add-to-list
1702 setter `(when (member ',name ,list)
1703 (mh-funcall-if-exists
1704 tool-bar-add-item ,icon ',function ',key
1705 :help ,doc :enable ',enable-expr)))
1706 (add-to-list mbuttons name)
1707 (if docs (add-to-list docs doc))))))
1708 (setq folder-buttons (nreverse folder-buttons)
1709 letter-buttons (nreverse letter-buttons)
1710 show-buttons (nreverse show-buttons)
1711 letter-docs (nreverse letter-docs)
1712 folder-docs (nreverse folder-docs)
1713 folder-vectors (nreverse folder-vectors)
1714 show-vectors (nreverse show-vectors)
1715 letter-vectors (nreverse letter-vectors))
1716 (dolist (x folder-defaults)
1717 (unless (memq x folder-buttons)
1718 (error "Folder defaults contains unknown button '%s'" x)))
1719 (dolist (x letter-defaults)
1720 (unless (memq x letter-buttons)
1721 (error "Letter defaults contains unknown button '%s'" x)))
1722 `(eval-when (compile load eval)
1723 (defvar mh-folder-tool-bar-map nil)
1724 (defvar mh-folder-seq-tool-bar-map nil)
1725 (defvar mh-show-tool-bar-map nil)
1726 (defvar mh-show-seq-tool-bar-map nil)
1727 (defvar mh-letter-tool-bar-map nil)
1728 ;; GNU Emacs tool bar specific code
1729 (mh-do-in-gnu-emacs
1730 ;; Custom setter functions
1731 (defun mh-tool-bar-folder-buttons-set (symbol value)
1732 "Construct toolbar for `mh-folder-mode' and `mh-show-mode'."
1733 (set-default symbol value)
1734 (setq mh-folder-tool-bar-map
1735 (let ((tool-bar-map (make-sparse-keymap)))
1736 ,@(nreverse folder-button-setter)
1737 tool-bar-map))
1738 (setq mh-show-tool-bar-map
1739 (let ((tool-bar-map (make-sparse-keymap)))
1740 ,@(nreverse show-button-setter)
1741 tool-bar-map))
1742 (setq mh-show-seq-tool-bar-map
1743 (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
1744 ,@(nreverse show-seq-button-setter)
1745 tool-bar-map))
1746 (setq mh-folder-seq-tool-bar-map
1747 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
1748 ,@(nreverse sequence-button-setter)
1749 tool-bar-map)))
1750 (defun mh-tool-bar-letter-buttons-set (symbol value)
1751 "Construct toolbar for `mh-letter-mode'."
1752 (set-default symbol value)
1753 (setq mh-letter-tool-bar-map
1754 (let ((tool-bar-map (make-sparse-keymap)))
1755 ,@(nreverse letter-button-setter)
1756 tool-bar-map))))
1757 ;; XEmacs specific code
1758 (mh-do-in-xemacs
1759 (defvar mh-toolbar-folder-vector-map
1760 ',(loop for button in folder-buttons
1761 for vector in folder-vectors
1762 collect (cons button vector)))
1763 (defvar mh-toolbar-show-vector-map
1764 ',(loop for button in show-buttons
1765 for vector in show-vectors
1766 collect (cons button vector)))
1767 (defvar mh-toolbar-letter-vector-map
1768 ',(loop for button in letter-buttons
1769 for vector in letter-vectors
1770 collect (cons button vector)))
1771 (defvar mh-toolbar-folder-buttons nil)
1772 (defvar mh-toolbar-show-buttons nil)
1773 (defvar mh-toolbar-letter-buttons nil)
1774 ;; Custom setter functions
1775 (defun mh-tool-bar-letter-buttons-set (symbol value)
1776 (set-default symbol value)
1777 (when mh-xemacs-has-toolbar-flag
1778 (setq mh-toolbar-letter-buttons
1779 (loop for b in value
1780 collect (cdr (assoc b mh-toolbar-letter-vector-map))))))
1781 (defun mh-tool-bar-folder-buttons-set (symbol value)
1782 (set-default symbol value)
1783 (when mh-xemacs-has-toolbar-flag
1784 (setq mh-toolbar-folder-buttons
1785 (loop for b in value
1786 collect (cdr (assoc b mh-toolbar-folder-vector-map))))
1787 (setq mh-toolbar-show-buttons
1788 (loop for b in value
1789 collect (cdr (assoc b mh-toolbar-show-vector-map))))))
1790 ;; Initialize toolbar
1791 (defun mh-toolbar-init (mode)
1792 "Install toolbar in MODE."
1793 (let ((toolbar (cond ((eq mode :folder) mh-toolbar-folder-buttons)
1794 ((eq mode :letter) mh-toolbar-letter-buttons)
1795 ((eq mode :show) mh-toolbar-show-buttons)))
1796 (height 37)
1797 (width 40)
1798 (buffer (current-buffer)))
1799 (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag
1800 mh-xemacs-has-toolbar-flag)
1801 (cond
1802 ((eq mh-xemacs-toolbar-position 'top)
1803 (set-specifier top-toolbar toolbar buffer)
1804 (set-specifier top-toolbar-visible-p t)
1805 (set-specifier top-toolbar-height height))
1806 ((eq mh-xemacs-toolbar-position 'bottom)
1807 (set-specifier bottom-toolbar toolbar buffer)
1808 (set-specifier bottom-toolbar-visible-p t)
1809 (set-specifier bottom-toolbar-height height))
1810 ((eq mh-xemacs-toolbar-position 'left)
1811 (set-specifier left-toolbar toolbar buffer)
1812 (set-specifier left-toolbar-visible-p t)
1813 (set-specifier left-toolbar-width width))
1814 ((eq mh-xemacs-toolbar-position 'right)
1815 (set-specifier right-toolbar toolbar buffer)
1816 (set-specifier right-toolbar-visible-p t)
1817 (set-specifier right-toolbar-width width))
1818 (t (set-specifier default-toolbar toolbar buffer)))))))
1819 ;; Declare customizable toolbars
1820 (custom-declare-variable
1821 'mh-tool-bar-folder-buttons
1822 '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults))
1823 "Choose buttons to include in MH-E folder/show toolbar."
1824 :group 'mh-toolbar :set 'mh-tool-bar-folder-buttons-set
1825 :type '(set ,@(loop for x in folder-buttons
1826 for y in folder-docs
1827 collect `(const :tag ,y ,x))))
1828 (custom-declare-variable
1829 'mh-tool-bar-letter-buttons
1830 '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults))
1831 "Choose buttons to include in MH-E letter toolbar."
1832 :group 'mh-toolbar :set 'mh-tool-bar-letter-buttons-set
1833 :type '(set ,@(loop for x in letter-buttons
1834 for y in letter-docs
1835 collect `(const :tag ,y ,x)))))))
1553 1836
1554(defcustom mh-alias-system-aliases 1837(mh-tool-bar-define
1555 '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd") 1838 ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg
1556 "*A list of system files from which to cull aliases. 1839 mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg
1557If these files are modified, they are automatically reread. This list need 1840 mh-undo mh-execute-commands mh-toggle-tick mh-reply
1558include only system aliases and the passwd file, since personal alias files 1841 mh-alias-grab-from-field mh-send mh-rescan-folder
1559listed in your \"AliasFile\" MH profile component are automatically included. 1842 mh-tool-bar-search mh-visit-folder
1560You can update the alias list manually using \\[mh-alias-reload]." 1843 mh-tool-bar-customize mh-tool-bar-folder-help mh-widen)
1561 :type '(choice (file) (repeat file)) 1844 (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer
1562 :group 'mh-alias) 1845 undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft
1846 mh-tool-bar-customize mh-tool-bar-letter-help))
1847 ;; Folder/Show buffer buttons
1848 (mh-inc-folder (folder) "mail"
1849 "Incorporate new mail in Inbox
1850This button runs `mh-inc-folder' which drags any
1851new mail into your Inbox folder.")
1852 (mh-mime-save-parts (folder) "attach"
1853 "Save MIME parts from this message
1854This button runs `mh-mime-save-parts' which saves a message's
1855different parts into separate files.")
1856 (mh-previous-undeleted-msg (folder) "left_arrow"
1857 "Go to the previous undeleted message
1858This button runs `mh-previous-undeleted-msg'")
1859 (mh-page-msg (folder) "page-down"
1860 "Page the current message forwards\nThis button runs `mh-page-msg'")
1861 (mh-next-undeleted-msg (folder) "right_arrow"
1862 "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'")
1863 (mh-delete-msg (folder) "close"
1864 "Mark this message for deletion\nThis button runs `mh-delete-msg'")
1865 (mh-refile-msg (folder) "refile"
1866 "Refile this message\nThis button runs `mh-refile-msg'")
1867 (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'"
1868 (mh-outstanding-commands-p))
1869 (mh-execute-commands (folder) "execute"
1870 "Perform moves and deletes\nThis button runs `mh-execute-commands'"
1871 (mh-outstanding-commands-p))
1872 (mh-toggle-tick (folder) "highlight"
1873 "Toggle tick mark\nThis button runs `mh-toggle-tick'")
1874 (mh-toggle-showing (folder) "show"
1875 "Toggle showing message\nThis button runs `mh-toggle-showing'")
1876 (mh-tool-bar-reply-from (folder) "reply-from" "Reply to \"from\"")
1877 (mh-tool-bar-reply-to (folder) "reply-to" "Reply to \"to\"")
1878 (mh-tool-bar-reply-all (folder) "reply-all" "Reply to \"all\"")
1879 (mh-reply (folder) "mail/reply2"
1880 "Reply to this message\nThis button runs `mh-reply'")
1881 (mh-alias-grab-from-field (folder) "alias"
1882 "Grab From alias\nThis button runs `mh-alias-grab-from-field'"
1883 (and (mh-extract-from-header-value) (not (mh-alias-for-from-p))))
1884 (mh-send (folder) "mail_compose"
1885 "Compose new message\nThis button runs `mh-send'")
1886 (mh-rescan-folder (folder) "rescan"
1887 "Rescan this folder\nThis button runs `mh-rescan-folder'")
1888 (mh-pack-folder (folder) "repack"
1889 "Repack this folder\nThis button runs `mh-pack-folder'")
1890 (mh-tool-bar-search (folder) "search"
1891 "Search\nThis button runs `mh-tool-bar-search-function'")
1892 (mh-visit-folder (folder) "fld_open"
1893 "Visit other folder\nThis button runs `mh-visit-folder'")
1894 ;; Letter buffer buttons
1895 (mh-send-letter (letter) "mail_send" "Send this letter")
1896 (mh-compose-insertion (letter) "attach" "Insert attachment")
1897 (ispell-message (letter) "spell" "Check spelling")
1898 (save-buffer (letter) "save" "Save current buffer to its file"
1899 (buffer-modified-p))
1900 (undo (letter) "undo" "Undo last operation")
1901 (kill-region (letter) "cut"
1902 "Cut (kill) text in region between mark and current position")
1903 (menu-bar-kill-ring-save (letter) "copy"
1904 "Copy text in region between mark and current position")
1905 (yank (letter) "paste" "Paste (yank) text cut or copied earlier")
1906 (mh-fully-kill-draft (letter) "close" "Kill this draft")
1907 ;; Common buttons
1908 (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
1909 (mh-tool-bar-folder-help (folder) "help"
1910 "Help! (general help)\nThis button runs `Info-goto-node'")
1911 (mh-tool-bar-letter-help (letter) "help"
1912 "Help! (general help)\nThis button runs `Info-goto-node'")
1913 ;; Folder narrowed to sequence buttons
1914 (mh-widen (sequence) "widen"
1915 "Widen from the sequence\nThis button runs `mh-widen'"))
1563 1916
1564 1917
1565 1918
1566;;; Multiple personalities (:group 'mh-identity) 1919;;; Hooks (:group 'mh-hooks + group where hook described)
1567 1920
1568(defcustom mh-identity-list nil 1921(defcustom mail-citation-hook nil
1569 "*List holding MH-E identity. 1922 "*Hook for modifying a citation just inserted in the mail buffer.
1570Omit the colon and trailing space from the field names. 1923Each hook function can find the citation between point and mark.
1571The keyword name \"none\" is reserved for internal use. 1924And each hook function should leave point and mark around the citation
1572Use the keyname name \"signature\" to specify either a signature file or a 1925text as modified.
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)
1614 1926
1615(defcustom mh-auto-fields-list nil 1927If this hook is entirely empty (nil), the text of the message is inserted
1616 "Alist of addresses for which header lines are automatically inserted. 1928with `mh-ins-buf-prefix' prefixed to each line.
1617Each element has the form (REGEXP ((KEYWORD VALUE) (KEYWORD VALUE)).
1618When the REGEXP appears in the To or cc fields of a message, the corresponding
1619KEYWORD header field is insert with its VALUE in the message header.
1620 1929
1621There is one special case for KEYWORD, that of \"identity\", which means to 1930See also the variable `mh-yank-from-start-of-msg', which controls how
1622insert that identity using `mh-insert-identity'. 1931much of the message passed to the hook.
1623 1932
1624The common KEYWORD cases of \"Mail-Followup-To\" and \"fcc\" are also 1933This hook was historically provided to set up supercite. You may now leave
1625prompted for in the customization interface." 1934this nil and set up supercite by setting the variable
1626 :type `(repeat 1935`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
1627 (list :tag "" 1936to 'autosupercite.
1628 (string :tag "Regular expression to match")
1629 (repeat :tag "At least one pair from below"
1630 (choice
1631 (cons :tag "Identity entry"
1632 (const "identity")
1633 ,(append
1634 '(radio)
1635 (mapcar (function (lambda (arg) `(const ,arg)))
1636 (mapcar 'car mh-identity-list))))
1637 (cons :tag "fcc field"
1638 (const "fcc")
1639 (string :tag "Value"))
1640 (cons :tag "Mail-Followup-To field"
1641 (const "Mail-Followup-To")
1642 (string :tag "Value"))
1643 (cons :tag "Other field and value pair"
1644 (string :tag "Field")
1645 (string :tag "Value"))))))
1646 :group 'mh-identity)
1647 1937
1648(defcustom mh-identity-default nil 1938The hook 'trivial-cite is NOT part of Emacs. It is provided from tc.el,
1649 "Default identity to use when `mh-letter-mode' is called." 1939available here:
1650 ;; Dynamically render :type corresponding to `mh-identity-list' entries, 1940 http://shasta.cs.uiuc.edu/~lrclause/tc.html
1651 ;; e.g.: 1941If you use it, customize `mh-yank-from-start-of-msg' to
1652 ;; :type '(radio (const :tag "none" nil) 1942 \"Entire message with headers\"."
1653 ;; (const "home") 1943 :type 'hook
1654 ;; (const "work")) 1944 :options '(trivial-cite)
1655 :type (append 1945 :group 'mh-hooks
1656 '(radio) 1946 :group 'mh-letter)
1657 (cons '(const :tag "None" nil)
1658 (mapcar (function (lambda (arg) `(const ,arg)))
1659 (mapcar 'car mh-identity-list))))
1660 :group 'mh-identity)
1661
1662
1663
1664;;; Hooks (:group 'mh-hooks + group where hook defined)
1665 1947
1666;;; These are alphabetized. All hooks should be placed in the 'mh-hook group; 1948(defcustom mh-alias-reloaded-hook nil
1667;;; in addition, add the group in which the hook is defined in the manual (or, 1949 "Invoked by `mh-alias-reload' after reloading aliases."
1668;;; if it is new, where it would be defined). 1950 :type 'hook
1951 :group 'mh-hooks
1952 :group 'mh-alias)
1669 1953
1670(defcustom mh-before-quit-hook nil 1954(defcustom mh-before-quit-hook nil
1671 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E. 1955 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
1672See also `mh-quit-hook'." 1956See also `mh-quit-hook'."
1673 :type 'hook 1957 :type 'hook
1674 :group 'mh-hooks 1958 :group 'mh-hooks
1675 :group 'mh-folder) 1959 :group 'mh-show)
1676 1960
1677(defcustom mh-before-send-letter-hook nil 1961(defcustom mh-before-send-letter-hook nil
1678 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command." 1962 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
@@ -1684,7 +1968,7 @@ See also `mh-quit-hook'."
1684 "Invoked after marking each message for deletion." 1968 "Invoked after marking each message for deletion."
1685 :type 'hook 1969 :type 'hook
1686 :group 'mh-hooks 1970 :group 'mh-hooks
1687 :group 'mh-folder) 1971 :group 'mh-show)
1688 1972
1689(defcustom mh-edit-mhn-hook nil 1973(defcustom mh-edit-mhn-hook nil
1690 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]." 1974 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
@@ -1696,13 +1980,13 @@ See also `mh-quit-hook'."
1696 "Invoked by `mh-find-path' after reading the user's MH profile." 1980 "Invoked by `mh-find-path' after reading the user's MH profile."
1697 :type 'hook 1981 :type 'hook
1698 :group 'mh-hooks 1982 :group 'mh-hooks
1699 :group 'mh-folder) 1983 :group 'mh-show)
1700 1984
1701(defcustom mh-folder-mode-hook nil 1985(defcustom mh-folder-mode-hook nil
1702 "Invoked in `mh-folder-mode' on a new folder." 1986 "Invoked in `mh-folder-mode' on a new folder."
1703 :type 'hook 1987 :type 'hook
1704 :group 'mh-hooks 1988 :group 'mh-hooks
1705 :group 'mh-folder) 1989 :group 'mh-show)
1706 1990
1707(defcustom mh-folder-updated-hook nil 1991(defcustom mh-folder-updated-hook nil
1708 "Invoked when the folder actions (such as moves and deletes) are performed. 1992 "Invoked when the folder actions (such as moves and deletes) are performed.
@@ -1712,11 +1996,17 @@ current folder, `mh-current-folder'."
1712 :type 'hook 1996 :type 'hook
1713 :group 'mh-hooks) 1997 :group 'mh-hooks)
1714 1998
1999(defcustom mh-forward-hook nil
2000 "Invoked on the forwarded letter by \\<mh-folder-mode-map>\\[mh-forward]."
2001 :type 'hook
2002 :group 'mh-hooks
2003 :group 'mh-folder)
2004
1715(defcustom mh-inc-folder-hook nil 2005(defcustom mh-inc-folder-hook nil
1716 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder." 2006 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
1717 :type 'hook 2007 :type 'hook
1718 :group 'mh-hooks 2008 :group 'mh-hooks
1719 :group 'mh-folder) 2009 :group 'mh-inc)
1720 2010
1721(defcustom mh-kill-folder-suppress-prompt-hook '(mh-index-p) 2011(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. 2012 "Invoked at the beginning of the \\<mh-folder-mode-map>`\\[mh-kill-folder]' command.
@@ -1733,13 +2023,12 @@ t on +inbox and you hit \\<mh-folder-mode-map>`\\[mh-kill-folder]' by accident
1733in the +inbox buffer, you will not be happy." 2023in the +inbox buffer, you will not be happy."
1734 :type 'hook 2024 :type 'hook
1735 :group 'mh-hooks 2025 :group 'mh-hooks
1736 :group 'mh-folder) 2026 :group 'mh-show)
1737 2027
1738(defcustom mh-letter-insert-signature-hook nil 2028(defcustom mh-letter-insert-signature-hook nil
1739 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. 2029 "Invoked after signature has been inserted.
1740Can be used to determine which signature file to use based on message content. 2030This hook may access the actual name of the file or the function used to
1741On return, if `mh-signature-file-name' is non-nil that file will be inserted at 2031insert the signature with `mh-signature-file-name'."
1742the current point in the buffer."
1743 :type 'hook 2032 :type 'hook
1744 :group 'mh-hooks 2033 :group 'mh-hooks
1745 :group 'mh-letter) 2034 :group 'mh-letter)
@@ -1748,26 +2037,26 @@ the current point in the buffer."
1748 "Invoked in `mh-letter-mode' on a new letter." 2037 "Invoked in `mh-letter-mode' on a new letter."
1749 :type 'hook 2038 :type 'hook
1750 :group 'mh-hooks 2039 :group 'mh-hooks
1751 :group 'mh-letter) 2040 :group 'mh-sending-mail)
1752 2041
1753(defcustom mh-pick-mode-hook nil 2042(defcustom mh-pick-mode-hook nil
1754 "Invoked upon entry to `mh-pick-mode'." 2043 "Invoked upon entry to `mh-pick-mode'."
1755 :type 'hook 2044 :type 'hook
1756 :group 'mh-hooks 2045 :group 'mh-hooks
1757 :group 'mh-folder) 2046 :group 'mh-index)
1758 2047
1759(defcustom mh-quit-hook nil 2048(defcustom mh-quit-hook nil
1760 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E. 2049 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
1761See also `mh-before-quit-hook'." 2050See also `mh-before-quit-hook'."
1762 :type 'hook 2051 :type 'hook
1763 :group 'mh-hooks 2052 :group 'mh-hooks
1764 :group 'mh-folder) 2053 :group 'mh-show)
1765 2054
1766(defcustom mh-refile-msg-hook nil 2055(defcustom mh-refile-msg-hook nil
1767 "Invoked after marking each message for refiling." 2056 "Invoked after marking each message for refiling."
1768 :type 'hook 2057 :type 'hook
1769 :group 'mh-hooks 2058 :group 'mh-hooks
1770 :group 'mh-folder) 2059 :group 'mh-show)
1771 2060
1772(defcustom mh-show-hook nil 2061(defcustom mh-show-hook nil
1773 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message." 2062 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
@@ -1787,44 +2076,13 @@ The variable `mh-seen-list' can be used to obtain the list of messages which
1787will be removed from the unseen sequence." 2076will be removed from the unseen sequence."
1788 :type 'hook 2077 :type 'hook
1789 :group 'mh-hooks 2078 :group 'mh-hooks
1790 :group 'mh-folder) 2079 :group 'mh-show)
1791 2080
1792 2081
1793 2082
1794;;; Faces 2083;;; Faces (:group 'mh-*-faces + group where faces described)
1795
1796;;; Faces used in speedbar (:group mh-speed-faces)
1797
1798(defface mh-speedbar-folder-face
1799 '((((class color) (background light))
1800 (:foreground "blue4"))
1801 (((class color) (background dark))
1802 (:foreground "light blue")))
1803 "Face used for folders in the speedbar buffer."
1804 :group 'mh-speed-faces)
1805
1806(defface mh-speedbar-selected-folder-face
1807 '((((class color) (background light))
1808 (:foreground "red" :underline t))
1809 (((class color) (background dark))
1810 (:foreground "red" :underline t))
1811 (t (:underline t)))
1812 "Face used for the current folder."
1813 :group 'mh-speed-faces)
1814 2084
1815(defface mh-speedbar-folder-with-unseen-messages-face 2085;;; Faces Used in Scan Listing (:group 'mh-folder-faces)
1816 '((t (:inherit mh-speedbar-folder-face :bold t)))
1817 "Face used for folders in the speedbar buffer which have unread messages."
1818 :group 'mh-speed-faces)
1819
1820(defface mh-speedbar-selected-folder-with-unseen-messages-face
1821 '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
1822 "Face used for the current folder when it has unread messages."
1823 :group 'mh-speed-faces)
1824
1825
1826
1827;;; Faces used in scan listing (:group mh-folder-faces)
1828 2086
1829(defvar mh-folder-body-face 'mh-folder-body-face 2087(defvar mh-folder-body-face 'mh-folder-body-face
1830 "Face for highlighting body text in MH-Folder buffers.") 2088 "Face for highlighting body text in MH-Folder buffers.")
@@ -1962,7 +2220,36 @@ will be removed from the unseen sequence."
1962 2220
1963 2221
1964 2222
1965;;; Faces used in message display (:group mh-show-faces) 2223;;; Faces Used in Searching (:group 'mh-index-faces)
2224
2225(defvar mh-index-folder-face 'mh-index-folder-face
2226 "Face for highlighting folders in MH-Index buffers.")
2227(defface mh-index-folder-face
2228 '((((class color) (background light))
2229 (:foreground "dark green" :bold t))
2230 (((class color) (background dark))
2231 (:foreground "indian red" :bold t))
2232 (t
2233 (:bold t)))
2234 "Face for highlighting folders in MH-Index buffers."
2235 :group 'mh-index-faces)
2236
2237
2238
2239;;; Faces Used in Message Drafts (:group 'mh-letter-faces)
2240
2241(defface mh-letter-header-field-face
2242 '((((class color) (background light))
2243 (:background "gray90"))
2244 (((class color) (background dark))
2245 (:background "gray10"))
2246 (t (:bold t)))
2247 "Face for displaying header fields in draft buffers."
2248 :group 'mh-letter-faces)
2249
2250
2251
2252;;; Faces Used in Message Display (:group 'mh-show-faces)
1966 2253
1967(defvar mh-show-cc-face 'mh-show-cc-face 2254(defvar mh-show-cc-face 'mh-show-cc-face
1968 "Face for highlighting cc header fields.") 2255 "Face for highlighting cc header fields.")
@@ -2002,6 +2289,11 @@ will be removed from the unseen sequence."
2002 "Face used to deemphasize unspecified header fields." 2289 "Face used to deemphasize unspecified header fields."
2003 :group 'mh-show-faces) 2290 :group 'mh-show-faces)
2004 2291
2292(defface mh-show-signature-face
2293 '((t (:italic t)))
2294 "Face for highlighting message signature."
2295 :group 'mh-show-faces)
2296
2005(defvar mh-show-to-face 'mh-show-to-face 2297(defvar mh-show-to-face 'mh-show-to-face
2006 "Face for highlighting the To: header field.") 2298 "Face for highlighting the To: header field.")
2007(if (boundp 'facemenu-unlisted-faces) 2299(if (boundp 'facemenu-unlisted-faces)
@@ -2041,32 +2333,34 @@ The background and foreground is used in the image."
2041 2333
2042 2334
2043 2335
2044;;; Faces used in indexed searches (:group mh-index-faces) 2336;;; Faces Used in Speedbar (:group 'mh-speed-faces)
2045 2337
2046(defvar mh-index-folder-face 'mh-index-folder-face 2338(defface mh-speedbar-folder-face
2047 "Face for highlighting folders in MH-Index buffers.")
2048(defface mh-index-folder-face
2049 '((((class color) (background light)) 2339 '((((class color) (background light))
2050 (:foreground "dark green" :bold t)) 2340 (:foreground "blue4"))
2051 (((class color) (background dark)) 2341 (((class color) (background dark))
2052 (:foreground "indian red" :bold t)) 2342 (:foreground "light blue")))
2053 (t 2343 "Face used for folders in the speedbar buffer."
2054 (:bold t))) 2344 :group 'mh-speed-faces)
2055 "Face for highlighting folders in MH-Index buffers."
2056 :group 'mh-index-faces)
2057
2058
2059
2060;;; Faces used when composing messages.
2061 2345
2062(defface mh-letter-header-field-face 2346(defface mh-speedbar-selected-folder-face
2063 '((((class color) (background light)) 2347 '((((class color) (background light))
2064 (:background "gray90")) 2348 (:foreground "red" :underline t))
2065 (((class color) (background dark)) 2349 (((class color) (background dark))
2066 (:background "gray10")) 2350 (:foreground "red" :underline t))
2067 (t (:bold t))) 2351 (t (:underline t)))
2068 "Face for displaying header fields in draft buffers." 2352 "Face used for the current folder."
2069 :group 'mh-letter-faces) 2353 :group 'mh-speed-faces)
2354
2355(defface mh-speedbar-folder-with-unseen-messages-face
2356 '((t (:inherit mh-speedbar-folder-face :bold t)))
2357 "Face used for folders in the speedbar buffer which have unread messages."
2358 :group 'mh-speed-faces)
2359
2360(defface mh-speedbar-selected-folder-with-unseen-messages-face
2361 '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
2362 "Face used for the current folder when it has unread messages."
2363 :group 'mh-speed-faces)
2070 2364
2071;;; Local Variables: 2365;;; Local Variables:
2072;;; indent-tabs-mode: nil 2366;;; indent-tabs-mode: nil
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index e72304c4412..2081d49b6cd 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -5,7 +5,7 @@
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.4.4 8;; Version: 7.82
9;; Keywords: mail 9;; Keywords: mail
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
@@ -75,25 +75,21 @@
75 75
76;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. 76;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
77;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. 77;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
78;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu 78;; Rewritten for GNU Emacs, James Larus, 1985.
79;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu 79;; Modified by Stephen Gildea, 1988.
80;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the 80;; Maintenance picked up by Bill Wohler and the
81;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. 81;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
82 82
83;;; Code: 83;;; Code:
84 84
85(provide 'mh-e) 85(provide 'mh-e)
86(require 'mh-utils)
87(mh-require-cl)
88
89(defvar recursive-load-depth-limit)
90(eval-when (compile load eval)
91 (if (and (boundp 'recursive-load-depth-limit)
92 (integerp recursive-load-depth-limit)
93 (> 50 recursive-load-depth-limit))
94 (setq recursive-load-depth-limit 50)))
95 86
87(eval-when-compile (require 'mh-acros))
88(mh-require-cl)
89(require 'mh-utils)
90(require 'mh-init)
96(require 'mh-inc) 91(require 'mh-inc)
92(require 'mh-seq)
97(require 'gnus-util) 93(require 'gnus-util)
98(require 'easymenu) 94(require 'easymenu)
99 95
@@ -101,35 +97,27 @@
101(defvar font-lock-auto-fontify) 97(defvar font-lock-auto-fontify)
102(defvar font-lock-defaults) 98(defvar font-lock-defaults)
103 99
104(defconst mh-version "7.4.4" "Version number of MH-E.") 100(defconst mh-version "7.82" "Version number of MH-E.")
105 101
106;;; Autoloads 102;;; Autoloads
107(autoload 'Info-goto-node "info") 103(autoload 'Info-goto-node "info")
108 104
109
110
111(defvar mh-note-deleted "D"
112 "String whose first character is used to notate deleted messages.")
113
114(defvar mh-note-refiled "^"
115 "String whose first character is used to notate refiled messages.")
116
117(defvar mh-note-cur "+"
118 "String whose first character is used to notate the current message.")
119
120(defvar mh-partial-folder-mode-line-annotation "select" 105(defvar mh-partial-folder-mode-line-annotation "select"
121 "Annotation when displaying part of a folder. 106 "Annotation when displaying part of a folder.
122The string is displayed after the folder's name. nil for no annotation.") 107The string is displayed after the folder's name. nil for no annotation.")
123 108
109
110;;; Scan Line Formats
111
124;;; Parameterize MH-E to work with different scan formats. The defaults work 112;;; Parameterize MH-E to work with different scan formats. The defaults work
125;;; with the standard MH scan listings, in which the first 4 characters on 113;;; with the standard MH scan listings, in which the first 4 characters on
126;;; the line are the message number, followed by two places for notations. 114;;; the line are the message number, followed by two places for notations.
127 115
128;; The following scan formats are passed to the scan program if the 116;; The following scan formats are passed to the scan program if the setting of
129;; setting of `mh-scan-format-file' above is nil. They are identical 117;; `mh-scan-format-file' is t. They are identical except the later one makes
130;; except the later one makes use of the nmh `decode' function to 118;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
131;; decode RFC 2047 encodings. If you just want to change the width of 119;; want to change the width of the msg number, use the `mh-set-cmd-note'
132;; the msg number, use the `mh-set-cmd-note' function. 120;; function.
133 121
134(defvar mh-scan-format-mh 122(defvar mh-scan-format-mh
135 (concat 123 (concat
@@ -150,11 +138,10 @@ This format is identical to the default except that additional hints for
150fontification have been added to the fifth column (remember that in Emacs, the 138fontification have been added to the fifth column (remember that in Emacs, the
151first column is 0). 139first column is 0).
152 140
153The values of the fifth column, in priority order, are: `-' if the 141The values of the fifth column, in priority order, are: `-' if the message has
154message has been replied to, t if an address on the To: line matches 142been replied to, t if an address on the To: line matches one of the
155one of the mailboxes of the current user, `c' if the Cc: line matches, 143mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc:
156`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header 144line matches, and `n' if a non-empty Newsgroups: header is present.")
157is present.")
158 145
159(defvar mh-scan-format-nmh 146(defvar mh-scan-format-nmh
160 (concat 147 (concat
@@ -176,78 +163,94 @@ This format is identical to the default except that additional hints for
176fontification have been added to the fifth column (remember that in Emacs, the 163fontification have been added to the fifth column (remember that in Emacs, the
177first column is 0). 164first column is 0).
178 165
179The values of the fifth column, in priority order, are: `-' if the 166The values of the fifth column, in priority order, are: `-' if the message has
180message has been replied to, t if an address on the To: line matches 167been replied to, t if an address on the To: field matches one of the
181one of the mailboxes of the current user, `c' if the Cc: line matches, 168mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc:
182`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header 169field matches, and `n' if a non-empty Newsgroups: field is present.")
183is present.") 170
171(defvar mh-note-deleted ?D
172 "Deleted messages are marked by this character.
173See also `mh-scan-deleted-msg-regexp'.")
174
175(defvar mh-note-refiled ?^
176 "Refiled messages are marked by this character.
177See also `mh-scan-refiled-msg-regexp'.")
178
179(defvar mh-note-cur ?+
180 "The current message (in MH) is marked by this character.
181See also `mh-scan-cur-msg-number-regexp'.")
184 182
185(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" 183(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
186 "Regexp specifying the scan lines that are 'good' messages. 184 "This regexp specifies the scan lines that are 'good' messages.
187The default `mh-folder-font-lock-keywords' expects this expression to contain 185Note that the default setting of `mh-folder-font-lock-keywords' expects this
188at least one parenthesized expression which matches the message number.") 186expression to contain at least one parenthesized expression which matches the
187message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\".")
189 188
190(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D" 189(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
191 "Regexp matching scan lines of deleted messages. 190 "This regexp matches deleted messages.
192The default `mh-folder-font-lock-keywords' expects this expression to contain 191Note that the default setting of `mh-folder-font-lock-keywords' expects this
193at least one parenthesized expression which matches the message number.") 192expression to contain at least one parenthesized expression which matches the
193message number as in the default of \"^\\\\( *[0-9]+\\\\)D\".
194See also `mh-note-deleted'.")
194 195
195(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^" 196(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
196 "Regexp matching scan lines of refiled messages. 197 "This regexp matches refiled messages.
197The default `mh-folder-font-lock-keywords' expects this expression to contain 198Note that the default setting of `mh-folder-font-lock-keywords' expects this
198at least one parenthesized expression which matches the message number.") 199expression to contain at least one parenthesized expression which matches the
200message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\".
201See also `mh-note-refiled'.")
199 202
200(defvar mh-scan-valid-regexp "^ *[0-9]" 203(defvar mh-scan-valid-regexp "^ *[0-9]"
201 "Regexp matching scan lines for messages (not error messages).") 204 "This regexp matches scan lines for messages (not error messages).")
202 205
203(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" 206(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
204 "Regexp matching scan line for the current message. 207 "This regexp matches the current message.
205The default `mh-folder-font-lock-keywords' expects this expression to contain 208Note that the default setting of `mh-folder-font-lock-keywords' expects this
206at least one parenthesized expression which matches the message number. 209expression to contain at least one parenthesized expression which matches the
207Don't disable this regexp as it's needed by non fontifying functions.") 210message number as in the default of \"^\\\\( *[0-9]+\\\\+\\\\).*\". Don't
208 211disable this regexp as it's needed by non-fontifying functions.
209(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)" 212See also `mh-note-cur'.")
210 "Regexp matching scan line for the current message.
211The default `mh-folder-font-lock-keywords' expects this expression to contain
212at least one parenthesized expression which matches the whole line.
213To enable this feature, remove the string DISABLED from the regexp.")
214 213
215(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" 214(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
216 "Regexp matching a valid date in scan lines. 215 "This regexp matches a valid date.
217The default `mh-folder-font-lock-keywords' expects this expression to contain 216Note that the default setting of `mh-folder-font-lock-keywords' expects this
218only one parenthesized expression which matches the date field 217expression to contain only one parenthesized expression which matches the date
219\(see `mh-scan-format-regexp').") 218field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}.
219See also `mh-scan-format-regexp'.")
220 220
221(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)" 221(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
222 "Regexp specifying the recipient in scan lines for messages we sent. 222 "This regexp specifies the recipient in messages you sent.
223The default `mh-folder-font-lock-keywords' expects this expression to contain 223Note that the default setting of `mh-folder-font-lock-keywords'
224two parenthesized expressions. The first is expected to match the To: 224expects this expression to contain two parenthesized expressions. The
225that the default scan format file generates. The second is expected to match 225first is expected to match the `To:' that the default scan format
226the recipient's name.") 226file generates. The second is expected to match the recipient's name
227as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\".")
227 228
228(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)" 229(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
229 "Regexp matching the message body beginning displayed in scan lines. 230 "This regexp matches the message body fragment displayed in scan lines.
230The default `mh-folder-font-lock-keywords' expects this expression to contain 231Note that the default setting of `mh-folder-font-lock-keywords' expects this
231at least one parenthesized expression which matches the body text.") 232expression to contain at least one parenthesized expression which matches the
233body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\".")
232 234
233(defvar mh-scan-subject-regexp 235(defvar mh-scan-subject-regexp
234 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
235 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" 236 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
236 "*Regexp matching the subject string in MH folder mode. 237 "This regexp matches the subject.
237The default `mh-folder-font-lock-keywords' expects this expression to contain 238Note that the default setting of `mh-folder-font-lock-keywords' expects this
238at least tree parenthesized expressions. The first is expected to match the Re: 239expression to contain at least three parenthesized expressions. The first is
239string, if any. The second matches an optional bracketed number after Re, 240expected to match the `Re:' string, if any. The second matches an optional
240such as in Re[2]: and the third is expected to match the subject line itself.") 241bracketed number after `Re:', such as in `Re[2]:' (and is thus a
242sub-expression of the first expression) and the third is expected to match
243the subject line itself as in the default of \"^ *[0-9]+........[ ]*...................\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*\\\\([^<\\n]*\\\\)\".")
241 244
242(defvar mh-scan-format-regexp 245(defvar mh-scan-format-regexp
243 (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)") 246 (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
244 "Regexp matching the output of scan. 247 "This regexp matches the output of scan.
245The default value is based upon the default values of either 248Note that the default setting of `mh-folder-font-lock-keywords' expects this
246`mh-scan-format-mh' or `mh-scan-format-nmh'. 249expression to contain at least three parenthesized expressions. The first
247The default `mh-folder-font-lock-keywords' expects this expression to contain 250should match the fontification hint, the second is found in
248at least three parenthesized expressions. The first should match the 251`mh-scan-date-regexp', and the third should match the user name as in the
249fontification hint, the second is found in `mh-scan-date-regexp', and the 252default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp
250third should match the user name.") 253 \"*\\\\(..................\\\\)\")\".")
251 254
252 255
253 256
@@ -279,10 +282,7 @@ third should match the user name.")
279 ;; scan font-lock name 282 ;; scan font-lock name
280 (list mh-scan-format-regexp 283 (list mh-scan-format-regexp
281 '(1 mh-folder-date-face) 284 '(1 mh-folder-date-face)
282 '(3 mh-folder-scan-format-face)) 285 '(3 mh-folder-scan-format-face)))
283 ;; Current message line
284 (list mh-scan-cur-msg-regexp
285 '(1 mh-folder-cur-msg-face prepend t)))
286 "Regexp keywords used to fontify the MH-Folder buffer.") 286 "Regexp keywords used to fontify the MH-Folder buffer.")
287 287
288(defvar mh-scan-cmd-note-width 1 288(defvar mh-scan-cmd-note-width 1
@@ -356,46 +356,6 @@ This column will only ever have spaces in it.")
356 356
357;; Fontifify unseen mesages in bold. 357;; Fontifify unseen mesages in bold.
358 358
359(defvar mh-folder-unseen-seq-name nil
360 "Name of unseen sequence.
361The default for this is provided by the function `mh-folder-unseen-seq-name'
362On nmh systems.")
363
364(defun mh-folder-unseen-seq-name ()
365 "Provide name of unseen sequence from mhparam."
366 (or mh-progs (mh-find-path))
367 (save-excursion
368 (let ((unseen-seq-name "unseen"))
369 (with-temp-buffer
370 (unwind-protect
371 (progn
372 (call-process (expand-file-name "mhparam" mh-progs)
373 nil '(t t) nil "-component" "Unseen-Sequence")
374 (goto-char (point-min))
375 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
376 (setq unseen-seq-name (match-string 1))))))
377 unseen-seq-name)))
378
379(defun mh-folder-unseen-seq-list ()
380 "Return a list of unseen message numbers for current folder."
381 (if (not mh-folder-unseen-seq-name)
382 (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
383 (cond
384 ((not mh-folder-unseen-seq-name)
385 nil)
386 (t
387 (let ((folder mh-current-folder))
388 (save-excursion
389 (with-temp-buffer
390 (unwind-protect
391 (progn
392 (call-process (expand-file-name "mark" mh-progs)
393 nil '(t t) nil
394 folder "-seq" mh-folder-unseen-seq-name
395 "-list")
396 (goto-char (point-min))
397 (sort (mh-read-msg-list) '<)))))))))
398
399(defmacro mh-generate-sequence-font-lock (seq prefix face) 359(defmacro mh-generate-sequence-font-lock (seq prefix face)
400 "Generate the appropriate code to fontify messages in SEQ. 360 "Generate the appropriate code to fontify messages in SEQ.
401PREFIX is used to generate unique names for the variables and functions 361PREFIX is used to generate unique names for the variables and functions
@@ -492,6 +452,8 @@ is done highlighting.")
492 ;Rememeber original notation that 452 ;Rememeber original notation that
493 ;is overwritten by `mh-note-seq'. 453 ;is overwritten by `mh-note-seq'.
494 454
455(defvar mh-colors-available-flag nil) ;Are colors available?
456
495;;; Macros and generic functions: 457;;; Macros and generic functions:
496 458
497(defun mh-mapc (function list) 459(defun mh-mapc (function list)
@@ -503,7 +465,7 @@ is done highlighting.")
503(defun mh-scan-format () 465(defun mh-scan-format ()
504 "Return the output format argument for the scan program." 466 "Return the output format argument for the scan program."
505 (if (equal mh-scan-format-file t) 467 (if (equal mh-scan-format-file t)
506 (list "-format" (if mh-nmh-flag 468 (list "-format" (if (mh-variant-p 'nmh 'mu-mh)
507 (list (mh-update-scan-format 469 (list (mh-update-scan-format
508 mh-scan-format-nmh mh-cmd-note)) 470 mh-scan-format-nmh mh-cmd-note))
509 (list (mh-update-scan-format 471 (list (mh-update-scan-format
@@ -519,7 +481,7 @@ is done highlighting.")
519(defun mh-rmail (&optional arg) 481(defun mh-rmail (&optional arg)
520 "Inc(orporate) new mail with MH. 482 "Inc(orporate) new mail with MH.
521Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, 483Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
522the Emacs front end to the MH mail system." 484the Emacs interface to the MH mail system."
523 (interactive "P") 485 (interactive "P")
524 (mh-find-path) 486 (mh-find-path)
525 (if arg 487 (if arg
@@ -532,7 +494,7 @@ the Emacs front end to the MH mail system."
532(defun mh-nmail (&optional arg) 494(defun mh-nmail (&optional arg)
533 "Check for new mail in inbox folder. 495 "Check for new mail in inbox folder.
534Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, 496Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
535the Emacs front end to the MH mail system." 497the Emacs interface to the MH mail system."
536 (interactive "P") 498 (interactive "P")
537 (mh-find-path) ; init mh-inbox 499 (mh-find-path) ; init mh-inbox
538 (if arg 500 (if arg
@@ -616,6 +578,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead."
616 (setq folder mh-inbox)) 578 (setq folder mh-inbox))
617 (let ((threading-needed-flag nil)) 579 (let ((threading-needed-flag nil))
618 (let ((config (current-window-configuration))) 580 (let ((config (current-window-configuration)))
581 (delete-other-windows)
619 (cond ((not (get-buffer folder)) 582 (cond ((not (get-buffer folder))
620 (mh-make-folder folder) 583 (mh-make-folder folder)
621 (setq threading-needed-flag mh-show-threads-flag) 584 (setq threading-needed-flag mh-show-threads-flag)
@@ -659,25 +622,26 @@ last undeleted message then pause for a second after printing message."
659 (if wait-after-complaining-flag (sit-for 1))))) 622 (if wait-after-complaining-flag (sit-for 1)))))
660 623
661(defun mh-folder-from-address () 624(defun mh-folder-from-address ()
662 "Determine folder name from address in From field. 625 "Derive folder name from sender.
663Takes the address in the From: header field, and returns one of: 626
627The name of the folder is derived as follows:
664 628
665 a) The folder name associated with the address in the alist 629 a) The folder name associated with the first address found in the list
666 `mh-default-folder-list'. If the `Check Recipient' boolean 630 `mh-default-folder-list' is used. Each element in this list contains a
667 is set, then the `mh-default-folder-list' addresses are 631 `Check Recipient' item. If this item is turned on, then the address is
668 checked against the recipient instead of the originator 632 checked against the recipient instead of the sender. This is useful for
669 (making possible to use this feature for mailing lists). 633 mailing lists.
670 The first match found in `mh-default-folder-list' is used.
671 634
672 b) The address' corresponding alias from the user's personal 635 b) An alias prefixed by `mh-default-folder-prefix' corresponding to the
673 aliases file prefixed by `mh-default-folder-prefix'. 636 address is used. The prefix is used to prevent clutter in your mail
637 directory.
674 638
675Returns nil if the address was not found in either place or if the variable 639Return nil if a folder name was not derived, or if the variable
676`mh-default-folder-must-exist-flag' is nil and the folder does not exist." 640`mh-default-folder-must-exist-flag' is t and the folder does not exist."
677 ;; Loop for all entries in mh-default-folder-list 641 ;; Loop for all entries in mh-default-folder-list
678 (save-restriction 642 (save-restriction
679 (goto-char (point-min)) 643 (goto-char (point-min))
680 (re-search-forward "\n\n" nil t) 644 (re-search-forward "\n\n" nil 'limit)
681 (narrow-to-region (point-min) (point)) 645 (narrow-to-region (point-min) (point))
682 (let ((to/cc (concat (or (message-fetch-field "to") "") ", " 646 (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
683 (or (message-fetch-field "cc") ""))) 647 (or (message-fetch-field "cc") "")))
@@ -715,25 +679,24 @@ Returns nil if the address was not found in either place or if the variable
715 "Prompt the user for a folder in which the message should be filed. 679 "Prompt the user for a folder in which the message should be filed.
716The folder is returned as a string. 680The folder is returned as a string.
717 681
718If `mh-default-folder-for-message-function' is a function then the message 682The default folder name is generated by the option
719being refiled is yanked into a temporary buffer and the function is called to 683`mh-default-folder-for-message-function' if it is non-nil or
720intelligently guess where the message is to be refiled. 684`mh-folder-from-address'."
721
722Otherwise, a default folder name is generated by `mh-folder-from-address'."
723 (mh-prompt-for-folder 685 (mh-prompt-for-folder
724 "Destination" 686 "Destination"
725 (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) 687 (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
726 (save-excursion 688 (if (null refile-file) ""
727 (set-buffer (get-buffer-create mh-temp-buffer)) 689 (save-excursion
728 (erase-buffer) 690 (set-buffer (get-buffer-create mh-temp-buffer))
729 (insert-file-contents refile-file) 691 (erase-buffer)
730 (or (and mh-default-folder-for-message-function 692 (insert-file-contents refile-file)
731 (let ((buffer-file-name refile-file)) 693 (or (and mh-default-folder-for-message-function
732 (funcall mh-default-folder-for-message-function))) 694 (let ((buffer-file-name refile-file))
733 (mh-folder-from-address) 695 (funcall mh-default-folder-for-message-function)))
734 (and (eq 'refile (car mh-last-destination-folder)) 696 (mh-folder-from-address)
735 (symbol-name (cdr mh-last-destination-folder))) 697 (and (eq 'refile (car mh-last-destination-folder))
736 ""))) 698 (symbol-name (cdr mh-last-destination-folder)))
699 ""))))
737 t)) 700 t))
738 701
739(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag) 702(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
@@ -872,7 +835,9 @@ are skipped."
872 (setq count (1- count))) 835 (setq count (1- count)))
873 (not (car unread-sequence))) 836 (not (car unread-sequence)))
874 (message "No more unread messages")) 837 (message "No more unread messages"))
875 (t (mh-goto-msg (car unread-sequence)))))) 838 (t (loop for msg in unread-sequence
839 when (mh-goto-msg msg t) return nil
840 finally (message "No more unread messages"))))))
876 841
877(defun mh-goto-next-button (backward-flag &optional criterion) 842(defun mh-goto-next-button (backward-flag &optional criterion)
878 "Search for next button satisfying criterion. 843 "Search for next button satisfying criterion.
@@ -1090,7 +1055,7 @@ interactive use."
1090 (if (not (mh-outstanding-commands-p)) 1055 (if (not (mh-outstanding-commands-p))
1091 (mh-set-folder-modified-p nil))) 1056 (mh-set-folder-modified-p nil)))
1092 1057
1093;;;###mh-autoload 1058
1094(defun mh-folder-line-matches-show-buffer-p () 1059(defun mh-folder-line-matches-show-buffer-p ()
1095 "Return t if the message under point in folder-mode is in the show buffer. 1060 "Return t if the message under point in folder-mode is in the show buffer.
1096Return nil in any other circumstance (no message under point, no show buffer, 1061Return nil in any other circumstance (no message under point, no show buffer,
@@ -1123,7 +1088,6 @@ compiled then macro expansion happens at compile time."
1123(defun mh-version () 1088(defun mh-version ()
1124 "Display version information about MH-E and the MH mail handling system." 1089 "Display version information about MH-E and the MH mail handling system."
1125 (interactive) 1090 (interactive)
1126 (mh-find-progs)
1127 (set-buffer (get-buffer-create mh-info-buffer)) 1091 (set-buffer (get-buffer-create mh-info-buffer))
1128 (erase-buffer) 1092 (erase-buffer)
1129 ;; MH-E version. 1093 ;; MH-E version.
@@ -1140,19 +1104,12 @@ compiled then macro expansion happens at compile time."
1140 ;; Emacs version. 1104 ;; Emacs version.
1141 (insert (emacs-version) "\n\n") 1105 (insert (emacs-version) "\n\n")
1142 ;; MH version. 1106 ;; MH version.
1143 (let ((help-start (point))) 1107 (if mh-variant-in-use
1144 (condition-case err-data 1108 (insert mh-variant-in-use "\n"
1145 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) 1109 " mh-progs:\t" mh-progs "\n"
1146 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) 1110 " mh-lib:\t" mh-lib "\n"
1147 (goto-char help-start) 1111 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1148 (if mh-nmh-flag 1112 (insert "No MH variant detected\n"))
1149 (search-forward "inc -- " nil t)
1150 (search-forward "version: " nil t))
1151 (delete-region help-start (point)))
1152 (goto-char (point-max))
1153 (insert " mh-progs:\t" mh-progs "\n"
1154 " mh-lib:\t" mh-lib "\n"
1155 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1156 ;; Linux version. 1113 ;; Linux version.
1157 (condition-case () 1114 (condition-case ()
1158 (call-process "uname" nil t nil "-a") 1115 (call-process "uname" nil t nil "-a")
@@ -1202,7 +1159,7 @@ used to avoid problems in corner cases involving folders whose names end with a
1202(defun mh-folder-size-flist (folder) 1159(defun mh-folder-size-flist (folder)
1203 "Find size of FOLDER using `flist'." 1160 "Find size of FOLDER using `flist'."
1204 (with-temp-buffer 1161 (with-temp-buffer
1205 (call-process (expand-file-name "flist" mh-progs) nil t nil 1162 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
1206 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) 1163 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
1207 (goto-char (point-min)) 1164 (goto-char (point-min))
1208 (multiple-value-bind (folder unseen total) 1165 (multiple-value-bind (folder unseen total)
@@ -1236,6 +1193,7 @@ regardless of the size of the `mh-large-folder' variable."
1236 (let ((config (current-window-configuration)) 1193 (let ((config (current-window-configuration))
1237 (current-buffer (current-buffer)) 1194 (current-buffer (current-buffer))
1238 (threaded-view-flag mh-show-threads-flag)) 1195 (threaded-view-flag mh-show-threads-flag))
1196 (delete-other-windows)
1239 (save-excursion 1197 (save-excursion
1240 (when (get-buffer folder) 1198 (when (get-buffer folder)
1241 (set-buffer folder) 1199 (set-buffer folder)
@@ -1258,12 +1216,11 @@ regardless of the size of the `mh-large-folder' variable."
1258 (mh-toggle-threads)) 1216 (mh-toggle-threads))
1259 (mh-index-data 1217 (mh-index-data
1260 (mh-index-insert-folder-headers))) 1218 (mh-index-insert-folder-headers)))
1261 (unless mh-showing-mode (delete-other-windows))
1262 (unless (eq current-buffer (current-buffer)) 1219 (unless (eq current-buffer (current-buffer))
1263 (setq mh-previous-window-config config))) 1220 (setq mh-previous-window-config config)))
1264 nil) 1221 nil)
1265 1222
1266;;;###mh-autoload 1223
1267(defun mh-update-sequences () 1224(defun mh-update-sequences ()
1268 "Update MH's Unseen-Sequence and current folder and message. 1225 "Update MH's Unseen-Sequence and current folder and message.
1269Flush MH-E's state out to MH. The message at the cursor becomes current." 1226Flush MH-E's state out to MH. The message at the cursor becomes current."
@@ -1334,7 +1291,7 @@ arguments, after the message has been refiled."
1334 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" 1291 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1335 "-src" mh-current-folder 1292 "-src" mh-current-folder
1336 (symbol-name folder)) 1293 (symbol-name folder))
1337 (message "Message not copied."))) 1294 (message "Message not copied")))
1338 (t 1295 (t
1339 (mh-set-folder-modified-p t) 1296 (mh-set-folder-modified-p t)
1340 (cond ((null (assoc folder mh-refile-list)) 1297 (cond ((null (assoc folder mh-refile-list))
@@ -1381,7 +1338,9 @@ With optional argument COUNT, COUNT-1 unread messages are skipped."
1381 (setq count (1- count))) 1338 (setq count (1- count)))
1382 (not (car unread-sequence))) 1339 (not (car unread-sequence)))
1383 (message "No more unread messages")) 1340 (message "No more unread messages"))
1384 (t (mh-goto-msg (car unread-sequence)))))) 1341 (t (loop for msg in unread-sequence
1342 when (mh-goto-msg msg t) return nil
1343 finally (message "No more unread messages"))))))
1385 1344
1386(defun mh-set-scan-mode () 1345(defun mh-set-scan-mode ()
1387 "Display the scan listing buffer, but do not show a message." 1346 "Display the scan listing buffer, but do not show a message."
@@ -1472,12 +1431,12 @@ Make it the current folder."
1472 ["Go to First Message" mh-first-msg t] 1431 ["Go to First Message" mh-first-msg t]
1473 ["Go to Last Message" mh-last-msg t] 1432 ["Go to Last Message" mh-last-msg t]
1474 ["Go to Message by Number..." mh-goto-msg t] 1433 ["Go to Message by Number..." mh-goto-msg t]
1475 ["Modify Message" mh-modify] 1434 ["Modify Message" mh-modify t]
1476 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] 1435 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
1477 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)] 1436 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
1478 ["Undo Delete/Refile" mh-undo t] 1437 ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
1479 ["Process Delete/Refile" mh-execute-commands 1438 ["Execute Delete/Refile" mh-execute-commands
1480 (or mh-refile-list mh-delete-list)] 1439 (mh-outstanding-commands-p)]
1481 "--" 1440 "--"
1482 ["Compose a New Message" mh-send t] 1441 ["Compose a New Message" mh-send t]
1483 ["Reply to Message..." mh-reply (mh-get-msg-num nil)] 1442 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
@@ -1501,7 +1460,7 @@ Make it the current folder."
1501 ["Incorporate New Mail" mh-inc-folder t] 1460 ["Incorporate New Mail" mh-inc-folder t]
1502 ["Toggle Show/Folder" mh-toggle-showing t] 1461 ["Toggle Show/Folder" mh-toggle-showing t]
1503 ["Execute Delete/Refile" mh-execute-commands 1462 ["Execute Delete/Refile" mh-execute-commands
1504 (or mh-refile-list mh-delete-list)] 1463 (mh-outstanding-commands-p)]
1505 ["Rescan Folder" mh-rescan-folder t] 1464 ["Rescan Folder" mh-rescan-folder t]
1506 ["Thread Folder" mh-toggle-threads 1465 ["Thread Folder" mh-toggle-threads
1507 (not (memq 'unthread mh-view-ops))] 1466 (not (memq 'unthread mh-view-ops))]
@@ -1541,6 +1500,12 @@ is used in previous versions and XEmacs."
1541 (defvar tool-bar-map) 1500 (defvar tool-bar-map)
1542 (defvar desktop-save-buffer)) ;Emacs 21.4 1501 (defvar desktop-save-buffer)) ;Emacs 21.4
1543 1502
1503;; Register mh-folder-mode as supporting which-function-mode...
1504(load "which-func" t t)
1505(when (and (boundp 'which-func-modes)
1506 (not (member 'mh-folder-mode which-func-modes)))
1507 (push 'mh-folder-mode which-func-modes))
1508
1544(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" 1509(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1545 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> 1510 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
1546 1511
@@ -1548,16 +1513,49 @@ You can show the message the cursor is pointing to, and step through the
1548messages. Messages can be marked for deletion or refiling into another 1513messages. Messages can be marked for deletion or refiling into another
1549folder; these commands are executed all at once with a separate command. 1514folder; these commands are executed all at once with a separate command.
1550 1515
1551A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
1552applies the action to a message sequence. If `transient-mark-mode',
1553is non-nil, the action is applied to the region.
1554
1555Options that control this mode can be changed with \\[customize-group]; 1516Options that control this mode can be changed with \\[customize-group];
1556specify the \"mh\" group. In particular, please see the `mh-scan-format-file' 1517specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
1557option if you wish to modify scan's format. 1518option if you wish to modify scan's format.
1558 1519
1559When a folder is visited, the hook `mh-folder-mode-hook' is run. 1520When a folder is visited, the hook `mh-folder-mode-hook' is run.
1560 1521
1522Ranges
1523======
1524Many commands that operate on individual messages, such as `mh-forward' or
1525`mh-refile-msg' take a RANGE argument. This argument can be used in several
1526ways.
1527
1528If you provide the prefix argument (\\[universal-argument]) to these commands,
1529then you will be prompted for the message range. This can be any legal MH
1530range which can include messages, sequences, and the abbreviations (described
1531in the mh(1) man page):
1532
1533<num1>-<num2>
1534 Indicates all messages in the range <num1> to <num2>, inclusive. The range
1535 must be nonempty.
1536
1537`<num>:N'
1538`<num>:+N'
1539`<num>:-N'
1540 Up to N messages beginning with (or ending with) message num. Num may be
1541 any of the pre-defined symbols: first, prev, cur, next or last.
1542
1543`first:N'
1544`prev:N'
1545`next:N'
1546`last:N'
1547 The first, previous, next or last messages, if they exist.
1548
1549`all'
1550 All of the messages.
1551
1552For example, a range that shows all of these things is `1 2 3 5-10 last:5
1553unseen'.
1554
1555If the option `transient-mark-mode' is set to t and you set a region in the
1556MH-Folder buffer, then the MH-E command will perform the operation on all
1557messages in that region.
1558
1561\\{mh-folder-mode-map}" 1559\\{mh-folder-mode-map}"
1562 1560
1563 (make-local-variable 'font-lock-defaults) 1561 (make-local-variable 'font-lock-defaults)
@@ -1565,10 +1563,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1565 (make-local-variable 'desktop-save-buffer) 1563 (make-local-variable 'desktop-save-buffer)
1566 (setq desktop-save-buffer t) 1564 (setq desktop-save-buffer t)
1567 (mh-make-local-vars 1565 (mh-make-local-vars
1566 'mh-colors-available-flag (mh-colors-available-p)
1567 ; Do we have colors available
1568 'mh-current-folder (buffer-name) ; Name of folder, a string 1568 'mh-current-folder (buffer-name) ; Name of folder, a string
1569 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 1569 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1570 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" 1570 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1571 (file-name-as-directory (mh-expand-file-name (buffer-name))) 1571 (file-name-as-directory (mh-expand-file-name (buffer-name)))
1572 'mh-display-buttons-for-inline-parts-flag
1573 mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
1574 ; be toggled.
1572 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed 1575 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
1573 'overlay-arrow-position nil ; Allow for simultaneous display in 1576 'overlay-arrow-position nil ; Allow for simultaneous display in
1574 'overlay-arrow-string ">" ; different MH-E buffers. 1577 'overlay-arrow-string ">" ; different MH-E buffers.
@@ -1597,6 +1600,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1597 'mh-sequence-notation-history (make-hash-table) 1600 'mh-sequence-notation-history (make-hash-table)
1598 ; Remember what is overwritten by 1601 ; Remember what is overwritten by
1599 ; mh-note-seq. 1602 ; mh-note-seq.
1603 'imenu-create-index-function 'mh-index-create-imenu-index
1604 ; Setup imenu support
1600 'mh-previous-window-config nil) ; Previous window configuration 1605 'mh-previous-window-config nil) ; Previous window configuration
1601 (mh-remove-xemacs-horizontal-scrollbar) 1606 (mh-remove-xemacs-horizontal-scrollbar)
1602 (setq truncate-lines t) 1607 (setq truncate-lines t)
@@ -1620,6 +1625,26 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1620 font-lock-auto-fontify) 1625 font-lock-auto-fontify)
1621 (turn-on-font-lock))) ; Force font-lock in XEmacs. 1626 (turn-on-font-lock))) ; Force font-lock in XEmacs.
1622 1627
1628(defun mh-toggle-mime-buttons ()
1629 "Toggle display of buttons for inline MIME parts."
1630 (interactive)
1631 (setq mh-display-buttons-for-inline-parts-flag
1632 (not mh-display-buttons-for-inline-parts-flag))
1633 (mh-show nil t))
1634
1635(defun mh-colors-available-p ()
1636 "Check if colors are available in the Emacs being used."
1637 (or mh-xemacs-flag
1638 (let ((color-cells
1639 (or (ignore-errors (mh-funcall-if-exists display-color-cells))
1640 (ignore-errors (mh-funcall-if-exists
1641 x-display-color-cells)))))
1642 (and (numberp color-cells) (>= color-cells 8)))))
1643
1644(defun mh-colors-in-use-p ()
1645 "Check if colors are being used in the folder buffer."
1646 (and mh-colors-available-flag font-lock-mode))
1647
1623(defun mh-make-local-vars (&rest pairs) 1648(defun mh-make-local-vars (&rest pairs)
1624 "Initialize local variables according to the variable-value PAIRS." 1649 "Initialize local variables according to the variable-value PAIRS."
1625 1650
@@ -1631,7 +1656,11 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1631(defun mh-restore-desktop-buffer (desktop-buffer-file-name 1656(defun mh-restore-desktop-buffer (desktop-buffer-file-name
1632 desktop-buffer-name 1657 desktop-buffer-name
1633 desktop-buffer-misc) 1658 desktop-buffer-misc)
1634 "Restore an MH folder buffer specified in a desktop file." 1659 "Restore an MH folder buffer specified in a desktop file.
1660When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the file name to
1661visit, DESKTOP-BUFFER-NAME holds the desired buffer name, and
1662DESKTOP-BUFFER-MISC holds a list of miscellaneous info used by the
1663`desktop-buffer-handlers' functions."
1635 (mh-find-path) 1664 (mh-find-path)
1636 (mh-visit-folder desktop-buffer-name) 1665 (mh-visit-folder desktop-buffer-name)
1637 (current-buffer)) 1666 (current-buffer))
@@ -1641,6 +1670,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1641If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 1670If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1642refiles aren't carried out. 1671refiles aren't carried out.
1643Return in the folder's buffer." 1672Return in the folder's buffer."
1673 (when (stringp range)
1674 (setq range (delete "" (split-string range "[ \t\n]"))))
1644 (cond ((null (get-buffer folder)) 1675 (cond ((null (get-buffer folder))
1645 (mh-make-folder folder)) 1676 (mh-make-folder folder))
1646 (t 1677 (t
@@ -1693,7 +1724,9 @@ If UPDATE, append the scan lines, otherwise replace."
1693 (goto-char scan-start) 1724 (goto-char scan-start)
1694 (cond ((looking-at "scan: no messages in") 1725 (cond ((looking-at "scan: no messages in")
1695 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines 1726 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
1696 ((looking-at "scan: bad message list ") 1727 ((looking-at (if (mh-variant-p 'mu-mh)
1728 "scan: message set .* does not exist"
1729 "scan: bad message list "))
1697 (keep-lines mh-scan-valid-regexp)) 1730 (keep-lines mh-scan-valid-regexp))
1698 ((looking-at "scan: ")) ; Keep error messages 1731 ((looking-at "scan: ")) ; Keep error messages
1699 (t 1732 (t
@@ -1869,46 +1902,21 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1869 ("")))))) 1902 (""))))))
1870 (mh-logo-display)))) 1903 (mh-logo-display))))
1871 1904
1872;;; XXX: Remove this function, if no one uses it any more...
1873(defun mh-unmark-all-headers (remove-all-flags)
1874 "Remove all '+' flags from the folder listing.
1875With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1876Optimized for speed (i.e., no regular expressions).
1877
1878This function is deprecated. Use `mh-remove-all-notation' instead."
1879 (save-excursion
1880 (let ((case-fold-search nil)
1881 (last-line (1- (point-max)))
1882 char)
1883 (mh-first-msg)
1884 (while (<= (point) last-line)
1885 (forward-char mh-cmd-note)
1886 (setq char (following-char))
1887 (if (or (and remove-all-flags
1888 (or (= char (aref mh-note-deleted 0))
1889 (= char (aref mh-note-refiled 0))))
1890 (= char (aref mh-note-cur 0)))
1891 (progn
1892 (delete-char 1)
1893 (insert " ")))
1894 (if remove-all-flags
1895 (progn
1896 (forward-char 1)
1897 (if (= (following-char) (aref mh-note-seq 0))
1898 (progn
1899 (delete-char 1)
1900 (insert " ")))))
1901 (forward-line)))))
1902
1903(defun mh-add-sequence-notation (msg internal-seq-flag) 1905(defun mh-add-sequence-notation (msg internal-seq-flag)
1904 "Add sequence notation to the MSG on the current line. 1906 "Add sequence notation to the MSG on the current line.
1905If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the 1907If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if font-lock is
1906current line, so that font-lock would automatically refontify it." 1908turned on."
1907 (with-mh-folder-updating (t) 1909 (with-mh-folder-updating (t)
1908 (save-excursion 1910 (save-excursion
1909 (beginning-of-line) 1911 (beginning-of-line)
1910 (if internal-seq-flag 1912 (if internal-seq-flag
1911 (mh-notate nil nil mh-cmd-note) 1913 (progn
1914 ;; Change the buffer so that if transient-mark-mode is active
1915 ;; and there is an active region it will get deactivated as in
1916 ;; the case of user sequences.
1917 (mh-notate nil nil mh-cmd-note)
1918 (when font-lock-mode
1919 (font-lock-fontify-region (point) (line-end-position))))
1912 (forward-char (1+ mh-cmd-note)) 1920 (forward-char (1+ mh-cmd-note))
1913 (let ((stack (gethash msg mh-sequence-notation-history))) 1921 (let ((stack (gethash msg mh-sequence-notation-history)))
1914 (setf (gethash msg mh-sequence-notation-history) 1922 (setf (gethash msg mh-sequence-notation-history)
@@ -1930,7 +1938,11 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
1930 (while (and all (cdr stack)) 1938 (while (and all (cdr stack))
1931 (setq stack (cdr stack))) 1939 (setq stack (cdr stack)))
1932 (when stack 1940 (when stack
1933 (mh-notate nil (car stack) (1+ mh-cmd-note))) 1941 (save-excursion
1942 (beginning-of-line)
1943 (forward-char (1+ mh-cmd-note))
1944 (delete-char 1)
1945 (insert (car stack))))
1934 (setf (gethash msg mh-sequence-notation-history) (cdr stack)))))) 1946 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
1935 1947
1936(defun mh-remove-cur-notation () 1948(defun mh-remove-cur-notation ()
@@ -1953,7 +1965,7 @@ If ALL is non-nil, then all sequence marks on the scan line are removed."
1953 (mh-remove-sequence-notation msg nil t)) 1965 (mh-remove-sequence-notation msg nil t))
1954 (clrhash mh-sequence-notation-history))) 1966 (clrhash mh-sequence-notation-history)))
1955 1967
1956;;;###mh-autoload 1968
1957(defun mh-goto-cur-msg (&optional minimal-changes-flag) 1969(defun mh-goto-cur-msg (&optional minimal-changes-flag)
1958 "Position the cursor at the current message. 1970 "Position the cursor at the current message.
1959When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't 1971When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
@@ -2102,7 +2114,10 @@ with no arguments, after the unseen sequence is updated."
2102 2114
2103(defun mh-outstanding-commands-p () 2115(defun mh-outstanding-commands-p ()
2104 "Return non-nil if there are outstanding deletes or refiles." 2116 "Return non-nil if there are outstanding deletes or refiles."
2105 (or mh-delete-list mh-refile-list)) 2117 (save-excursion
2118 (when (eq major-mode 'mh-show-mode)
2119 (set-buffer mh-show-folder-buffer))
2120 (or mh-delete-list mh-refile-list)))
2106 2121
2107(defun mh-coalesce-msg-list (messages) 2122(defun mh-coalesce-msg-list (messages)
2108 "Given a list of MESSAGES, return a list of message number ranges. 2123 "Given a list of MESSAGES, return a list of message number ranges.
@@ -2223,7 +2238,7 @@ numbers, a sequence, a region in a cons cell. If nil all messages are notated."
2223 "Return non-nil if NAME is the name of an internal MH-E sequence." 2238 "Return non-nil if NAME is the name of an internal MH-E sequence."
2224 (or (memq name mh-internal-seqs) 2239 (or (memq name mh-internal-seqs)
2225 (eq name mh-unseen-seq) 2240 (eq name mh-unseen-seq)
2226 (and mh-tick-seq (eq name mh-tick-seq)) 2241 (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
2227 (eq name mh-previous-seq) 2242 (eq name mh-previous-seq)
2228 (mh-folder-name-p name))) 2243 (mh-folder-name-p name)))
2229 2244
@@ -2264,6 +2279,15 @@ change."
2264 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) 2279 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
2265 (apply #'mh-speed-flists t folders-changed))))) 2280 (apply #'mh-speed-flists t folders-changed)))))
2266 2281
2282(defun mh-catchup (range)
2283 "Delete RANGE from the `mh-unseen-seq' sequence.
2284
2285Check the document of `mh-interactive-range' to see how RANGE is read in
2286interactive use."
2287 (interactive (list (mh-interactive-range "Catchup"
2288 (cons (point-min) (point-max)))))
2289 (mh-delete-msg-from-seq range mh-unseen-seq))
2290
2267(defun mh-delete-a-msg-from-seq (msg sequence internal-flag) 2291(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
2268 "Delete MSG from SEQUENCE. 2292 "Delete MSG from SEQUENCE.
2269If INTERNAL-FLAG is non-nil, then do not inform MH of the change." 2293If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
@@ -2291,23 +2315,6 @@ Signals an error if SEQ is an illegal name."
2291 "-sequence" (symbol-name seq) 2315 "-sequence" (symbol-name seq)
2292 (mh-coalesce-msg-list msgs))))) 2316 (mh-coalesce-msg-list msgs)))))
2293 2317
2294(defun mh-map-over-seqs (function seq-list)
2295 "Apply FUNCTION to each sequence in SEQ-LIST.
2296The sequence name and the list of messages are passed as arguments."
2297 (while seq-list
2298 (funcall function
2299 (mh-seq-name (car seq-list))
2300 (mh-seq-msgs (car seq-list)))
2301 (setq seq-list (cdr seq-list))))
2302
2303(defun mh-notate-if-in-one-seq (msg character offset seq)
2304 "Notate MSG.
2305The CHARACTER is placed at the given OFFSET from the beginning of the listing.
2306The notation is performed if the MSG is only in SEQ."
2307 (let ((in-seqs (mh-seq-containing-msg msg nil)))
2308 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2309 (mh-notate msg character offset))))
2310
2311(defun mh-seq-containing-msg (msg &optional include-internal-flag) 2318(defun mh-seq-containing-msg (msg &optional include-internal-flag)
2312 "Return a list of the sequences containing MSG. 2319 "Return a list of the sequences containing MSG.
2313If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." 2320If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
@@ -2341,6 +2348,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2341 "'" mh-toggle-tick 2348 "'" mh-toggle-tick
2342 "," mh-header-display 2349 "," mh-header-display
2343 "." mh-alt-show 2350 "." mh-alt-show
2351 ";" mh-toggle-mh-decode-mime-flag
2344 ">" mh-write-msg-to-file 2352 ">" mh-write-msg-to-file
2345 "?" mh-help 2353 "?" mh-help
2346 "E" mh-extract-rejected-mail 2354 "E" mh-extract-rejected-mail
@@ -2362,7 +2370,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2362 "g" mh-goto-msg 2370 "g" mh-goto-msg
2363 "i" mh-inc-folder 2371 "i" mh-inc-folder
2364 "k" mh-delete-subject-or-thread 2372 "k" mh-delete-subject-or-thread
2365 "l" mh-print-msg
2366 "m" mh-alt-send 2373 "m" mh-alt-send
2367 "n" mh-next-undeleted-msg 2374 "n" mh-next-undeleted-msg
2368 "\M-n" mh-next-unread-msg 2375 "\M-n" mh-next-unread-msg
@@ -2382,6 +2389,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2382 "?" mh-prefix-help 2389 "?" mh-prefix-help
2383 "'" mh-index-ticked-messages 2390 "'" mh-index-ticked-messages
2384 "S" mh-sort-folder 2391 "S" mh-sort-folder
2392 "c" mh-catchup
2385 "f" mh-alt-visit-folder 2393 "f" mh-alt-visit-folder
2386 "i" mh-index-search 2394 "i" mh-index-search
2387 "k" mh-kill-folder 2395 "k" mh-kill-folder
@@ -2402,6 +2410,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2402 "b" mh-junk-blacklist 2410 "b" mh-junk-blacklist
2403 "w" mh-junk-whitelist) 2411 "w" mh-junk-whitelist)
2404 2412
2413(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
2414 "?" mh-prefix-help
2415 "A" mh-ps-print-toggle-mime
2416 "C" mh-ps-print-toggle-color
2417 "F" mh-ps-print-toggle-faces
2418 "M" mh-ps-print-toggle-mime
2419 "f" mh-ps-print-msg-file
2420 "l" mh-print-msg
2421 "p" mh-ps-print-msg
2422 "s" mh-ps-print-msg-show)
2423
2405(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) 2424(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2406 "'" mh-narrow-to-tick 2425 "'" mh-narrow-to-tick
2407 "?" mh-prefix-help 2426 "?" mh-prefix-help
@@ -2446,8 +2465,10 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2446(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) 2465(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
2447 "?" mh-prefix-help 2466 "?" mh-prefix-help
2448 "a" mh-mime-save-parts 2467 "a" mh-mime-save-parts
2468 "e" mh-display-with-external-viewer
2449 "i" mh-folder-inline-mime-part 2469 "i" mh-folder-inline-mime-part
2450 "o" mh-folder-save-mime-part 2470 "o" mh-folder-save-mime-part
2471 "t" mh-toggle-mime-buttons
2451 "v" mh-folder-toggle-mime-part 2472 "v" mh-folder-toggle-mime-part
2452 "\t" mh-next-button 2473 "\t" mh-next-button
2453 [backtab] mh-prev-button 2474 [backtab] mh-prev-button
@@ -2477,13 +2498,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2477(defvar mh-help-messages 2498(defvar mh-help-messages
2478 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" 2499 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
2479 "[d]elete, [o]refile, e[x]ecute,\n" 2500 "[d]elete, [o]refile, e[x]ecute,\n"
2480 "[s]end, [r]eply.\n" 2501 "[s]end, [r]eply,\n"
2502 "[;]toggle MIME decoding.\n"
2481 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," 2503 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
2482 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.") 2504 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
2483 2505
2484 (?F "[l]ist; [v]isit folder;\n" 2506 (?F "[l]ist; [v]isit folder;\n"
2485 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n" 2507 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
2486 "[p]ack; [S]ort; [r]escan; [k]ill") 2508 "[p]ack; [S]ort; [r]escan; [k]ill")
2509 (?P "PS [p]rint message; [l]non-PS print;\n"
2510 "PS Print [s]how window, message to [f]ile;\n"
2511 "Toggle printing of [M]IME parts, [C]olor, [F]aces")
2487 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n" 2512 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
2488 "[s]equences, [l]ist,\n" 2513 "[s]equences, [l]ist,\n"
2489 "[d]elete message from sequence, [k]ill sequence") 2514 "[d]elete message from sequence, [k]ill sequence")
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 46201860e2a..ef745f4c06f 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -1,6 +1,6 @@
1;;; mh-funcs.el --- MH-E functions not everyone will use right away 1;;; mh-funcs.el --- MH-E functions not everyone will use right away
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,6 +34,8 @@
34 34
35;;; Code: 35;;; Code:
36 36
37(eval-when-compile (require 'mh-acros))
38(mh-require-cl)
37(require 'mh-e) 39(require 'mh-e)
38 40
39;;; Customization 41;;; Customization
@@ -45,11 +47,13 @@ prefix argument. Normally default arguments to sortm are specified in the
45MH profile. 47MH profile.
46For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") 48For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
47 49
50;;; Scan Line Formats
51
48(defvar mh-note-copied "C" 52(defvar mh-note-copied "C"
49 "String whose first character is used to notate copied messages.") 53 "Copied messages are marked by this character.")
50 54
51(defvar mh-note-printed "P" 55(defvar mh-note-printed "P"
52 "String whose first character is used to notate printed messages.") 56 "Messages that have been printed are marked by this character.")
53 57
54;;; Functions 58;;; Functions
55 59
@@ -233,60 +237,6 @@ Otherwise just send the message's body without the headers."
233 (mh-recenter 0))) 237 (mh-recenter 0)))
234 238
235;;;###mh-autoload 239;;;###mh-autoload
236(defun mh-print-msg (range)
237 "Print RANGE on printer.
238
239Check the documentation of `mh-interactive-range' to see how RANGE is read in
240interactive use.
241
242The variable `mh-lpr-command-format' is used to generate the print command.
243The messages are formatted by mhl. See the variable `mhl-formfile'."
244 (interactive (list (mh-interactive-range "Print")))
245 (message "Printing...")
246 (let (msgs)
247 ;; Gather message numbers and add them to "printed" sequence.
248 (mh-iterate-on-range msg range
249 (mh-add-msgs-to-seq msg 'printed t)
250 (mh-notate nil mh-note-printed mh-cmd-note)
251 (push msg msgs))
252 (setq msgs (nreverse msgs))
253 ;; Print scan listing if we have more than one message.
254 (if (> (length msgs) 1)
255 (let* ((msgs-string
256 (mapconcat 'identity (mh-list-to-string
257 (mh-coalesce-msg-list msgs)) " "))
258 (lpr-command
259 (format mh-lpr-command-format
260 (cond ((listp range)
261 (format "Folder: %s, Messages: %s"
262 mh-current-folder msgs-string))
263 ((symbolp range)
264 (format "Folder: %s, Sequence: %s"
265 mh-current-folder range)))))
266 (scan-command
267 (format "scan %s | %s" msgs-string lpr-command)))
268 (if mh-print-background-flag
269 (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
270 (call-process shell-file-name nil nil nil "-c" scan-command))))
271 ;; Print the messages
272 (dolist (msg msgs)
273 (let* ((mhl-command (format "%s %s %s"
274 (expand-file-name "mhl" mh-lib-progs)
275 (if mhl-formfile
276 (format " -form %s" mhl-formfile)
277 "")
278 (mh-msg-filename msg)))
279 (lpr-command
280 (format mh-lpr-command-format
281 (format "%s/%s" mh-current-folder msg)))
282 (print-command
283 (format "%s | %s" mhl-command lpr-command)))
284 (if mh-print-background-flag
285 (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
286 (call-process shell-file-name nil nil nil "-c" print-command)))))
287 (message "Printing...done"))
288
289;;;###mh-autoload
290(defun mh-sort-folder (&optional extra-args) 240(defun mh-sort-folder (&optional extra-args)
291 "Sort the messages in the current folder by date. 241 "Sort the messages in the current folder by date.
292Calls the MH program sortm to do the work. 242Calls the MH program sortm to do the work.
@@ -307,9 +257,8 @@ argument EXTRA-ARGS is given."
307 (mh-index-data (mh-index-insert-folder-headers))))) 257 (mh-index-data (mh-index-insert-folder-headers)))))
308 258
309;;;###mh-autoload 259;;;###mh-autoload
310(defun mh-undo-folder (&rest ignore) 260(defun mh-undo-folder ()
311 "Undo all pending deletes and refiles in current folder. 261 "Undo all pending deletes and refiles in current folder."
312Argument IGNORE is deprecated."
313 (interactive) 262 (interactive)
314 (cond ((or mh-do-not-confirm-flag 263 (cond ((or mh-do-not-confirm-flag
315 (yes-or-no-p "Undo all commands in folder? ")) 264 (yes-or-no-p "Undo all commands in folder? "))
@@ -320,10 +269,7 @@ Argument IGNORE is deprecated."
320 (with-mh-folder-updating (nil) 269 (with-mh-folder-updating (nil)
321 (mh-remove-all-notation))) 270 (mh-remove-all-notation)))
322 (t 271 (t
323 (message "Commands not undone.") 272 (message "Commands not undone"))))
324 ;; Remove by 2003-06-30 if nothing seems amiss. XXX
325 ;; (sit-for 2)
326 )))
327 273
328;;;###mh-autoload 274;;;###mh-autoload
329(defun mh-store-msg (directory) 275(defun mh-store-msg (directory)
@@ -413,11 +359,15 @@ Default directory is the last directory used, or initially the value of
413 359
414;;;###mh-autoload 360;;;###mh-autoload
415(defun mh-help () 361(defun mh-help ()
416 "Display cheat sheet for the MH-Folder commands in minibuffer." 362 "Display cheat sheet for the MH-E commands."
417 (interactive) 363 (interactive)
418 (mh-ephem-message 364 (with-electric-help
419 (substitute-command-keys 365 (function
420 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) 366 (lambda ()
367 (insert
368 (substitute-command-keys
369 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
370 mh-help-buffer)))
421 371
422;;;###mh-autoload 372;;;###mh-autoload
423(defun mh-prefix-help () 373(defun mh-prefix-help ()
@@ -430,9 +380,14 @@ Default directory is the last directory used, or initially the value of
430 ;; from the recent keys. 380 ;; from the recent keys.
431 (let* ((keys (recent-keys)) 381 (let* ((keys (recent-keys))
432 (prefix-char (elt keys (- (length keys) 2)))) 382 (prefix-char (elt keys (- (length keys) 2))))
433 (mh-ephem-message 383 (with-electric-help
434 (substitute-command-keys 384 (function
435 (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) 385 (lambda ()
386 (insert
387 (substitute-command-keys
388 (mapconcat 'identity
389 (cdr (assoc prefix-char mh-help-messages)) "")))))
390 mh-help-buffer)))
436 391
437(provide 'mh-funcs) 392(provide 'mh-funcs)
438 393
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 0a893efa3c9..b850c8fdc43 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -1,6 +1,6 @@
1;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus. 1;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
2 2
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 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,6 +34,7 @@
34(load "mm-uu" t t) ; Non-fatal dependency 34(load "mm-uu" t t) ; Non-fatal dependency
35(load "mailcap" t t) ; Non-fatal dependency 35(load "mailcap" t t) ; Non-fatal dependency
36(load "smiley" t t) ; Non-fatal dependency 36(load "smiley" t t) ; Non-fatal dependency
37(load "mailabbrev" t t)
37 38
38(defmacro mh-defun-compat (function arg-list &rest body) 39(defmacro mh-defun-compat (function arg-list &rest body)
39 "This is a macro to define functions which are not defined. 40 "This is a macro to define functions which are not defined.
@@ -74,12 +75,28 @@ BODY."
74 (put-text-property 0 (length (car handle)) parameter value 75 (put-text-property 0 (length (car handle)) parameter value
75 (car handle)))) 76 (car handle))))
76 77
78;; Copy of function from mm-view.el
79(mh-defun-compat mm-inline-text-vcard (handle)
80 (let (buffer-read-only)
81 (mm-insert-inline
82 handle
83 (concat "\n-- \n"
84 (ignore-errors
85 (if (fboundp 'vcard-pretty-print)
86 (vcard-pretty-print (mm-get-part handle))
87 (vcard-format-string
88 (vcard-parse-string (mm-get-part handle)
89 'vcard-standard-filter))))))))
90
91;; Function from mm-decode.el used in PGP messages. Just define it with older
92;; gnus to avoid compiler warning.
93(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl)
94 nil)
95
77;; Copy of original macro is in mm-decode.el 96;; Copy of original macro is in mm-decode.el
78(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter) 97(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
79 `(get-text-property 0 ,parameter (car ,handle))) 98 `(get-text-property 0 ,parameter (car ,handle)))
80 99
81(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
82
83;; Copy of original function in mm-decode.el 100;; Copy of original function in mm-decode.el
84(mh-defun-compat mm-readable-p (handle) 101(mh-defun-compat mm-readable-p (handle)
85 "Say whether the content of HANDLE is readable." 102 "Say whether the content of HANDLE is readable."
@@ -134,10 +151,23 @@ BODY."
134 file))) 151 file)))
135 (mm-save-part-to-file handle file)))) 152 (mm-save-part-to-file handle file))))
136 153
154(defun mh-mm-text-html-renderer ()
155 "Find the renderer gnus is using to display text/html MIME parts."
156 (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer)
157 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))
158
159(defun mh-mail-abbrev-make-syntax-table ()
160 "Call `mail-abbrev-make-syntax-table' if available."
161 (when (fboundp 'mail-abbrev-make-syntax-table)
162 (mail-abbrev-make-syntax-table)))
163
137(provide 'mh-gnus) 164(provide 'mh-gnus)
165
138;;; Local Variables: 166;;; Local Variables:
139;;; no-byte-compile: t 167;;; no-byte-compile: t
140;;; no-update-autoloads: t 168;;; no-update-autoloads: t
169;;; indent-tabs-mode: nil
170;;; sentence-end-double-space: nil
141;;; End: 171;;; End:
142 172
143;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa 173;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index f4edc7a2087..be385ad09e6 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -39,47 +39,50 @@
39 39
40;;; Code: 40;;; Code:
41 41
42 42(eval-when-compile (require 'mh-acros))
43(require 'mh-utils)
44(mh-require-cl) 43(mh-require-cl)
45 44(require 'mh-comp)
46(eval-when (compile load eval)
47 (defvar mh-comp-loaded nil)
48 (unless mh-comp-loaded
49 (setq mh-comp-loaded t)
50 (require 'mh-comp))) ;Since we do this on sending
51 45
52(autoload 'mml-insert-tag "mml") 46(autoload 'mml-insert-tag "mml")
53 47
48(defvar mh-identity-pgg-default-user-id nil
49 "Holds the GPG key ID to be used by pgg.el.
50This is normally set as part of an Identity in `mh-identity-list'.")
51(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
52
54;;;###mh-autoload 53;;;###mh-autoload
55(defun mh-identity-make-menu () 54(defun mh-identity-make-menu ()
56 "Build (or rebuild) the Identity menu (e.g. after the list is modified)." 55 "Build the Identity menu.
57 (when (and mh-identity-list (boundp 'mh-letter-mode-map)) 56This should be called any time `mh-identity-list' or `mh-auto-fields-list'
58 (easy-menu-define mh-identity-menu mh-letter-mode-map 57change."
59 "mh-e identity menu" 58 (easy-menu-define mh-identity-menu mh-letter-mode-map
60 (append 59 "MH-E identity menu"
61 '("Identity") 60 (append
62 ;; Dynamically render :type corresponding to `mh-identity-list' 61 '("Identity")
63 ;; e.g.: 62 ;; Dynamically render :type corresponding to `mh-identity-list'
64 ;; ["home" (mh-insert-identity "home") 63 ;; e.g.:
65 ;; :style radio :active (not (equal mh-identity-local "home")) 64 ;; ["Home" (mh-insert-identity "Home")
66 ;; :selected (equal mh-identity-local "home")] 65 ;; :style radio :active (not (equal mh-identity-local "Home"))
67 '(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list] 66 ;; :selected (equal mh-identity-local "Home")]
68 "--") 67 '(["Insert Auto Fields"
69 (mapcar (function 68 (mh-insert-auto-fields) mh-auto-fields-list]
70 (lambda (arg) 69 "--")
71 `[,arg (mh-insert-identity ,arg) :style radio 70
72 :active (not (equal mh-identity-local ,arg)) 71 (mapcar (function
73 :selected (equal mh-identity-local ,arg)])) 72 (lambda (arg)
74 (mapcar 'car mh-identity-list)) 73 `[,arg (mh-insert-identity ,arg) :style radio
75 '("--" 74 :selected (equal mh-identity-local ,arg)]))
76 ["none" (mh-insert-identity "none") mh-identity-local] 75 (mapcar 'car mh-identity-list))
77 ["Set Default for Session" 76 '(["None"
78 (setq mh-identity-default mh-identity-local) t] 77 (mh-insert-identity "None") :style radio
79 ["Save as Default" 78 :selected (not mh-identity-local)]
80 (customize-save-variable 79 "--"
81 'mh-identity-default mh-identity-local) t] 80 ["Set Default for Session"
82 ))))) 81 (setq mh-identity-default mh-identity-local) t]
82 ["Save as Default"
83 (customize-save-variable 'mh-identity-default mh-identity-local) t]
84 ["Customize Identities" (customize-variable 'mh-identity-list) t]
85 ))))
83 86
84;;;###mh-autoload 87;;;###mh-autoload
85(defun mh-identity-list-set (symbol value) 88(defun mh-identity-list-set (symbol value)
@@ -97,21 +100,36 @@ customization). This is called after 'customize is used to alter
97(defun mh-header-field-delete (field value-only) 100(defun mh-header-field-delete (field value-only)
98 "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. 101 "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
99Return t if anything is deleted." 102Return t if anything is deleted."
100 (when (mh-goto-header-field field) 103 (let ((field-colon (if (string-match "^.*:$" field)
101 (if (not value-only) 104 field
102 (beginning-of-line) 105 (concat field ":"))))
103 (forward-char)) 106 (when (mh-goto-header-field field-colon)
104 (delete-region (point) 107 (if (not value-only)
105 (progn (mh-header-field-end) 108 (beginning-of-line)
106 (if (not value-only) (forward-char 1)) 109 (forward-char))
107 (point))) 110 (delete-region (point)
108 t)) 111 (progn (mh-header-field-end)
112 (if (not value-only) (forward-char 1))
113 (point)))
114 t)))
109 115
110(defvar mh-identity-signature-start nil 116(defvar mh-identity-signature-start nil
111 "Marker for the beginning of a signature inserted by `mh-insert-identity'.") 117 "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
112(defvar mh-identity-signature-end nil 118(defvar mh-identity-signature-end nil
113 "Marker for the end of a signature inserted by `mh-insert-identity'.") 119 "Marker for the end of a signature inserted by `mh-insert-identity'.")
114 120
121(defun mh-identity-field-handler (field)
122 "Return the handler for a FIELD or nil if none set.
123The field name is downcased. If the FIELD begins with the character
124`:', then it must have a special handler defined in
125`mh-identity-handlers', else return an error since it is not a legal
126message header."
127 (or (cdr (assoc (downcase field) mh-identity-handlers))
128 (and (eq (aref field 0) ?:)
129 (error (format "Field %s - unknown mh-identity-handler" field)))
130 (cdr (assoc ":default" mh-identity-handlers))
131 'mh-identity-handler-default))
132
115;;;###mh-autoload 133;;;###mh-autoload
116(defun mh-insert-identity (identity) 134(defun mh-insert-identity (identity)
117 "Insert proper fields for given IDENTITY. 135 "Insert proper fields for given IDENTITY.
@@ -120,7 +138,7 @@ Edit the `mh-identity-list' variable to define identity."
120 (list (completing-read 138 (list (completing-read
121 "Identity: " 139 "Identity: "
122 (if mh-identity-local 140 (if mh-identity-local
123 (cons '("none") 141 (cons '("None")
124 (mapcar 'list (mapcar 'car mh-identity-list))) 142 (mapcar 'list (mapcar 'car mh-identity-list)))
125 (mapcar 'list (mapcar 'car mh-identity-list))) 143 (mapcar 'list (mapcar 'car mh-identity-list)))
126 nil t))) 144 nil t)))
@@ -129,83 +147,135 @@ Edit the `mh-identity-list' variable to define identity."
129 (when mh-identity-local 147 (when mh-identity-local
130 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) 148 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
131 (while pers-list 149 (while pers-list
132 (let ((field (concat (caar pers-list) ":"))) 150 (let* ((field (caar pers-list))
133 (cond 151 (handler (mh-identity-field-handler field)))
134 ((string-equal "signature:" field) 152 (funcall handler field 'remove))
135 (when (and (boundp 'mh-identity-signature-start)
136 (markerp mh-identity-signature-start))
137 (goto-char mh-identity-signature-start)
138 (forward-char -1)
139 (delete-region (point) mh-identity-signature-end)))
140 ((mh-header-field-delete field nil))))
141 (setq pers-list (cdr pers-list))))) 153 (setq pers-list (cdr pers-list)))))
142 ;; Then insert the replacement 154 ;; Then insert the replacement
143 (when (not (equal "none" identity)) 155 (when (not (equal "None" identity))
144 (let ((pers-list (cadr (assoc identity mh-identity-list)))) 156 (let ((pers-list (cadr (assoc identity mh-identity-list))))
145 (while pers-list 157 (while pers-list
146 (let ((field (concat (caar pers-list) ":")) 158 (let* ((field (caar pers-list))
147 (value (cdar pers-list))) 159 (value (cdar pers-list))
148 (cond 160 (handler (mh-identity-field-handler field)))
149 ;; No value, remove field 161 (funcall handler field 'add value))
150 ((or (not value)
151 (string= value ""))
152 (mh-header-field-delete field nil))
153 ;; Existing field, replace
154 ((mh-header-field-delete field t)
155 (insert value))
156 ;; Handle "signature" special case. Insert file or call function.
157 ((and (string-equal "signature:" field)
158 (or (and (stringp value)
159 (file-readable-p value))
160 (fboundp value)))
161 (goto-char (point-max))
162 (if (not (looking-at "^$"))
163 (insert "\n"))
164 (insert "\n")
165 (save-restriction
166 (narrow-to-region (point) (point))
167 (set (make-local-variable 'mh-identity-signature-start)
168 (make-marker))
169 (set-marker mh-identity-signature-start (point))
170 (cond
171 ;; If MIME composition done, insert signature at the end as
172 ;; an inline MIME part.
173 ((mh-mhn-directive-present-p)
174 (insert "#\n" "Content-Description: Signature\n"))
175 ((mh-mml-directive-present-p)
176 (mml-insert-tag 'part 'type "text/plain"
177 'disposition "inline"
178 'description "Signature")))
179 (if (stringp value)
180 (insert-file-contents value)
181 (funcall value))
182 (goto-char (point-min))
183 (when (not (re-search-forward "^--" nil t))
184 (cond ((mh-mhn-directive-present-p)
185 (forward-line 2))
186 ((mh-mml-directive-present-p)
187 (forward-line 1)))
188 (insert "-- \n"))
189 (set (make-local-variable 'mh-identity-signature-end)
190 (make-marker))
191 (set-marker mh-identity-signature-end (point-max))))
192 ;; Handle "From" field differently, adding it at the beginning.
193 ((string-equal "From:" field)
194 (goto-char (point-min))
195 (insert "From: " value "\n"))
196 ;; Skip empty signature (Can't remove what we don't know)
197 ((string-equal "signature:" field))
198 ;; Other field, add at end
199 (t ;Otherwise, add the end.
200 (goto-char (point-min))
201 (mh-goto-header-end 0)
202 (mh-insert-fields field value))))
203 (setq pers-list (cdr pers-list)))))) 162 (setq pers-list (cdr pers-list))))))
204 ;; Remember what is in use in this buffer 163 ;; Remember what is in use in this buffer
205 (if (equal "none" identity) 164 (if (equal "None" identity)
206 (setq mh-identity-local nil) 165 (setq mh-identity-local nil)
207 (setq mh-identity-local identity))) 166 (setq mh-identity-local identity)))
208 167
168;;;###mh-autoload
169(defun mh-identity-handler-gpg-identity (field action &optional value)
170 "For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
171The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
172when action 'add is selected."
173 (cond
174 ((or (equal action 'remove)
175 (not value)
176 (string= value ""))
177 (setq mh-identity-pgg-default-user-id nil))
178 ((equal action 'add)
179 (setq mh-identity-pgg-default-user-id value))))
180
181;;;###mh-autoload
182(defun mh-identity-handler-signature (field action &optional value)
183 "For FIELD \"signature\", process headers for ACTION 'remove or 'add.
184The VALUE is added."
185 (cond
186 ((equal action 'remove)
187 (when (and (markerp mh-identity-signature-start)
188 (markerp mh-identity-signature-end))
189 (delete-region mh-identity-signature-start
190 mh-identity-signature-end)))
191 (t
192 ;; Insert "signature". Nil value means to use `mh-signature-file-name'.
193 (when (not (mh-signature-separator-p)) ;...unless already present
194 (goto-char (point-max))
195 (save-restriction
196 (narrow-to-region (point) (point))
197 (if (null value)
198 (mh-insert-signature)
199 (mh-insert-signature value))
200 (set (make-local-variable 'mh-identity-signature-start)
201 (point-min-marker))
202 (set-marker-insertion-type mh-identity-signature-start t)
203 (set (make-local-variable 'mh-identity-signature-end)
204 (point-max-marker)))))))
205
206(defvar mh-identity-attribution-verb-start nil
207 "Marker for the beginning of the attribution verb.")
208(defvar mh-identity-attribution-verb-end nil
209 "Marker for the end of the attribution verb.")
210
211;;;###mh-autoload
212(defun mh-identity-handler-attribution-verb (field action &optional value)
213 "For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
214The VALUE is added."
215 (when (and (markerp mh-identity-attribution-verb-start)
216 (markerp mh-identity-attribution-verb-end))
217 (delete-region mh-identity-attribution-verb-start
218 mh-identity-attribution-verb-end)
219 (goto-char mh-identity-attribution-verb-start)
220 (cond
221 ((equal action 'remove) ; Replace with default
222 (mh-identity-insert-attribution-verb nil))
223 (t ; Insert attribution verb.
224 (mh-identity-insert-attribution-verb value)))))
225
226;;;###mh-autoload
227(defun mh-identity-insert-attribution-verb (value)
228 "Insert VALUE as attribution verb, setting up delimiting markers.
229If VALUE is nil, use `mh-extract-from-attribution-verb'."
230 (save-restriction
231 (narrow-to-region (point) (point))
232 (if (null value)
233 (insert mh-extract-from-attribution-verb)
234 (insert value))
235 (set (make-local-variable 'mh-identity-attribution-verb-start)
236 (point-min-marker))
237 (set-marker-insertion-type mh-identity-attribution-verb-start t)
238 (set (make-local-variable 'mh-identity-attribution-verb-end)
239 (point-max-marker))))
240
241(defun mh-identity-handler-default (field action top &optional value)
242 "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
243if TOP is non-nil, add the field and it's VALUE at the top of the header, else
244add it at the bottom of the header."
245 (let ((field-colon (if (string-match "^.*:$" field)
246 field
247 (concat field ":"))))
248 (cond
249 ((equal action 'remove)
250 (mh-header-field-delete field-colon nil))
251 (t
252 (cond
253 ;; No value, remove field
254 ((or (not value)
255 (string= value ""))
256 (mh-header-field-delete field-colon nil))
257 ;; Existing field, replace
258 ((mh-header-field-delete field-colon t)
259 (insert value))
260 ;; Other field, add at end or top
261 (t
262 (goto-char (point-min))
263 (if (not top)
264 (mh-goto-header-end 0))
265 (insert field-colon " " value "\n")))))))
266
267;;;###mh-autoload
268(defun mh-identity-handler-top (field action &optional value)
269 "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
270If the field wasn't present, the VALUE is added at the top of the header."
271 (mh-identity-handler-default field action t value))
272
273;;;###mh-autoload
274(defun mh-identity-handler-bottom (field action &optional value)
275 "For FIELD, process mh-identity headers for ACTION 'remove or 'add.
276If the field wasn't present, the VALUE is added at the bottom of the header."
277 (mh-identity-handler-default field action nil value))
278
209(provide 'mh-identity) 279(provide 'mh-identity)
210 280
211;;; Local Variables: 281;;; Local Variables:
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 1c052b140bd..42ca018506f 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -1,6 +1,6 @@
1;;; mh-inc.el --- MH-E `inc' and separate mail spool handling 1;;; mh-inc.el --- MH-E `inc' and separate mail spool handling
2;; 2;;
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 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>
@@ -34,7 +34,8 @@
34 34
35;;; Code: 35;;; Code:
36 36
37(eval-when-compile (require 'cl)) 37(eval-when-compile (require 'mh-acros))
38(mh-require-cl)
38 39
39(defvar mh-inc-spool-map (make-sparse-keymap) 40(defvar mh-inc-spool-map (make-sparse-keymap)
40 "Keymap for MH-E's mh-inc-spool commands.") 41 "Keymap for MH-E's mh-inc-spool commands.")
@@ -46,7 +47,8 @@
46 '(lambda () 47 '(lambda ()
47 (interactive) 48 (interactive)
48 (if mh-inc-spool-map-help 49 (if mh-inc-spool-map-help
49 (mh-ephem-message (substring mh-inc-spool-map-help 0 -1)) 50 (let ((mh-help-messages (list (list nil mh-inc-spool-map-help))))
51 (mh-help))
50 (mh-ephem-message 52 (mh-ephem-message
51 "There are no keys defined yet. Customize `mh-inc-spool-list'")))) 53 "There are no keys defined yet. Customize `mh-inc-spool-list'"))))
52 54
diff --git a/lisp/mh-e/mh-index.el b/lisp/mh-e/mh-index.el
index 734ce938616..91eed420e2e 100644
--- a/lisp/mh-e/mh-index.el
+++ b/lisp/mh-e/mh-index.el
@@ -31,7 +31,6 @@
31;;; swish-e 31;;; swish-e
32;;; mairix 32;;; mairix
33;;; namazu 33;;; namazu
34;;; glimpse
35;;; grep 34;;; grep
36;;; 35;;;
37;;; (2) To use this package, you first have to build an index. Please read 36;;; (2) To use this package, you first have to build an index. Please read
@@ -43,7 +42,7 @@
43 42
44;;; Code: 43;;; Code:
45 44
46(require 'mh-utils) 45(eval-when-compile (require 'mh-acros))
47(mh-require-cl) 46(mh-require-cl)
48(require 'mh-e) 47(require 'mh-e)
49(require 'mh-mime) 48(require 'mh-mime)
@@ -66,8 +65,6 @@
66 mh-mairix-regexp-builder) 65 mh-mairix-regexp-builder)
67 (namazu 66 (namazu
68 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) 67 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil)
69 (glimpse
70 mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil)
71 (pick 68 (pick
72 mh-pick-binary mh-pick-execute-search mh-pick-next-result 69 mh-pick-binary mh-pick-execute-search mh-pick-next-result
73 mh-pick-regexp-builder) 70 mh-pick-regexp-builder)
@@ -200,7 +197,8 @@ This function should only be called in the appropriate index folder buffer."
200 (call-process "rm" nil nil nil 197 (call-process "rm" nil nil nil
201 (format "%s%s/%s" mh-user-path 198 (format "%s%s/%s" mh-user-path
202 (substring mh-current-folder 1) msg)) 199 (substring mh-current-folder 1) msg))
203 (remhash omsg (gethash ofolder mh-index-data)))) 200 (when (gethash ofolder mh-index-data)
201 (remhash omsg (gethash ofolder mh-index-data)))))
204 (t 202 (t
205 (setf (gethash msg mh-index-msg-checksum-map) checksum) 203 (setf (gethash msg mh-index-msg-checksum-map) checksum)
206 (when origin-map 204 (when origin-map
@@ -301,7 +299,8 @@ list of messages in that sequence."
301 (pair (gethash checksum mh-index-checksum-origin-map)) 299 (pair (gethash checksum mh-index-checksum-origin-map))
302 (ofolder (car pair)) 300 (ofolder (car pair))
303 (omsg (cdr pair))) 301 (omsg (cdr pair)))
304 (loop for seq in (gethash omsg (gethash ofolder seq-hash)) 302 (loop for seq in (ignore-errors
303 (gethash omsg (gethash ofolder seq-hash)))
305 do (if (assoc seq seq-list) 304 do (if (assoc seq seq-list)
306 (push msg (cdr (assoc seq seq-list))) 305 (push msg (cdr (assoc seq seq-list)))
307 (push (list seq msg) seq-list))))) 306 (push (list seq msg) seq-list)))))
@@ -374,7 +373,6 @@ index for each program:
374 - `mh-swish-execute-search' 373 - `mh-swish-execute-search'
375 - `mh-mairix-execute-search' 374 - `mh-mairix-execute-search'
376 - `mh-namazu-execute-search' 375 - `mh-namazu-execute-search'
377 - `mh-glimpse-execute-search'
378 376
379If none of these programs are present then we use pick. If desired grep can be 377If none of these programs are present then we use pick. If desired grep can be
380used instead. Details about these methods can be found in: 378used instead. Details about these methods can be found in:
@@ -436,7 +434,7 @@ This has the effect of renaming already present X-MHE-Checksum headers."
436 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) 434 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
437 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) 435 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
438 (setq index-folder buffer-name)) 436 (setq index-folder buffer-name))
439 (setq index-folder (mh-index-new-folder index-folder))) 437 (setq index-folder (mh-index-new-folder index-folder search-regexp)))
440 438
441 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) 439 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
442 (folder-results-map (make-hash-table :test #'equal)) 440 (folder-results-map (make-hash-table :test #'equal))
@@ -587,13 +585,6 @@ PROC is used to convert the value to actual data."
587 mh-previous-window-config) 585 mh-previous-window-config)
588 (error "No search terms")))) 586 (error "No search terms"))))
589 587
590(defun mh-replace-string (old new)
591 "Replace all occurrences of OLD with NEW in the current buffer."
592 (goto-char (point-min))
593 (let ((case-fold-search t))
594 (while (search-forward old nil t)
595 (replace-match new t t))))
596
597;;;###mh-autoload 588;;;###mh-autoload
598(defun mh-index-parse-search-regexp (input-string) 589(defun mh-index-parse-search-regexp (input-string)
599 "Construct parse tree for INPUT-STRING. 590 "Construct parse tree for INPUT-STRING.
@@ -739,28 +730,48 @@ results."
739 "Check if MSG exists in FOLDER." 730 "Check if MSG exists in FOLDER."
740 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) 731 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
741 732
742(defun mh-index-new-folder (name) 733(defun mh-index-new-folder (name search-regexp)
743 "Create and return an MH folder name based on NAME. 734 "Return a folder name based on NAME for search results of SEARCH-REGEXP.
744If the folder NAME already exists then check if NAME<2> exists. If it doesn't 735
745then it is created and returned. Otherwise try NAME<3>. This is repeated till 736If folder NAME already exists and was generated for the same SEARCH-REGEXP
746we find a new folder name." 737then it is reused.
738
739Otherwise if the folder NAME was generated from a different search then check
740if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a
741new folder name.
742
743If the folder returned doesn't exist then it is created."
747 (unless (mh-folder-name-p name) 744 (unless (mh-folder-name-p name)
748 (error "The argument should be a valid MH folder name")) 745 (error "The argument should be a valid MH folder name"))
749 (let ((chosen-name name)) 746 (let ((chosen-name
750 (block unique-name 747 (loop for i from 1
751 (unless (mh-folder-exists-p name) 748 for candidate = (if (equal i 1) name (format "%s<%s>" name i))
752 (return-from unique-name)) 749 when (or (not (mh-folder-exists-p candidate))
753 (loop for index from 2 750 (equal (mh-index-folder-search-regexp candidate)
754 do (let ((new-name (format "%s<%s>" name index))) 751 search-regexp))
755 (unless (mh-folder-exists-p new-name) 752 return candidate)))
756 (setq chosen-name new-name) 753 ;; Do pending refiles/deletes...
757 (return-from unique-name))))) 754 (when (get-buffer chosen-name)
755 (mh-process-or-undo-commands chosen-name))
756 ;; Recreate folder...
757 (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name))
758 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) 758 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
759 (mh-remove-from-sub-folders-cache chosen-name) 759 (mh-remove-from-sub-folders-cache chosen-name)
760 (when (boundp 'mh-speed-folder-map) 760 (when (boundp 'mh-speed-folder-map)
761 (mh-speed-add-folder chosen-name)) 761 (mh-speed-add-folder chosen-name))
762 chosen-name)) 762 chosen-name))
763 763
764(defun mh-index-folder-search-regexp (folder)
765 "If FOLDER was created by a index search, return the search regexp.
766Return nil if FOLDER doesn't exist or the .mhe_index file is garbled."
767 (ignore-errors
768 (with-temp-buffer
769 (insert-file-contents
770 (format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file))
771 (goto-char (point-min))
772 (forward-list 3)
773 (cadr (read (current-buffer))))))
774
764;;;###mh-autoload 775;;;###mh-autoload
765(defun mh-index-insert-folder-headers () 776(defun mh-index-insert-folder-headers ()
766 "Annotate the search results with original folder names." 777 "Annotate the search results with original folder names."
@@ -777,8 +788,27 @@ we find a new folder name."
777 (insert (if last-folder "\n" "") current-folder "\n") 788 (insert (if last-folder "\n" "") current-folder "\n")
778 (setq last-folder current-folder)) 789 (setq last-folder current-folder))
779 (forward-line)) 790 (forward-line))
780 (when cur-msg (mh-goto-msg cur-msg t)) 791 (when cur-msg
781 (set-buffer-modified-p old-buffer-modified-flag))) 792 (mh-notate-cur)
793 (mh-goto-msg cur-msg t))
794 (set-buffer-modified-p old-buffer-modified-flag))
795 (mh-index-create-imenu-index))
796
797;;;###mh-autoload
798(defun mh-index-create-imenu-index ()
799 "Create alist of folder names and positions in index folder buffers."
800 (save-excursion
801 (setq which-func-mode t)
802 (let ((alist ()))
803 (goto-char (point-min))
804 (while (re-search-forward "^+" nil t)
805 (save-excursion
806 (beginning-of-line)
807 (push (cons (buffer-substring-no-properties
808 (point) (line-end-position))
809 (set-marker (make-marker) (point)))
810 alist)))
811 (setq imenu--index-alist (nreverse alist)))))
782 812
783;;;###mh-autoload 813;;;###mh-autoload
784(defun mh-index-group-by-folder () 814(defun mh-index-group-by-folder ()
@@ -837,23 +867,6 @@ list of messages originally from that folder."
837 folder (loop for x being the hash-keys of (gethash folder mh-index-data) 867 folder (loop for x being the hash-keys of (gethash folder mh-index-data)
838 when (mh-msg-exists-p x folder) collect x))))) 868 when (mh-msg-exists-p x folder) collect x)))))
839 869
840;;;###mh-autoload
841(defun mh-index-update-unseen (msg)
842 "Remove counterpart of MSG in source folder from `mh-unseen-seq'.
843Also `mh-update-unseen' is called in the original folder, if we have it open."
844 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
845 (folder-msg-pair (gethash checksum mh-index-checksum-origin-map))
846 (orig-folder (car folder-msg-pair))
847 (orig-msg (cdr folder-msg-pair)))
848 (when (mh-index-match-checksum orig-msg orig-folder checksum)
849 (when (get-buffer orig-folder)
850 (save-excursion
851 (set-buffer orig-folder)
852 (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list))
853 (mh-update-unseen)))
854 (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg)
855 "-sequence" (symbol-name mh-unseen-seq) "-del"))))
856
857(defun mh-index-match-checksum (msg folder checksum) 870(defun mh-index-match-checksum (msg folder checksum)
858 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." 871 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
859 (with-temp-buffer 872 (with-temp-buffer
@@ -973,90 +986,6 @@ update the source folder buffer if present."
973 986
974 987
975 988
976;; Glimpse interface
977
978(defvar mh-glimpse-binary (executable-find "glimpse"))
979(defvar mh-glimpse-directory ".glimpse")
980
981;;;###mh-autoload
982(defun mh-glimpse-execute-search (folder-path search-regexp)
983 "Execute glimpse and read the results.
984
985In the examples below, replace /home/user/Mail with the path to your MH
986directory.
987
988First create the directory /home/user/Mail/.glimpse. Then create the file
989/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
990
991 */.*
992 */#*
993 */,*
994 */*~
995 ^/home/user/Mail/.glimpse
996 ^/home/user/Mail/mhe-index
997
998If there are any directories you would like to ignore, append lines like the
999following to .glimpse_exclude:
1000
1001 ^/home/user/Mail/scripts
1002
1003You do not want to index the folders that hold the results of your searches
1004since they tend to be ephemeral and the original messages are indexed anyway.
1005The configuration file above assumes that the results are found in sub-folders
1006of `mh-index-folder' which is +mhe-index by default.
1007
1008Use the following command line to generate the glimpse index. Run this
1009daily from cron:
1010
1011 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
1012
1013FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
1014 (set-buffer (get-buffer-create mh-index-temp-buffer))
1015 (erase-buffer)
1016 (call-process mh-glimpse-binary nil '(t nil) nil
1017 ;(format "-%s" fuzz)
1018 "-i" "-y"
1019 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
1020 "-F" (format "^%s" folder-path)
1021 search-regexp)
1022 (goto-char (point-min)))
1023
1024(defun mh-glimpse-next-result ()
1025 "Read the next result.
1026Parse it and return the message folder, message index and the match. If no
1027other matches left then return nil. If the current record is invalid return
1028'error."
1029 (prog1
1030 (block nil
1031 (when (eobp)
1032 (return nil))
1033 (let ((eol-pos (line-end-position))
1034 (bol-pos (line-beginning-position))
1035 folder-start msg-end)
1036 (goto-char bol-pos)
1037 (unless (search-forward mh-user-path eol-pos t)
1038 (return 'error))
1039 (setq folder-start (point))
1040 (unless (search-forward ": " eol-pos t)
1041 (return 'error))
1042 (let ((match (buffer-substring-no-properties (point) eol-pos)))
1043 (forward-char -2)
1044 (setq msg-end (point))
1045 (unless (search-backward "/" folder-start t)
1046 (return 'error))
1047 (list (format "+%s" (buffer-substring-no-properties
1048 folder-start (point)))
1049 (let ((val (ignore-errors (read-from-string
1050 (buffer-substring-no-properties
1051 (1+ (point)) msg-end)))))
1052 (if (and (consp val) (integerp (car val)))
1053 (car val)
1054 (return 'error)))
1055 match))))
1056 (forward-line)))
1057
1058
1059
1060;; Pick interface 989;; Pick interface
1061 990
1062(defvar mh-index-pick-folder) 991(defvar mh-index-pick-folder)
@@ -1319,16 +1248,12 @@ then the folders are searched recursively. All parameters ARGS are ignored."
1319;;;###mh-autoload 1248;;;###mh-autoload
1320(defun mh-index-sequenced-messages (folders sequence) 1249(defun mh-index-sequenced-messages (folders sequence)
1321 "Display messages from FOLDERS in SEQUENCE. 1250 "Display messages from FOLDERS in SEQUENCE.
1322By default the folders specified by `mh-index-new-messages-folders' are 1251All messages in the sequence you provide from the folders in
1323searched. With a prefix argument, enter a space-separated list of folders, or 1252`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
1324nothing to search all folders. 1253space-separated list of folders, or nothing 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."
1329 (interactive 1254 (interactive
1330 (list (if current-prefix-arg 1255 (list (if current-prefix-arg
1331 (split-string (read-string "Search folder(s) [all]? ")) 1256 (split-string (read-string "Search folder(s): [all] "))
1332 mh-index-new-messages-folders) 1257 mh-index-new-messages-folders)
1333 (mh-read-seq-default "Search" nil))) 1258 (mh-read-seq-default "Search" nil)))
1334 (unless sequence (setq sequence mh-unseen-seq)) 1259 (unless sequence (setq sequence mh-unseen-seq))
@@ -1367,26 +1292,26 @@ sequence to use."
1367;;;###mh-autoload 1292;;;###mh-autoload
1368(defun mh-index-new-messages (folders) 1293(defun mh-index-new-messages (folders)
1369 "Display unseen messages. 1294 "Display unseen messages.
1370All messages in the `unseen' sequence from FOLDERS are displayed. 1295If you use a program such as `procmail' to use `rcvstore' to file your
1371By default the folders specified by `mh-index-new-messages-folders' 1296incoming mail automatically, you can display new, unseen, messages using this
1372are searched. With a prefix argument, enter a space-separated list of 1297command. All messages in the `unseen' sequence from the folders in
1373folders, or nothing to search all folders." 1298`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
1299space-separated list of FOLDERS, or nothing to search all folders."
1374 (interactive 1300 (interactive
1375 (list (if current-prefix-arg 1301 (list (if current-prefix-arg
1376 (split-string (read-string "Search folder(s) [all]? ")) 1302 (split-string (read-string "Search folder(s): [all] "))
1377 mh-index-new-messages-folders))) 1303 mh-index-new-messages-folders)))
1378 (mh-index-sequenced-messages folders mh-unseen-seq)) 1304 (mh-index-sequenced-messages folders mh-unseen-seq))
1379 1305
1380;;;###mh-autoload 1306;;;###mh-autoload
1381(defun mh-index-ticked-messages (folders) 1307(defun mh-index-ticked-messages (folders)
1382 "Display ticked messages. 1308 "Display ticked messages.
1383All messages in the `tick' sequence from FOLDERS are displayed. 1309All messages in `mh-tick-seq' from the folders in
1384By default the folders specified by `mh-index-ticked-messages-folders' 1310`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
1385are searched. With a prefix argument, enter a space-separated list of 1311space-separated list of FOLDERS, or nothing to search all folders."
1386folders, or nothing to search all folders."
1387 (interactive 1312 (interactive
1388 (list (if current-prefix-arg 1313 (list (if current-prefix-arg
1389 (split-string (read-string "Search folder(s) [all]? ")) 1314 (split-string (read-string "Search folder(s): [all] "))
1390 mh-index-ticked-messages-folders))) 1315 mh-index-ticked-messages-folders)))
1391 (mh-index-sequenced-messages folders mh-tick-seq)) 1316 (mh-index-sequenced-messages folders mh-tick-seq))
1392 1317
diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el
new file mode 100644
index 00000000000..a975b882128
--- /dev/null
+++ b/lisp/mh-e/mh-init.el
@@ -0,0 +1,308 @@
1;;; mh-init.el --- MH-E initialization.
2
3;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
4
5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Sets up the MH variant (currently nmh or MH).
30;;
31;; Users may customize `mh-variant' to switch between available variants.
32;; Available MH variants are described in the variable `mh-variants'.
33;; Developers may check which variant is currently in use with the
34;; variable `mh-variant-in-use' or the function `mh-variant-p'.
35
36;;; Change Log:
37
38;;; Code:
39
40(eval-when-compile (require 'mh-acros))
41(mh-require-cl)
42(require 'mh-utils)
43
44;;; Set for local environment:
45;;; mh-progs and mh-lib used to be set in paths.el, which tried to
46;;; figure out at build time which of several possible directories MH
47;;; was installed into. But if you installed MH after building Emacs,
48;;; this would almost certainly be wrong, so now we do it at run time.
49
50(defvar mh-progs nil
51 "Directory containing MH commands, such as inc, repl, and rmm.")
52
53(defvar mh-lib nil
54 "Directory containing the MH library.
55This directory contains, among other things, the components file.")
56
57(defvar mh-lib-progs nil
58 "Directory containing MH helper programs.
59This directory contains, among other things, the mhl program.")
60
61(defvar mh-flists-present-flag nil
62 "Non-nil means that we have `flists'.")
63
64;;;###autoload
65(put 'mh-progs 'risky-local-variable t)
66;;;###autoload
67(put 'mh-lib 'risky-local-variable t)
68;;;###autoload
69(put 'mh-lib-progs 'risky-local-variable t)
70
71(defvar mh-variant-in-use nil
72 "The MH variant currently in use; a string with variant and version number.
73This differs from `mh-variant' when the latter is set to `autodetect'.")
74
75;;;###mh-autoload
76(defun mh-variant-set (variant)
77 "Set the MH variant to VARIANT.
78Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
79If the VARIANT is `autodetect', then first try nmh, then MH and finally
80GNU mailutils."
81 (interactive
82 (list (completing-read
83 "MH Variant: "
84 (mapcar (lambda (x) (list (car x))) (mh-variants))
85 nil t)))
86 (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
87 (cond
88 ((eq variant 'none))
89 ((eq variant 'autodetect)
90 (cond
91 ((mh-variant-set-variant 'nmh)
92 (message "%s installed as MH variant" mh-variant-in-use))
93 ((mh-variant-set-variant 'mh)
94 (message "%s installed as MH variant" mh-variant-in-use))
95 ((mh-variant-set-variant 'mu-mh)
96 (message "%s installed as MH variant" mh-variant-in-use))
97 (t
98 (message "No MH variant found on the system!"))))
99 ((member variant valid-list)
100 (when (not (mh-variant-set-variant variant))
101 (message "Warning: %s variant not found. Autodetecting..." variant)
102 (mh-variant-set 'autodetect)))
103 (t
104 (message "Unknown variant. Use %s"
105 (mapconcat '(lambda (x) (format "%s" (car x)))
106 mh-variants " or "))))))
107
108(defun mh-variant-set-variant (variant)
109 "Setup the system variables for the MH variant named VARIANT.
110If VARIANT is a string, use that key in the variable `mh-variants'.
111If VARIANT is a symbol, select the first entry that matches that variant."
112 (cond
113 ((stringp variant) ;e.g. "nmh 1.1-RC1"
114 (when (assoc variant mh-variants)
115 (let* ((alist (cdr (assoc variant mh-variants)))
116 (lib-progs (cadr (assoc 'mh-lib-progs alist)))
117 (lib (cadr (assoc 'mh-lib alist)))
118 (progs (cadr (assoc 'mh-progs alist)))
119 (flists (cadr (assoc 'flists alist))))
120 ;;(set-default mh-variant variant)
121 (setq mh-x-mailer-string nil
122 mh-flists-present-flag flists
123 mh-lib-progs lib-progs
124 mh-lib lib
125 mh-progs progs
126 mh-variant-in-use variant))))
127 ((symbolp variant) ;e.g. 'nmh (pick the first match)
128 (loop for variant-list in mh-variants
129 when (eq variant (cadr (assoc 'variant (cdr variant-list))))
130 return (let* ((version (car variant-list))
131 (alist (cdr variant-list))
132 (lib-progs (cadr (assoc 'mh-lib-progs alist)))
133 (lib (cadr (assoc 'mh-lib alist)))
134 (progs (cadr (assoc 'mh-progs alist)))
135 (flists (cadr (assoc 'flists alist))))
136 ;;(set-default mh-variant flavor)
137 (setq mh-x-mailer-string nil
138 mh-flists-present-flag flists
139 mh-lib-progs lib-progs
140 mh-lib lib
141 mh-progs progs
142 mh-variant-in-use version)
143 t)))))
144
145;;;###mh-autoload
146(defun mh-variant-p (&rest variants)
147 "Return t if variant is any of VARIANTS.
148Currently known variants are 'MH, 'nmh, and 'mu-mh."
149 (let ((variant-in-use
150 (cadr (assoc 'variant (assoc mh-variant-in-use mh-variants)))))
151 (not (null (member variant-in-use variants)))))
152
153(defvar mh-sys-path
154 '("/usr/local/nmh/bin" ; nmh default
155 "/usr/local/bin/mh/"
156 "/usr/local/mh/"
157 "/usr/bin/mh/" ; Ultrix 4.2, Linux
158 "/usr/new/mh/" ; Ultrix < 4.2
159 "/usr/contrib/mh/bin/" ; BSDI
160 "/usr/pkg/bin/" ; NetBSD
161 "/usr/local/bin/"
162 "/usr/local/bin/mu-mh/" ; GNU mailutils - default
163 "/usr/bin/mu-mh/") ; GNU mailutils - packaged
164 "List of directories to search for variants of the MH variant.
165The list `exec-path' is searched in addition to this list.
166There's no need for users to modify this list. Instead add extra
167directories to the customizable variable `mh-path'.")
168
169(defcustom mh-path nil
170 "*List of directories to search for variants of the MH variant.
171The directories will be searched for `mhparam' in addition to directories
172listed in `mh-sys-path' and `exec-path'."
173 :group 'mh
174 :type '(repeat (directory)))
175
176(defvar mh-variants nil
177 "List describing known MH variants.
178Created by the function `mh-variants'")
179
180(defun mh-variant-mh-info (dir)
181 "Return info for MH variant in DIR assuming a temporary buffer is setup."
182 ;; MH does not have the -version option.
183 ;; Its version number is included in the output of `-help' as:
184 ;;
185 ;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
186 ;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
187 ;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
188 ;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
189 ;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
190 ;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
191 ;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
192 (let ((mhparam (expand-file-name "mhparam" dir)))
193 (when (and (file-exists-p mhparam) (file-executable-p mhparam))
194 (erase-buffer)
195 (call-process mhparam nil '(t nil) nil "-help")
196 (goto-char (point-min))
197 (when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
198 (let ((version (format "MH %s" (match-string 1))))
199 (erase-buffer)
200 (call-process mhparam nil '(t nil) nil "libdir")
201 (goto-char (point-min))
202 (when (search-forward-regexp "^.*$" nil t)
203 (let ((libdir (match-string 0)))
204 `(,version
205 (variant mh)
206 (mh-lib-progs ,libdir)
207 (mh-lib ,libdir)
208 (mh-progs ,dir)
209 (flists nil)))))))))
210
211(defun mh-variant-mu-mh-info (dir)
212 "Return info for GNU mailutils variant in DIR.
213This assumes that a temporary buffer is setup."
214 ;; 'mhparam -version' output:
215 ;; mhparam (GNU mailutils 0.3.2)
216 (let ((mhparam (expand-file-name "mhparam" dir)))
217 (when (and (file-exists-p mhparam) (file-executable-p mhparam))
218 (erase-buffer)
219 (call-process mhparam nil '(t nil) nil "-version")
220 (goto-char (point-min))
221 (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
222 nil t)
223 (let ((version (match-string 1)))
224 (erase-buffer)
225 (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
226 (goto-char (point-min))
227 (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
228 (let ((libdir (match-string 1)))
229 (goto-char (point-min))
230 (when (search-forward-regexp
231 "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
232 (let ((etcdir (match-string 1))
233 (flists (file-exists-p (expand-file-name "flists" dir))))
234 `(,version
235 (variant mu-mh)
236 (mh-lib-progs ,libdir)
237 (mh-lib ,etcdir)
238 (mh-progs ,dir)
239 (flists ,flists)))))))))))
240
241(defun mh-variant-nmh-info (dir)
242 "Return info for nmh variant in DIR assuming a temporary buffer is setup."
243 ;; `mhparam -version' outputs:
244 ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
245 (let ((mhparam (expand-file-name "mhparam" dir)))
246 (when (and (file-exists-p mhparam) (file-executable-p mhparam))
247 (erase-buffer)
248 (call-process mhparam nil '(t nil) nil "-version")
249 (goto-char (point-min))
250 (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
251 (let ((version (format "nmh %s" (match-string 1))))
252 (erase-buffer)
253 (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
254 (goto-char (point-min))
255 (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
256 (let ((libdir (match-string 1)))
257 (goto-char (point-min))
258 (when (search-forward-regexp
259 "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
260 (let ((etcdir (match-string 1))
261 (flists (file-exists-p (expand-file-name "flists" dir))))
262 `(,version
263 (variant nmh)
264 (mh-lib-progs ,libdir)
265 (mh-lib ,etcdir)
266 (mh-progs ,dir)
267 (flists ,flists)))))))))))
268
269(defun mh-variant-info (dir)
270 "Return MH variant found in DIR, or nil if none present."
271 (save-excursion
272 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
273 (set-buffer tmp-buffer)
274 (cond
275 ((mh-variant-mh-info dir))
276 ((mh-variant-nmh-info dir))
277 ((mh-variant-mu-mh-info dir))))))
278
279;;;###mh-autoload
280(defun mh-variants ()
281 "Return a list of installed variants of MH on the system.
282This function looks for MH in `mh-sys-path', `mh-path' and
283`exec-path'. The format of the list of variants that is returned is described
284by the variable `mh-variants'."
285 (if mh-variants
286 mh-variants
287 (let ((list-unique))
288 ;; Make a unique list of directories, keeping the given order.
289 ;; We don't want the same MH variant to be listed multiple times.
290 (loop for dir in (append mh-path mh-sys-path exec-path) do
291 (setq dir (file-chase-links (directory-file-name dir)))
292 (add-to-list 'list-unique dir))
293 (loop for dir in (nreverse list-unique) do
294 (when (and dir (file-directory-p dir) (file-readable-p dir))
295 (let ((variant (mh-variant-info dir)))
296 (if variant
297 (add-to-list 'mh-variants variant)))))
298 mh-variants)))
299
300(provide 'mh-init)
301
302;;; Local Variables:
303;;; indent-tabs-mode: nil
304;;; sentence-end-double-space: nil
305;;; End:
306
307;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
308;;; mh-init.el ends here
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 42ec4c444d3..095a8c3c3fd 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -1,6 +1,6 @@
1;;; mh-junk.el --- Interface to anti-spam measures 1;;; mh-junk.el --- Interface to anti-spam measures
2 2
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 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;; Bill Wohler <wohler@newt.com> 6;; Bill Wohler <wohler@newt.com>
@@ -32,6 +32,8 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'mh-acros))
36(mh-require-cl)
35(require 'mh-e) 37(require 'mh-e)
36 38
37;; Interactive functions callable from the folder buffer 39;; Interactive functions callable from the folder buffer
@@ -39,36 +41,33 @@
39(defun mh-junk-blacklist (range) 41(defun mh-junk-blacklist (range)
40 "Blacklist RANGE as spam. 42 "Blacklist RANGE as spam.
41 43
42Check the documentation of `mh-interactive-range' to see how RANGE is read in 44This command trains the spam program in use (see the `mh-junk-program' option)
43interactive use. 45with the content of the range (see `mh-interactive-range') and then handles
46the message(s) as specified by the `mh-junk-disposition' option.
44 47
45First the appropriate function is called depending on the value of 48For more information about using your particular spam fighting program, see:
46`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
47refiled to that folder. If nil, the message is deleted.
48
49To change the spam program being used, customize `mh-junk-program'. Directly
50setting `mh-junk-choice' is not recommended.
51
52The documentation for the following functions describes what setup is needed
53for the different spam fighting programs:
54 49
50 - `mh-spamassassin-blacklist'
55 - `mh-bogofilter-blacklist' 51 - `mh-bogofilter-blacklist'
56 - `mh-spamprobe-blacklist' 52 - `mh-spamprobe-blacklist'"
57 - `mh-spamassassin-blacklist'"
58 (interactive (list (mh-interactive-range "Blacklist"))) 53 (interactive (list (mh-interactive-range "Blacklist")))
59 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) 54 (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
60 (unless blacklist-func 55 (unless blacklist-func
61 (error "Customize `mh-junk-program' appropriately")) 56 (error "Customize `mh-junk-program' appropriately"))
62 (let ((dest (cond ((null mh-junk-mail-folder) nil) 57 (let ((dest (cond ((null mh-junk-disposition) nil)
63 ((equal mh-junk-mail-folder "") "+") 58 ((equal mh-junk-disposition "") "+")
64 ((eq (aref mh-junk-mail-folder 0) ?+) 59 ((eq (aref mh-junk-disposition 0) ?+)
65 mh-junk-mail-folder) 60 mh-junk-disposition)
66 ((eq (aref mh-junk-mail-folder 0) ?@) 61 ((eq (aref mh-junk-disposition 0) ?@)
67 (concat mh-current-folder "/" 62 (concat mh-current-folder "/"
68 (substring mh-junk-mail-folder 1))) 63 (substring mh-junk-disposition 1)))
69 (t (concat "+" mh-junk-mail-folder))))) 64 (t (concat "+" mh-junk-disposition)))))
70 (mh-iterate-on-range msg range 65 (mh-iterate-on-range msg range
66 (message (format "Blacklisting message %d..." msg))
71 (funcall (symbol-function blacklist-func) msg) 67 (funcall (symbol-function blacklist-func) msg)
68 (message (format "Blacklisting message %d...done" msg))
69 (if (not (memq msg mh-seen-list))
70 (setq mh-seen-list (cons msg mh-seen-list)))
72 (if dest 71 (if dest
73 (mh-refile-a-msg nil (intern dest)) 72 (mh-refile-a-msg nil (intern dest))
74 (mh-delete-a-msg nil))) 73 (mh-delete-a-msg nil)))
@@ -76,231 +75,124 @@ for the different spam fighting programs:
76 75
77;;;###mh-autoload 76;;;###mh-autoload
78(defun mh-junk-whitelist (range) 77(defun mh-junk-whitelist (range)
79 "Whitelist RANGE incorrectly classified as spam. 78 "Whitelist RANGE as ham.
80
81Check the documentation of `mh-interactive-range' to see how RANGE is read in
82interactive use.
83 79
84First the appropriate function is called depending on the value of 80This command reclassifies a range of messages (see `mh-interactive-range') as
85`mh-junk-choice'. Then the message is refiled to `mh-inbox'. 81ham if it were incorrectly classified as spam. It then refiles the message
82into the `+inbox' folder.
86 83
87To change the spam program being used, customize `mh-junk-program'. Directly 84The `mh-junk-program' option specifies the spam program in use."
88setting `mh-junk-choice' is not recommended."
89 (interactive (list (mh-interactive-range "Whitelist"))) 85 (interactive (list (mh-interactive-range "Whitelist")))
90 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) 86 (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
91 (unless whitelist-func 87 (unless whitelist-func
92 (error "Customize `mh-junk-program' appropriately")) 88 (error "Customize `mh-junk-program' appropriately"))
93 (mh-iterate-on-range msg range 89 (mh-iterate-on-range msg range
90 (message (format "Whitelisting message %d..." msg))
94 (funcall (symbol-function whitelist-func) msg) 91 (funcall (symbol-function whitelist-func) msg)
92 (message (format "Whitelisting message %d...done" msg))
95 (mh-refile-a-msg nil (intern mh-inbox))) 93 (mh-refile-a-msg nil (intern mh-inbox)))
96 (mh-next-msg))) 94 (mh-next-msg)))
97 95
98 96
99 97
100;; Bogofilter Interface 98;; Spamassassin Interface
101
102(defvar mh-bogofilter-executable (executable-find "bogofilter"))
103
104(defun mh-bogofilter-blacklist (msg)
105 "Classify MSG as spam.
106Tell bogofilter that the message is spam.
107 99
108Bogofilter is a Bayesian spam filtering program. Get it from your local 100(defvar mh-spamassassin-executable (executable-find "spamassassin"))
109distribution or from: 101(defvar mh-sa-learn-executable (executable-find "sa-learn"))
110 http://bogofilter.sourceforge.net/
111 102
112You first need to teach bogofilter. This is done by running 103(defun mh-spamassassin-blacklist (msg)
104 "Blacklist MSG with SpamAssassin.
113 105
114 bogofilter -n < good-message 106SpamAssassin is one of the more popular spam filtering programs. Get it from
107your local distribution or from http://spamassassin.org/.
115 108
116on every good message, and 109To use SpamAssassin, add the following recipes to `.procmailrc':
117 110
118 bogofilter -s < spam-message 111 MAILDIR=$HOME/`mhparam Path`
119 112
120on every spam message. Most Bayesian filters need 1000 to 5000 of each to 113 # Fight spam with SpamAssassin.
121start doing a good job. 114 :0fw
115 | spamc
122 116
123To use bogofilter, add the following .procmailrc recipes which you can also 117 # Anything with a spam level of 10 or more is junked immediately.
124find in the bogofilter man page: 118 :0:
119 * ^X-Spam-Level: ..........
120 /dev/null
125 121
126 # Bogofilter 122 :0:
127 :0fw 123 * ^X-Spam-Status: Yes
128 | bogofilter -u -e -p 124 spam/.
129 125
130 :0 126If you don't use `spamc', use `spamassassin -P -a'.
131 * ^X-Bogosity: Yes, tests=bogofilter
132 $SPAM
133 127
134Bogofilter continues to feed the messages it classifies back into its 128Note that one of the recipes above throws away messages with a score greater
135database. Occasionally it misses, and those messages need to be reclassified. 129than or equal to 10. Here's how you can determine a value that works best for
136MH-E can do this for you. Use \\[mh-junk-blacklist] to reclassify messges in 130you.
137your +inbox as spam, and \\[mh-junk-whitelist] to reclassify messages in your
138spambox as good messages."
139 (unless mh-bogofilter-executable
140 (error "Couldn't find the bogofilter executable"))
141 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
142 (call-process mh-bogofilter-executable msg-file 0 nil "-Ns")))
143 131
144(defun mh-bogofilter-whitelist (msg) 132First, run `spamassassin -t' on every mail message in your archive and use
145 "Reinstate incorrectly filtered MSG. 133Gnumeric to verify that the average plus the standard deviation of good mail
146Train bogofilter to think of the message as non-spam." 134is under 5, the SpamAssassin default for \"spam\".
147 (unless mh-bogofilter-executable
148 (error "Couldn't find the bogofilter executable"))
149 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
150 (call-process mh-bogofilter-executable msg-file 0 nil "-Sn")))
151 135
152 136Using Gnumeric, sort the messages by score and view the messages with the
137highest score. Determine the score which encompasses all of your interesting
138messages and add a couple of points to be conservative. Add that many dots to
139the `X-Spam-Level:' header field above to send messages with that score down
140the drain.
153 141
154;; Spamprobe Interface 142In the example above, messages with a score of 5-9 are set aside in the
143`+spam' folder for later review. The major weakness of rules-based filters is
144a plethora of false positives so it is worthwhile to check.
155 145
156(defvar mh-spamprobe-executable (executable-find "spamprobe")) 146If SpamAssassin classifies a message incorrectly, or is unsure, you can use
147the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist].
157 148
158(defun mh-spamprobe-blacklist (msg) 149The \\[mh-junk-blacklist] command adds a `blacklist_from' entry to
159 "Classify MSG as spam. 150`~/spamassassin/user_prefs', deletes the message, and sends the message to the
160Tell spamprobe that the message is spam. 151Razor, so that others might not see this spam. If the `sa-learn' command is
161 152available, the message is also recategorized as spam.
162Spamprobe is a Bayesian spam filtering program. More info about the program can
163be found at:
164 http://spamprobe.sourceforge.net
165
166Here is a procmail recipe to stores incoming spam mail into the folder +spam
167and good mail in /home/user/Mail/mdrop/mbox. This recipe is provided as an
168example in the spamprobe man page.
169
170 PATH=/bin:/usr/bin:/usr/local/bin
171 DEFAULT=/home/user/Mail/mdrop/mbox
172 SPAM=/home/user/Mail/spam/.
173
174 # Spamprobe filtering
175 :0
176 SCORE=| spamprobe receive
177 :0 wf
178 | formail -I \"X-SpamProbe: $SCORE\"
179 :0 a:
180 *^X-SpamProbe: SPAM
181 $SPAM
182
183Occasionally some good mail gets misclassified as spam. You can use
184\\[mh-junk-whitelist] to reclassify that as good mail."
185 (unless mh-spamprobe-executable
186 (error "Couldn't find the spamprobe executable"))
187 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
188 (call-process mh-spamprobe-executable msg-file 0 nil "spam")))
189 153
190(defun mh-spamprobe-whitelist (msg) 154The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
191 "Reinstate incorrectly filtered MSG. 155`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
192Train spamprobe to think of the message as non-spam." 156message is also recategorized as ham.
193 (unless mh-spamprobe-executable
194 (error "Couldn't find the spamprobe executable"))
195 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
196 (call-process mh-spamprobe-executable msg-file 0 nil "good")))
197 157
198 158Over time, you'll observe that the same host or domain occurs repeatedly in
159the `blacklist_from' entries, so you might think that you could avoid future
160spam by blacklisting all mail from a particular domain. The utility function
161`mh-spamassassin-identify-spammers' helps you do precisely that. This function
162displays a frequency count of the hosts and domains in the `blacklist_from'
163entries from the last blank line in `~/.spamassassin/user_prefs' to the end of
164the file. This information can be used so that you can replace multiple
165`blacklist_from' entries with a single wildcard entry such as:
199 166
200;; Spamassassin Interface 167 blacklist_from *@*amazingoffersdirect2u.com
201 168
202(defvar mh-spamassassin-executable (executable-find "spamassassin")) 169In versions of SpamAssassin (2.50 and on) that support a Bayesian classifier,
203(defvar mh-sa-learn-executable (executable-find "sa-learn")) 170\\[mh-junk-blacklist] uses the `sa-learn' program to recategorize the message
171as spam. Neither MH-E, nor SpamAssassin, rebuilds the database after adding
172words, so you will need to run `sa-learn --rebuild' periodically. This can be
173done by adding the following to your crontab:
204 174
205(defun mh-spamassassin-blacklist (msg) 175 0 * * * * sa-learn --rebuild > /dev/null 2>&1"
206 "Blacklist MSG.
207This is done by sending the message to Razor and by appending the sender to
208~/.spamassassin/user_prefs in a blacklist_from rule. If sa-learn is available,
209the message is also recategorized as spam.
210
211Spamassassin is an excellent spam filter. For more information, see:
212 http://spamassassin.org/.
213
214I ran \"spamassassin -t\" on every mail message in my archive and ran an
215analysis in Gnumeric to find that the standard deviation of good mail
216scored under 5 (coincidentally, the spamassassin default for \"spam\").
217
218Furthermore, I observed that there weren't any messages with a score of 8
219or more that were interesting, so I added a couple of points to be
220conservative and send any message with a score of 10 or more down the
221drain. You might want to use a score of 12 or 13 to be really conservative.
222I have found that this really decreases the amount of junk to review.
223
224Messages with a score of 5-9 are set aside for later review. The major
225weakness of rules-based filters is a plethora of false positives\; I catch one
226or two legitimate messages in here a week, so it is worthwhile to check.
227
228You might choose to do this analysis yourself to pick a good score for
229deleting spam sight unseen, or you might pick a score out of a hat, or you
230might choose to be very conservative and not delete any messages at all.
231
232Based upon this discussion, here is what the associated ~/.procmailrc
233entries look like. These rules appear before my list filters so that spam
234sent to mailing lists gets pruned too.
235
236 #
237 # Spam
238 #
239 :0fw
240 | spamc
241
242 # Anything with a spam level of 10 or more is junked immediately.
243 :0:
244 * ^X-Spam-Level: ..........
245 /dev/null
246
247 :0
248 * ^X-Spam-Status: Yes
249 $SPAM
250
251If you don't use \"spamc\", use \"spamassassin -P -a\".
252
253A handful of spam does find its way into +inbox. In this case, use
254\\[mh-junk-blacklist] to add a \"blacklist_from\" line to
255~/spamassassin/user_prefs, delete the message, and send the message to the
256Razor, so that others might not see this spam.
257
258Over time, you see some patterns in the blacklisted addresses and can
259replace several lines with wildcards. For example, it is clear that High
260Speed Media is the biggest bunch of jerks on the Net. Here are some of the
261entries I have for them, and the list continues to grow.
262
263 blacklist_from *@*-hsm-*.com
264 blacklist_from *@*182*643*.com
265 blacklist_from *@*antarhsm*.com
266 blacklist_from *@*h*speed*
267 blacklist_from *@*hsm*182*.com
268 blacklist_from *@*hsm*643*.com
269 blacklist_from *@*hsmridi2983cslt227.com
270 blacklist_from *@*list*hsm*.com
271 blacklist_from *@h*s*media*
272 blacklist_from *@hsmdrct.com
273 blacklist_from *@hsmridi2983csltsite.com
274
275The function `mh-spamassassin-identify-spammers' is provided that shows the
276frequency counts of the host and domain names in your blacklist_from
277entries. This can be helpful when editing the blacklist_from entries.
278
279In versions of spamassassin (2.50 and on) that support a Bayesian classifier,
280\\[mh-junk-blacklist] uses the sa-learn program to recategorize the message as
281spam. Neither MH-E, nor spamassassin, rebuilds the database after adding
282words, so you will need to run \"sa-learn --rebuild\" periodically. This can
283be done by adding the following to your crontab:
284
285 0 * * * * sa-learn --rebuild > /dev/null 2>&1"
286 (unless mh-spamassassin-executable 176 (unless mh-spamassassin-executable
287 (error "Couldn't find the spamassassin executable")) 177 (error "Unable to find the spamassassin executable"))
288 (let ((current-folder mh-current-folder) 178 (let ((current-folder mh-current-folder)
289 (msg-file (mh-msg-filename msg mh-current-folder)) 179 (msg-file (mh-msg-filename msg mh-current-folder))
290 (sender)) 180 (sender))
291 (save-excursion 181 (save-excursion
292 (message "Giving this message the Razor...") 182 (message (format "Reporting message %d..." msg))
293 (mh-truncate-log-buffer) 183 (mh-truncate-log-buffer)
294 (call-process mh-spamassassin-executable msg-file mh-log-buffer nil 184 (call-process mh-spamassassin-executable msg-file mh-log-buffer nil
295 "--report" "--remove-from-whitelist") 185 ;;"--report" "--remove-from-whitelist"
186 "-r" "-R") ; spamassassin V2.20
296 (when mh-sa-learn-executable 187 (when mh-sa-learn-executable
297 (message "Recategorizing this message as spam...") 188 (message "Recategorizing this message as spam...")
298 (call-process mh-sa-learn-executable msg-file mh-log-buffer nil 189 (call-process mh-sa-learn-executable msg-file mh-log-buffer nil
299 "--single" "--spam" "--local" "--no-rebuild")) 190 "--single" "--spam" "--local" "--no-rebuild"))
300 (message "Blacklisting address...") 191 (message (format "Blacklisting message %d..." msg))
301 (set-buffer (get-buffer-create mh-temp-buffer)) 192 (set-buffer (get-buffer-create mh-temp-buffer))
302 (erase-buffer) 193 (erase-buffer)
303 (call-process (expand-file-name mh-scan-prog mh-progs) nil t nil 194 (call-process (expand-file-name mh-scan-prog mh-progs) mh-junk-background
195 t nil
304 (format "%s" msg) current-folder 196 (format "%s" msg) current-folder
305 "-format" "%<(mymbox{from})%|%(addr{from})%>") 197 "-format" "%<(mymbox{from})%|%(addr{from})%>")
306 (goto-char (point-min)) 198 (goto-char (point-min))
@@ -308,15 +200,19 @@ be done by adding the following to your crontab:
308 (progn 200 (progn
309 (setq sender (match-string 0)) 201 (setq sender (match-string 0))
310 (mh-spamassassin-add-rule "blacklist_from" sender) 202 (mh-spamassassin-add-rule "blacklist_from" sender)
311 (message "Blacklisting address...done")) 203 (message (format "Blacklisting message %d...done" msg)))
312 (message "Blacklisting address...not done (from my address)"))))) 204 (message (format "Blacklisting message %d...not done (from my address)" msg))))))
313 205
314(defun mh-spamassassin-whitelist (msg) 206(defun mh-spamassassin-whitelist (msg)
315 "Whitelist MSG. 207 "Whitelist MSG with SpamAssassin.
316Add a whitelist_from rule to the ~/.spamassassin/user_prefs file. If sa-learn 208
317is available, then the message is recategorized as ham." 209The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the
210`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the
211message is also recategorized as ham.
212
213See `mh-spamassassin-blacklist' for more information."
318 (unless mh-spamassassin-executable 214 (unless mh-spamassassin-executable
319 (error "Couldn't find the spamassassin executable")) 215 (error "Unable to find the spamassassin executable"))
320 (let ((msg-file (mh-msg-filename msg mh-current-folder)) 216 (let ((msg-file (mh-msg-filename msg mh-current-folder))
321 (show-buffer (get-buffer mh-show-buffer)) 217 (show-buffer (get-buffer mh-show-buffer))
322 from) 218 from)
@@ -325,7 +221,8 @@ is available, then the message is recategorized as ham."
325 (erase-buffer) 221 (erase-buffer)
326 (message "Removing spamassassin markup from message...") 222 (message "Removing spamassassin markup from message...")
327 (call-process mh-spamassassin-executable msg-file mh-temp-buffer nil 223 (call-process mh-spamassassin-executable msg-file mh-temp-buffer nil
328 "--remove-markup") 224 ;; "--remove-markup"
225 "-d") ; spamassassin V2.20
329 (if show-buffer 226 (if show-buffer
330 (kill-buffer show-buffer)) 227 (kill-buffer show-buffer))
331 (write-file msg-file) 228 (write-file msg-file)
@@ -333,15 +230,17 @@ is available, then the message is recategorized as ham."
333 (message "Recategorizing this message as ham...") 230 (message "Recategorizing this message as ham...")
334 (call-process mh-sa-learn-executable msg-file mh-temp-buffer nil 231 (call-process mh-sa-learn-executable msg-file mh-temp-buffer nil
335 "--single" "--ham" "--local --no-rebuild")) 232 "--single" "--ham" "--local --no-rebuild"))
336 (message "Whitelisting address...") 233 (message (format "Whitelisting message %d..." msg))
337 (setq from (car (ietf-drums-parse-address (mh-get-header-field "From:")))) 234 (setq from
235 (car (mh-funcall-if-exists
236 ietf-drums-parse-address (mh-get-header-field "From:"))))
338 (kill-buffer nil) 237 (kill-buffer nil)
339 (unless (equal from "") 238 (unless (or (null from) (equal from ""))
340 (mh-spamassassin-add-rule "whitelist_from" from)) 239 (mh-spamassassin-add-rule "whitelist_from" from))
341 (message "Whitelisting address...done")))) 240 (message (format "Whitelisting message %d...done" msg)))))
342 241
343(defun mh-spamassassin-add-rule (rule body) 242(defun mh-spamassassin-add-rule (rule body)
344 "Add a new rule to ~/.spamassassin/user_prefs. 243 "Add a new rule to `~/.spamassassin/user_prefs'.
345The name of the rule is RULE and its body is BODY." 244The name of the rule is RULE and its body is BODY."
346 (save-window-excursion 245 (save-window-excursion
347 (let* ((line (format "%s\t%s\n" rule body)) 246 (let* ((line (format "%s\t%s\n" rule body))
@@ -358,15 +257,15 @@ The name of the rule is RULE and its body is BODY."
358 (kill-buffer nil))))) 257 (kill-buffer nil)))))
359 258
360(defun mh-spamassassin-identify-spammers () 259(defun mh-spamassassin-identify-spammers ()
361 "Identifies spammers who are repeat offenders. 260 "Identify spammers who are repeat offenders.
362 261
363For each blacklist_from entry from the last blank line of 262This function displays a frequency count of the hosts and domains in the
364~/.spamassassin/user_prefs to the end of the file, a list of host and domain 263`blacklist_from' entries from the last blank line in
365names along with their frequency counts is displayed. This information can be 264`~/.spamassassin/user_prefs' to the end of the file. This information can be
366used to replace multiple blacklist_from entries with a single wildcard entry 265used so that you can replace multiple `blacklist_from' entries with a single
367such as: 266wildcard entry such as:
368 267
369 blacklist_from *@*amazingoffersdirect2u.com" 268 blacklist_from *@*amazingoffersdirect2u.com"
370 (interactive) 269 (interactive)
371 (let* ((file (expand-file-name "~/.spamassassin/user_prefs")) 270 (let* ((file (expand-file-name "~/.spamassassin/user_prefs"))
372 (domains (make-hash-table :test 'equal))) 271 (domains (make-hash-table :test 'equal)))
@@ -385,7 +284,7 @@ such as:
385 ;; Add counts for each host and domain part. 284 ;; Add counts for each host and domain part.
386 (while host 285 (while host
387 (setq value (gethash (car host) domains)) 286 (setq value (gethash (car host) domains))
388 (puthash (car host) (1+ (if (not value) 0 value)) domains) 287 (setf (gethash (car host) domains) (1+ (if (not value) 0 value)))
389 (setq host (cdr host)))))) 288 (setq host (cdr host))))))
390 289
391 ;; Output 290 ;; Output
@@ -400,6 +299,121 @@ such as:
400 (reverse-region (point-min) (point-max)) 299 (reverse-region (point-min) (point-max))
401 (goto-char (point-min)))) 300 (goto-char (point-min))))
402 301
302
303
304;; Bogofilter Interface
305
306(defvar mh-bogofilter-executable (executable-find "bogofilter"))
307
308(defun mh-bogofilter-blacklist (msg)
309 "Blacklist MSG with Bogofilter.
310
311Bogofilter is a Bayesian spam filtering program. Get it from your local
312distribution or from http://bogofilter.sourceforge.net/.
313
314Bogofilter is taught by running:
315
316 bogofilter -n < good-message
317
318on every good message, and
319
320 bogofilter -s < spam-message
321
322on every spam message. This is called a full training; three other
323training methods are described in the FAQ that is distributed with bogofilter.
324Note that most Bayesian filters need 1000 to 5000 of each type of message to
325start doing a good job.
326
327To use Bogofilter, add the following recipes to `.procmailrc':
328
329 MAILDIR=$HOME/`mhparam Path`
330
331 # Fight spam with Bogofilter.
332 :0fw
333 | bogofilter -3 -e -p
334
335 :0:
336 * ^X-Bogosity: Yes, tests=bogofilter
337 spam/.
338
339 :0:
340 * ^X-Bogosity: Unsure, tests=bogofilter
341 spam/unsure/.
342
343If Bogofilter classifies a message incorrectly, or is unsure, you can use the
344MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update
345Bogofilter's training.
346
347The \"Bogofilter FAQ\" suggests that you run the following
348occasionally to shrink the database:
349
350 bogoutil -d wordlist.db | bogoutil -l wordlist.db.new
351 mv wordlist.db wordlist.db.prv
352 mv wordlist.db.new wordlist.db
353
354The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
355 (unless mh-bogofilter-executable
356 (error "Unable to find the bogofilter executable"))
357 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
358 (call-process mh-bogofilter-executable msg-file mh-junk-background
359 nil "-s")))
360
361(defun mh-bogofilter-whitelist (msg)
362 "Whitelist MSG with Bogofilter.
363
364See `mh-bogofilter-blacklist' for more information."
365 (unless mh-bogofilter-executable
366 (error "Unable to find the bogofilter executable"))
367 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
368 (call-process mh-bogofilter-executable msg-file mh-junk-background
369 nil "-n")))
370
371
372
373;; Spamprobe Interface
374
375(defvar mh-spamprobe-executable (executable-find "spamprobe"))
376
377(defun mh-spamprobe-blacklist (msg)
378 "Blacklist MSG with SpamProbe.
379
380SpamProbe is a Bayesian spam filtering program. Get it from your local
381distribution or from http://spamprobe.sourceforge.net.
382
383To use SpamProbe, add the following recipes to `.procmailrc':
384
385 MAILDIR=$HOME/`mhparam Path`
386
387 # Fight spam with SpamProbe.
388 :0
389 SCORE=| spamprobe receive
390
391 :0 wf
392 | formail -I \"X-SpamProbe: $SCORE\"
393
394 :0:
395 *^X-SpamProbe: SPAM
396 spam/.
397
398If SpamProbe classifies a message incorrectly, you can use the MH-E commands
399\\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update SpamProbe's
400training."
401 (unless mh-spamprobe-executable
402 (error "Unable to find the spamprobe executable"))
403 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
404 (call-process mh-spamprobe-executable msg-file mh-junk-background
405 nil "spam")))
406
407(defun mh-spamprobe-whitelist (msg)
408 "Whitelist MSG with SpamProbe.
409
410See `mh-spamprobe-blacklist' for more information."
411 (unless mh-spamprobe-executable
412 (error "Unable to find the spamprobe executable"))
413 (let ((msg-file (mh-msg-filename msg mh-current-folder)))
414 (call-process mh-spamprobe-executable msg-file mh-junk-background
415 nil "good")))
416
403(provide 'mh-junk) 417(provide 'mh-junk)
404 418
405;;; Local Variables: 419;;; Local Variables:
diff --git a/lisp/mh-e/mh-loaddefs.el b/lisp/mh-e/mh-loaddefs.el
index a5578760845..fd989ffa3b9 100644
--- a/lisp/mh-e/mh-loaddefs.el
+++ b/lisp/mh-e/mh-loaddefs.el
@@ -11,22 +11,24 @@
11;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft 11;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft
12;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields 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-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
14;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward 14;;;;;; mh-get-header-field mh-send-other-window mh-send mh-reply
15;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el" 15;;;;;; mh-redistribute mh-forward mh-extract-rejected-mail mh-edit-again)
16;;;;;; (16625 53169)) 16;;;;;; "mh-comp" "mh-comp.el" (16665 53716))
17;;; Generated autoloads from mh-comp.el 17;;; Generated autoloads from mh-comp.el
18 18
19(autoload (quote mh-edit-again) "mh-comp" "\ 19(autoload (quote mh-edit-again) "mh-comp" "\
20Clean up a draft or a message MSG previously sent and make it resendable. 20Clean up a draft or a message MSG previously sent and make it resendable.
21Default is the current message. 21Default is the current message.
22The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. 22The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
23See also documentation for `\\[mh-send]' function." t nil) 23
24See also `mh-send'." t nil)
24 25
25(autoload (quote mh-extract-rejected-mail) "mh-comp" "\ 26(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
26Extract message MSG returned by the mail system and make it resendable. 27Extract message MSG returned by the mail system and make it resendable.
27Default is the current message. The variable `mh-new-draft-cleaned-headers' 28Default is the current message. The variable `mh-new-draft-cleaned-headers'
28gives the headers to clean out of the original message. 29gives the headers to clean out of the original message.
29See also documentation for `\\[mh-send]' function." t nil) 30
31See also `mh-send'." t nil)
30 32
31(autoload (quote mh-forward) "mh-comp" "\ 33(autoload (quote mh-forward) "mh-comp" "\
32Forward messages to the recipients TO and CC. 34Forward messages to the recipients TO and CC.
@@ -36,7 +38,7 @@ Default is the displayed message.
36Check the documentation of `mh-interactive-range' to see how RANGE is read in 38Check the documentation of `mh-interactive-range' to see how RANGE is read in
37interactive use. 39interactive use.
38 40
39See also documentation for `\\[mh-send]' function." t nil) 41See also `mh-send'." t nil)
40 42
41(autoload (quote mh-redistribute) "mh-comp" "\ 43(autoload (quote mh-redistribute) "mh-comp" "\
42Redistribute displayed message to recipients TO and CC. 44Redistribute displayed message to recipients TO and CC.
@@ -55,11 +57,12 @@ to reply to:
55If optional prefix argument INCLUDEP provided, then include the message 57If optional prefix argument INCLUDEP provided, then include the message
56in the reply using filter `mhl.reply' in your MH directory. 58in the reply using filter `mhl.reply' in your MH directory.
57If the file named by `mh-repl-formfile' exists, it is used as a skeleton 59If the file named by `mh-repl-formfile' exists, it is used as a skeleton
58for the reply. See also documentation for `\\[mh-send]' function." t nil) 60for the reply.
61
62See also `mh-send'." t nil)
59 63
60(autoload (quote mh-send) "mh-comp" "\ 64(autoload (quote mh-send) "mh-comp" "\
61Compose and send a letter. 65Compose and send a letter.
62
63Do not call this function from outside MH-E; use \\[mh-smail] instead. 66Do not call this function from outside MH-E; use \\[mh-smail] instead.
64 67
65The file named by `mh-comp-formfile' will be used as the form. 68The file named by `mh-comp-formfile' will be used as the form.
@@ -70,7 +73,6 @@ passed three arguments: TO, CC, and SUBJECT." t nil)
70 73
71(autoload (quote mh-send-other-window) "mh-comp" "\ 74(autoload (quote mh-send-other-window) "mh-comp" "\
72Compose and send a letter in another window. 75Compose and send a letter in another window.
73
74Do not call this function from outside MH-E; use \\[mh-smail-other-window] 76Do not call this function from outside MH-E; use \\[mh-smail-other-window]
75instead. 77instead.
76 78
@@ -80,6 +82,11 @@ details.
80If `mh-compose-letter-function' is defined, it is called on the draft and 82If `mh-compose-letter-function' is defined, it is called on the draft and
81passed three arguments: TO, CC, and SUBJECT." t nil) 83passed three arguments: TO, CC, and SUBJECT." t nil)
82 84
85(autoload (quote mh-get-header-field) "mh-comp" "\
86Find and return the body of FIELD in the mail header.
87Returns the empty string if the field is not in the header of the
88current buffer." nil nil)
89
83(autoload (quote mh-fill-paragraph-function) "mh-comp" "\ 90(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
84Fill paragraph at or after point. 91Fill paragraph at or after point.
85Prefix ARG means justify as well. This function enables `fill-paragraph' to 92Prefix ARG means justify as well. This function enables `fill-paragraph' to
@@ -96,9 +103,12 @@ Insert an Fcc: FOLDER field in the current message.
96Prompt for the field name with a completion list of the current folders." t nil) 103Prompt for the field name with a completion list of the current folders." t nil)
97 104
98(autoload (quote mh-insert-signature) "mh-comp" "\ 105(autoload (quote mh-insert-signature) "mh-comp" "\
99Insert the file named by `mh-signature-file-name' at point. 106Insert the signature specified by `mh-signature-file-name' or FILE at point.
107A signature separator (`-- ') will be added if the signature block does not
108contain one and `mh-signature-separator-flag' is on.
100The value of `mh-letter-insert-signature-hook' is a list of functions to be 109The value of `mh-letter-insert-signature-hook' is a list of functions to be
101called, with no arguments, before the signature is actually inserted." t nil) 110called, with no arguments, after the signature is inserted.
111The signature can also be inserted with `mh-identity-list'." t nil)
102 112
103(autoload (quote mh-check-whom) "mh-comp" "\ 113(autoload (quote mh-check-whom) "mh-comp" "\
104Verify recipients of the current letter, showing expansion of any aliases." t nil) 114Verify recipients of the current letter, showing expansion of any aliases." t nil)
@@ -109,7 +119,9 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
109something. If NON-INTERACTIVE is non-nil, do not be verbose and only 119something. If NON-INTERACTIVE is non-nil, do not be verbose and only
110attempt matches if `mh-insert-auto-fields-done-local' is nil. 120attempt matches if `mh-insert-auto-fields-done-local' is nil.
111 121
112An `identity' entry is skipped if one was already entered manually." t nil) 122An `identity' entry is skipped if one was already entered manually.
123
124Return t if fields added; otherwise return nil." t nil)
113 125
114(autoload (quote mh-send-letter) "mh-comp" "\ 126(autoload (quote mh-send-letter) "mh-comp" "\
115Send the draft letter in the current buffer. 127Send the draft letter in the current buffer.
@@ -117,13 +129,12 @@ If optional prefix argument ARG is provided, monitor delivery.
117The value of `mh-before-send-letter-hook' is a list of functions to be called, 129The value of `mh-before-send-letter-hook' is a list of functions to be called,
118with no arguments, before doing anything. 130with no arguments, before doing anything.
119Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise 131Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise
120run `\\[mh-mml-to-mime]' if mml directives are present. 132run `\\[mh-mml-to-mime]' if mml directives are present." t nil)
121Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
122Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
123 133
124(autoload (quote mh-insert-letter) "mh-comp" "\ 134(autoload (quote mh-insert-letter) "mh-comp" "\
125Insert a message into the current letter. 135Insert a message into the current letter.
126Removes the header fields according to the variable `mh-invisible-headers'. 136Removes the header fields according to the variable
137`mh-invisible-header-fields-compiled'.
127Prefixes each non-blank line with `mh-ins-buf-prefix', unless 138Prefixes each non-blank line with `mh-ins-buf-prefix', unless
128`mh-yank-from-start-of-msg' is set for supercite in which case supercite is 139`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
129used to format the message. 140used to format the message.
@@ -168,42 +179,11 @@ If we are at the first header field go to the start of the message body." t nil)
168 179
169;;;*** 180;;;***
170 181
171;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el"
172;;;;;; (16625 53481))
173;;; Generated autoloads from mh-customize.el
174
175(autoload (quote mh-customize) "mh-customize" "\
176Customize MH-E variables.
177With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame
178are removed." t nil)
179
180;;;***
181
182;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
183;;;;;; "mh-e" "mh-e.el" (16627 22341))
184;;; Generated autoloads from mh-e.el
185
186(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
187Return t if the message under point in folder-mode is in the show buffer.
188Return nil in any other circumstance (no message under point, no show buffer,
189the message in the show buffer doesn't match." nil nil)
190
191(autoload (quote mh-update-sequences) "mh-e" "\
192Update MH's Unseen-Sequence and current folder and message.
193Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
194
195(autoload (quote mh-goto-cur-msg) "mh-e" "\
196Position the cursor at the current message.
197When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
198recenter the folder buffer." nil nil)
199
200;;;***
201
202;;;### (autoloads (mh-prefix-help mh-help mh-ephem-message mh-store-buffer 182;;;### (autoloads (mh-prefix-help mh-help mh-ephem-message mh-store-buffer
203;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards 183;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-page-digest-backwards
204;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders 184;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
205;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el" 185;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
206;;;;;; (16625 54011)) 186;;;;;; (16671 48788))
207;;; Generated autoloads from mh-funcs.el 187;;; Generated autoloads from mh-funcs.el
208 188
209(autoload (quote mh-burst-digest) "mh-funcs" "\ 189(autoload (quote mh-burst-digest) "mh-funcs" "\
@@ -245,15 +225,6 @@ Advance displayed message to next digested message." t nil)
245(autoload (quote mh-page-digest-backwards) "mh-funcs" "\ 225(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
246Back up displayed message to previous digested message." t nil) 226Back up displayed message to previous digested message." t nil)
247 227
248(autoload (quote mh-print-msg) "mh-funcs" "\
249Print RANGE on printer.
250
251Check the documentation of `mh-interactive-range' to see how RANGE is read in
252interactive use.
253
254The variable `mh-lpr-command-format' is used to generate the print command.
255The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
256
257(autoload (quote mh-sort-folder) "mh-funcs" "\ 228(autoload (quote mh-sort-folder) "mh-funcs" "\
258Sort the messages in the current folder by date. 229Sort the messages in the current folder by date.
259Calls the MH program sortm to do the work. 230Calls the MH program sortm to do the work.
@@ -261,8 +232,7 @@ The arguments in the list `mh-sortm-args' are passed to sortm if the optional
261argument EXTRA-ARGS is given." t nil) 232argument EXTRA-ARGS is given." t nil)
262 233
263(autoload (quote mh-undo-folder) "mh-funcs" "\ 234(autoload (quote mh-undo-folder) "mh-funcs" "\
264Undo all pending deletes and refiles in current folder. 235Undo all pending deletes and refiles in current folder." t nil)
265Argument IGNORE is deprecated." t nil)
266 236
267(autoload (quote mh-store-msg) "mh-funcs" "\ 237(autoload (quote mh-store-msg) "mh-funcs" "\
268Store the file(s) contained in the current message into DIRECTORY. 238Store the file(s) contained in the current message into DIRECTORY.
@@ -280,19 +250,24 @@ Default directory is the last directory used, or initially the value of
280Display STRING in the minibuffer momentarily." nil nil) 250Display STRING in the minibuffer momentarily." nil nil)
281 251
282(autoload (quote mh-help) "mh-funcs" "\ 252(autoload (quote mh-help) "mh-funcs" "\
283Display cheat sheet for the MH-Folder commands in minibuffer." t nil) 253Display cheat sheet for the MH-E commands." t nil)
284 254
285(autoload (quote mh-prefix-help) "mh-funcs" "\ 255(autoload (quote mh-prefix-help) "mh-funcs" "\
286Display cheat sheet for the commands of the current prefix in minibuffer." t nil) 256Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
287 257
288;;;*** 258;;;***
289 259
290;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu) 260;;;### (autoloads (mh-identity-handler-bottom mh-identity-handler-top
291;;;;;; "mh-identity" "mh-identity.el" (16625 54171)) 261;;;;;; mh-identity-insert-attribution-verb mh-identity-handler-attribution-verb
262;;;;;; mh-identity-handler-signature mh-identity-handler-gpg-identity
263;;;;;; mh-insert-identity mh-identity-list-set mh-identity-make-menu)
264;;;;;; "mh-identity" "mh-identity.el" (16671 57010))
292;;; Generated autoloads from mh-identity.el 265;;; Generated autoloads from mh-identity.el
293 266
294(autoload (quote mh-identity-make-menu) "mh-identity" "\ 267(autoload (quote mh-identity-make-menu) "mh-identity" "\
295Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil) 268Build the Identity menu.
269This should be called any time `mh-identity-list' or `mh-auto-fields-list'
270change." nil nil)
296 271
297(autoload (quote mh-identity-list-set) "mh-identity" "\ 272(autoload (quote mh-identity-list-set) "mh-identity" "\
298Update the `mh-identity-list' variable, and rebuild the menu. 273Update the `mh-identity-list' variable, and rebuild the menu.
@@ -304,10 +279,35 @@ customization). This is called after 'customize is used to alter
304Insert proper fields for given IDENTITY. 279Insert proper fields for given IDENTITY.
305Edit the `mh-identity-list' variable to define identity." t nil) 280Edit the `mh-identity-list' variable to define identity." t nil)
306 281
282(autoload (quote mh-identity-handler-gpg-identity) "mh-identity" "\
283For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add.
284The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE
285when action 'add is selected." nil nil)
286
287(autoload (quote mh-identity-handler-signature) "mh-identity" "\
288For FIELD \"signature\", process headers for ACTION 'remove or 'add.
289The VALUE is added." nil nil)
290
291(autoload (quote mh-identity-handler-attribution-verb) "mh-identity" "\
292For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add.
293The VALUE is added." nil nil)
294
295(autoload (quote mh-identity-insert-attribution-verb) "mh-identity" "\
296Insert VALUE as attribution verb, setting up delimiting markers.
297If VALUE is nil, use `mh-extract-from-attribution-verb'." nil nil)
298
299(autoload (quote mh-identity-handler-top) "mh-identity" "\
300For FIELD, process mh-identity headers for ACTION 'remove or 'add.
301If the field wasn't present, the VALUE is added at the top of the header." nil nil)
302
303(autoload (quote mh-identity-handler-bottom) "mh-identity" "\
304For FIELD, process mh-identity headers for ACTION 'remove or 'add.
305If the field wasn't present, the VALUE is added at the bottom of the header." nil nil)
306
307;;;*** 307;;;***
308 308
309;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625 309;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16671
310;;;;;; 54212)) 310;;;;;; 48848))
311;;; Generated autoloads from mh-inc.el 311;;; Generated autoloads from mh-inc.el
312 312
313(autoload (quote mh-inc-spool-list-set) "mh-inc" "\ 313(autoload (quote mh-inc-spool-list-set) "mh-inc" "\
@@ -319,14 +319,14 @@ This is called after 'customize is used to alter `mh-inc-spool-list'." nil nil)
319 319
320;;;### (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
321;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages 321;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages
322;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence 322;;;;;; mh-index-sequenced-messages mh-index-delete-from-sequence
323;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen 323;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-visit-folder
324;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder 324;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-create-imenu-index
325;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder 325;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder
326;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p 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 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" 328;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el"
329;;;;;; (16625 54348)) 329;;;;;; (16665 53754))
330;;; Generated autoloads from mh-index.el 330;;; Generated autoloads from mh-index.el
331 331
332(autoload (quote mh-index-update-maps) "mh-index" "\ 332(autoload (quote mh-index-update-maps) "mh-index" "\
@@ -367,7 +367,6 @@ index for each program:
367 - `mh-swish-execute-search' 367 - `mh-swish-execute-search'
368 - `mh-mairix-execute-search' 368 - `mh-mairix-execute-search'
369 - `mh-namazu-execute-search' 369 - `mh-namazu-execute-search'
370 - `mh-glimpse-execute-search'
371 370
372If none of these programs are present then we use pick. If desired grep can be 371If none of these programs are present then we use pick. If desired grep can be
373used instead. Details about these methods can be found in: 372used instead. Details about these methods can be found in:
@@ -411,6 +410,9 @@ Jump to the previous folder marker." t nil)
411(autoload (quote mh-index-insert-folder-headers) "mh-index" "\ 410(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
412Annotate the search results with original folder names." nil nil) 411Annotate the search results with original folder names." nil nil)
413 412
413(autoload (quote mh-index-create-imenu-index) "mh-index" "\
414Create alist of folder names and positions in index folder buffers." nil nil)
415
414(autoload (quote mh-index-group-by-folder) "mh-index" "\ 416(autoload (quote mh-index-group-by-folder) "mh-index" "\
415Partition the messages based on source folder. 417Partition the messages based on source folder.
416Returns an alist with the the folder names in the car and the cdr being the 418Returns an alist with the the folder names in the car and the cdr being the
@@ -422,10 +424,6 @@ Delete the folder headers." nil nil)
422(autoload (quote mh-index-visit-folder) "mh-index" "\ 424(autoload (quote mh-index-visit-folder) "mh-index" "\
423Visit original folder from where the message at point was found." t nil) 425Visit original folder from where the message at point was found." t nil)
424 426
425(autoload (quote mh-index-update-unseen) "mh-index" "\
426Remove counterpart of MSG in source folder from `mh-unseen-seq'.
427Also `mh-update-unseen' is called in the original folder, if we have it open." nil nil)
428
429(autoload (quote mh-index-execute-commands) "mh-index" "\ 427(autoload (quote mh-index-execute-commands) "mh-index" "\
430Delete/refile the actual messages. 428Delete/refile the actual messages.
431The copies in the searched folder are then deleted/refiled to get the desired 429The copies in the searched folder are then deleted/refiled to get the desired
@@ -442,62 +440,25 @@ Delete from SEQ the messages in MSGS.
442This function updates the source folder sequences. Also makes an attempt to 440This function updates the source folder sequences. Also makes an attempt to
443update the source folder buffer if present." nil nil) 441update the source folder buffer if present." nil nil)
444 442
445(autoload (quote mh-glimpse-execute-search) "mh-index" "\
446Execute glimpse and read the results.
447
448In the examples below, replace /home/user/Mail with the path to your MH
449directory.
450
451First create the directory /home/user/Mail/.glimpse. Then create the file
452/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
453
454 */.*
455 */#*
456 */,*
457 */*~
458 ^/home/user/Mail/.glimpse
459 ^/home/user/Mail/mhe-index
460
461If there are any directories you would like to ignore, append lines like the
462following to .glimpse_exclude:
463
464 ^/home/user/Mail/scripts
465
466You do not want to index the folders that hold the results of your searches
467since they tend to be ephemeral and the original messages are indexed anyway.
468The configuration file above assumes that the results are found in sub-folders
469of `mh-index-folder' which is +mhe-index by default.
470
471Use the following command line to generate the glimpse index. Run this
472daily from cron:
473
474 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
475
476FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
477
478(autoload (quote mh-index-sequenced-messages) "mh-index" "\ 443(autoload (quote mh-index-sequenced-messages) "mh-index" "\
479Display messages from FOLDERS in SEQUENCE. 444Display messages from FOLDERS in SEQUENCE.
480By default the folders specified by `mh-index-new-messages-folders' are 445All messages in the sequence you provide from the folders in
481searched. With a prefix argument, enter a space-separated list of folders, or 446`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
482nothing to search all folders. 447space-separated list of folders, or nothing to search all folders." t nil)
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 448
488(autoload (quote mh-index-new-messages) "mh-index" "\ 449(autoload (quote mh-index-new-messages) "mh-index" "\
489Display unseen messages. 450Display unseen messages.
490All messages in the `unseen' sequence from FOLDERS are displayed. 451If you use a program such as `procmail' to use `rcvstore' to file your
491By default the folders specified by `mh-index-new-messages-folders' 452incoming mail automatically, you can display new, unseen, messages using this
492are searched. With a prefix argument, enter a space-separated list of 453command. All messages in the `unseen' sequence from the folders in
493folders, or nothing to search all folders." t nil) 454`mh-index-new-messages-folders' are listed. With a prefix argument, enter a
455space-separated list of FOLDERS, or nothing to search all folders." t nil)
494 456
495(autoload (quote mh-index-ticked-messages) "mh-index" "\ 457(autoload (quote mh-index-ticked-messages) "mh-index" "\
496Display ticked messages. 458Display ticked messages.
497All messages in the `tick' sequence from FOLDERS are displayed. 459All messages in `mh-tick-seq' from the folders in
498By default the folders specified by `mh-index-ticked-messages-folders' 460`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a
499are searched. With a prefix argument, enter a space-separated list of 461space-separated list of FOLDERS, or nothing to search all folders." t nil)
500folders, or nothing to search all folders." t nil)
501 462
502(autoload (quote mh-swish-execute-search) "mh-index" "\ 463(autoload (quote mh-swish-execute-search) "mh-index" "\
503Execute swish-e and read the results. 464Execute swish-e and read the results.
@@ -620,54 +581,70 @@ system." nil nil)
620 581
621;;;*** 582;;;***
622 583
584;;;### (autoloads (mh-variants mh-variant-p mh-variant-set) "mh-init"
585;;;;;; "mh-init.el" (16684 6777))
586;;; Generated autoloads from mh-init.el
587
588(autoload (quote mh-variant-set) "mh-init" "\
589Set the MH variant to VARIANT.
590Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
591If the VARIANT is `autodetect', then first try nmh, then MH and finally
592GNU mailutils." t nil)
593
594(autoload (quote mh-variant-p) "mh-init" "\
595Return t if variant is any of VARIANTS.
596Currently known variants are 'MH, 'nmh, and 'mu-mh." nil nil)
597
598(autoload (quote mh-variants) "mh-init" "\
599Return a list of installed variants of MH on the system.
600This function looks for MH in `mh-sys-path', `mh-path' and
601`exec-path'. The format of the list of variants that is returned is described
602by the variable `mh-variants'." nil nil)
603
604;;;***
605
623;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk" 606;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk"
624;;;;;; "mh-junk.el" (16625 54386)) 607;;;;;; "mh-junk.el" (16671 48929))
625;;; Generated autoloads from mh-junk.el 608;;; Generated autoloads from mh-junk.el
626 609
627(autoload (quote mh-junk-blacklist) "mh-junk" "\ 610(autoload (quote mh-junk-blacklist) "mh-junk" "\
628Blacklist RANGE as spam. 611Blacklist RANGE as spam.
629 612
630Check the documentation of `mh-interactive-range' to see how RANGE is read in 613This command trains the spam program in use (see the `mh-junk-program' option)
631interactive use. 614with the content of the range (see `mh-interactive-range') and then handles
632 615the message(s) as specified by the `mh-junk-disposition' option.
633First the appropriate function is called depending on the value of
634`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is
635refiled to that folder. If nil, the message is deleted.
636 616
637To change the spam program being used, customize `mh-junk-program'. Directly 617For more information about using your particular spam fighting program, see:
638setting `mh-junk-choice' is not recommended.
639
640The documentation for the following functions describes what setup is needed
641for the different spam fighting programs:
642 618
619 - `mh-spamassassin-blacklist'
643 - `mh-bogofilter-blacklist' 620 - `mh-bogofilter-blacklist'
644 - `mh-spamprobe-blacklist' 621 - `mh-spamprobe-blacklist'" t nil)
645 - `mh-spamassassin-blacklist'" t nil)
646 622
647(autoload (quote mh-junk-whitelist) "mh-junk" "\ 623(autoload (quote mh-junk-whitelist) "mh-junk" "\
648Whitelist RANGE incorrectly classified as spam. 624Whitelist RANGE as ham.
649
650Check the documentation of `mh-interactive-range' to see how RANGE is read in
651interactive use.
652 625
653First the appropriate function is called depending on the value of 626This command reclassifies a range of messages (see `mh-interactive-range') as
654`mh-junk-choice'. Then the message is refiled to `mh-inbox'. 627ham if it were incorrectly classified as spam. It then refiles the message
628into the `+inbox' folder.
655 629
656To change the spam program being used, customize `mh-junk-program'. Directly 630The `mh-junk-program' option specifies the spam program in use." t nil)
657setting `mh-junk-choice' is not recommended." t nil)
658 631
659;;;*** 632;;;***
660 633
661;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button 634;;;### (autoloads (mh-display-with-external-viewer mh-mime-inline-part
662;;;;;; mh-press-button mh-mime-display mh-decode-message-header 635;;;;;; mh-mime-save-part mh-push-button mh-press-button mh-mime-display
663;;;;;; mh-mime-save-parts mh-display-emphasis mh-display-smileys 636;;;;;; mh-decode-message-header mh-toggle-mh-decode-mime-flag mh-mime-save-parts
664;;;;;; mh-add-missing-mime-version-header mh-destroy-postponed-handles 637;;;;;; mh-display-emphasis mh-display-smileys mh-add-missing-mime-version-header
665;;;;;; mh-mime-cleanup mh-mml-directive-present-p mh-mml-secure-message-encrypt-pgpmime 638;;;;;; mh-destroy-postponed-handles mh-mime-cleanup mh-mml-directive-present-p
666;;;;;; mh-mml-secure-message-sign-pgpmime mh-mml-attach-file mh-mml-forward-message 639;;;;;; mh-mml-secure-message-signencrypt mh-mml-secure-message-encrypt
640;;;;;; mh-mml-secure-message-sign mh-mml-unsecure-message mh-mml-attach-file
641;;;;;; mh-mml-query-cryptographic-method mh-mml-forward-message
667;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit 642;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit
668;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar 643;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-type
669;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward 644;;;;;; mh-mhn-compose-external-compressed-tar mh-mhn-compose-anon-ftp
670;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523)) 645;;;;;; mh-mhn-compose-insertion mh-file-mime-type mh-have-file-command
646;;;;;; mh-compose-forward mh-compose-insertion) "mh-mime" "mh-mime.el"
647;;;;;; (16684 7323))
671;;; Generated autoloads from mh-mime.el 648;;; Generated autoloads from mh-mime.el
672 649
673(autoload (quote mh-compose-insertion) "mh-mime" "\ 650(autoload (quote mh-compose-insertion) "mh-mime" "\
@@ -686,6 +663,14 @@ come.
686Optional argument MESSAGE is the message to forward. 663Optional argument MESSAGE is the message to forward.
687If any of the optional arguments are absent, they are prompted for." t nil) 664If any of the optional arguments are absent, they are prompted for." t nil)
688 665
666(autoload (quote mh-have-file-command) "mh-mime" "\
667Return t if 'file' command is on the system.
668'file -i' is used to get MIME type of composition insertion." nil nil)
669
670(autoload (quote mh-file-mime-type) "mh-mime" "\
671Return MIME type of FILENAME from file command.
672Returns nil if file command not on system." nil nil)
673
689(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\ 674(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
690Add a directive to insert a MIME message part from a file. 675Add a directive to insert a MIME message part from a file.
691This is the typical way to insert non-text parts in a message. 676This is the typical way to insert non-text parts in a message.
@@ -718,6 +703,18 @@ DESCRIPTION, a line of text for the Content-description header.
718 703
719See also \\[mh-edit-mhn]." t nil) 704See also \\[mh-edit-mhn]." t nil)
720 705
706(autoload (quote mh-mhn-compose-external-type) "mh-mime" "\
707Add a directive to include a MIME reference to a remote file.
708The file should be available via anonymous ftp. This directive tells MH to
709include a reference to a message/external-body part.
710
711Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
712file and TYPE which is the MIME Content-Type. Optional arguments include
713DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
714EXTRA-PARAMS, and COMMENT.
715
716See also \\[mh-edit-mhn]." t nil)
717
721(autoload (quote mh-mhn-compose-forw) "mh-mime" "\ 718(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
722Add a forw directive to this message, to forward a message with MIME. 719Add a forw directive to this message, to forward a message with MIME.
723This directive tells MH to include the named messages in this one. 720This directive tells MH to include the named messages in this one.
@@ -758,7 +755,9 @@ Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
758Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil) 755Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
759 756
760(autoload (quote mh-mhn-directive-present-p) "mh-mime" "\ 757(autoload (quote mh-mhn-directive-present-p) "mh-mime" "\
761Check if the current buffer has text which might be a MHN directive." nil nil) 758Check if the text between BEGIN and END might be a MHN directive.
759The optional argument BEGIN defaults to the beginning of the buffer, while END
760defaults to the the end of the buffer." nil nil)
762 761
763(autoload (quote mh-mml-to-mime) "mh-mime" "\ 762(autoload (quote mh-mml-to-mime) "mh-mime" "\
764Compose MIME message from mml directives. 763Compose MIME message from mml directives.
@@ -770,6 +769,9 @@ Forward a message as attachment.
770The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE 769The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
771number." nil nil) 770number." nil nil)
772 771
772(autoload (quote mh-mml-query-cryptographic-method) "mh-mime" "\
773Read the cryptographic method to use." nil nil)
774
773(autoload (quote mh-mml-attach-file) "mh-mime" "\ 775(autoload (quote mh-mml-attach-file) "mh-mime" "\
774Attach a file to the outgoing MIME message. 776Attach a file to the outgoing MIME message.
775The file is not inserted or encoded until you send the message with 777The file is not inserted or encoded until you send the message with
@@ -781,12 +783,18 @@ This is basically `mml-attach-file' from gnus, modified such that a prefix
781argument yields an `inline' disposition and Content-Type is determined 783argument yields an `inline' disposition and Content-Type is determined
782automatically." nil nil) 784automatically." nil nil)
783 785
784(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\ 786(autoload (quote mh-mml-unsecure-message) "mh-mime" "\
785Add directive to encrypt/sign the entire message." t nil) 787Remove any secure message directives.
788The IGNORE argument is not used." t nil)
789
790(autoload (quote mh-mml-secure-message-sign) "mh-mime" "\
791Add security directive to sign the entire message using METHOD." t nil)
786 792
787(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\ 793(autoload (quote mh-mml-secure-message-encrypt) "mh-mime" "\
788Add directive to encrypt and sign the entire message. 794Add security directive to encrypt the entire message using METHOD." t nil)
789If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil) 795
796(autoload (quote mh-mml-secure-message-signencrypt) "mh-mime" "\
797Add security directive to encrypt and sign the entire message using METHOD." t nil)
790 798
791(autoload (quote mh-mml-directive-present-p) "mh-mime" "\ 799(autoload (quote mh-mml-directive-present-p) "mh-mime" "\
792Check if the current buffer has text which may be an MML directive." nil nil) 800Check if the current buffer has text which may be an MML directive." nil nil)
@@ -814,6 +822,9 @@ If ARG, prompt for directory, else use that specified by the variable
814mh_profile directives, since this function calls on mhstore or mhn to do the 822mh_profile directives, since this function calls on mhstore or mhn to do the
815actual storing." t nil) 823actual storing." t nil)
816 824
825(autoload (quote mh-toggle-mh-decode-mime-flag) "mh-mime" "\
826Toggle whether MH-E should decode MIME or not." t nil)
827
817(autoload (quote mh-decode-message-header) "mh-mime" "\ 828(autoload (quote mh-decode-message-header) "mh-mime" "\
818Decode RFC2047 encoded message header fields." nil nil) 829Decode RFC2047 encoded message header fields." nil nil)
819 830
@@ -840,10 +851,13 @@ Save MIME part at point." t nil)
840(autoload (quote mh-mime-inline-part) "mh-mime" "\ 851(autoload (quote mh-mime-inline-part) "mh-mime" "\
841Toggle display of the raw MIME part." t nil) 852Toggle display of the raw MIME part." t nil)
842 853
854(autoload (quote mh-display-with-external-viewer) "mh-mime" "\
855View MIME PART-INDEX externally." t nil)
856
843;;;*** 857;;;***
844 858
845;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search 859;;;### (autoloads (mh-do-search mh-pick-do-search mh-search-folder)
846;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571)) 860;;;;;; "mh-pick" "mh-pick.el" (16671 49140))
847;;; Generated autoloads from mh-pick.el 861;;; Generated autoloads from mh-pick.el
848 862
849(autoload (quote mh-search-folder) "mh-pick" "\ 863(autoload (quote mh-search-folder) "mh-pick" "\
@@ -853,13 +867,6 @@ Add the messages found to the sequence named `search'.
853Argument WINDOW-CONFIG is the current window configuration and is used when 867Argument WINDOW-CONFIG is the current window configuration and is used when
854the search folder is dismissed." t nil) 868the search folder is dismissed." t nil)
855 869
856(autoload (quote mh-do-pick-search) "mh-pick" "\
857Find messages that match the qualifications in the current pattern buffer.
858Messages are searched for in the folder named in `mh-searching-folder'.
859Add the messages found to the sequence named `search'.
860
861This is a deprecated function and `mh-pick-do-search' should be used instead." t nil)
862
863(autoload (quote mh-pick-do-search) "mh-pick" "\ 870(autoload (quote mh-pick-do-search) "mh-pick" "\
864Find messages that match the qualifications in the current pattern buffer. 871Find messages that match the qualifications in the current pattern buffer.
865Messages are searched for in the folder named in `mh-searching-folder'. 872Messages are searched for in the folder named in `mh-searching-folder'.
@@ -873,19 +880,62 @@ indexing program specified in `mh-index-program' is used." t nil)
873 880
874;;;*** 881;;;***
875 882
883;;;### (autoloads (mh-print-msg mh-ps-print-toggle-mime mh-ps-print-toggle-color
884;;;;;; mh-ps-print-toggle-faces mh-ps-print-msg-show mh-ps-print-msg-file
885;;;;;; mh-ps-print-msg) "mh-print" "mh-print.el" (16680 11171))
886;;; Generated autoloads from mh-print.el
887
888(autoload (quote mh-ps-print-msg) "mh-print" "\
889Print the messages in RANGE.
890
891Check the documentation of `mh-interactive-range' to see how RANGE is read in
892interactive use." t nil)
893
894(autoload (quote mh-ps-print-msg-file) "mh-print" "\
895Print to FILE the messages in RANGE.
896
897Check the documentation of `mh-interactive-range' to see how RANGE is read in
898interactive use." t nil)
899
900(autoload (quote mh-ps-print-msg-show) "mh-print" "\
901Print current show buffer to FILE." t nil)
902
903(autoload (quote mh-ps-print-toggle-faces) "mh-print" "\
904Toggle whether printing is done with faces or not." t nil)
905
906(autoload (quote mh-ps-print-toggle-color) "mh-print" "\
907Toggle whether color is used in printing messages." t nil)
908
909(autoload (quote mh-ps-print-toggle-mime) "mh-print" "\
910Cycle through available choices on how MIME parts should be printed.
911The available settings are:
912 1. Print only inline MIME parts.
913 2. Print all MIME parts.
914 3. Print no MIME parts." t nil)
915
916(autoload (quote mh-print-msg) "mh-print" "\
917Print RANGE on printer.
918
919Check the documentation of `mh-interactive-range' to see how RANGE is read in
920interactive use.
921
922The variable `mh-lpr-command-format' is used to generate the print command.
923The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
924
925;;;***
926
876;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile 927;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile
877;;;;;; mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling 928;;;;;; mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling
878;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads 929;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads
879;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc 930;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc
880;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range 931;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range
881;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject 932;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject
882;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list 933;;;;;; mh-interactive-range mh-range-to-msg-list mh-iterate-on-range
883;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence 934;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur
884;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq 935;;;;;; mh-rename-seq mh-translate-range mh-read-range mh-read-seq-default
885;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled 936;;;;;; mh-notate-deleted-and-refiled mh-widen mh-put-msg-in-seq
886;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq 937;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq)
887;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625 938;;;;;; "mh-seq" "mh-seq.el" (16671 65286))
888;;;;;; 54690))
889;;; Generated autoloads from mh-seq.el 939;;; Generated autoloads from mh-seq.el
890 940
891(autoload (quote mh-delete-seq) "mh-seq" "\ 941(autoload (quote mh-delete-seq) "mh-seq" "\
@@ -895,8 +945,9 @@ Delete the SEQUENCE." t nil)
895List the sequences defined in the folder being visited." t nil) 945List the sequences defined in the folder being visited." t nil)
896 946
897(autoload (quote mh-msg-is-in-seq) "mh-seq" "\ 947(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
898Display the sequences that contain MESSAGE. 948Display the sequences in which the current message appears.
899Default is the displayed message." t nil) 949Use a prefix argument to display the sequences in which another MESSAGE
950appears." t nil)
900 951
901(autoload (quote mh-narrow-to-seq) "mh-seq" "\ 952(autoload (quote mh-narrow-to-seq) "mh-seq" "\
902Restrict display of this folder to just messages in SEQUENCE. 953Restrict display of this folder to just messages in SEQUENCE.
@@ -909,10 +960,8 @@ Check the documentation of `mh-interactive-range' to see how RANGE is read in
909interactive use." t nil) 960interactive use." t nil)
910 961
911(autoload (quote mh-widen) "mh-seq" "\ 962(autoload (quote mh-widen) "mh-seq" "\
912Remove last restriction from current folder. 963Restore the previous limit.
913If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning 964If optional prefix argument ALL-FLAG is non-nil, remove all limits." t nil)
914of the view stack thereby showing all messages that the buffer originally
915contained." t nil)
916 965
917(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\ 966(autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\
918Notate messages marked for deletion or refiling. 967Notate messages marked for deletion or refiling.
@@ -965,16 +1014,6 @@ In FOLDER, translate the string EXPR to a list of messages numbers." nil nil)
965(autoload (quote mh-rename-seq) "mh-seq" "\ 1014(autoload (quote mh-rename-seq) "mh-seq" "\
966Rename SEQUENCE to have NEW-NAME." t nil) 1015Rename SEQUENCE to have NEW-NAME." t nil)
967 1016
968(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
969Invoke the FUNC at each message in the SEQ.
970SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
971passed as arguments to FUNC." nil nil)
972
973(autoload (quote mh-notate-seq) "mh-seq" "\
974Mark the scan listing.
975All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
976the line." nil nil)
977
978(autoload (quote mh-notate-cur) "mh-seq" "\ 1017(autoload (quote mh-notate-cur) "mh-seq" "\
979Mark the MH sequence cur. 1018Mark the MH sequence cur.
980In addition to notating the current message with `mh-note-cur' the function 1019In addition to notating the current message with `mh-note-cur' the function
@@ -1019,37 +1058,44 @@ RANGE-PROMPT. A list of messages in that range is returned.
1019If a MH range is given, say something like last:20, then a list containing 1058If a MH range is given, say something like last:20, then a list containing
1020the messages in that range is returned. 1059the messages in that range is returned.
1021 1060
1061If DEFAULT non-nil then it is returned.
1062
1022Otherwise, the message number at point is returned. 1063Otherwise, the message number at point is returned.
1023 1064
1024This function is usually used with `mh-iterate-on-range' in order to provide 1065This function is usually used with `mh-iterate-on-range' in order to provide
1025a uniform interface to MH-E functions." nil nil) 1066a uniform interface to MH-E functions." nil nil)
1026 1067
1027(autoload (quote mh-region-to-msg-list) "mh-seq" "\
1028Return a list of messages within the region between BEGIN and END." nil nil)
1029
1030(autoload (quote mh-narrow-to-subject) "mh-seq" "\ 1068(autoload (quote mh-narrow-to-subject) "mh-seq" "\
1031Narrow to a sequence containing all following messages with same subject." t nil) 1069Limit to messages with same subject.
1070With a prefix argument, edit PICK-EXPR.
1071
1072Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1032 1073
1033(autoload (quote mh-narrow-to-from) "mh-seq" "\ 1074(autoload (quote mh-narrow-to-from) "mh-seq" "\
1034Limit to messages with the same From header field as the message at point. 1075Limit to messages with the same `From:' field.
1035With a prefix argument, prompt for the regular expression, REGEXP given to 1076With a prefix argument, edit PICK-EXPR.
1036pick." t nil) 1077
1078Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1037 1079
1038(autoload (quote mh-narrow-to-cc) "mh-seq" "\ 1080(autoload (quote mh-narrow-to-cc) "mh-seq" "\
1039Limit to messages with the same Cc header field as the message at point. 1081Limit to messages with the same `Cc:' field.
1040With a prefix argument, prompt for the regular expression, REGEXP given to 1082With a prefix argument, edit PICK-EXPR.
1041pick." t nil) 1083
1084Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1042 1085
1043(autoload (quote mh-narrow-to-to) "mh-seq" "\ 1086(autoload (quote mh-narrow-to-to) "mh-seq" "\
1044Limit to messages with the same To header field as the message at point. 1087Limit to messages with the same `To:' field.
1045With a prefix argument, prompt for the regular expression, REGEXP given to 1088With a prefix argument, edit PICK-EXPR.
1046pick." t nil) 1089
1090Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1047 1091
1048(autoload (quote mh-narrow-to-range) "mh-seq" "\ 1092(autoload (quote mh-narrow-to-range) "mh-seq" "\
1049Limit to messages in RANGE. 1093Limit to messages in RANGE.
1050 1094
1051Check the documentation of `mh-interactive-range' to see how RANGE is read in 1095Check the documentation of `mh-interactive-range' to see how RANGE is read in
1052interactive use." t nil) 1096interactive use.
1097
1098Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1053 1099
1054(autoload (quote mh-delete-subject) "mh-seq" "\ 1100(autoload (quote mh-delete-subject) "mh-seq" "\
1055Mark all following messages with same subject to be deleted. 1101Mark all following messages with same subject to be deleted.
@@ -1103,14 +1149,15 @@ Mark current message and all its children for refiling to FOLDER." t nil)
1103Toggle tick mark of all messages in RANGE." t nil) 1149Toggle tick mark of all messages in RANGE." t nil)
1104 1150
1105(autoload (quote mh-narrow-to-tick) "mh-seq" "\ 1151(autoload (quote mh-narrow-to-tick) "mh-seq" "\
1106Restrict display of this folder to just messages in `mh-tick-seq'. 1152Limit to messages in `mh-tick-seq'.
1153
1107Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) 1154Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
1108 1155
1109;;;*** 1156;;;***
1110 1157
1111;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists 1158;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
1112;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons) 1159;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
1113;;;;;; "mh-speed" "mh-speed.el" (16625 54721)) 1160;;;;;; "mh-speed" "mh-speed.el" (16665 53793))
1114;;; Generated autoloads from mh-speed.el 1161;;; Generated autoloads from mh-speed.el
1115 1162
1116(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\ 1163(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
@@ -1145,31 +1192,24 @@ The function invalidates the latest ancestor that is present." nil nil)
1145 1192
1146;;;*** 1193;;;***
1147 1194
1148;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
1149;;;;;; "mh-utils" "mh-utils.el" (16625 54979))
1150;;; Generated autoloads from mh-utils.el
1151
1152(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
1153Find e-mail address around or before point.
1154Then search backwards to beginning of line for the start of an e-mail
1155address. If no e-mail address found, return nil." nil nil)
1156
1157(autoload (quote mh-get-msg-num) "mh-utils" "\
1158Return the message number of the displayed message.
1159If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
1160not pointing to a message." nil nil)
1161
1162;;;***
1163
1164;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point 1195;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point
1165;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p 1196;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-for-from-p
1166;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address 1197;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address
1167;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias" 1198;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias"
1168;;;;;; "mh-alias.el" (16625 53006)) 1199;;;;;; "mh-alias.el" (16671 49382))
1169;;; Generated autoloads from mh-alias.el 1200;;; Generated autoloads from mh-alias.el
1170 1201
1171(autoload (quote mh-alias-reload) "mh-alias" "\ 1202(autoload (quote mh-alias-reload) "mh-alias" "\
1172Load MH aliases into `mh-alias-alist'." t nil) 1203Reload MH aliases.
1204
1205Since aliases are updated frequently, MH-E will reload aliases automatically
1206whenever an alias lookup occurs if an alias source (a file listed in your
1207`Aliasfile:' profile component and your password file if variable
1208`mh-alias-local-users' is non-nil) has changed. However, you can reload your
1209aliases manually by calling this command directly.
1210
1211The value of `mh-alias-reloaded-hook' is a list of functions to be called,
1212with no arguments, after the aliases have been loaded." t nil)
1173 1213
1174(autoload (quote mh-alias-reload-maybe) "mh-alias" "\ 1214(autoload (quote mh-alias-reload-maybe) "mh-alias" "\
1175Load new MH aliases." nil nil) 1215Load new MH aliases." nil nil)
@@ -1186,26 +1226,25 @@ Expand mail alias before point." nil nil)
1186(autoload (quote mh-alias-address-to-alias) "mh-alias" "\ 1226(autoload (quote mh-alias-address-to-alias) "mh-alias" "\
1187Return the ADDRESS alias if defined, or nil." nil nil) 1227Return the ADDRESS alias if defined, or nil." nil nil)
1188 1228
1189(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\ 1229(autoload (quote mh-alias-for-from-p) "mh-alias" "\
1190Return t is From has no current alias set. 1230Return t if sender's address has a corresponding alias." nil nil)
1191In the exceptional situation where there isn't a From header in the message the
1192function returns nil." nil nil)
1193 1231
1194(autoload (quote mh-alias-add-alias) "mh-alias" "\ 1232(autoload (quote mh-alias-add-alias) "mh-alias" "\
1195*Add ALIAS for ADDRESS in personal alias file. 1233*Add ALIAS for ADDRESS in personal alias file.
1196Prompts for confirmation if the address already has an alias. 1234This function prompts you for an alias and address. If the alias exists
1197If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil) 1235already, you will have the choice of inserting the new alias before or after
1236the old alias. In the former case, this alias will be used when sending mail
1237to this alias. In the latter case, the alias serves as an additional folder
1238name hint when filing messages." t nil)
1198 1239
1199(autoload (quote mh-alias-grab-from-field) "mh-alias" "\ 1240(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
1200*Add ALIAS for ADDRESS in personal alias file. 1241*Add alias for the sender of the current message." t nil)
1201Prompts for confirmation if the alias is already in use or if the address
1202already has an alias." t nil)
1203 1242
1204(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\ 1243(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
1205Insert an alias for email address under point." t nil) 1244Insert an alias for address under point." t nil)
1206 1245
1207(autoload (quote mh-alias-apropos) "mh-alias" "\ 1246(autoload (quote mh-alias-apropos) "mh-alias" "\
1208Show all aliases that match REGEXP either in name or content." t nil) 1247Show all aliases or addresses that match REGEXP." t nil)
1209 1248
1210;;;*** 1249;;;***
1211 1250
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 91cbcec0c06..72cb654dedd 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -34,7 +34,7 @@
34 34
35;;; Code: 35;;; Code:
36 36
37(require 'mh-utils) 37(eval-when-compile (require 'mh-acros))
38(mh-require-cl) 38(mh-require-cl)
39(require 'mh-comp) 39(require 'mh-comp)
40(require 'gnus-util) 40(require 'gnus-util)
@@ -46,8 +46,7 @@
46(autoload 'gnus-eval-format "gnus-spec") 46(autoload 'gnus-eval-format "gnus-spec")
47(autoload 'widget-convert-button "wid-edit") 47(autoload 'widget-convert-button "wid-edit")
48(autoload 'message-options-set-recipient "message") 48(autoload 'message-options-set-recipient "message")
49(autoload 'mml-secure-message-sign-pgpmime "mml-sec") 49(autoload 'mml-unsecure-message "mml-sec")
50(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
51(autoload 'mml-minibuffer-read-file "mml") 50(autoload 'mml-minibuffer-read-file "mml")
52(autoload 'mml-minibuffer-read-description "mml") 51(autoload 'mml-minibuffer-read-description "mml")
53(autoload 'mml-insert-empty-tag "mml") 52(autoload 'mml-insert-empty-tag "mml")
@@ -82,7 +81,7 @@ If any of the optional arguments are absent, they are prompted for."
82 (read-string "Forw Content-description: ") 81 (read-string "Forw Content-description: ")
83 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) 82 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
84 (read-string (format "Messages%s: " 83 (read-string (format "Messages%s: "
85 (if mh-sent-from-msg 84 (if (numberp mh-sent-from-msg)
86 (format " [%d]" mh-sent-from-msg) 85 (format " [%d]" mh-sent-from-msg)
87 ""))))) 86 "")))))
88 (if (equal mh-compose-insertion 'gnus) 87 (if (equal mh-compose-insertion 'gnus)
@@ -114,6 +113,7 @@ MH profile.")
114;; the variable, so things should work exactly as before. 113;; the variable, so things should work exactly as before.
115(defvar mh-have-file-command) 114(defvar mh-have-file-command)
116 115
116;;;###mh-autoload
117(defun mh-have-file-command () 117(defun mh-have-file-command ()
118 "Return t if 'file' command is on the system. 118 "Return t if 'file' command is on the system.
119'file -i' is used to get MIME type of composition insertion." 119'file -i' is used to get MIME type of composition insertion."
@@ -129,7 +129,8 @@ MH profile.")
129 129
130(defvar mh-file-mime-type-substitutions 130(defvar mh-file-mime-type-substitutions
131 '(("application/msword" "\.xls" "application/ms-excel") 131 '(("application/msword" "\.xls" "application/ms-excel")
132 ("application/msword" "\.ppt" "application/ms-powerpoint")) 132 ("application/msword" "\.ppt" "application/ms-powerpoint")
133 ("text/plain" "\.vcf" "text/x-vcard"))
133 "Substitutions to make for Content-Type returned from file command. 134 "Substitutions to make for Content-Type returned from file command.
134The first element is the Content-Type returned by the file command. 135The first element is the Content-Type returned by the file command.
135The second element is a regexp matching the file name, usually the extension. 136The second element is a regexp matching the file name, usually the extension.
@@ -151,6 +152,7 @@ Substitutions are made from the `mh-file-mime-type-substitutions' variable."
151 (setq subst (cdr subst)))) 152 (setq subst (cdr subst))))
152 answer)) 153 answer))
153 154
155;;;###mh-autoload
154(defun mh-file-mime-type (filename) 156(defun mh-file-mime-type (filename)
155 "Return MIME type of FILENAME from file command. 157 "Return MIME type of FILENAME from file command.
156Returns nil if file command not on system." 158Returns nil if file command not on system."
@@ -192,12 +194,38 @@ Returns nil if file command not on system."
192 ("message/external-body") ("message/partial") ("message/rfc822") 194 ("message/external-body") ("message/partial") ("message/rfc822")
193 195
194 ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers") 196 ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
195 ("text/richtext") ("text/xml") 197 ("text/richtext") ("text/x-vcard") ("text/xml")
196 198
197 ("video/mpeg") ("video/quicktime")) 199 ("video/mpeg") ("video/quicktime"))
198 "Legal MIME content types. 200 "Legal MIME content types.
199See documentation for \\[mh-edit-mhn].") 201See documentation for \\[mh-edit-mhn].")
200 202
203;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One:
204;; Format of Internet Message Bodies.
205;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two:
206;; Media Types.
207;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five:
208;; Conformance Criteria and Examples.
209;; RFC 2017 - Definition of the URL MIME External-Body Access-Type
210;; RFC 1738 - Uniform Resource Locators (URL)
211(defvar mh-access-types
212 '(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol
213 ("file") ; RFC1738 Host-specific file names
214 ("ftp") ; RFC2046 File Transfer Protocol
215 ("gopher") ; RFC1738 The Gopher Protocol
216 ("http") ; RFC1738 Hypertext Transfer Protocol
217 ("local-file") ; RFC2046 Local file access
218 ("mail-server") ; RFC2046 mail-server Electronic mail address
219 ("mailto") ; RFC1738 Electronic mail address
220 ("news") ; RFC1738 Usenet news
221 ("nntp") ; RFC1738 Usenet news using NNTP access
222 ("propspero") ; RFC1738 Prospero Directory Service
223 ("telnet") ; RFC1738 Telnet
224 ("tftp") ; RFC2046 Trivial File Transfer Protocol
225 ("url") ; RFC2017 URL scheme MIME access-type Protocol
226 ("wais")) ; RFC1738 Wide Area Information Servers
227 "Legal MIME access-type values.")
228
201;;;###mh-autoload 229;;;###mh-autoload
202(defun mh-mhn-compose-insertion (filename type description attributes) 230(defun mh-mhn-compose-insertion (filename type description attributes)
203 "Add a directive to insert a MIME message part from a file. 231 "Add a directive to insert a MIME message part from a file.
@@ -286,7 +314,7 @@ See also \\[mh-edit-mhn]."
286 "type=tar; conversions=x-compress" 314 "type=tar; conversions=x-compress"
287 "mode=image")) 315 "mode=image"))
288 316
289 317;;;###mh-autoload
290(defun mh-mhn-compose-external-type (access-type host filename type 318(defun mh-mhn-compose-external-type (access-type host filename type
291 &optional description 319 &optional description
292 attributes extra-params 320 attributes extra-params
@@ -301,6 +329,18 @@ DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
301EXTRA-PARAMS, and COMMENT. 329EXTRA-PARAMS, and COMMENT.
302 330
303See also \\[mh-edit-mhn]." 331See also \\[mh-edit-mhn]."
332 (interactive (list
333 (completing-read "Access Type: " mh-access-types)
334 (read-string "Remote host: ")
335 (read-string "Remote url-path: ")
336 (completing-read "Content-Type: "
337 (if (fboundp 'mailcap-mime-types)
338 (mapcar 'list (mailcap-mime-types))
339 mh-mime-content-types))
340 (if current-prefix-arg (read-string "Content-description: "))
341 (if current-prefix-arg (read-string "Attributes: "))
342 (if current-prefix-arg (read-string "Extra Parameters: "))
343 (if current-prefix-arg (read-string "Comment: "))))
304 (beginning-of-line) 344 (beginning-of-line)
305 (insert "#@" type) 345 (insert "#@" type)
306 (and attributes 346 (and attributes
@@ -314,7 +354,9 @@ See also \\[mh-edit-mhn]."
314 (insert "access-type=" access-type "; ") 354 (insert "access-type=" access-type "; ")
315 (insert "site=" host) 355 (insert "site=" host)
316 (insert "; name=" (file-name-nondirectory filename)) 356 (insert "; name=" (file-name-nondirectory filename))
317 (insert "; directory=\"" (file-name-directory filename) "\"") 357 (let ((directory (file-name-directory filename)))
358 (and directory
359 (insert "; directory=\"" directory "\"")))
318 (and extra-params 360 (and extra-params
319 (insert "; " extra-params)) 361 (insert "; " extra-params))
320 (insert "\n")) 362 (insert "\n"))
@@ -332,7 +374,7 @@ See also \\[mh-edit-mhn]."
332 (read-string "Forw Content-description: ") 374 (read-string "Forw Content-description: ")
333 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) 375 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
334 (read-string (format "Messages%s: " 376 (read-string (format "Messages%s: "
335 (if mh-sent-from-msg 377 (if (numberp mh-sent-from-msg)
336 (format " [%d]" mh-sent-from-msg) 378 (format " [%d]" mh-sent-from-msg)
337 ""))))) 379 "")))))
338 (beginning-of-line) 380 (beginning-of-line)
@@ -349,7 +391,7 @@ See also \\[mh-edit-mhn]."
349 (let ((start (point))) 391 (let ((start (point)))
350 (insert " " messages) 392 (insert " " messages)
351 (subst-char-in-region start (point) ?, ? )) 393 (subst-char-in-region start (point) ?, ? ))
352 (if mh-sent-from-msg 394 (if (numberp mh-sent-from-msg)
353 (insert " " (int-to-string mh-sent-from-msg)))) 395 (insert " " (int-to-string mh-sent-from-msg))))
354 (insert "\n")) 396 (insert "\n"))
355 397
@@ -380,10 +422,11 @@ arguments, after performing the conversion.
380 422
381The mhn program is part of MH version 6.8 or later." 423The mhn program is part of MH version 6.8 or later."
382 (interactive "*P") 424 (interactive "*P")
425 (mh-mhn-quote-unescaped-sharp)
383 (save-buffer) 426 (save-buffer)
384 (message "mhn editing...") 427 (message "mhn editing...")
385 (cond 428 (cond
386 (mh-nmh-flag 429 ((mh-variant-p 'nmh)
387 (mh-exec-cmd-error nil 430 (mh-exec-cmd-error nil
388 "mhbuild" (if extra-args mh-mhn-args) buffer-file-name)) 431 "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
389 (t 432 (t
@@ -393,6 +436,19 @@ The mhn program is part of MH version 6.8 or later."
393 (message "mhn editing...done") 436 (message "mhn editing...done")
394 (run-hooks 'mh-edit-mhn-hook)) 437 (run-hooks 'mh-edit-mhn-hook))
395 438
439(defun mh-mhn-quote-unescaped-sharp ()
440 "Quote `#' characters that haven't been quoted for `mhbuild'.
441If the `#' character is present in the first column, but it isn't part of a
442MHN directive then `mhbuild' gives an error. This function will quote all such
443characters."
444 (save-excursion
445 (goto-char (point-min))
446 (while (re-search-forward "^#" nil t)
447 (beginning-of-line)
448 (unless (mh-mhn-directive-present-p (point) (line-end-position))
449 (insert "#"))
450 (goto-char (line-end-position)))))
451
396;;;###mh-autoload 452;;;###mh-autoload
397(defun mh-revert-mhn-edit (noconfirm) 453(defun mh-revert-mhn-edit (noconfirm)
398 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. 454 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
@@ -422,18 +478,24 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation."
422 (after-find-file nil))) 478 (after-find-file nil)))
423 479
424;;;###mh-autoload 480;;;###mh-autoload
425(defun mh-mhn-directive-present-p () 481(defun mh-mhn-directive-present-p (&optional begin end)
426 "Check if the current buffer has text which might be a MHN directive." 482 "Check if the text between BEGIN and END might be a MHN directive.
483The optional argument BEGIN defaults to the beginning of the buffer, while END
484defaults to the the end of the buffer."
485 (unless begin (setq begin (point-min)))
486 (unless end (setq end (point-max)))
427 (save-excursion 487 (save-excursion
428 (block 'search-for-mhn-directive 488 (block 'search-for-mhn-directive
429 (goto-char (point-min)) 489 (goto-char begin)
430 (while (re-search-forward "^#" nil t) 490 (while (re-search-forward "^#" end t)
431 (let ((s (buffer-substring-no-properties (point) (line-end-position)))) 491 (let ((s (buffer-substring-no-properties (point) (line-end-position))))
432 (cond ((equal s "")) 492 (cond ((equal s ""))
433 ((string-match "^forw[ \t\n]+" s) 493 ((string-match "^forw[ \t\n]+" s)
434 (return-from 'search-for-mhn-directive t)) 494 (return-from 'search-for-mhn-directive t))
435 (t (let ((first-token (car (split-string s "[ \t;@]")))) 495 (t (let ((first-token (car (split-string s "[ \t;@]"))))
436 (when (string-match mh-media-type-regexp first-token) 496 (when (and first-token
497 (string-match mh-media-type-regexp
498 first-token))
437 (return-from 'search-for-mhn-directive t))))))) 499 (return-from 'search-for-mhn-directive t)))))))
438 nil))) 500 nil)))
439 501
@@ -450,14 +512,23 @@ function may be called manually before sending the draft as well."
450 (require 'message) 512 (require 'message)
451 (when mh-gnus-pgp-support-flag ;; This is only needed for PGP 513 (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
452 (message-options-set-recipient)) 514 (message-options-set-recipient))
453 (mml-to-mime)) 515 (let ((saved-text (buffer-string))
516 (buffer (current-buffer))
517 (modified-flag (buffer-modified-p)))
518 (condition-case err (mml-to-mime)
519 (error
520 (with-current-buffer buffer
521 (delete-region (point-min) (point-max))
522 (insert saved-text)
523 (set-buffer-modified-p modified-flag))
524 (error (error-message-string err))))))
454 525
455;;;###mh-autoload 526;;;###mh-autoload
456(defun mh-mml-forward-message (description folder message) 527(defun mh-mml-forward-message (description folder message)
457 "Forward a message as attachment. 528 "Forward a message as attachment.
458The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE 529The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
459number." 530number."
460 (let ((msg (if (equal message "") 531 (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg))
461 mh-sent-from-msg 532 mh-sent-from-msg
462 (car (read-from-string message))))) 533 (car (read-from-string message)))))
463 (cond ((integerp msg) 534 (cond ((integerp msg)
@@ -473,6 +544,19 @@ number."
473 description))) 544 description)))
474 (t (error "The message number, %s is not a integer!" msg))))) 545 (t (error "The message number, %s is not a integer!" msg)))))
475 546
547(defvar mh-mml-cryptographic-method-history ())
548
549;;;###mh-autoload
550(defun mh-mml-query-cryptographic-method ()
551 "Read the cryptographic method to use."
552 (if current-prefix-arg
553 (let ((def (or (car mh-mml-cryptographic-method-history)
554 mh-mml-method-default)))
555 (completing-read (format "Method: [%s] " def)
556 '(("pgp") ("pgpmime") ("smime"))
557 nil t nil 'mh-mml-cryptographic-method-history def))
558 mh-mml-method-default))
559
476;;;###mh-autoload 560;;;###mh-autoload
477(defun mh-mml-attach-file (&optional disposition) 561(defun mh-mml-attach-file (&optional disposition)
478 "Attach a file to the outgoing MIME message. 562 "Attach a file to the outgoing MIME message.
@@ -499,22 +583,58 @@ automatically."
499 (mml-insert-empty-tag 'part 'type type 'filename file 583 (mml-insert-empty-tag 'part 'type type 'filename file
500 'disposition dispos 'description description))) 584 'disposition dispos 'description description)))
501 585
502;;;###mh-autoload 586(defvar mh-identity-pgg-default-user-id)
503(defun mh-mml-secure-message-sign-pgpmime () 587
504 "Add directive to encrypt/sign the entire message." 588(defun mh-secure-message (method mode &optional identity)
505 (interactive) 589 "Add directive to Encrypt/Sign an entire message.
590METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
591MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
592IDENTITY is optionally the default-user-id to use."
506 (if (not mh-gnus-pgp-support-flag) 593 (if (not mh-gnus-pgp-support-flag)
507 (error "Sorry. Your version of gnus does not support PGP/GPG") 594 (error "Sorry. Your version of gnus does not support PGP/GPG")
508 (mml-secure-message-sign-pgpmime))) 595 ;; Check the arguments
596 (let ((valid-methods (list "pgpmime" "pgp" "smime"))
597 (valid-modes (list "sign" "encrypt" "signencrypt" "none")))
598 (if (not (member method valid-methods))
599 (error (format "Sorry. METHOD \"%s\" is invalid." method)))
600 (if (not (member mode valid-modes))
601 (error (format "Sorry. MODE \"%s\" is invalid" mode)))
602 (mml-unsecure-message)
603 (if (not (string= mode "none"))
604 (save-excursion
605 (goto-char (point-min))
606 (mh-goto-header-end 1)
607 (if mh-identity-pgg-default-user-id
608 (mml-insert-tag 'secure 'method method 'mode mode
609 'sender mh-identity-pgg-default-user-id)
610 (mml-insert-tag 'secure 'method method 'mode mode)))))))
509 611
510;;;###mh-autoload 612;;;###mh-autoload
511(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) 613(defun mh-mml-unsecure-message (&optional ignore)
512 "Add directive to encrypt and sign the entire message. 614 "Remove any secure message directives.
513If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." 615The IGNORE argument is not used."
514 (interactive "P") 616 (interactive "P")
515 (if (not mh-gnus-pgp-support-flag) 617 (if (not mh-gnus-pgp-support-flag)
516 (error "Sorry. Your version of gnus does not support PGP/GPG") 618 (error "Sorry. Your version of gnus does not support PGP/GPG")
517 (mml-secure-message-encrypt-pgpmime dontsign))) 619 (mml-unsecure-message)))
620
621;;;###mh-autoload
622(defun mh-mml-secure-message-sign (method)
623 "Add security directive to sign the entire message using METHOD."
624 (interactive (list (mh-mml-query-cryptographic-method)))
625 (mh-secure-message method "sign" mh-identity-pgg-default-user-id))
626
627;;;###mh-autoload
628(defun mh-mml-secure-message-encrypt (method)
629 "Add security directive to encrypt the entire message using METHOD."
630 (interactive (list (mh-mml-query-cryptographic-method)))
631 (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))
632
633;;;###mh-autoload
634(defun mh-mml-secure-message-signencrypt (method)
635 "Add security directive to encrypt and sign the entire message using METHOD."
636 (interactive (list (mh-mml-query-cryptographic-method)))
637 (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))
518 638
519;;;###mh-autoload 639;;;###mh-autoload
520(defun mh-mml-directive-present-p () 640(defun mh-mml-directive-present-p ()
@@ -667,19 +787,19 @@ actual storing."
667 (folder (if (eq major-mode 'mh-show-mode) 787 (folder (if (eq major-mode 'mh-show-mode)
668 mh-show-folder-buffer 788 mh-show-folder-buffer
669 mh-current-folder)) 789 mh-current-folder))
670 (command (if mh-nmh-flag "mhstore" "mhn")) 790 (command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
671 (directory 791 (directory
672 (cond 792 (cond
673 ((and (or arg 793 ((and (or arg
674 (equal nil mh-mime-save-parts-default-directory) 794 (equal nil mh-mime-save-parts-default-directory)
675 (equal t mh-mime-save-parts-default-directory)) 795 (equal t mh-mime-save-parts-default-directory))
676 (not mh-mime-save-parts-directory)) 796 (not mh-mime-save-parts-directory))
677 (read-file-name "Store in what directory? " nil nil t nil)) 797 (read-file-name "Store in directory: " nil nil t nil))
678 ((and (or arg 798 ((and (or arg
679 (equal t mh-mime-save-parts-default-directory)) 799 (equal t mh-mime-save-parts-default-directory))
680 mh-mime-save-parts-directory) 800 mh-mime-save-parts-directory)
681 (read-file-name (format 801 (read-file-name (format
682 "Store in what directory? [%s] " 802 "Store in directory: [%s] "
683 mh-mime-save-parts-directory) 803 mh-mime-save-parts-directory)
684 "" mh-mime-save-parts-directory t "")) 804 "" mh-mime-save-parts-directory t ""))
685 ((stringp mh-mime-save-parts-default-directory) 805 ((stringp mh-mime-save-parts-default-directory)
@@ -689,7 +809,7 @@ actual storing."
689 (if (and (equal directory "") mh-mime-save-parts-directory) 809 (if (and (equal directory "") mh-mime-save-parts-directory)
690 (setq directory mh-mime-save-parts-directory)) 810 (setq directory mh-mime-save-parts-directory))
691 (if (not (file-directory-p directory)) 811 (if (not (file-directory-p directory))
692 (message "No directory specified.") 812 (message "No directory specified")
693 (if (equal nil mh-mime-save-parts-default-directory) 813 (if (equal nil mh-mime-save-parts-default-directory)
694 (setq mh-mime-save-parts-directory directory)) 814 (setq mh-mime-save-parts-directory directory))
695 (save-excursion 815 (save-excursion
@@ -732,6 +852,14 @@ If message has been encoded for transfer take that into account."
732 (car ct)))))) 852 (car ct))))))
733 853
734;;;###mh-autoload 854;;;###mh-autoload
855(defun mh-toggle-mh-decode-mime-flag ()
856 "Toggle whether MH-E should decode MIME or not."
857 (interactive)
858 (setq mh-decode-mime-flag (not mh-decode-mime-flag))
859 (mh-show nil t)
860 (message (format "(setq mh-decode-mime-flag %s)" mh-decode-mime-flag)))
861
862;;;###mh-autoload
735(defun mh-decode-message-header () 863(defun mh-decode-message-header ()
736 "Decode RFC2047 encoded message header fields." 864 "Decode RFC2047 encoded message header fields."
737 (when mh-decode-mime-flag 865 (when mh-decode-mime-flag
@@ -766,17 +894,18 @@ displayed."
766 (mh-mime-handles (mh-buffer-data)))) 894 (mh-mime-handles (mh-buffer-data))))
767 (unless handles (mh-decode-message-body))) 895 (unless handles (mh-decode-message-body)))
768 896
769 (when (and handles 897 (cond ((and handles
770 (or (not (stringp (car handles))) (cdr handles))) 898 (or (not (stringp (car handles))) (cdr handles)))
771 ;; Goto start of message body 899 ;; Goto start of message body
772 (goto-char (point-min)) 900 (goto-char (point-min))
773 (or (search-forward "\n\n" nil t) (goto-char (point-max))) 901 (or (search-forward "\n\n" nil t) (goto-char (point-max)))
774 902
775 ;; Delete the body 903 ;; Delete the body
776 (delete-region (point) (point-max)) 904 (delete-region (point) (point-max))
777 905
778 ;; Display the MIME handles 906 ;; Display the MIME handles
779 (mh-mime-display-part handles))) 907 (mh-mime-display-part handles))
908 (t (mh-signature-highlight))))
780 (error 909 (error
781 (message "Please report this error. The error message is:\n %s" 910 (message "Please report this error. The error message is:\n %s"
782 (error-message-string err)) 911 (error-message-string err))
@@ -874,7 +1003,7 @@ This is only useful if a Content-Disposition header is not present."
874 (save-restriction 1003 (save-restriction
875 (widen) 1004 (widen)
876 (goto-char (point-min)) 1005 (goto-char (point-min))
877 (not (re-search-forward "^-- $" nil t))))))) 1006 (not (mh-signature-separator-p)))))))
878 1007
879(defun mh-mime-display-single (handle) 1008(defun mh-mime-display-single (handle)
880 "Display a leaf node, HANDLE in the MIME tree." 1009 "Display a leaf node, HANDLE in the MIME tree."
@@ -904,7 +1033,8 @@ This is only useful if a Content-Disposition header is not present."
904 (insert "\n") 1033 (insert "\n")
905 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) 1034 (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
906 ((and displayp (not mh-display-buttons-for-inline-parts-flag)) 1035 ((and displayp (not mh-display-buttons-for-inline-parts-flag))
907 (or (mm-display-part handle) (mm-display-part handle))) 1036 (or (mm-display-part handle) (mm-display-part handle))
1037 (mh-signature-highlight handle))
908 ((and displayp mh-display-buttons-for-inline-parts-flag) 1038 ((and displayp mh-display-buttons-for-inline-parts-flag)
909 (insert "\n") 1039 (insert "\n")
910 (mh-insert-mime-button handle (mh-mime-part-index handle) nil) 1040 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
@@ -912,6 +1042,28 @@ This is only useful if a Content-Disposition header is not present."
912 (mh-mm-display-part handle))) 1042 (mh-mm-display-part handle)))
913 (goto-char (point-max))))) 1043 (goto-char (point-max)))))
914 1044
1045(defun mh-signature-highlight (&optional handle)
1046 "Highlight message signature in HANDLE.
1047The optional argument, HANDLE is a MIME handle if the function is being used
1048to highlight the signature in a MIME part."
1049 (let ((regexp
1050 (cond ((not handle) "^-- $")
1051 ((not (and (equal (mm-handle-media-supertype handle) "text")
1052 (equal (mm-handle-media-subtype handle) "html")))
1053 "^-- $")
1054 ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$")
1055 (t "^--$"))))
1056 (save-excursion
1057 (goto-char (point-max))
1058 (when (re-search-backward regexp nil t)
1059 (mh-do-in-gnu-emacs
1060 (let ((ov (make-overlay (point) (point-max))))
1061 (overlay-put ov 'face 'mh-show-signature-face)
1062 (overlay-put ov 'evaporate t)))
1063 (mh-do-in-xemacs
1064 (set-extent-property (make-extent (point) (point-max))
1065 'face 'mh-show-signature-face))))))
1066
915(mh-do-in-xemacs 1067(mh-do-in-xemacs
916 (defvar dots) 1068 (defvar dots)
917 (defvar type)) 1069 (defvar type))
@@ -954,7 +1106,9 @@ like \"K v\" which operate on individual MIME parts."
954 :action 'mh-widget-press-button 1106 :action 'mh-widget-press-button
955 :button-keymap mh-mime-button-map 1107 :button-keymap mh-mime-button-map
956 :help-echo 1108 :help-echo
957 "Mouse-2 click or press RET (in show buffer) to toggle display"))) 1109 "Mouse-2 click or press RET (in show buffer) to toggle display")
1110 (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1111 (mh-funcall-if-exists overlay-put ov 'evaporate t))))
958 1112
959;; There is a bug in Gnus inline image display due to which an extra line 1113;; There is a bug in Gnus inline image display due to which an extra line
960;; gets inserted every time it is viewed. To work around that problem we are 1114;; gets inserted every time it is viewed. To work around that problem we are
@@ -1009,7 +1163,8 @@ like \"K v\" which operate on individual MIME parts."
1009 (when (eq mh-highlight-citation-p 'gnus) 1163 (when (eq mh-highlight-citation-p 'gnus)
1010 (mh-gnus-article-highlight-citation)) 1164 (mh-gnus-article-highlight-citation))
1011 (mh-display-smileys) 1165 (mh-display-smileys)
1012 (mh-display-emphasis)) 1166 (mh-display-emphasis)
1167 (mh-signature-highlight handle))
1013 (setq region (cons (progn (goto-char (point-min)) 1168 (setq region (cons (progn (goto-char (point-min))
1014 (point-marker)) 1169 (point-marker))
1015 (progn (goto-char (point-max)) 1170 (progn (goto-char (point-max))
@@ -1098,6 +1253,31 @@ button."
1098 (goto-char point) 1253 (goto-char point)
1099 (set-buffer-modified-p nil))) 1254 (set-buffer-modified-p nil)))
1100 1255
1256;;;###mh-autoload
1257(defun mh-display-with-external-viewer (part-index)
1258 "View MIME PART-INDEX externally."
1259 (interactive "P")
1260 (when (consp part-index) (setq part-index (car part-index)))
1261 (mh-folder-mime-action
1262 part-index
1263 #'(lambda ()
1264 (let* ((part (get-text-property (point) 'mh-data))
1265 (type (mm-handle-media-type part))
1266 (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
1267 (mailcap-mime-info type 'all)))
1268 (def (caar methods))
1269 (prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
1270 (method (completing-read prompt methods nil nil nil nil def))
1271 (folder mh-show-folder-buffer)
1272 (buffer-read-only nil))
1273 (when (string-match "^[^% \t]+$" method)
1274 (setq method (concat method " %s")))
1275 (flet ((mm-handle-set-external-undisplayer (handle function)
1276 (mh-handle-set-external-undisplayer folder handle function)))
1277 (unwind-protect (mm-display-external part method)
1278 (set-buffer-modified-p nil)))))
1279 nil))
1280
1101(defun mh-widget-press-button (widget el) 1281(defun mh-widget-press-button (widget el)
1102 "Callback for widget, WIDGET. 1282 "Callback for widget, WIDGET.
1103Parameter EL is unused." 1283Parameter EL is unused."
@@ -1106,9 +1286,9 @@ Parameter EL is unused."
1106 1286
1107(defun mh-mime-display-security (handle) 1287(defun mh-mime-display-security (handle)
1108 "Display PGP encrypted/signed message, HANDLE." 1288 "Display PGP encrypted/signed message, HANDLE."
1109 (insert "\n")
1110 (save-restriction 1289 (save-restriction
1111 (narrow-to-region (point) (point)) 1290 (narrow-to-region (point) (point))
1291 (insert "\n")
1112 (mh-insert-mime-security-button handle) 1292 (mh-insert-mime-security-button handle)
1113 (mh-mime-display-mixed (cdr handle)) 1293 (mh-mime-display-mixed (cdr handle))
1114 (insert "\n") 1294 (insert "\n")
@@ -1116,9 +1296,7 @@ Parameter EL is unused."
1116 mh-mime-security-button-end-line-format)) 1296 mh-mime-security-button-end-line-format))
1117 (mh-insert-mime-security-button handle)) 1297 (mh-insert-mime-security-button handle))
1118 (mm-set-handle-multipart-parameter 1298 (mm-set-handle-multipart-parameter
1119 handle 'mh-region 1299 handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
1120 (cons (set-marker (make-marker) (point-min))
1121 (set-marker (make-marker) (point-max))))))
1122 1300
1123;;; I rewrote the security part because Gnus doesn't seem to ever minimize 1301;;; I rewrote the security part because Gnus doesn't seem to ever minimize
1124;;; the button. That is once the mime-security button is pressed there seems 1302;;; the button. That is once the mime-security button is pressed there seems
@@ -1149,8 +1327,22 @@ Parameter EL is unused."
1149 1327
1150(defun mh-mime-security-press-button (handle) 1328(defun mh-mime-security-press-button (handle)
1151 "Callback from security button for part HANDLE." 1329 "Callback from security button for part HANDLE."
1152 (when (mm-handle-multipart-ctl-parameter handle 'gnus-info) 1330 (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
1153 (mh-mime-security-show-details handle))) 1331 (mh-mime-security-show-details handle)
1332 (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
1333 point)
1334 (setq point (point))
1335 (goto-char (car region))
1336 (delete-region (car region) (cdr region))
1337 (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
1338 (let* ((mm-verify-option 'known)
1339 (mm-decrypt-option 'known)
1340 (new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
1341 (unless (eq new (cdr handle))
1342 (mm-destroy-parts (cdr handle))
1343 (setcdr handle new))))
1344 (mh-mime-display-security handle)
1345 (goto-char point))))
1154 1346
1155;; These variables should already be initialized in mm-decode.el if we have a 1347;; These variables should already be initialized in mm-decode.el if we have a
1156;; recent enough Gnus. The defvars are here to avoid compiler warnings. 1348;; recent enough Gnus. The defvars are here to avoid compiler warnings.
@@ -1191,6 +1383,8 @@ Parameter EL is unused."
1191 :action 'mh-widget-press-button 1383 :action 'mh-widget-press-button
1192 :button-keymap mh-mime-security-button-map 1384 :button-keymap mh-mime-security-button-map
1193 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") 1385 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
1386 (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1387 (mh-funcall-if-exists overlay-put ov 'evaporate t))
1194 (when (equal info "Failed") 1388 (when (equal info "Failed")
1195 (let* ((type (if (equal (car handle) "multipart/signed") 1389 (let* ((type (if (equal (car handle) "multipart/signed")
1196 "verification" "decryption")) 1390 "verification" "decryption"))
@@ -1204,8 +1398,8 @@ The function decodes the message and displays it. It avoids decoding the same
1204message multiple times." 1398message multiple times."
1205 (let ((b (point)) 1399 (let ((b (point))
1206 (clean-message-header mh-clean-message-header-flag) 1400 (clean-message-header mh-clean-message-header-flag)
1207 (invisible-headers mh-invisible-headers) 1401 (invisible-headers mh-invisible-header-fields-compiled)
1208 (visible-headers mh-visible-headers)) 1402 (visible-headers nil))
1209 (save-excursion 1403 (save-excursion
1210 (save-restriction 1404 (save-restriction
1211 (narrow-to-region b b) 1405 (narrow-to-region b b)
diff --git a/lisp/mh-e/mh-pick.el b/lisp/mh-e/mh-pick.el
index a888f02154f..b92a98f26cc 100644
--- a/lisp/mh-e/mh-pick.el
+++ b/lisp/mh-e/mh-pick.el
@@ -1,6 +1,6 @@
1;;; mh-pick.el --- make a search pattern and search for a message in MH-E 1;;; mh-pick.el --- make a search pattern and search for a message in MH-E
2 2
3;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1995, 2001, 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>
@@ -32,6 +32,8 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'mh-acros))
36(mh-require-cl)
35(require 'mh-e) 37(require 'mh-e)
36(require 'easymenu) 38(require 'easymenu)
37(require 'gnus-util) 39(require 'gnus-util)
@@ -44,6 +46,9 @@
44(defvar mh-searching-folder nil) ;Folder this pick is searching. 46(defvar mh-searching-folder nil) ;Folder this pick is searching.
45(defvar mh-searching-function nil) 47(defvar mh-searching-function nil)
46 48
49(defconst mh-pick-single-dash '(cc date from subject to)
50 "Search components that are supported by single-dash option in pick.")
51
47;;;###mh-autoload 52;;;###mh-autoload
48(defun mh-search-folder (folder window-config) 53(defun mh-search-folder (folder window-config)
49 "Search FOLDER for messages matching a pattern. 54 "Search FOLDER for messages matching a pattern.
@@ -139,16 +144,6 @@ with no arguments, upon entry to this mode.
139 (run-hooks 'mh-pick-mode-hook)) 144 (run-hooks 'mh-pick-mode-hook))
140 145
141;;;###mh-autoload 146;;;###mh-autoload
142(defun mh-do-pick-search ()
143 "Find messages that match the qualifications in the current pattern buffer.
144Messages are searched for in the folder named in `mh-searching-folder'.
145Add the messages found to the sequence named `search'.
146
147This is a deprecated function and `mh-pick-do-search' should be used instead."
148 (interactive)
149 (mh-pick-do-search))
150
151;;;###mh-autoload
152(defun mh-pick-do-search () 147(defun mh-pick-do-search ()
153 "Find messages that match the qualifications in the current pattern buffer. 148 "Find messages that match the qualifications in the current pattern buffer.
154Messages are searched for in the folder named in `mh-searching-folder'. 149Messages are searched for in the folder named in `mh-searching-folder'.
@@ -260,6 +255,13 @@ COMPONENT is the component to search."
260 "-rbrace")) 255 "-rbrace"))
261 (t (error "Unknown operator '%s' seen" (car expr))))) 256 (t (error "Unknown operator '%s' seen" (car expr)))))
262 257
258;; All implementations of pick have special options -cc, -date, -from and
259;; -subject that allow to search for corresponding components. Any other
260;; component is searched using option --COMPNAME, for example: `pick
261;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain
262;; kludge, but it prefers the following syntax for this purpose:
263;; `--component=COMPNAME --pattern=PATTERN'.
264;; -- Sergey Poznyakoff, Aug 2003
263(defun mh-pick-regexp-builder (pattern-list) 265(defun mh-pick-regexp-builder (pattern-list)
264 "Generate pick search expression from PATTERN-LIST." 266 "Generate pick search expression from PATTERN-LIST."
265 (let ((result ())) 267 (let ((result ()))
@@ -267,9 +269,18 @@ COMPONENT is the component to search."
267 (when (cdr pattern) 269 (when (cdr pattern)
268 (setq result `(,@result "-and" "-lbrace" 270 (setq result `(,@result "-and" "-lbrace"
269 ,@(mh-pick-construct-regexp 271 ,@(mh-pick-construct-regexp
270 (cdr pattern) (if (car pattern) 272 (if (and (mh-variant-p 'mu-mh) (car pattern))
271 (format "-%s" (car pattern)) 273 (format "--pattern=%s" (cdr pattern))
272 "-search")) 274 (cdr pattern))
275 (if (car pattern)
276 (cond
277 ((mh-variant-p 'mu-mh)
278 (format "--component=%s" (car pattern)))
279 ((member (car pattern) mh-pick-single-dash)
280 (format "-%s" (car pattern)))
281 (t
282 (format "--%s" (car pattern))))
283 "-search"))
273 "-rbrace")))) 284 "-rbrace"))))
274 (cdr result))) 285 (cdr result)))
275 286
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
new file mode 100644
index 00000000000..7539e455919
--- /dev/null
+++ b/lisp/mh-e/mh-print.el
@@ -0,0 +1,279 @@
1;;; mh-print.el --- MH-E printing support
2
3;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
4
5;; Author: Jeffrey C Honig <jch@honig.net>
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;; Pp Print to lpr | Default inline settings
29;; Pf Print to file | Generate a postscript file
30;; Ps Print show buffer | Fails if no show buffer
31;;
32;; PA Toggle inline/attachments
33;; PC Toggle color
34;; PF Toggle faces
35
36;;; Change Log:
37
38;;; Code:
39
40(eval-when-compile (require 'mh-acros))
41(mh-require-cl)
42(require 'ps-print)
43(require 'mh-utils)
44(require 'mh-funcs)
45(eval-when-compile (require 'mh-seq))
46
47(defvar mh-ps-print-mime nil
48 "Control printing of MIME parts.
49The three possible states are:
50 1. nil to not print inline parts
51 2. t to print inline parts
52 3. non-zero to print inline parts and attachments")
53
54(defvar mh-ps-print-color-option ps-print-color-p
55 "MH-E's version of `\\[ps-print-color-p]'.")
56
57(defvar mh-ps-print-func 'ps-spool-buffer-with-faces
58 "Function to use to spool a buffer.
59Sensible choices are the functions `ps-spool-buffer' and
60`ps-spool-buffer-with-faces'.")
61
62;; XXX - If buffer is already being displayed, use that buffer
63;; XXX - What about showing MIME content?
64;; XXX - Default print buffer is bogus
65(defun mh-ps-spool-buffer (buffer)
66 "Send BUFFER to printer queue."
67 (message (format "mh-ps-spool-buffer %s" buffer))
68 (save-excursion
69 (set-buffer buffer)
70 (let ((ps-print-color-p mh-ps-print-color-option)
71 (ps-left-header
72 (list
73 (concat "("
74 (mh-get-header-field "Subject:") ")")
75 (concat "("
76 (mh-get-header-field "From:") ")")))
77 (ps-right-header
78 (list
79 "/pagenumberstring load"
80 (concat "("
81 (mh-get-header-field "Date:") ")"))))
82 (funcall mh-ps-print-func))))
83
84(defun mh-ps-spool-a-msg (msg buffer)
85 "Print MSG.
86First the message is decoded in BUFFER before the results are sent to the
87printer."
88 (message (format "mh-ps-spool-a-msg msg %s buffer %s"
89 msg buffer))
90 (let ((mh-show-buffer mh-show-buffer)
91 (folder mh-current-folder)
92 ;; The following is commented out because
93 ;; `clean-message-header-flag' isn't used anywhere. I
94 ;; commented rather than deleted in case somebody had some
95 ;; future plans for it. --SY.
96 ;(clean-message-header-flag mh-clean-message-header-flag)
97 )
98 (unwind-protect
99 (progn
100 (setq mh-show-buffer buffer)
101 (save-excursion
102 ;;
103 ;; XXX - Use setting of mh-ps-print-mime
104 ;;
105 (mh-display-msg msg folder)
106 (mh-ps-spool-buffer mh-show-buffer)
107 (kill-buffer mh-show-buffer))))))
108
109;;;###mh-autoload
110(defun mh-ps-print-msg (range)
111 "Print the messages in RANGE.
112
113Check the documentation of `mh-interactive-range' to see how RANGE is read in
114interactive use."
115 (interactive (list (mh-interactive-range "Print")))
116 (message (format "mh-ps-print-msg range %s keys %s"
117 range (this-command-keys)))
118 (mh-iterate-on-range msg range
119 (let ((buffer (get-buffer-create mh-temp-buffer)))
120 (unwind-protect
121 (mh-ps-spool-a-msg msg buffer)
122 (kill-buffer buffer)))
123 (mh-notate nil mh-note-printed mh-cmd-note))
124 (ps-despool nil))
125
126(defun mh-ps-print-preprint (prefix-arg)
127 "Replacement for `ps-print-preprint'.
128The original function does not handle the fact that MH folders are directories
129nicely, when generating the default file name. This function works around
130that. The function is passed the interactive PREFIX-ARG."
131 (let ((buffer-file-name (format "/tmp/%s" (substring (buffer-name) 1))))
132 (ps-print-preprint prefix-arg)))
133
134;;;###mh-autoload
135(defun mh-ps-print-msg-file (file range)
136 "Print to FILE the messages in RANGE.
137
138Check the documentation of `mh-interactive-range' to see how RANGE is read in
139interactive use."
140 (interactive (list
141 (mh-ps-print-preprint 1)
142 (mh-interactive-range "Print")))
143 (mh-iterate-on-range msg range
144 (let ((buffer (get-buffer-create mh-temp-buffer)))
145 (unwind-protect
146 (mh-ps-spool-a-msg msg buffer)
147 (kill-buffer buffer)))
148 (mh-notate nil mh-note-printed mh-cmd-note))
149 (ps-despool file))
150
151;;;###mh-autoload
152(defun mh-ps-print-msg-show (file)
153 "Print current show buffer to FILE."
154 (interactive (list (mh-ps-print-preprint current-prefix-arg)))
155 (message (format "mh-ps-print-msg-show file %s keys %s mh-show-buffer %s"
156 file (this-command-keys) mh-show-buffer))
157 (let ((msg (mh-get-msg-num t))
158 (folder mh-current-folder)
159 (show-buffer mh-show-buffer)
160 (show-window (get-buffer-window mh-show-buffer)))
161 (if (and show-buffer show-window)
162 (mh-in-show-buffer (show-buffer)
163 (if (equal (mh-msg-filename msg folder) buffer-file-name)
164 (progn
165 (mh-ps-spool-buffer show-buffer)
166 (ps-despool file))
167 (message "Current message is not being shown(1).")))
168 (message "Current message is not being shown(2)."))))
169
170;;;###mh-autoload
171(defun mh-ps-print-toggle-faces ()
172 "Toggle whether printing is done with faces or not."
173 (interactive)
174 (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces)
175 (progn
176 (setq mh-ps-print-func 'ps-spool-buffer)
177 (message "Printing without faces"))
178 (setq mh-ps-print-func 'ps-spool-buffer-with-faces)
179 (message "Printing with faces")))
180
181;;;###mh-autoload
182(defun mh-ps-print-toggle-color ()
183 "Toggle whether color is used in printing messages."
184 (interactive)
185 (if (eq mh-ps-print-color-option nil)
186 (progn
187 (setq mh-ps-print-color-option 'black-white)
188 (message "Colors will be printed as black & white."))
189 (if (eq mh-ps-print-color-option 'black-white)
190 (progn
191 (setq mh-ps-print-color-option t)
192 (message "Colors will be printed."))
193 (setq mh-ps-print-color-option nil)
194 (message "Colors will not be printed."))))
195
196;;; XXX: Check option 3. Documentation doesn't sound right.
197;;;###mh-autoload
198(defun mh-ps-print-toggle-mime ()
199 "Cycle through available choices on how MIME parts should be printed.
200The available settings are:
201 1. Print only inline MIME parts.
202 2. Print all MIME parts.
203 3. Print no MIME parts."
204 (interactive)
205 (if (eq mh-ps-print-mime nil)
206 (progn
207 (setq mh-ps-print-mime t)
208 (message "Inline parts will be printed, attachments will not be printed."))
209 (if (eq mh-ps-print-mime t)
210 (progn
211 (setq mh-ps-print-mime 1)
212 (message "Both Inline parts and attachments will be printed."))
213 (setq mh-ps-print-mime nil)
214 (message "Neither inline parts nor attachments will be printed."))))
215
216;;; Old non-PS based printing
217;;;###mh-autoload
218(defun mh-print-msg (range)
219 "Print RANGE on printer.
220
221Check the documentation of `mh-interactive-range' to see how RANGE is read in
222interactive use.
223
224The variable `mh-lpr-command-format' is used to generate the print command.
225The messages are formatted by mhl. See the variable `mhl-formfile'."
226 (interactive (list (mh-interactive-range "Print")))
227 (message "Printing...")
228 (let (msgs)
229 ;; Gather message numbers and add them to "printed" sequence.
230 (mh-iterate-on-range msg range
231 (mh-add-msgs-to-seq msg 'printed t)
232 (mh-notate nil mh-note-printed mh-cmd-note)
233 (push msg msgs))
234 (setq msgs (nreverse msgs))
235 ;; Print scan listing if we have more than one message.
236 (if (> (length msgs) 1)
237 (let* ((msgs-string
238 (mapconcat 'identity (mh-list-to-string
239 (mh-coalesce-msg-list msgs)) " "))
240 (lpr-command
241 (format mh-lpr-command-format
242 (cond ((listp range)
243 (format "Folder: %s, Messages: %s"
244 mh-current-folder msgs-string))
245 ((symbolp range)
246 (format "Folder: %s, Sequence: %s"
247 mh-current-folder range)))))
248 (scan-command
249 (format "scan %s | %s" msgs-string lpr-command)))
250 (if mh-print-background-flag
251 (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
252 (call-process shell-file-name nil nil nil "-c" scan-command))))
253 ;; Print the messages
254 (dolist (msg msgs)
255 (let* ((mhl-command (format "%s %s %s"
256 (expand-file-name "mhl" mh-lib-progs)
257 (if mhl-formfile
258 (format " -form %s" mhl-formfile)
259 "")
260 (mh-msg-filename msg)))
261 (lpr-command
262 (format mh-lpr-command-format
263 (format "%s/%s" mh-current-folder msg)))
264 (print-command
265 (format "%s | %s" mhl-command lpr-command)))
266 (if mh-print-background-flag
267 (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
268 (call-process shell-file-name nil nil nil "-c" print-command)))))
269 (message "Printing...done"))
270
271(provide 'mh-print)
272
273;;; Local Variables:
274;;; indent-tabs-mode: nil
275;;; sentence-end-double-space: nil
276;;; End:
277
278;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679
279;;; mh-print.el ends here
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 20950d36c4c..8d2369ed19a 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -70,7 +70,7 @@
70 70
71;;; Code: 71;;; Code:
72 72
73(require 'mh-utils) 73(eval-when-compile (require 'mh-acros))
74(mh-require-cl) 74(mh-require-cl)
75(require 'mh-e) 75(require 'mh-e)
76 76
@@ -78,15 +78,15 @@
78(defvar tool-bar-mode) 78(defvar tool-bar-mode)
79 79
80;;; Data structures (used in message threading)... 80;;; Data structures (used in message threading)...
81(defstruct (mh-thread-message (:conc-name mh-message-) 81(mh-defstruct (mh-thread-message (:conc-name mh-message-)
82 (:constructor mh-thread-make-message)) 82 (:constructor mh-thread-make-message))
83 (id nil) 83 (id nil)
84 (references ()) 84 (references ())
85 (subject "") 85 (subject "")
86 (subject-re-p nil)) 86 (subject-re-p nil))
87 87
88(defstruct (mh-thread-container (:conc-name mh-container-) 88(mh-defstruct (mh-thread-container (:conc-name mh-container-)
89 (:constructor mh-thread-make-container)) 89 (:constructor mh-thread-make-container))
90 message parent children 90 message parent children
91 (real-child-p t)) 91 (real-child-p t))
92 92
@@ -201,12 +201,15 @@ redone to get the new thread tree. This makes incremental threading easier.")
201 201
202;;;###mh-autoload 202;;;###mh-autoload
203(defun mh-msg-is-in-seq (message) 203(defun mh-msg-is-in-seq (message)
204 "Display the sequences that contain MESSAGE. 204 "Display the sequences in which the current message appears.
205Default is the displayed message." 205Use a prefix argument to display the sequences in which another MESSAGE
206 (interactive (list (mh-get-msg-num t))) 206appears."
207 (interactive "P")
208 (if (not message)
209 (setq message (mh-get-msg-num t)))
207 (let* ((dest-folder (loop for seq in mh-refile-list 210 (let* ((dest-folder (loop for seq in mh-refile-list
208 until (member message (cdr seq)) 211 when (member message (cdr seq)) return (car seq)
209 finally return (car seq))) 212 finally return nil))
210 (deleted-flag (unless dest-folder (member message mh-delete-list)))) 213 (deleted-flag (unless dest-folder (member message mh-delete-list))))
211 (message "Message %d%s is in sequences: %s" 214 (message "Message %d%s is in sequences: %s"
212 message 215 message
@@ -269,12 +272,11 @@ interactive use."
269 (let* ((internal-seq-flag (mh-internal-seq sequence)) 272 (let* ((internal-seq-flag (mh-internal-seq sequence))
270 (original-msgs (mh-seq-msgs (mh-find-seq sequence))) 273 (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
271 (folders (list mh-current-folder)) 274 (folders (list mh-current-folder))
272 (msg-list ())) 275 (msg-list (mh-range-to-msg-list range)))
276 (mh-add-msgs-to-seq msg-list sequence nil t)
273 (mh-iterate-on-range m range 277 (mh-iterate-on-range m range
274 (push m msg-list)
275 (unless (memq m original-msgs) 278 (unless (memq m original-msgs)
276 (mh-add-sequence-notation m internal-seq-flag))) 279 (mh-add-sequence-notation m internal-seq-flag)))
277 (mh-add-msgs-to-seq msg-list sequence nil t)
278 (if (not internal-seq-flag) 280 (if (not internal-seq-flag)
279 (setq mh-last-seq-used sequence)) 281 (setq mh-last-seq-used sequence))
280 (when mh-index-data 282 (when mh-index-data
@@ -292,10 +294,8 @@ OP is one of 'widen and 'unthread."
292 294
293;;;###mh-autoload 295;;;###mh-autoload
294(defun mh-widen (&optional all-flag) 296(defun mh-widen (&optional all-flag)
295 "Remove last restriction from current folder. 297 "Restore the previous limit.
296If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning 298If optional prefix argument ALL-FLAG is non-nil, remove all limits."
297of the view stack thereby showing all messages that the buffer originally
298contained."
299 (interactive "P") 299 (interactive "P")
300 (let ((msg (mh-get-msg-num nil))) 300 (let ((msg (mh-get-msg-num nil)))
301 (when mh-folder-view-stack 301 (when mh-folder-view-stack
@@ -533,28 +533,6 @@ should be replaced with:
533 (rplaca old-seq new-name))) 533 (rplaca old-seq new-name)))
534 534
535;;;###mh-autoload 535;;;###mh-autoload
536(defun mh-map-to-seq-msgs (func seq &rest args)
537 "Invoke the FUNC at each message in the SEQ.
538SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
539passed as arguments to FUNC."
540 (save-excursion
541 (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
542 (while msgs
543 (if (mh-goto-msg (car msgs) t t)
544 (apply func (car msgs) args))
545 (setq msgs (cdr msgs))))))
546
547;;;###mh-autoload
548(defun mh-notate-seq (seq notation offset)
549 "Mark the scan listing.
550All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
551the line."
552 (let ((msg-list (mh-seq-to-msgs seq)))
553 (mh-iterate-on-messages-in-region msg (point-min) (point-max)
554 (when (member msg msg-list)
555 (mh-notate nil notation offset)))))
556
557;;;###mh-autoload
558(defun mh-notate-cur () 536(defun mh-notate-cur ()
559 "Mark the MH sequence cur. 537 "Mark the MH sequence cur.
560In addition to notating the current message with `mh-note-cur' the function 538In addition to notating the current message with `mh-note-cur' the function
@@ -577,14 +555,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
577 "-sequence" (symbol-name seq) 555 "-sequence" (symbol-name seq)
578 (mh-coalesce-msg-list msgs))))) 556 (mh-coalesce-msg-list msgs)))))
579 557
580;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
581;; that the folder buffer is sorted. However in this case that assumption
582;; doesn't hold. So we will do this the dumb way.
583;(defun mh-copy-seq-to-point (seq location)
584; ;; Copy the scan listing of the messages in SEQUENCE to after the point
585; ;; LOCATION in the current buffer.
586; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
587
588(defvar mh-thread-last-ancestor) 558(defvar mh-thread-last-ancestor)
589 559
590(defun mh-copy-seq-to-eob (seq) 560(defun mh-copy-seq-to-eob (seq)
@@ -614,21 +584,6 @@ uses `overlay-arrow-position' to put a marker in the fringe."
614 (mh-index-data 584 (mh-index-data
615 (mh-index-insert-folder-headers))))))) 585 (mh-index-insert-folder-headers)))))))
616 586
617(defun mh-copy-line-to-point (msg location)
618 "Copy current message line to a specific location.
619The argument MSG is not used. The message in the current line is copied to
620LOCATION."
621 ;; msg is not used?
622 ;; Copy the current line to the LOCATION in the current buffer.
623 (beginning-of-line)
624 (save-excursion
625 (let ((beginning-of-line (point))
626 end)
627 (forward-line 1)
628 (setq end (point))
629 (goto-char location)
630 (insert-buffer-substring (current-buffer) beginning-of-line end))))
631
632;;;###mh-autoload 587;;;###mh-autoload
633(defmacro mh-iterate-on-messages-in-region (var begin end &rest body) 588(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
634 "Iterate over region. 589 "Iterate over region.
@@ -702,7 +657,7 @@ a region in a cons cell."
702 (nreverse msg-list))) 657 (nreverse msg-list)))
703 658
704;;;###mh-autoload 659;;;###mh-autoload
705(defun mh-interactive-range (range-prompt) 660(defun mh-interactive-range (range-prompt &optional default)
706 "Return interactive specification for message, sequence, range or region. 661 "Return interactive specification for message, sequence, range or region.
707By convention, the name of this argument is RANGE. 662By convention, the name of this argument is RANGE.
708 663
@@ -715,24 +670,17 @@ RANGE-PROMPT. A list of messages in that range is returned.
715If a MH range is given, say something like last:20, then a list containing 670If a MH range is given, say something like last:20, then a list containing
716the messages in that range is returned. 671the messages in that range is returned.
717 672
673If DEFAULT non-nil then it is returned.
674
718Otherwise, the message number at point is returned. 675Otherwise, the message number at point is returned.
719 676
720This function is usually used with `mh-iterate-on-range' in order to provide 677This function is usually used with `mh-iterate-on-range' in order to provide
721a uniform interface to MH-E functions." 678a uniform interface to MH-E functions."
722 (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) 679 (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
723 (current-prefix-arg (mh-read-range range-prompt nil nil t t)) 680 (current-prefix-arg (mh-read-range range-prompt nil nil t t))
681 (default default)
724 (t (mh-get-msg-num t)))) 682 (t (mh-get-msg-num t))))
725 683
726;;;###mh-autoload
727(defun mh-region-to-msg-list (begin end)
728 "Return a list of messages within the region between BEGIN and END."
729 ;; If end is end of buffer back up one position
730 (setq end (if (equal end (point-max)) (1- end) end))
731 (let ((result))
732 (mh-iterate-on-messages-in-region index begin end
733 (when (numberp index) (push index result)))
734 result))
735
736 684
737 685
738;;; Commands to handle new 'subject sequence. 686;;; Commands to handle new 'subject sequence.
@@ -772,7 +720,7 @@ Return number of messages put in the sequence:
772 (if (or (not (looking-at mh-scan-subject-regexp)) 720 (if (or (not (looking-at mh-scan-subject-regexp))
773 (not (match-string 3)) 721 (not (match-string 3))
774 (string-equal "" (match-string 3))) 722 (string-equal "" (match-string 3)))
775 (progn (message "No subject line.") 723 (progn (message "No subject line")
776 nil) 724 nil)
777 (let ((subject (match-string-no-properties 3)) 725 (let ((subject (match-string-no-properties 3))
778 (list)) 726 (list))
@@ -835,61 +783,57 @@ This function can only be used the folder is threaded."
835 (mh-container-message (gethash (gethash msg mh-thread-index-id-map) 783 (mh-container-message (gethash (gethash msg mh-thread-index-id-map)
836 mh-thread-id-table))))) 784 mh-thread-id-table)))))
837 785
838;;;###mh-autoload 786(defun mh-edit-pick-expr (default)
839(defun mh-narrow-to-subject () 787 "With prefix arg edit a pick expression.
840 "Narrow to a sequence containing all following messages with same subject."
841 (interactive)
842 (let ((num (mh-get-msg-num nil))
843 (count (mh-subject-to-sequence t)))
844 (cond
845 ((not count) ; No subject line, delete msg anyway
846 nil)
847 ((= 0 count) ; No other msgs, delete msg anyway.
848 (message "No other messages with same Subject following this one.")
849 nil)
850 (t ; We have a subject sequence.
851 (message "Found %d messages for subject sequence." count)
852 (mh-narrow-to-seq 'subject)
853 (if (numberp num)
854 (mh-goto-msg num t t))))))
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." 788If no prefix arg is given, then return DEFAULT."
859 (let ((default-string (loop for x in default concat (format " %s" x)))) 789 (let ((default-string (loop for x in default concat (format " %s" x))))
860 (if (or current-prefix-arg (equal default-string "")) 790 (if (or current-prefix-arg (equal default-string ""))
861 (delete "" (split-string (read-string "Pick regexp: " default-string))) 791 (delete "" (split-string (read-string "Pick expression: "
792 default-string)))
862 default))) 793 default)))
863 794
864;;;###mh-autoload 795;;;###mh-autoload
865(defun mh-narrow-to-from (&optional regexp) 796(defun mh-narrow-to-subject (&optional pick-expr)
866 "Limit to messages with the same From header field as the message at point. 797 "Limit to messages with same subject.
867With a prefix argument, prompt for the regular expression, REGEXP given to 798With a prefix argument, edit PICK-EXPR.
868pick." 799
800Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
869 (interactive 801 (interactive
870 (list (mh-read-pick-regexp (mh-current-message-header-field 'from)))) 802 (list (mh-edit-pick-expr (mh-current-message-header-field 'subject))))
871 (mh-narrow-to-header-field 'from regexp)) 803 (mh-narrow-to-header-field 'subject pick-expr))
872 804
873;;;###mh-autoload 805;;;###mh-autoload
874(defun mh-narrow-to-cc (&optional regexp) 806(defun mh-narrow-to-from (&optional pick-expr)
875 "Limit to messages with the same Cc header field as the message at point. 807 "Limit to messages with the same `From:' field.
876With a prefix argument, prompt for the regular expression, REGEXP given to 808With a prefix argument, edit PICK-EXPR.
877pick." 809
810Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
878 (interactive 811 (interactive
879 (list (mh-read-pick-regexp (mh-current-message-header-field 'cc)))) 812 (list (mh-edit-pick-expr (mh-current-message-header-field 'from))))
880 (mh-narrow-to-header-field 'cc regexp)) 813 (mh-narrow-to-header-field 'from pick-expr))
881 814
882;;;###mh-autoload 815;;;###mh-autoload
883(defun mh-narrow-to-to (&optional regexp) 816(defun mh-narrow-to-cc (&optional pick-expr)
884 "Limit to messages with the same To header field as the message at point. 817 "Limit to messages with the same `Cc:' field.
885With a prefix argument, prompt for the regular expression, REGEXP given to 818With a prefix argument, edit PICK-EXPR.
886pick." 819
820Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
887 (interactive 821 (interactive
888 (list (mh-read-pick-regexp (mh-current-message-header-field 'to)))) 822 (list (mh-edit-pick-expr (mh-current-message-header-field 'cc))))
889 (mh-narrow-to-header-field 'to regexp)) 823 (mh-narrow-to-header-field 'cc pick-expr))
890 824
891(defun mh-narrow-to-header-field (header-field regexp) 825;;;###mh-autoload
892 "Limit to messages whose HEADER-FIELD match REGEXP. 826(defun mh-narrow-to-to (&optional pick-expr)
827 "Limit to messages with the same `To:' field.
828With a prefix argument, edit PICK-EXPR.
829
830Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
831 (interactive
832 (list (mh-edit-pick-expr (mh-current-message-header-field 'to))))
833 (mh-narrow-to-header-field 'to pick-expr))
834
835(defun mh-narrow-to-header-field (header-field pick-expr)
836 "Limit to messages whose HEADER-FIELD match PICK-EXPR.
893The MH command pick is used to do the match." 837The MH command pick is used to do the match."
894 (let ((folder mh-current-folder) 838 (let ((folder mh-current-folder)
895 (original (mh-coalesce-msg-list 839 (original (mh-coalesce-msg-list
@@ -897,7 +841,7 @@ The MH command pick is used to do the match."
897 (msg-list ())) 841 (msg-list ()))
898 (with-temp-buffer 842 (with-temp-buffer
899 (apply #'mh-exec-cmd-output "pick" nil folder 843 (apply #'mh-exec-cmd-output "pick" nil folder
900 (append original (list "-list") regexp)) 844 (append original (list "-list") pick-expr))
901 (goto-char (point-min)) 845 (goto-char (point-min))
902 (while (not (eobp)) 846 (while (not (eobp))
903 (let ((num (read-from-string 847 (let ((num (read-from-string
@@ -939,7 +883,9 @@ The MH command pick is used to do the match."
939 "Limit to messages in RANGE. 883 "Limit to messages in RANGE.
940 884
941Check the documentation of `mh-interactive-range' to see how RANGE is read in 885Check the documentation of `mh-interactive-range' to see how RANGE is read in
942interactive use." 886interactive use.
887
888Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
943 (interactive (list (mh-interactive-range "Narrow to"))) 889 (interactive (list (mh-interactive-range "Narrow to")))
944 (when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) 890 (when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
945 (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) 891 (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
@@ -958,7 +904,7 @@ subject sequence."
958 ((not count) ; No subject line, delete msg anyway 904 ((not count) ; No subject line, delete msg anyway
959 (mh-delete-msg (mh-get-msg-num t))) 905 (mh-delete-msg (mh-get-msg-num t)))
960 ((= 0 count) ; No other msgs, delete msg anyway. 906 ((= 0 count) ; No other msgs, delete msg anyway.
961 (message "No other messages with same Subject following this one.") 907 (message "No other messages with same Subject following this one")
962 (mh-delete-msg (mh-get-msg-num t))) 908 (mh-delete-msg (mh-get-msg-num t)))
963 (t ; We have a subject sequence. 909 (t ; We have a subject sequence.
964 (message "Marked %d messages for deletion" count) 910 (message "Marked %d messages for deletion" count)
@@ -1078,13 +1024,12 @@ SUBJECT and REFS fields."
1078 message) 1024 message)
1079 (container 1025 (container
1080 (setf (mh-container-message container) 1026 (setf (mh-container-message container)
1081 (mh-thread-make-message :subject subject 1027 (mh-thread-make-message :id id :references refs
1082 :subject-re-p subject-re-p 1028 :subject subject
1083 :id id :references refs))) 1029 :subject-re-p subject-re-p)))
1084 (t (let ((message (mh-thread-make-message 1030 (t (let ((message (mh-thread-make-message :id id :references refs
1085 :subject subject 1031 :subject-re-p subject-re-p
1086 :subject-re-p subject-re-p 1032 :subject subject)))
1087 :id id :references refs)))
1088 (prog1 message 1033 (prog1 message
1089 (mh-thread-get-message-container message))))))) 1034 (mh-thread-get-message-container message)))))))
1090 1035
@@ -1450,8 +1395,7 @@ MSG is the message being notated with NOTATION at OFFSET."
1450 (cur-scan-line (and mh-thread-scan-line-map 1395 (cur-scan-line (and mh-thread-scan-line-map
1451 (gethash msg mh-thread-scan-line-map))) 1396 (gethash msg mh-thread-scan-line-map)))
1452 (old-scan-lines (loop for map in mh-thread-scan-line-map-stack 1397 (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
1453 collect (and map (gethash msg map)))) 1398 collect (and map (gethash msg map)))))
1454 (notation (if (stringp notation) (aref notation 0) notation)))
1455 (when cur-scan-line 1399 (when cur-scan-line
1456 (setf (aref (car cur-scan-line) offset) notation)) 1400 (setf (aref (car cur-scan-line) offset) notation))
1457 (dolist (line old-scan-lines) 1401 (dolist (line old-scan-lines)
@@ -1486,7 +1430,8 @@ MSG is the message being notated with NOTATION at OFFSET."
1486 (setf (gethash msg mh-thread-scan-line-map) v)))) 1430 (setf (gethash msg mh-thread-scan-line-map) v))))
1487 (when (> (hash-table-count mh-thread-scan-line-map) 0) 1431 (when (> (hash-table-count mh-thread-scan-line-map) 0)
1488 (insert (if (bobp) "" "\n") (car x) "\n") 1432 (insert (if (bobp) "" "\n") (car x) "\n")
1489 (mh-thread-generate-scan-lines thread-tree -2))))))) 1433 (mh-thread-generate-scan-lines thread-tree -2))))
1434 (mh-index-create-imenu-index))))
1490 1435
1491(defun mh-thread-folder () 1436(defun mh-thread-folder ()
1492 "Generate thread view of folder." 1437 "Generate thread view of folder."
@@ -1711,11 +1656,12 @@ start of the region and the second is the point at the end."
1711 (push msg unticked) 1656 (push msg unticked)
1712 (setcdr tick-seq (delq msg (cdr tick-seq))) 1657 (setcdr tick-seq (delq msg (cdr tick-seq)))
1713 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) 1658 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
1714 (mh-remove-sequence-notation msg t)) 1659 (mh-remove-sequence-notation msg (mh-colors-in-use-p)))
1715 (t 1660 (t
1716 (push msg ticked) 1661 (push msg ticked)
1717 (setq mh-last-seq-used mh-tick-seq) 1662 (setq mh-last-seq-used mh-tick-seq)
1718 (mh-add-sequence-notation msg t)))) 1663 (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
1664 (mh-add-sequence-notation msg (mh-colors-in-use-p))))))
1719 (mh-add-msgs-to-seq ticked mh-tick-seq nil t) 1665 (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
1720 (mh-undefine-sequence mh-tick-seq unticked) 1666 (mh-undefine-sequence mh-tick-seq unticked)
1721 (when mh-index-data 1667 (when mh-index-data
@@ -1724,16 +1670,16 @@ start of the region and the second is the point at the end."
1724 1670
1725;;;###mh-autoload 1671;;;###mh-autoload
1726(defun mh-narrow-to-tick () 1672(defun mh-narrow-to-tick ()
1727 "Restrict display of this folder to just messages in `mh-tick-seq'. 1673 "Limit to messages in `mh-tick-seq'.
1674
1728Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." 1675Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
1729 (interactive) 1676 (interactive)
1730 (cond ((not mh-tick-seq) 1677 (cond ((not mh-tick-seq)
1731 (error "Enable ticking by customizing `mh-tick-seq'")) 1678 (error "Enable ticking by customizing `mh-tick-seq'"))
1732 ((null (mh-seq-msgs (mh-find-seq mh-tick-seq))) 1679 ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
1733 (message "No messages in tick sequence")) 1680 (message "No messages in %s sequence" mh-tick-seq))
1734 (t (mh-narrow-to-seq mh-tick-seq)))) 1681 (t (mh-narrow-to-seq mh-tick-seq))))
1735 1682
1736
1737(provide 'mh-seq) 1683(provide 'mh-seq)
1738 1684
1739;;; Local Variables: 1685;;; Local Variables:
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 967984d1104..2617a941de1 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -34,10 +34,11 @@
34;;; Code: 34;;; Code:
35 35
36;; Requires 36;; Requires
37(require 'mh-utils) 37(eval-when-compile (require 'mh-acros))
38(mh-require-cl) 38(mh-require-cl)
39(require 'mh-e) 39(require 'mh-e)
40(require 'speedbar) 40(require 'speedbar)
41(require 'timer)
41 42
42;; Global variables 43;; Global variables
43(defvar mh-speed-refresh-flag nil) 44(defvar mh-speed-refresh-flag nil)
@@ -90,26 +91,25 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
90 "+" mh-speed-expand-folder 91 "+" mh-speed-expand-folder
91 "-" mh-speed-contract-folder 92 "-" mh-speed-contract-folder
92 "\r" mh-speed-view 93 "\r" mh-speed-view
93 "f" mh-speed-flists 94 "r" mh-speed-refresh)
94 "i" mh-speed-invalidate-map)
95 95
96(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) 96(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
97(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) 97(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
98 98
99;; Menus for speedbar... 99;; Menus for speedbar...
100(defvar mh-folder-speedbar-menu-items 100(defvar mh-folder-speedbar-menu-items
101 '(["Visit Folder" mh-speed-view 101 '("--"
102 ["Visit Folder" mh-speed-view
102 (save-excursion 103 (save-excursion
103 (set-buffer speedbar-buffer) 104 (set-buffer speedbar-buffer)
104 (get-text-property (line-beginning-position) 'mh-folder))] 105 (get-text-property (line-beginning-position) 'mh-folder))]
105 ["Expand nested folders" mh-speed-expand-folder 106 ["Expand Nested Folders" mh-speed-expand-folder
106 (and (get-text-property (line-beginning-position) 'mh-children-p) 107 (and (get-text-property (line-beginning-position) 'mh-children-p)
107 (not (get-text-property (line-beginning-position) 'mh-expanded)))] 108 (not (get-text-property (line-beginning-position) 'mh-expanded)))]
108 ["Contract nested folders" mh-speed-contract-folder 109 ["Contract Nested Folders" mh-speed-contract-folder
109 (and (get-text-property (line-beginning-position) 'mh-children-p) 110 (and (get-text-property (line-beginning-position) 'mh-children-p)
110 (get-text-property (line-beginning-position) 'mh-expanded))] 111 (get-text-property (line-beginning-position) 'mh-expanded))]
111 ["Run Flists" mh-speed-flists t] 112 ["Refresh Speedbar" mh-speed-refresh t])
112 ["Invalidate cached folders" mh-speed-invalidate-map t])
113 "Extra menu items for speedbar.") 113 "Extra menu items for speedbar.")
114 114
115(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) 115(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
@@ -352,6 +352,14 @@ Optional ARGS are ignored."
352(defvar mh-speed-current-folder nil) 352(defvar mh-speed-current-folder nil)
353(defvar mh-speed-flists-folder nil) 353(defvar mh-speed-flists-folder nil)
354 354
355(defmacro mh-process-kill-without-query (process)
356 "PROCESS can be killed without query on Emacs exit.
357Avoid using `process-kill-without-query' if possible since it is now
358obsolete."
359 (if (fboundp 'set-process-query-on-exit-flag)
360 `(set-process-query-on-exit-flag ,process nil)
361 `(process-kill-without-query ,process)))
362
355;;;###mh-autoload 363;;;###mh-autoload
356(defun mh-speed-flists (force &rest folders) 364(defun mh-speed-flists (force &rest folders)
357 "Execute flists -recurse and update message counts. 365 "Execute flists -recurse and update message counts.
@@ -396,6 +404,7 @@ only for that one folder."
396 (or mh-speed-flists-folder '("-recurse")))) 404 (or mh-speed-flists-folder '("-recurse"))))
397 ;; Run flists on all folders the next time around... 405 ;; Run flists on all folders the next time around...
398 (setq mh-speed-flists-folder nil) 406 (setq mh-speed-flists-folder nil)
407 (mh-process-kill-without-query mh-speed-flists-process)
399 (set-process-filter mh-speed-flists-process 408 (set-process-filter mh-speed-flists-process
400 'mh-speed-parse-flists-output))))))) 409 'mh-speed-parse-flists-output)))))))
401 410
@@ -494,6 +503,14 @@ next."
494 (when (equal folder "") 503 (when (equal folder "")
495 (clrhash mh-sub-folders-cache))))) 504 (clrhash mh-sub-folders-cache)))))
496 505
506(defun mh-speed-refresh ()
507 "Refresh the speedbar.
508Use this function to refresh the speedbar if folders have been added or
509deleted or message ranges have been updated outside of MH-E."
510 (interactive)
511 (mh-speed-flists t)
512 (mh-speed-invalidate-map ""))
513
497;;;###mh-autoload 514;;;###mh-autoload
498(defun mh-speed-add-folder (folder) 515(defun mh-speed-add-folder (folder)
499 "Add FOLDER since it is being created. 516 "Add FOLDER since it is being created.
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index b1966915e86..a57567a7bd3 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -33,20 +33,14 @@
33 33
34;;; Code: 34;;; Code:
35 35
36;; Is this XEmacs-land? Located here since needed by mh-customize.el. 36(defvar recursive-load-depth-limit)
37(defvar mh-xemacs-flag (featurep 'xemacs) 37(eval-and-compile
38 "Non-nil means the current Emacs is XEmacs.") 38 (if (and (boundp 'recursive-load-depth-limit)
39 39 (integerp recursive-load-depth-limit)
40;; The Emacs coding conventions require that the cl package not be required at 40 (> 50 recursive-load-depth-limit))
41;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl 41 (setq recursive-load-depth-limit 50)))
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 42
43(eval-when-compile (require 'mh-acros))
50(mh-require-cl) 44(mh-require-cl)
51(require 'gnus-util) 45(require 'gnus-util)
52(require 'font-lock) 46(require 'font-lock)
@@ -58,6 +52,7 @@
58 52
59(load "mm-decode" t t) ; Non-fatal dependency 53(load "mm-decode" t t) ; Non-fatal dependency
60(load "mm-view" t t) ; Non-fatal dependency 54(load "mm-view" t t) ; Non-fatal dependency
55(load "vcard" t t) ; Non-fatal dependency
61(load "hl-line" t t) ; Non-fatal dependency 56(load "hl-line" t t) ; Non-fatal dependency
62(load "executable" t t) ; Non-fatal dependency on 57(load "executable" t t) ; Non-fatal dependency on
63 ; executable-find 58 ; executable-find
@@ -69,43 +64,12 @@
69 64
70;;; Autoloads 65;;; Autoloads
71(autoload 'gnus-article-highlight-citation "gnus-cite") 66(autoload 'gnus-article-highlight-citation "gnus-cite")
67(autoload 'message-fetch-field "message")
68(autoload 'message-tokenize-header "message")
72(require 'sendmail) 69(require 'sendmail)
73(autoload 'Info-goto-node "info")
74(unless (fboundp 'make-hash-table) 70(unless (fboundp 'make-hash-table)
75 (autoload 'make-hash-table "cl")) 71 (autoload 'make-hash-table "cl"))
76 72
77;;; Set for local environment:
78;;; mh-progs and mh-lib used to be set in paths.el, which tried to
79;;; figure out at build time which of several possible directories MH
80;;; was installed into. But if you installed MH after building Emacs,
81;;; this would almost certainly be wrong, so now we do it at run time.
82
83(defvar mh-progs nil
84 "Directory containing MH commands, such as inc, repl, and rmm.")
85
86(defvar mh-lib nil
87 "Directory containing the MH library.
88This directory contains, among other things, the components file.")
89
90(defvar mh-lib-progs nil
91 "Directory containing MH helper programs.
92This directory contains, among other things, the mhl program.")
93
94(defvar mh-nmh-flag nil
95 "Non-nil means nmh is installed on this system instead of MH.")
96
97(defvar mh-flists-present-flag nil
98 "Non-nil means that we have `flists'.")
99
100;;;###autoload
101(put 'mh-progs 'risky-local-variable t)
102;;;###autoload
103(put 'mh-lib 'risky-local-variable t)
104;;;###autoload
105(put 'mh-lib-progs 'risky-local-variable t)
106;;;###autoload
107(put 'mh-nmh-flag 'risky-local-variable t)
108
109;;; CL Replacements 73;;; CL Replacements
110(defun mh-search-from-end (char string) 74(defun mh-search-from-end (char string)
111 "Return the position of last occurrence of CHAR in STRING. 75 "Return the position of last occurrence of CHAR in STRING.
@@ -115,92 +79,52 @@ of `search' in the CL package."
115 when (equal (aref string index) char) return index 79 when (equal (aref string index) char) return index
116 finally return nil)) 80 finally return nil))
117 81
118;;; Macros to generate correct code for different emacs variants
119
120(defmacro mh-do-in-gnu-emacs (&rest body)
121 "Execute BODY if in GNU Emacs."
122 (unless mh-xemacs-flag `(progn ,@body)))
123(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
124
125(defmacro mh-do-in-xemacs (&rest body)
126 "Execute BODY if in GNU Emacs."
127 (when mh-xemacs-flag `(progn ,@body)))
128(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
129
130(defmacro mh-funcall-if-exists (function &rest args)
131 "Call FUNCTION with ARGS as parameters if it exists."
132 (if (fboundp function)
133 `(funcall ',function ,@args)))
134
135(defmacro mh-make-local-hook (hook)
136 "Make HOOK local if needed.
137XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
138called."
139 (when (and (fboundp 'make-local-hook)
140 (not (get 'make-local-hook 'byte-obsolete-info)))
141 `(make-local-hook ,hook)))
142
143(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
144 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
145In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
146variable `transient-mark-mode' is active."
147 (cond (mh-xemacs-flag ;XEmacs
148 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
149 ((not check-transient-mark-mode-flag) ;GNU Emacs
150 `(and (boundp 'mark-active) mark-active))
151 (t ;GNU Emacs
152 `(and (boundp 'transient-mark-mode) transient-mark-mode
153 (boundp 'mark-active) mark-active))))
154
155;;; Additional header fields that might someday be added: 82;;; Additional header fields that might someday be added:
156;;; "Sender: " "Reply-to: " 83;;; "Sender: " "Reply-to: "
157 84
85
86;;; Scan Line Formats
87
158(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" 88(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
159 "Regexp to find the number of a message in a scan line. 89 "This regexp is used to extract the message number from a scan line.
160The message's number must be surrounded with \\( \\)") 90Note that the message number must be placed in a parenthesized expression as
91in the default of \"^ *\\\\([0-9]+\\\\)\".")
161 92
162(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" 93(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
163 "Regexp to find a scan line in which the message number overflowed. 94 "This regexp matches scan lines in which the message number overflowed.")
164The message's number is left truncated in this case.")
165 95
166(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" 96(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
167 "Regexp to find message number width in an scan format. 97 "This regexp is used to find the message number width in a scan format.
168The message number width must be surrounded with \\( \\).") 98Note that the message number must be placed in a parenthesized expression as
99in the default of \"%\\\\([0-9]*\\\\)(msg)\".")
169 100
170(defvar mh-scan-msg-format-string "%d" 101(defvar mh-scan-msg-format-string "%d"
171 "Format string for width of the message number in a scan format. 102 "This is a format string for width of the message number in a scan format.
172Use `0%d' for zero-filled message numbers.") 103Use `0%d' for zero-filled message numbers.")
173 104
174(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" 105(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
175 "Format string containing a regexp matching the scan listing for a message. 106 "This format string regexp matches the scan line for a particular message.
176The desired message's number will be an argument to format.") 107Use `%d' to represent the location of the message number within the
177 108expression as in the default of \"^[^0-9]*%d[^0-9]\".")
178(defvar mh-default-folder-for-message-function nil 109
179 "Function to select a default folder for refiling or Fcc. 110(defvar mh-cmd-note 4
180If set to a function, that function is called with no arguments by 111 "This is the number of characters to skip over before inserting notation.
181`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when 112This variable should be set with the function `mh-set-cmd-note'. This variable
182prompting the user for a folder. The function is called from within a 113may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and
183`save-excursion', with point at the start of the message. It should 114`mh-scan-format-file' is t.")
184return the folder to offer as the refile or Fcc folder, as a string 115(make-variable-buffer-local 'mh-cmd-note)
185with a leading `+' sign. It can also return an empty string to use no 116
186default, or nil to calculate the default the usual way. 117(defvar mh-note-seq ?%
187NOTE: This variable is not an ordinary hook; 118 "Messages in a user-defined sequence are marked by this character.
188It may not be a list of functions.") 119Messages in the `search' sequence are marked by this character as well.")
120
121
189 122
190(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" 123(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d"
191 "Format string to produce `mode-line-buffer-identification' for show buffers. 124 "Format string to produce `mode-line-buffer-identification' for show buffers.
192First argument is folder name. Second is message number.") 125First argument is folder name. Second is message number.")
193 126
194(defvar mh-cmd-note 4 127
195 "Column to insert notation.
196Use `mh-set-cmd-note' to modify it.
197This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is
198non-nil and `mh-scan-format-file' is t.
199Note that the first column is column number 0.")
200(make-variable-buffer-local 'mh-cmd-note)
201
202(defvar mh-note-seq "%"
203 "String whose first character is used to notate messages in a sequence.")
204 128
205(defvar mh-mail-header-separator "--------" 129(defvar mh-mail-header-separator "--------"
206 "*Line used by MH to separate headers from text in messages being composed. 130 "*Line used by MH to separate headers from text in messages being composed.
@@ -213,11 +137,29 @@ Do not make this a regexp as it may be the argument to `insert' and it is
213passed through `regexp-quote' before being used by functions like 137passed through `regexp-quote' before being used by functions like
214`re-search-forward'.") 138`re-search-forward'.")
215 139
140(defvar mh-signature-separator-regexp "^-- $"
141 "Regexp used to find signature separator.
142See `mh-signature-separator'.")
143
144(defvar mh-signature-separator "-- \n"
145 "Text of a signature separator.
146A signature separator is used to separate the body of a message from the
147signature. This can be used by user agents such as MH-E to render the
148signature differently or to suppress the inclusion of the signature in a
149reply.
150Use `mh-signature-separator-regexp' when searching for a separator.")
151
152(defun mh-signature-separator-p ()
153 "Return non-nil if buffer includes \"^-- $\"."
154 (save-excursion
155 (goto-char (point-min))
156 (re-search-forward mh-signature-separator-regexp nil t)))
157
216;; Variables for MIME display 158;; Variables for MIME display
217 159
218;; Structure to keep track of MIME handles on a per buffer basis. 160;; Structure to keep track of MIME handles on a per buffer basis.
219(defstruct (mh-buffer-data (:conc-name mh-mime-) 161(mh-defstruct (mh-buffer-data (:conc-name mh-mime-)
220 (:constructor mh-make-buffer-data)) 162 (:constructor mh-make-buffer-data))
221 (handles ()) ; List of MIME handles 163 (handles ()) ; List of MIME handles
222 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of 164 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
223 ; nested messages 165 ; nested messages
@@ -331,7 +273,7 @@ passed through `regexp-quote' before being used by functions like
331 "A regular expression probably matching an e-mail address.") 273 "A regular expression probably matching an e-mail address.")
332 274
333;; From goto-addr.el, which we don't want to force-load on users. 275;; From goto-addr.el, which we don't want to force-load on users.
334;;;###mh-autoload 276
335(defun mh-goto-address-find-address-at-point () 277(defun mh-goto-address-find-address-at-point ()
336 "Find e-mail address around or before point. 278 "Find e-mail address around or before point.
337Then search backwards to beginning of line for the start of an e-mail 279Then search backwards to beginning of line for the start of an e-mail
@@ -348,7 +290,18 @@ address. If no e-mail address found, return nil."
348In MH-E we frequently need to find the end of headers in nested messages, where 290In MH-E we frequently need to find the end of headers in nested messages, where
349the buffer has been narrowed. This function works in this situation." 291the buffer has been narrowed. This function works in this situation."
350 (save-excursion 292 (save-excursion
351 (rfc822-goto-eoh) 293 ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally,
294 ;; mail headers that MH-E has to read contains lines of the form:
295 ;; From xxx@yyy Mon May 10 11:48:07 2004
296 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the
297 ;; header. The replacement allows From_ lines in the mail header.
298 (goto-char (point-min))
299 (loop for p = (re-search-forward
300 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
301 do (cond ((null p) (return))
302 (t (goto-char (match-beginning 0))
303 (unless (looking-at "From ") (return))
304 (goto-char p))))
352 (point))) 305 (point)))
353 306
354(defun mh-in-header-p () 307(defun mh-in-header-p ()
@@ -528,17 +481,20 @@ message about the fontification operation."
528;; hidden and can be programmatically removed in mh-quit), and the variable 481;; hidden and can be programmatically removed in mh-quit), and the variable
529;; names have the form mh-temp-.*-buffer. 482;; names have the form mh-temp-.*-buffer.
530(defconst mh-temp-buffer " *mh-temp*") ;scratch 483(defconst mh-temp-buffer " *mh-temp*") ;scratch
484(defconst mh-temp-fetch-buffer " *mh-fetch*") ;wget/curl/fetch output
531 485
532;; The names of MH-E buffers that are not ephemeral and can be used by the 486;; The names of MH-E buffers that are not ephemeral and can be used by the
533;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix 487;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
534;; (so they can be programmatically removed in mh-quit), and the variable 488;; (so they can be programmatically removed in mh-quit), and the variable
535;; names have the form mh-.*-buffer. 489;; names have the form mh-.*-buffer.
490(defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups
536(defconst mh-folders-buffer "*MH-E Folders*") ;folder list 491(defconst mh-folders-buffer "*MH-E Folders*") ;folder list
492(defconst mh-help-buffer "*MH-E Help*") ;quick help
537(defconst mh-info-buffer "*MH-E Info*") ;version information buffer 493(defconst mh-info-buffer "*MH-E Info*") ;version information buffer
538(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on 494(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
495(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
539(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent 496(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
540(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list 497(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
541(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
542 498
543;; Number of lines to keep in mh-log-buffer. 499;; Number of lines to keep in mh-log-buffer.
544(defvar mh-log-buffer-lines 100) 500(defvar mh-log-buffer-lines 100)
@@ -593,7 +549,6 @@ message about the fontification operation."
593 (cons modeline-buffer-id-left-extent "XEmacs%N:")) 549 (cons modeline-buffer-id-left-extent "XEmacs%N:"))
594 (cons modeline-buffer-id-right-extent " %17b"))))) 550 (cons modeline-buffer-id-right-extent " %17b")))))
595 551
596
597;;; This holds a documentation string used by describe-mode. 552;;; This holds a documentation string used by describe-mode.
598(defun mh-showing-mode (&optional arg) 553(defun mh-showing-mode (&optional arg)
599 "Change whether messages should be displayed. 554 "Change whether messages should be displayed.
@@ -614,7 +569,6 @@ With arg, display messages iff ARG is positive."
614;; Showing message with headers or normally. 569;; Showing message with headers or normally.
615(defvar mh-showing-with-headers nil) 570(defvar mh-showing-with-headers nil)
616 571
617
618;;; MH-E macros 572;;; MH-E macros
619 573
620(defmacro with-mh-folder-updating (save-modification-flag &rest body) 574(defmacro with-mh-folder-updating (save-modification-flag &rest body)
@@ -742,7 +696,7 @@ of the buffer in the event window is preserved."
742 (unlock-buffer) 696 (unlock-buffer)
743 (setq buffer-file-name nil)) 697 (setq buffer-file-name nil))
744 698
745;;;###mh-autoload 699
746(defun mh-get-msg-num (error-if-no-message) 700(defun mh-get-msg-num (error-if-no-message)
747 "Return the message number of the displayed message. 701 "Return the message number of the displayed message.
748If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is 702If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
@@ -915,6 +869,16 @@ still visible.\n")
915(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) 869(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
916(mh-defun-show-buffer mh-show-index-sequenced-messages 870(mh-defun-show-buffer mh-show-index-sequenced-messages
917 mh-index-sequenced-messages) 871 mh-index-sequenced-messages)
872(mh-defun-show-buffer mh-show-catchup mh-catchup)
873(mh-defun-show-buffer mh-show-ps-print-toggle-mime mh-ps-print-toggle-mime)
874(mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
875(mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
876(mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
877(mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
878(mh-defun-show-buffer mh-show-ps-print-msg-show mh-ps-print-msg-show)
879(mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
880(mh-defun-show-buffer mh-show-display-with-external-viewer
881 mh-display-with-external-viewer)
918 882
919;;; Populate mh-show-mode-map 883;;; Populate mh-show-mode-map
920(gnus-define-keys mh-show-mode-map 884(gnus-define-keys mh-show-mode-map
@@ -941,7 +905,6 @@ still visible.\n")
941 "g" mh-show-goto-msg 905 "g" mh-show-goto-msg
942 "i" mh-show-inc-folder 906 "i" mh-show-inc-folder
943 "k" mh-show-delete-subject-or-thread 907 "k" mh-show-delete-subject-or-thread
944 "l" mh-show-print-msg
945 "m" mh-show-send 908 "m" mh-show-send
946 "n" mh-show-next-undeleted-msg 909 "n" mh-show-next-undeleted-msg
947 "\M-n" mh-show-next-unread-msg 910 "\M-n" mh-show-next-unread-msg
@@ -961,6 +924,7 @@ still visible.\n")
961 "?" mh-prefix-help 924 "?" mh-prefix-help
962 "'" mh-index-ticked-messages 925 "'" mh-index-ticked-messages
963 "S" mh-show-sort-folder 926 "S" mh-show-sort-folder
927 "c" mh-show-catchup
964 "f" mh-show-visit-folder 928 "f" mh-show-visit-folder
965 "i" mh-index-search 929 "i" mh-index-search
966 "k" mh-show-kill-folder 930 "k" mh-show-kill-folder
@@ -992,6 +956,17 @@ still visible.\n")
992 "b" mh-show-junk-blacklist 956 "b" mh-show-junk-blacklist
993 "w" mh-show-junk-whitelist) 957 "w" mh-show-junk-whitelist)
994 958
959(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
960 "?" mh-prefix-help
961 "A" mh-show-ps-print-toggle-mime
962 "C" mh-show-ps-print-toggle-color
963 "F" mh-show-ps-print-toggle-faces
964 "M" mh-show-ps-print-toggle-mime
965 "f" mh-show-ps-print-msg-file
966 "l" mh-show-print-msg
967 "p" mh-show-ps-print-msg
968 "s" mh-show-ps-print-msg-show)
969
995(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) 970(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
996 "?" mh-prefix-help 971 "?" mh-prefix-help
997 "u" mh-show-thread-ancestor 972 "u" mh-show-thread-ancestor
@@ -1026,9 +1001,11 @@ still visible.\n")
1026(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) 1001(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
1027 "?" mh-prefix-help 1002 "?" mh-prefix-help
1028 "a" mh-mime-save-parts 1003 "a" mh-mime-save-parts
1004 "e" mh-show-display-with-external-viewer
1029 "v" mh-show-toggle-mime-part 1005 "v" mh-show-toggle-mime-part
1030 "o" mh-show-save-mime-part 1006 "o" mh-show-save-mime-part
1031 "i" mh-show-inline-mime-part 1007 "i" mh-show-inline-mime-part
1008 "t" mh-show-toggle-mime-buttons
1032 "\t" mh-show-next-button 1009 "\t" mh-show-next-button
1033 [backtab] mh-show-prev-button 1010 [backtab] mh-show-prev-button
1034 "\M-\t" mh-show-prev-button) 1011 "\M-\t" mh-show-prev-button)
@@ -1115,7 +1092,10 @@ still visible.\n")
1115(define-derived-mode mh-show-mode text-mode "MH-Show" 1092(define-derived-mode mh-show-mode text-mode "MH-Show"
1116 "Major mode for showing messages in MH-E.\\<mh-show-mode-map> 1093 "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
1117The value of `mh-show-mode-hook' is a list of functions to 1094The value of `mh-show-mode-hook' is a list of functions to
1118be called, with no arguments, upon entry to this mode." 1095be called, with no arguments, upon entry to this mode.
1096See also `mh-folder-mode'.
1097
1098\\{mh-show-mode-map}"
1119 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) 1099 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
1120 (setq paragraph-start (default-value 'paragraph-start)) 1100 (setq paragraph-start (default-value 'paragraph-start))
1121 (mh-show-unquote-From) 1101 (mh-show-unquote-From)
@@ -1210,8 +1190,9 @@ be called, with no arguments, upon entry to this mode."
1210(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) 1190(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
1211 1191
1212(defun mh-face-display-function () 1192(defun mh-face-display-function ()
1213 "Display a Face or X-Face header field. 1193 "Display a Face, X-Face, or X-Image-URL header field.
1214Display Face if both are present." 1194If more than one of these are present, then the first one found in this order
1195is used."
1215 (save-restriction 1196 (save-restriction
1216 (goto-char (point-min)) 1197 (goto-char (point-min))
1217 (re-search-forward "\n\n" (point-max) t) 1198 (re-search-forward "\n\n" (point-max) t)
@@ -1226,7 +1207,8 @@ Display Face if both are present."
1226 type 'png)) 1207 type 'png))
1227 (x-face (setq raw (mh-uncompface x-face) 1208 (x-face (setq raw (mh-uncompface x-face)
1228 type 'pbm)) 1209 type 'pbm))
1229 (url (setq type 'url))) 1210 (url (setq type 'url))
1211 (t (multiple-value-setq (type raw) (mh-picon-get-image))))
1230 (when type 1212 (when type
1231 (goto-char (point-min)) 1213 (goto-char (point-min))
1232 (when (re-search-forward "^from:" (point-max) t) 1214 (when (re-search-forward "^from:" (point-max) t)
@@ -1261,10 +1243,15 @@ Display Face if both are present."
1261 ((and (eq type 'pbm) 1243 ((and (eq type 'pbm)
1262 (fboundp 'x-face-xmas-wl-display-x-face) 1244 (fboundp 'x-face-xmas-wl-display-x-face)
1263 (fboundp 'executable-find) (executable-find "uncompface")) 1245 (fboundp 'executable-find) (executable-find "uncompface"))
1264 (mh-funcall-if-exists x-face-xmas-wl-display-x-face))) 1246 (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
1247 ;; Picon display
1248 ((and raw (member type '(xpm xbm gif)))
1249 (when (featurep type)
1250 (set-extent-begin-glyph
1251 (make-extent (point) (point))
1252 (make-glyph (vector type ':data raw))))))
1265 (when raw (insert " ")))))))) 1253 (when raw (insert " "))))))))
1266 1254
1267
1268(defun mh-show-xface () 1255(defun mh-show-xface ()
1269 "Display X-Face." 1256 "Display X-Face."
1270 (when (and window-system mh-show-use-xface-flag 1257 (when (and window-system mh-show-use-xface-flag
@@ -1274,49 +1261,207 @@ Display Face if both are present."
1274 1261
1275 1262
1276 1263
1264;; Picon display
1265
1266;;; XXX: This should be customizable. As a side-effect of setting this
1267;;; variable, arrange to reset mh-picon-existing-directory-list to 'unset.
1268(defvar mh-picon-directory-list
1269 '("~/.picons" "~/.picons/users" "~/.picons/usenix" "~/.picons/news"
1270 "~/.picons/domains" "~/.picons/misc"
1271 "/usr/share/picons/" "/usr/share/picons/users" "/usr/share/picons/usenix"
1272 "/usr/share/picons/news" "/usr/share/picons/domains"
1273 "/usr/share/picons/misc")
1274 "List of directories where picons reside.
1275The directories are searched for in the order they appear in the list.")
1276
1277(defvar mh-picon-existing-directory-list 'unset
1278 "List of directories to search in.")
1279
1280(defvar mh-picon-cache (make-hash-table :test #'equal))
1281
1282(defvar mh-picon-image-types
1283 (loop for type in '(xpm xbm gif)
1284 when (or (mh-do-in-gnu-emacs
1285 (ignore-errors
1286 (mh-funcall-if-exists image-type-available-p type)))
1287 (mh-do-in-xemacs (featurep type)))
1288 collect type))
1289
1290(defun mh-picon-set-directory-list ()
1291 "Update `mh-picon-existing-directory-list' if needed."
1292 (when (eq mh-picon-existing-directory-list 'unset)
1293 (setq mh-picon-existing-directory-list
1294 (loop for x in mh-picon-directory-list
1295 when (file-directory-p x) collect x))))
1296
1297(defun* mh-picon-get-image ()
1298 "Find the best possible match and return contents."
1299 (mh-picon-set-directory-list)
1300 (save-restriction
1301 (let* ((from-field (ignore-errors (car (message-tokenize-header
1302 (mh-get-header-field "from:")))))
1303 (from (car (ignore-errors
1304 (mh-funcall-if-exists ietf-drums-parse-address
1305 from-field))))
1306 (host (and from
1307 (string-match "\\([^+]*\\)\\(+.*\\)?@\\(.*\\)" from)
1308 (downcase (match-string 3 from))))
1309 (user (and host (downcase (match-string 1 from))))
1310 (canonical-address (format "%s@%s" user host))
1311 (cached-value (gethash canonical-address mh-picon-cache))
1312 (host-list (and host (delete "" (split-string host "\\."))))
1313 (match nil))
1314 (cond (cached-value (return-from mh-picon-get-image cached-value))
1315 ((not host-list) (return-from mh-picon-get-image nil)))
1316 (setq match
1317 (block 'loop
1318 ;; u@h search
1319 (loop for dir in mh-picon-existing-directory-list
1320 do (loop for type in mh-picon-image-types
1321 ;; [path]user@host
1322 for file1 = (format "%s/%s.%s"
1323 dir canonical-address type)
1324 when (file-exists-p file1)
1325 do (return-from 'loop file1)
1326 ;; [path]user
1327 for file2 = (format "%s/%s.%s" dir user type)
1328 when (file-exists-p file2)
1329 do (return-from 'loop file2)
1330 ;; [path]host
1331 for file3 = (format "%s/%s.%s" dir host type)
1332 when (file-exists-p file3)
1333 do (return-from 'loop file3)))
1334 ;; facedb search
1335 ;; Search order for user@foo.net:
1336 ;; [path]net/foo/user
1337 ;; [path]net/foo/user/face
1338 ;; [path]net/user
1339 ;; [path]net/user/face
1340 ;; [path]net/foo/unknown
1341 ;; [path]net/foo/unknown/face
1342 ;; [path]net/unknown
1343 ;; [path]net/unknown/face
1344 (loop for u in (list user "unknown")
1345 do (loop for dir in mh-picon-existing-directory-list
1346 do (loop for x on host-list by #'cdr
1347 for y = (mh-picon-generate-path x u dir)
1348 do (loop for type in mh-picon-image-types
1349 for z1 = (format "%s.%s" y type)
1350 when (file-exists-p z1)
1351 do (return-from 'loop z1)
1352 for z2 = (format "%s/face.%s"
1353 y type)
1354 when (file-exists-p z2)
1355 do (return-from 'loop z2)))))))
1356 (setf (gethash canonical-address mh-picon-cache)
1357 (mh-picon-file-contents match)))))
1358
1359(defun mh-picon-file-contents (file)
1360 "Return details about FILE.
1361A list of consisting of a symbol for the type of the file and the file
1362contents as a string is returned. If FILE is nil, then both elements of the
1363list are nil."
1364 (if (stringp file)
1365 (with-temp-buffer
1366 (let ((type (and (string-match ".*\\.\\(...\\)$" file)
1367 (intern (match-string 1 file)))))
1368 (insert-file-contents-literally file)
1369 (values type (buffer-string))))
1370 (values nil nil)))
1371
1372(defun mh-picon-generate-path (host-list user directory)
1373 "Generate the image file path.
1374HOST-LIST is the parsed host address of the email address, USER the username
1375and DIRECTORY is the directory relative to which the path is generated."
1376 (loop with acc = ""
1377 for elem in host-list
1378 do (setq acc (format "%s/%s" elem acc))
1379 finally return (format "%s/%s%s" directory acc user)))
1380
1381
1382
1277;; X-Image-URL display 1383;; X-Image-URL display
1278 1384
1279(defvar mh-x-image-cache-directory nil 1385(defvar mh-x-image-cache-directory nil
1280 "Directory where X-Image-URL images are cached.") 1386 "Directory where X-Image-URL images are cached.")
1281 1387(defvar mh-x-image-scaling-function
1282(defvar mh-convert-executable (executable-find "convert")) 1388 (cond ((executable-find "convert")
1283(defvar mh-wget-executable (executable-find "wget")) 1389 'mh-x-image-scale-with-convert)
1390 ((and (executable-find "anytopnm") (executable-find "pnmscale")
1391 (executable-find "pnmtopng"))
1392 'mh-x-image-scale-with-pnm)
1393 (t 'ignore))
1394 "Function to use to scale image to proper size.")
1395(defvar mh-wget-executable nil)
1396(defvar mh-wget-choice
1397 (or (and (setq mh-wget-executable (executable-find "wget")) 'wget)
1398 (and (setq mh-wget-executable (executable-find "fetch")) 'fetch)
1399 (and (setq mh-wget-executable (executable-find "curl")) 'curl)))
1400(defvar mh-wget-option
1401 (cdr (assoc mh-wget-choice '((curl . "-o") (fetch . "-o") (wget . "-O")))))
1284(defvar mh-x-image-temp-file nil) 1402(defvar mh-x-image-temp-file nil)
1285(defvar mh-x-image-url nil) 1403(defvar mh-x-image-url nil)
1286(defvar mh-x-image-marker nil) 1404(defvar mh-x-image-marker nil)
1287(defvar mh-x-image-url-cache-file nil) 1405(defvar mh-x-image-url-cache-file nil)
1288 1406
1407;; Functions to scale image to proper size
1408(defun mh-x-image-scale-with-pnm (input output)
1409 "Scale image in INPUT file and write to OUTPUT file using pnm tools."
1410 (let ((res (shell-command-to-string
1411 (format "anytopnm < %s | pnmscale -xysize 96 48 | pnmtopng > %s"
1412 input output))))
1413 (unless (equal res "")
1414 (delete-file output))))
1415
1416(defun mh-x-image-scale-with-convert (input output)
1417 "Scale image in INPUT file and write to OUTPUT file using ImageMagick."
1418 (call-process "convert" nil nil nil "-geometry" "96x48" input output))
1419
1289(defun mh-x-image-url-cache-canonicalize (url) 1420(defun mh-x-image-url-cache-canonicalize (url)
1290 "Canonicalize URL. 1421 "Canonicalize URL.
1291Replace the ?/ character with a ?! character." 1422Replace the ?/ character with a ?! character and append .png."
1292 (with-temp-buffer 1423 (format "%s/%s.png" mh-x-image-cache-directory
1293 (insert url) 1424 (with-temp-buffer
1294 (goto-char (point-min)) 1425 (insert url)
1295 (while (search-forward "/" nil t) (replace-match "!")) 1426 (mh-replace-string "/" "!")
1296 (format "%s/%s.png" mh-x-image-cache-directory (buffer-string)))) 1427 (buffer-string))))
1428
1429(defun mh-x-image-set-download-state (file data)
1430 "Setup a symbolic link from FILE to DATA."
1431 (if data
1432 (make-symbolic-link (symbol-name data) file t)
1433 (delete-file file)))
1434
1435(defun mh-x-image-get-download-state (file)
1436 "Check the state of FILE by following any symbolic links."
1437 (unless (file-exists-p mh-x-image-cache-directory)
1438 (call-process "mkdir" nil nil nil mh-x-image-cache-directory))
1439 (cond ((file-symlink-p file)
1440 (intern (file-name-nondirectory (file-chase-links file))))
1441 ((not (file-exists-p file)) nil)
1442 (t 'ok)))
1297 1443
1298(defun mh-x-image-url-fetch-image (url cache-file marker sentinel) 1444(defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
1299 "Fetch and display the image specified by URL. 1445 "Fetch and display the image specified by URL.
1300After the image is fetched, it is stored in CACHE-FILE. It will be displayed 1446After the image is fetched, it is stored in CACHE-FILE. It will be displayed
1301in a buffer and position specified by MARKER. The actual display is carried 1447in a buffer and position specified by MARKER. The actual display is carried
1302out by the SENTINEL function." 1448out by the SENTINEL function."
1303 (if (and mh-wget-executable 1449 (if mh-wget-executable
1304 mh-fetch-x-image-url 1450 (let ((buffer (get-buffer-create (generate-new-buffer-name
1305 (or (eq mh-fetch-x-image-url t) 1451 mh-temp-fetch-buffer)))
1306 (y-or-n-p (format "Fetch %s? " url)))) 1452 (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch")
1307 (let ((buffer (get-buffer-create (generate-new-buffer-name " *mh-url*"))) 1453 (expand-file-name (make-temp-name "~/mhe-fetch")))))
1308 (filename (make-temp-name "/tmp/mhe-wget")))
1309 (save-excursion 1454 (save-excursion
1310 (set-buffer buffer) 1455 (set-buffer buffer)
1311 (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) 1456 (set (make-local-variable 'mh-x-image-url-cache-file) cache-file)
1312 (set (make-local-variable 'mh-x-image-marker) marker) 1457 (set (make-local-variable 'mh-x-image-marker) marker)
1313 (set (make-local-variable 'mh-x-image-temp-file) filename)) 1458 (set (make-local-variable 'mh-x-image-temp-file) filename))
1314 (set-process-sentinel 1459 (set-process-sentinel
1315 (start-process "*wget*" buffer mh-wget-executable "-O" filename url) 1460 (start-process "*mh-x-image-url-fetch*" buffer
1461 mh-wget-executable mh-wget-option filename url)
1316 sentinel)) 1462 sentinel))
1317 ;; Make sure we don't ask about this image again 1463 ;; Temporary failure
1318 (when (and mh-wget-executable (eq mh-fetch-x-image-url 'ask)) 1464 (mh-x-image-set-download-state cache-file 'try-again)))
1319 (make-symbolic-link mh-x-image-cache-directory cache-file t))))
1320 1465
1321(defun mh-x-image-display (image marker) 1466(defun mh-x-image-display (image marker)
1322 "Display IMAGE at MARKER." 1467 "Display IMAGE at MARKER."
@@ -1326,7 +1471,8 @@ out by the SENTINEL function."
1326 (default-enable-multibyte-characters nil) 1471 (default-enable-multibyte-characters nil)
1327 (buffer-modified-flag (buffer-modified-p))) 1472 (buffer-modified-flag (buffer-modified-p)))
1328 (unwind-protect 1473 (unwind-protect
1329 (when (and (file-readable-p image) (not (file-symlink-p image))) 1474 (when (and (file-readable-p image) (not (file-symlink-p image))
1475 (eq marker mh-x-image-marker))
1330 (goto-char marker) 1476 (goto-char marker)
1331 (mh-do-in-gnu-emacs 1477 (mh-do-in-gnu-emacs
1332 (mh-funcall-if-exists insert-image (create-image image 'png))) 1478 (mh-funcall-if-exists insert-image (create-image image 'png)))
@@ -1350,32 +1496,56 @@ The argument CHANGE is ignored."
1350 (setq marker mh-x-image-marker 1496 (setq marker mh-x-image-marker
1351 cache-filename mh-x-image-url-cache-file 1497 cache-filename mh-x-image-url-cache-file
1352 temp-file mh-x-image-temp-file)) 1498 temp-file mh-x-image-temp-file))
1353 (when mh-convert-executable 1499 (cond
1354 (call-process mh-convert-executable nil nil nil "-resize" "96x48" 1500 ;; Check if we have `convert'
1355 temp-file cache-filename)) 1501 ((eq mh-x-image-scaling-function 'ignore)
1356 (if (file-exists-p cache-filename) 1502 (message "The `convert' program is needed to display X-Image-URL")
1357 (mh-x-image-display cache-filename marker) 1503 (mh-x-image-set-download-state cache-filename 'try-again))
1358 (make-symbolic-link mh-x-image-cache-directory cache-filename t)) 1504 ;; Scale fetched image
1505 ((and (funcall mh-x-image-scaling-function temp-file cache-filename)
1506 nil))
1507 ;; Attempt to display image if we have it
1508 ((file-exists-p cache-filename)
1509 (mh-x-image-display cache-filename marker))
1510 ;; We didn't find the image. Should we try to display it the next time?
1511 (t (mh-x-image-set-download-state cache-filename 'try-again)))
1359 (ignore-errors 1512 (ignore-errors
1360 (set-marker marker nil) 1513 (set-marker marker nil)
1361 (delete-process process) 1514 (delete-process process)
1362 (kill-buffer wget-buffer) 1515 (kill-buffer wget-buffer)
1363 (delete-file temp-file))))) 1516 (delete-file temp-file)))))
1364 1517
1518(defun mh-x-image-url-sane-p (url)
1519 "Check if URL is something sensible."
1520 (let ((len (length url)))
1521 (cond ((< len 5) nil)
1522 ((not (equal (substring url 0 5) "http:")) nil)
1523 ((> len 100) nil)
1524 (t t))))
1525
1365(defun mh-x-image-url-display (url) 1526(defun mh-x-image-url-display (url)
1366 "Display image from location URL. 1527 "Display image from location URL.
1367If the URL isn't present in the cache then it is fetched with wget." 1528If the URL isn't present in the cache then it is fetched with wget."
1368 (let ((cache-filename (mh-x-image-url-cache-canonicalize url)) 1529 (let* ((cache-filename (mh-x-image-url-cache-canonicalize url))
1369 (marker (set-marker (make-marker) (point)))) 1530 (state (mh-x-image-get-download-state cache-filename))
1370 (cond ((file-exists-p cache-filename) 1531 (marker (set-marker (make-marker) (point))))
1532 (set (make-local-variable 'mh-x-image-marker) marker)
1533 (cond ((not (mh-x-image-url-sane-p url)))
1534 ((eq state 'ok)
1371 (mh-x-image-display cache-filename marker)) 1535 (mh-x-image-display cache-filename marker))
1536 ((or (not mh-wget-executable)
1537 (eq mh-x-image-scaling-function 'ignore)))
1538 ((eq state 'never))
1372 ((not mh-fetch-x-image-url) 1539 ((not mh-fetch-x-image-url)
1373 (set-marker marker nil)) 1540 (set-marker marker nil))
1374 ((and (not (file-exists-p mh-x-image-cache-directory)) 1541 ((eq state 'try-again)
1375 (call-process "mkdir" nil nil nil mh-x-image-cache-directory) 1542 (mh-x-image-set-download-state cache-filename nil)
1376 nil)) 1543 (mh-x-image-url-fetch-image url cache-filename marker
1377 ((and (file-exists-p mh-x-image-cache-directory) 1544 'mh-x-image-scale-and-display))
1378 (file-directory-p mh-x-image-cache-directory)) 1545 ((and (eq mh-fetch-x-image-url 'ask)
1546 (not (y-or-n-p (format "Fetch %s? " url))))
1547 (mh-x-image-set-download-state cache-filename 'never))
1548 ((eq state nil)
1379 (mh-x-image-url-fetch-image url cache-filename marker 1549 (mh-x-image-url-fetch-image url cache-filename marker
1380 'mh-x-image-scale-and-display))))) 1550 'mh-x-image-scale-and-display)))))
1381 1551
@@ -1386,27 +1556,32 @@ If the URL isn't present in the cache then it is fetched with wget."
1386If optional arg MSG is non-nil, display that message instead." 1556If optional arg MSG is non-nil, display that message instead."
1387 (if mh-showing-mode (mh-show msg))) 1557 (if mh-showing-mode (mh-show msg)))
1388 1558
1389(defun mh-show (&optional message) 1559(defun mh-show (&optional message redisplay-flag)
1390 "Show message at cursor. 1560 "Show message at cursor.
1391If optional argument MESSAGE is non-nil, display that message instead. 1561If optional argument MESSAGE is non-nil, display that message instead.
1392Force a two-window display with the folder window on top (size given by the 1562Force a two-window display with the folder window on top (size given by the
1393variable `mh-summary-height') and the show buffer below it. 1563variable `mh-summary-height') and the show buffer below it.
1394If the message is already visible, display the start of the message. 1564If the message is already visible, display the start of the message.
1395 1565
1566If REDISPLAY-FLAG is non-nil, the default when called interactively, the
1567message is redisplayed even if the show buffer was already displaying the
1568correct message.
1569
1396Display of the message is controlled by setting the variables 1570Display of the message is controlled by setting the variables
1397`mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is 1571`mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is
1398to scroll uninteresting headers off the top of the window. 1572to scroll uninteresting headers off the top of the window.
1399Type \"\\[mh-header-display]\" to see the message with all its headers." 1573Type \"\\[mh-header-display]\" to see the message with all its headers."
1400 (interactive) 1574 (interactive (list nil t))
1401 (and mh-showing-with-headers 1575 (when (or redisplay-flag
1402 (or mhl-formfile mh-clean-message-header-flag) 1576 (and mh-showing-with-headers
1403 (mh-invalidate-show-buffer)) 1577 (or mhl-formfile mh-clean-message-header-flag)))
1578 (mh-invalidate-show-buffer))
1404 (mh-show-msg message)) 1579 (mh-show-msg message))
1405 1580
1406(defun mh-show-mouse (EVENT) 1581(defun mh-show-mouse (event)
1407 "Move point to mouse EVENT and show message." 1582 "Move point to mouse EVENT and show message."
1408 (interactive "e") 1583 (interactive "e")
1409 (mouse-set-point EVENT) 1584 (mouse-set-point event)
1410 (mh-show)) 1585 (mh-show))
1411 1586
1412(defun mh-summary-height () 1587(defun mh-summary-height ()
@@ -1428,10 +1603,12 @@ arguments, after the message has been displayed."
1428 (let ((folder mh-current-folder) 1603 (let ((folder mh-current-folder)
1429 (folders (list mh-current-folder)) 1604 (folders (list mh-current-folder))
1430 (clean-message-header mh-clean-message-header-flag) 1605 (clean-message-header mh-clean-message-header-flag)
1431 (show-window (get-buffer-window mh-show-buffer))) 1606 (show-window (get-buffer-window mh-show-buffer))
1607 (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
1432 (if (not (eq (next-window (minibuffer-window)) (selected-window))) 1608 (if (not (eq (next-window (minibuffer-window)) (selected-window)))
1433 (delete-other-windows)) ; force ourself to the top window 1609 (delete-other-windows)) ; force ourself to the top window
1434 (mh-in-show-buffer (mh-show-buffer) 1610 (mh-in-show-buffer (mh-show-buffer)
1611 (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
1435 (if (and show-window 1612 (if (and show-window
1436 (equal (mh-msg-filename msg folder) buffer-file-name)) 1613 (equal (mh-msg-filename msg folder) buffer-file-name))
1437 (progn ;just back up to start 1614 (progn ;just back up to start
@@ -1443,6 +1620,9 @@ arguments, after the message has been displayed."
1443 (shrink-window (- (window-height) (or mh-summary-height 1620 (shrink-window (- (window-height) (or mh-summary-height
1444 (mh-summary-height))))) 1621 (mh-summary-height)))))
1445 (mh-recenter nil) 1622 (mh-recenter nil)
1623 ;; The following line is a nop which forces update of the scan line so
1624 ;; that font-lock will update it (if needed)...
1625 (mh-notate nil nil mh-cmd-note)
1446 (if (not (memq msg mh-seen-list)) 1626 (if (not (memq msg mh-seen-list))
1447 (setq mh-seen-list (cons msg mh-seen-list))) 1627 (setq mh-seen-list (cons msg mh-seen-list)))
1448 (when mh-update-sequences-after-mh-show-flag 1628 (when mh-update-sequences-after-mh-show-flag
@@ -1518,8 +1698,8 @@ Sets the current buffer to the show buffer."
1518 ;; Bind variables in folder buffer in case they are local 1698 ;; Bind variables in folder buffer in case they are local
1519 (let ((formfile mhl-formfile) 1699 (let ((formfile mhl-formfile)
1520 (clean-message-header mh-clean-message-header-flag) 1700 (clean-message-header mh-clean-message-header-flag)
1521 (invisible-headers mh-invisible-headers) 1701 (invisible-headers mh-invisible-header-fields-compiled)
1522 (visible-headers mh-visible-headers) 1702 (visible-headers nil)
1523 (msg-filename (mh-msg-filename msg-num folder-name)) 1703 (msg-filename (mh-msg-filename msg-num folder-name))
1524 (show-buffer mh-show-buffer) 1704 (show-buffer mh-show-buffer)
1525 (mm-inline-media-tests mh-mm-inline-media-tests)) 1705 (mm-inline-media-tests mh-mm-inline-media-tests))
@@ -1596,7 +1776,10 @@ Sets the current buffer to the show buffer."
1596Header is cleaned from START to the end of the message header. 1776Header is cleaned from START to the end of the message header.
1597INVISIBLE-HEADERS contains a regular expression specifying lines to delete 1777INVISIBLE-HEADERS contains a regular expression specifying lines to delete
1598from the header. VISIBLE-HEADERS contains a regular expression specifying the 1778from the header. VISIBLE-HEADERS contains a regular expression specifying the
1599lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." 1779lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil.
1780
1781Note that MH-E no longer supports the `mh-visible-headers' variable, so
1782this function could be trimmed of this feature too."
1600 (let ((case-fold-search t) 1783 (let ((case-fold-search t)
1601 (buffer-read-only nil) 1784 (buffer-read-only nil)
1602 (after-change-functions nil)) ;Work around emacs-20 font-lock bug 1785 (after-change-functions nil)) ;Work around emacs-20 font-lock bug
@@ -1639,8 +1822,7 @@ If NOTATION is nil then no change in the buffer occurs."
1639 (with-mh-folder-updating (t) 1822 (with-mh-folder-updating (t)
1640 (beginning-of-line) 1823 (beginning-of-line)
1641 (forward-char offset) 1824 (forward-char offset)
1642 (let* ((change-stack-flag (and (stringp notation) 1825 (let* ((change-stack-flag (and (equal offset (1+ mh-cmd-note))
1643 (equal offset (1+ mh-cmd-note))
1644 (not (eq notation mh-note-seq)))) 1826 (not (eq notation mh-note-seq))))
1645 (msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) 1827 (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
1646 (stack (and msg (gethash msg mh-sequence-notation-history))) 1828 (stack (and msg (gethash msg mh-sequence-notation-history)))
@@ -1652,7 +1834,7 @@ If NOTATION is nil then no change in the buffer occurs."
1652 ;; at the bottom of the stack. If the sequence is deleted, 1834 ;; at the bottom of the stack. If the sequence is deleted,
1653 ;; the correct notation will be shown. 1835 ;; the correct notation will be shown.
1654 (setf (gethash msg mh-sequence-notation-history) 1836 (setf (gethash msg mh-sequence-notation-history)
1655 (reverse (cons (aref notation 0) (cdr (reverse stack))))) 1837 (reverse (cons notation (cdr (reverse stack)))))
1656 ;; Since we don't have any sequence notations in the way, just 1838 ;; Since we don't have any sequence notations in the way, just
1657 ;; notate the scan line. 1839 ;; notate the scan line.
1658 (delete-char 1) 1840 (delete-char 1)
@@ -1660,25 +1842,6 @@ If NOTATION is nil then no change in the buffer occurs."
1660 (when change-stack-flag 1842 (when change-stack-flag
1661 (mh-thread-update-scan-line-map msg notation offset))))))) 1843 (mh-thread-update-scan-line-map msg notation offset)))))))
1662 1844
1663(defun mh-find-msg-get-num (step)
1664 "Return the message number of the message nearest the cursor.
1665Jumps over non-message lines, such as inc errors.
1666If we have to search, STEP tells whether to search forward or backward."
1667 (or (mh-get-msg-num nil)
1668 (let ((msg-num nil)
1669 (nreverses 0))
1670 (while (and (not msg-num)
1671 (< nreverses 2))
1672 (cond ((eobp)
1673 (setq step -1)
1674 (setq nreverses (1+ nreverses)))
1675 ((bobp)
1676 (setq step 1)
1677 (setq nreverses (1+ nreverses))))
1678 (forward-line step)
1679 (setq msg-num (mh-get-msg-num nil)))
1680 msg-num)))
1681
1682(defun mh-goto-msg (number &optional no-error-if-no-message dont-show) 1845(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
1683 "Position the cursor at message NUMBER. 1846 "Position the cursor at message NUMBER.
1684Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil 1847Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil
@@ -1699,10 +1862,6 @@ Non-nil third argument DONT-SHOW means not to show the message."
1699 (or dont-show (not return-value) (mh-maybe-show number)) 1862 (or dont-show (not return-value) (mh-maybe-show number))
1700 return-value)) 1863 return-value))
1701 1864
1702(defun mh-msg-search-pat (n)
1703 "Return a search pattern for message N in the scan listing."
1704 (format mh-scan-msg-search-regexp n))
1705
1706(defun mh-get-profile-field (field) 1865(defun mh-get-profile-field (field)
1707 "Find and return the value of FIELD in the current buffer. 1866 "Find and return the value of FIELD in the current buffer.
1708Returns nil if the field is not in the buffer." 1867Returns nil if the field is not in the buffer."
@@ -1716,120 +1875,65 @@ Returns nil if the field is not in the buffer."
1716 (end-of-line) 1875 (end-of-line)
1717 (buffer-substring start (point))))))) 1876 (buffer-substring start (point)))))))
1718 1877
1719(defvar mail-user-agent)
1720(defvar read-mail-command)
1721
1722(defvar mh-find-path-run nil 1878(defvar mh-find-path-run nil
1723 "Non-nil if `mh-find-path' has been run already.") 1879 "Non-nil if `mh-find-path' has been run already.")
1724 1880
1725(defun mh-find-path () 1881(defun mh-find-path ()
1726 "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables. 1882 "Set variables from user's MH profile.
1727Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq', 1883Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq',
1728`mh-inbox' from user's MH profile. 1884`mh-inbox' from user's MH profile.
1729The value of `mh-find-path-hook' is a list of functions to be called, with no 1885The value of `mh-find-path-hook' is a list of functions to be called, with no
1730arguments, after these variable have been set." 1886arguments, after these variable have been set."
1731 (mh-find-progs) 1887 (mh-variants)
1732 (unless mh-find-path-run 1888 (unless mh-find-path-run
1733 (setq mh-find-path-run t) 1889 (setq mh-find-path-run t)
1734 (setq read-mail-command 'mh-rmail) 1890 (save-excursion
1735 (setq mail-user-agent 'mh-e-user-agent)) 1891 ;; Be sure profile is fully expanded before switching buffers
1736 (save-excursion 1892 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
1737 ;; Be sure profile is fully expanded before switching buffers 1893 (set-buffer (get-buffer-create mh-temp-buffer))
1738 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) 1894 (setq buffer-offer-save nil) ;for people who set default to t
1739 (set-buffer (get-buffer-create mh-temp-buffer)) 1895 (erase-buffer)
1740 (setq buffer-offer-save nil) ;for people who set default to t 1896 (condition-case err
1741 (erase-buffer) 1897 (insert-file-contents profile)
1742 (condition-case err 1898 (file-error
1743 (insert-file-contents profile) 1899 (mh-install profile err)))
1744 (file-error 1900 (setq mh-user-path (mh-get-profile-field "Path:"))
1745 (mh-install profile err))) 1901 (if (not mh-user-path)
1746 (setq mh-user-path (mh-get-profile-field "Path:")) 1902 (setq mh-user-path "Mail"))
1747 (if (not mh-user-path) 1903 (setq mh-user-path
1748 (setq mh-user-path "Mail")) 1904 (file-name-as-directory
1749 (setq mh-user-path 1905 (expand-file-name mh-user-path (expand-file-name "~"))))
1750 (file-name-as-directory 1906 (unless mh-x-image-cache-directory
1751 (expand-file-name mh-user-path (expand-file-name "~")))) 1907 (setq mh-x-image-cache-directory
1752 (unless mh-x-image-cache-directory 1908 (expand-file-name ".mhe-x-image-cache" mh-user-path)))
1753 (setq mh-x-image-cache-directory 1909 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
1754 (expand-file-name ".mhe-x-image-cache" mh-user-path))) 1910 (if mh-draft-folder
1755 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) 1911 (progn
1756 (if mh-draft-folder 1912 (if (not (mh-folder-name-p mh-draft-folder))
1757 (progn 1913 (setq mh-draft-folder (format "+%s" mh-draft-folder)))
1758 (if (not (mh-folder-name-p mh-draft-folder)) 1914 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
1759 (setq mh-draft-folder (format "+%s" mh-draft-folder))) 1915 (error
1760 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) 1916 "Draft folder \"%s\" not found. Create it and try again"
1761 (error "Draft folder \"%s\" not found. Create it and try again" 1917 (mh-expand-file-name mh-draft-folder)))))
1762 (mh-expand-file-name mh-draft-folder))))) 1918 (setq mh-inbox (mh-get-profile-field "Inbox:"))
1763 (setq mh-inbox (mh-get-profile-field "Inbox:")) 1919 (cond ((not mh-inbox)
1764 (cond ((not mh-inbox) 1920 (setq mh-inbox "+inbox"))
1765 (setq mh-inbox "+inbox")) 1921 ((not (mh-folder-name-p mh-inbox))
1766 ((not (mh-folder-name-p mh-inbox)) 1922 (setq mh-inbox (format "+%s" mh-inbox))))
1767 (setq mh-inbox (format "+%s" mh-inbox)))) 1923 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
1768 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) 1924 (if mh-unseen-seq
1769 (if mh-unseen-seq 1925 (setq mh-unseen-seq (intern mh-unseen-seq))
1770 (setq mh-unseen-seq (intern mh-unseen-seq)) 1926 (setq mh-unseen-seq 'unseen)) ;old MH default?
1771 (setq mh-unseen-seq 'unseen)) ;old MH default? 1927 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
1772 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) 1928 (if mh-previous-seq
1773 (if mh-previous-seq 1929 (setq mh-previous-seq (intern mh-previous-seq)))
1774 (setq mh-previous-seq (intern mh-previous-seq))) 1930 (run-hooks 'mh-find-path-hook)
1775 (run-hooks 'mh-find-path-hook) 1931 (mh-collect-folder-names)))))
1776 (mh-collect-folder-names))))
1777 1932
1778(defun mh-file-command-p (file) 1933(defun mh-file-command-p (file)
1779 "Return t if file FILE is the name of a executable regular file." 1934 "Return t if file FILE is the name of a executable regular file."
1780 (and (file-regular-p file) (file-executable-p file))) 1935 (and (file-regular-p file) (file-executable-p file)))
1781 1936
1782(defun mh-find-progs ()
1783 "Find the directories for the installed MH/nmh binaries and config files.
1784Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the
1785directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1786 (unless (and mh-progs mh-lib mh-lib-progs)
1787 (let ((path (or (mh-path-search exec-path "mhparam")
1788 (mh-path-search '("/usr/local/nmh/bin" ; nmh default
1789 "/usr/local/bin/mh/"
1790 "/usr/local/mh/"
1791 "/usr/bin/mh/" ;Ultrix 4.2, Linux
1792 "/usr/new/mh/" ;Ultrix <4.2
1793 "/usr/contrib/mh/bin/" ;BSDI
1794 "/usr/pkg/bin/" ; NetBSD
1795 "/usr/local/bin/"
1796 )
1797 "mhparam"))))
1798 (if (not path)
1799 (error "Unable to find the `mhparam' command"))
1800 (save-excursion
1801 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
1802 (set-buffer tmp-buffer)
1803 (unwind-protect
1804 (progn
1805 (call-process (expand-file-name "mhparam" path)
1806 nil '(t nil) nil "libdir" "etcdir")
1807 (goto-char (point-min))
1808 (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$"
1809 nil t)
1810 (setq mh-lib-progs (match-string 1)
1811 mh-lib mh-lib-progs
1812 mh-progs path))
1813 (goto-char (point-min))
1814 (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$"
1815 nil t)
1816 (setq mh-lib (match-string 1)
1817 mh-nmh-flag t)))
1818 (kill-buffer tmp-buffer))))
1819 (unless (and mh-progs mh-lib mh-lib-progs)
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))))))
1823
1824(defun mh-path-search (path file)
1825 "Search PATH, a list of directory names, for FILE.
1826Returns the element of PATH that contains FILE, or nil if not found."
1827 (while (and path
1828 (not (funcall 'mh-file-command-p
1829 (expand-file-name file (car path)))))
1830 (setq path (cdr path)))
1831 (car path))
1832
1833(defvar mh-no-install nil) ;do not run install-mh 1937(defvar mh-no-install nil) ;do not run install-mh
1834 1938
1835(defun mh-install (profile error-val) 1939(defun mh-install (profile error-val)
@@ -1911,18 +2015,18 @@ not updated."
1911 (let ((entry (mh-find-seq seq)) 2015 (let ((entry (mh-find-seq seq))
1912 (internal-seq-flag (mh-internal-seq seq))) 2016 (internal-seq-flag (mh-internal-seq seq)))
1913 (if (and msgs (atom msgs)) (setq msgs (list msgs))) 2017 (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)))))
1920 (if (null entry) 2018 (if (null entry)
1921 (setq mh-seq-list 2019 (setq mh-seq-list
1922 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) 2020 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
1923 mh-seq-list)) 2021 mh-seq-list))
1924 (if msgs (setcdr entry (mh-canonicalize-sequence 2022 (if msgs (setcdr entry (mh-canonicalize-sequence
1925 (append msgs (mh-seq-msgs entry)))))))) 2023 (append msgs (mh-seq-msgs entry))))))
2024 (unless internal-flag
2025 (mh-add-to-sequence seq msgs)
2026 (when (not dont-annotate-flag)
2027 (mh-iterate-on-range msg msgs
2028 (unless (memq msg (cdr entry))
2029 (mh-add-sequence-notation msg internal-seq-flag)))))))
1926 2030
1927(defun mh-canonicalize-sequence (msgs) 2031(defun mh-canonicalize-sequence (msgs)
1928 "Sort MSGS in decreasing order and remove duplicates." 2032 "Sort MSGS in decreasing order and remove duplicates."
@@ -2076,12 +2180,15 @@ aren't usually mail folders are hidden."
2076 (goto-char (point-min)) 2180 (goto-char (point-min))
2077 (while (not (and (eolp) (bolp))) 2181 (while (not (and (eolp) (bolp)))
2078 (goto-char (line-end-position)) 2182 (goto-char (line-end-position))
2079 (let ((has-pos (search-backward " has " (line-beginning-position) t))) 2183 (let ((start-pos (line-beginning-position))
2184 (has-pos (search-backward " has " (line-beginning-position) t)))
2080 (when (integerp has-pos) 2185 (when (integerp has-pos)
2081 (while (equal (char-after has-pos) ? ) 2186 (while (equal (char-after has-pos) ? )
2082 (decf has-pos)) 2187 (decf has-pos))
2083 (incf has-pos) 2188 (incf has-pos)
2084 (let* ((name (buffer-substring (line-beginning-position) has-pos)) 2189 (while (equal (char-after start-pos) ? )
2190 (incf start-pos))
2191 (let* ((name (buffer-substring start-pos has-pos))
2085 (first-char (aref name 0)) 2192 (first-char (aref name 0))
2086 (last-char (aref name (1- (length name))))) 2193 (last-char (aref name (1- (length name)))))
2087 (unless (member first-char '(?. ?# ?,)) 2194 (unless (member first-char '(?. ?# ?,))
@@ -2189,7 +2296,9 @@ whether the completion is over."
2189If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name 2296If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name
2190corresponding to `mh-user-path'." 2297corresponding to `mh-user-path'."
2191 (mh-normalize-folder-name 2298 (mh-normalize-folder-name
2192 (let ((minibuffer-local-completion-map mh-folder-completion-map) 2299 (let ((minibuffer-completing-file-name t)
2300 (completion-root-regexp "^[+/]")
2301 (minibuffer-local-completion-map mh-folder-completion-map)
2193 (mh-allow-root-folder-flag allow-root-folder-flag)) 2302 (mh-allow-root-folder-flag allow-root-folder-flag))
2194 (completing-read prompt 'mh-folder-completion-function nil nil nil 2303 (completing-read prompt 'mh-folder-completion-function nil nil nil
2195 'mh-folder-hist default)) 2304 'mh-folder-hist default))
@@ -2206,11 +2315,10 @@ non-nil then the function will accept the folder +, which means all folders
2206when used in searching." 2315when used in searching."
2207 (if (null default) 2316 (if (null default)
2208 (setq default "")) 2317 (setq default ""))
2209 (let* ((default-string (cond (default-string (format " [%s]? " 2318 (let* ((default-string (cond (default-string (format "[%s] " default-string))
2210 default-string)) 2319 ((equal "" default) "")
2211 ((equal "" default) "? ") 2320 (t (format "[%s] " default))))
2212 (t (format " [%s]? " default)))) 2321 (prompt (format "%s folder: %s" prompt default-string))
2213 (prompt (format "%s folder%s" prompt default-string))
2214 (mh-current-folder-name mh-current-folder) 2322 (mh-current-folder-name mh-current-folder)
2215 read-name folder-name) 2323 read-name folder-name)
2216 (while (and (setq read-name (mh-folder-completing-read 2324 (while (and (setq read-name (mh-folder-completing-read
@@ -2452,6 +2560,13 @@ Put the output into buffer after point. Set mark after inserted text."
2452 (setq l (cdr l))) 2560 (setq l (cdr l)))
2453 new-list)) 2561 new-list))
2454 2562
2563(defun mh-replace-string (old new)
2564 "Replace all occurrences of OLD with NEW in the current buffer."
2565 (goto-char (point-min))
2566 (let ((case-fold-search t))
2567 (while (search-forward old nil t)
2568 (replace-match new t t))))
2569
2455(defun mh-replace-in-string (regexp newtext string) 2570(defun mh-replace-in-string (regexp newtext string)
2456 "Replace REGEXP with NEWTEXT everywhere in STRING and return result. 2571 "Replace REGEXP with NEWTEXT everywhere in STRING and return result.
2457NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. 2572NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 8e9d0bda5af..c1f3c0a8d52 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1014,7 +1014,7 @@ or nil meaning don't change it."
1014 1014
1015(defun ange-ftp-hash-entry-exists-p (key tbl) 1015(defun ange-ftp-hash-entry-exists-p (key tbl)
1016 "Return whether there is an association for KEY in TABLE." 1016 "Return whether there is an association for KEY in TABLE."
1017 (not (eq (gethash key tbl 'unknown) 'unknown))) 1017 (and tbl (not (eq (gethash key tbl 'unknown) 'unknown))))
1018 1018
1019(defun ange-ftp-hash-table-keys (tbl) 1019(defun ange-ftp-hash-table-keys (tbl)
1020 "Return a sorted list of all the active keys in TABLE, as strings." 1020 "Return a sorted list of all the active keys in TABLE, as strings."
@@ -1771,7 +1771,7 @@ good, skip, fatal, or unknown."
1771 ange-ftp-gateway-program 1771 ange-ftp-gateway-program
1772 ange-ftp-gateway-host))) 1772 ange-ftp-gateway-host)))
1773 (ftp (mapconcat 'identity args " "))) 1773 (ftp (mapconcat 'identity args " ")))
1774 (process-kill-without-query proc) 1774 (set-process-query-on-exit-flag proc nil)
1775 (set-process-sentinel proc 'ange-ftp-gwp-sentinel) 1775 (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
1776 (set-process-filter proc 'ange-ftp-gwp-filter) 1776 (set-process-filter proc 'ange-ftp-gwp-filter)
1777 (save-excursion 1777 (save-excursion
@@ -1880,7 +1880,7 @@ been queued with no result. CONT will still be called, however."
1880 (start-process " *nslookup*" " *nslookup*" 1880 (start-process " *nslookup*" " *nslookup*"
1881 ange-ftp-nslookup-program host))) 1881 ange-ftp-nslookup-program host)))
1882 (res host)) 1882 (res host))
1883 (process-kill-without-query proc) 1883 (set-process-query-on-exit-flag proc nil)
1884 (save-excursion 1884 (save-excursion
1885 (set-buffer (process-buffer proc)) 1885 (set-buffer (process-buffer proc))
1886 (while (memq (process-status proc) '(run open)) 1886 (while (memq (process-status proc) '(run open))
@@ -1938,7 +1938,7 @@ on the gateway machine to do the ftp instead."
1938 (set-buffer (process-buffer proc)) 1938 (set-buffer (process-buffer proc))
1939 (goto-char (point-max)) 1939 (goto-char (point-max))
1940 (set-marker (process-mark proc) (point))) 1940 (set-marker (process-mark proc) (point)))
1941 (process-kill-without-query proc) 1941 (set-process-query-on-exit-flag proc nil)
1942 (set-process-sentinel proc 'ange-ftp-process-sentinel) 1942 (set-process-sentinel proc 'ange-ftp-process-sentinel)
1943 (set-process-filter proc 'ange-ftp-process-filter) 1943 (set-process-filter proc 'ange-ftp-process-filter)
1944 ;; On Windows, the standard ftp client buffers its output (because 1944 ;; On Windows, the standard ftp client buffers its output (because
@@ -2919,11 +2919,8 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
2919 ;; error message. 2919 ;; error message.
2920 (gethash "." ent)) 2920 (gethash "." ent))
2921 ;; Child lookup failed, so try the parent. 2921 ;; Child lookup failed, so try the parent.
2922 (let ((table (ange-ftp-get-files dir 'no-error))) 2922 (ange-ftp-hash-entry-exists-p
2923 ;; If the dir doesn't exist, don't use it as a hash table. 2923 file (ange-ftp-get-files dir 'no-error))))))
2924 (and table
2925 (ange-ftp-hash-entry-exists-p file
2926 table)))))))
2927 2924
2928(defun ange-ftp-get-file-entry (name) 2925(defun ange-ftp-get-file-entry (name)
2929 "Given NAME, return the given file entry. 2926 "Given NAME, return the given file entry.
@@ -3374,11 +3371,11 @@ system TYPE.")
3374 (setq file (ange-ftp-expand-file-name file)) 3371 (setq file (ange-ftp-expand-file-name file))
3375 (if (ange-ftp-ftp-name file) 3372 (if (ange-ftp-ftp-name file)
3376 (condition-case nil 3373 (condition-case nil
3377 (let ((file-ent 3374 (let ((ent (ange-ftp-get-files (file-name-directory file))))
3378 (gethash 3375 (and ent
3379 (ange-ftp-get-file-part file) 3376 (stringp (setq ent
3380 (ange-ftp-get-files (file-name-directory file))))) 3377 (gethash (ange-ftp-get-file-part file) ent)))
3381 (and (stringp file-ent) file-ent)) 3378 ent))
3382 ;; If we can't read the parent directory, just assume 3379 ;; If we can't read the parent directory, just assume
3383 ;; this file is not a symlink. 3380 ;; this file is not a symlink.
3384 ;; This makes it possible to access a directory that 3381 ;; This makes it possible to access a directory that
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 02b076483c1..cda0d41fd8d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2055,7 +2055,7 @@ target of the symlink differ."
2055 2055
2056(defun tramp-handle-file-truename (filename &optional counter prev-dirs) 2056(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2057 "Like `file-truename' for tramp files." 2057 "Like `file-truename' for tramp files."
2058 (with-parsed-tramp-file-name filename nil 2058 (with-parsed-tramp-file-name (expand-file-name filename) nil
2059 (let* ((steps (tramp-split-string localname "/")) 2059 (let* ((steps (tramp-split-string localname "/"))
2060 (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs 2060 (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
2061 (file-name-as-directory localname))) 2061 (file-name-as-directory localname)))
@@ -2299,32 +2299,33 @@ If it doesn't exist, generate a new one."
2299 (unless (buffer-file-name) 2299 (unless (buffer-file-name)
2300 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" 2300 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2301 (buffer-name))) 2301 (buffer-name)))
2302 (when time-list 2302 (if time-list
2303 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))) 2303 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2304 (let ((f (buffer-file-name)) 2304 (let ((f (buffer-file-name))
2305 (coding-system-used nil)) 2305 (coding-system-used nil))
2306 (with-parsed-tramp-file-name f nil 2306 (with-parsed-tramp-file-name f nil
2307 (let* ((attr (file-attributes f)) 2307 (let* ((attr (file-attributes f))
2308 (modtime (nth 5 attr))) 2308 ;; '(-1 65535) means file doesn't exists yet.
2309 ;; We use '(0 0) as a don't-know value. See also 2309 (modtime (or (nth 5 attr) '(-1 65535))))
2310 ;; `tramp-handle-file-attributes-with-ls'. 2310 ;; We use '(0 0) as a don't-know value. See also
2311 (when (boundp 'last-coding-system-used) 2311 ;; `tramp-handle-file-attributes-with-ls'.
2312 (setq coding-system-used last-coding-system-used)) 2312 (when (boundp 'last-coding-system-used)
2313 (if (not (equal modtime '(0 0))) 2313 (setq coding-system-used last-coding-system-used))
2314 (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) 2314 (if (not (equal modtime '(0 0)))
2315 (save-excursion 2315 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2316 (tramp-send-command 2316 (save-excursion
2317 multi-method method user host 2317 (tramp-send-command
2318 (format "%s -ild %s" 2318 multi-method method user host
2319 (tramp-get-ls-command multi-method method user host) 2319 (format "%s -ild %s"
2320 (tramp-shell-quote-argument localname))) 2320 (tramp-get-ls-command multi-method method user host)
2321 (tramp-wait-for-output) 2321 (tramp-shell-quote-argument localname)))
2322 (setq attr (buffer-substring (point) 2322 (tramp-wait-for-output)
2323 (progn (end-of-line) (point))))) 2323 (setq attr (buffer-substring (point)
2324 (setq tramp-buffer-file-attributes attr)) 2324 (progn (end-of-line) (point)))))
2325 (when (boundp 'last-coding-system-used) 2325 (setq tramp-buffer-file-attributes attr))
2326 (setq last-coding-system-used coding-system-used)) 2326 (when (boundp 'last-coding-system-used)
2327 nil)))) 2327 (setq last-coding-system-used coding-system-used))
2328 nil)))))
2328 2329
2329;; CCC continue here 2330;; CCC continue here
2330 2331
@@ -3811,8 +3812,11 @@ This will break if COMMAND prints a newline, followed by the value of
3811 (unless (equal curbuf (current-buffer)) 3812 (unless (equal curbuf (current-buffer))
3812 (error "Buffer has changed from `%s' to `%s'" 3813 (error "Buffer has changed from `%s' to `%s'"
3813 curbuf (current-buffer))) 3814 curbuf (current-buffer)))
3814 (when (eq visit t) 3815 (when (or (eq visit t) (stringp visit))
3815 (set-visited-file-modtime)) 3816 (set-visited-file-modtime
3817 ;; We must pass modtime explicitely, because filename can be different
3818 ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
3819 (nth 5 (file-attributes filename))))
3816 ;; Make `last-coding-system-used' have the right value. 3820 ;; Make `last-coding-system-used' have the right value.
3817 (when (boundp 'last-coding-system-used) 3821 (when (boundp 'last-coding-system-used)
3818 (setq last-coding-system-used coding-system-used)) 3822 (setq last-coding-system-used coding-system-used))
@@ -5847,7 +5851,8 @@ locale to C and sets up the remote shell search path."
5847 multi-method method user host 5851 multi-method method user host
5848 (concat "tramp_file_attributes () {\n" 5852 (concat "tramp_file_attributes () {\n"
5849 tramp-remote-perl 5853 tramp-remote-perl
5850 " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n" 5854 " -e '" tramp-perl-file-attributes "'"
5855 " \"$1\" \"$2\" 2>/dev/null\n"
5851 "}")) 5856 "}"))
5852 (tramp-wait-for-output) 5857 (tramp-wait-for-output)
5853 (unless (tramp-method-out-of-band-p multi-method method user host) 5858 (unless (tramp-method-out-of-band-p multi-method method user host)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index b3223d7a46e..46b33b2d50f 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -30,7 +30,7 @@
30;; are auto-frobbed from configure.ac, so you should edit that file and run 30;; are auto-frobbed from configure.ac, so you should edit that file and run
31;; "autoconf && ./configure" to change them. 31;; "autoconf && ./configure" to change them.
32 32
33(defconst tramp-version "2.0.39" 33(defconst tramp-version "2.0.44"
34 "This version of Tramp.") 34 "This version of Tramp.")
35 35
36(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org" 36(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el
index c1726ee84c7..84dbf218581 100644
--- a/lisp/pcvs-parse.el
+++ b/lisp/pcvs-parse.el
@@ -1,7 +1,7 @@
1;;; pcvs-parse.el --- the CVS output parser 1;;; pcvs-parse.el --- the CVS output parser
2 2
3;; Copyright (C) 1991,92,93,94,95,96,97,98,99,2000,02,2003 3;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4;; Free Software Foundation, Inc. 4;; 2000, 2002, 2003, 2004 Free Software Foundation, Inc.
5 5
6;; Author: Stefan Monnier <monnier@cs.yale.edu> 6;; Author: Stefan Monnier <monnier@cs.yale.edu>
7;; Keywords: pcl-cvs 7;; Keywords: pcl-cvs
@@ -370,7 +370,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
370 ;; File you removed still exists. Ignore (will be noted as removed). 370 ;; File you removed still exists. Ignore (will be noted as removed).
371 (cvs-match ".* should be removed and is still there$") 371 (cvs-match ".* should be removed and is still there$")
372 ;; just a note 372 ;; just a note
373 (cvs-match "use '.+ commit' to \\sw+ th\\sw+ files? permanently$") 373 (cvs-match "use ['`].+ commit' to \\sw+ th\\sw+ files? permanently$")
374 ;; [add,status] followed by a more complete status description anyway 374 ;; [add,status] followed by a more complete status description anyway
375 (and (cvs-match "nothing known about \\(.*\\)$" (path 1)) 375 (and (cvs-match "nothing known about \\(.*\\)$" (path 1))
376 (cvs-parsed-fileinfo 'DEAD path 'trust)) 376 (cvs-parsed-fileinfo 'DEAD path 'trust))
@@ -492,12 +492,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
492 :head-rev head-rev)))) 492 :head-rev head-rev))))
493 493
494(defun cvs-parse-commit () 494(defun cvs-parse-commit ()
495 (let (path base-rev subtype) 495 (let (path file base-rev subtype)
496 (cvs-or 496 (cvs-or
497 497
498 (and 498 (and
499 (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) 499 (cvs-or
500 (cvs-match ".*,v <-- .*$") 500 (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2))
501 t)
502 (cvs-match ".*,v <-- \\(.*\\)$" (file 1))
501 (cvs-or 503 (cvs-or
502 ;; deletion 504 ;; deletion
503 (cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$" 505 (cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$"
@@ -508,7 +510,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
508 ;; update 510 ;; update
509 (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$" 511 (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$"
510 (subtype 'COMMITTED) (base-rev 1))) 512 (subtype 'COMMITTED) (base-rev 1)))
511 (cvs-match "done$") 513 (cvs-or (cvs-match "done$") t)
512 (progn 514 (progn
513 ;; Try to remove the temp files used by VC. 515 ;; Try to remove the temp files used by VC.
514 (vc-delete-automatic-version-backups (expand-file-name path)) 516 (vc-delete-automatic-version-backups (expand-file-name path))
@@ -516,7 +518,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
516 ;; because `cvs commit' might begin by a series of Examining messages 518 ;; because `cvs commit' might begin by a series of Examining messages
517 ;; so the processing of the actual checkin messages might begin with 519 ;; so the processing of the actual checkin messages might begin with
518 ;; a `current-dir' set to something different from "" 520 ;; a `current-dir' set to something different from ""
519 (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) path 'trust 521 (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype)
522 (or path file) (if path 'trust)
520 :base-rev base-rev))) 523 :base-rev base-rev)))
521 524
522 ;; useless message added before the actual addition: ignored 525 ;; useless message added before the actual addition: ignored
@@ -525,5 +528,5 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
525 528
526(provide 'pcvs-parse) 529(provide 'pcvs-parse)
527 530
528;;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6 531;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6
529;;; pcvs-parse.el ends here 532;;; pcvs-parse.el ends here
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index c9bfbd76c23..fc1d2d46ab3 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -33,7 +33,7 @@
33;;; for lookup and completion in Ada mode. 33;;; for lookup and completion in Ada mode.
34;;; 34;;;
35;;; If a file *.`adp' exists in the ada-file directory, then it is 35;;; If a file *.`adp' exists in the ada-file directory, then it is
36;;; read for configuration informations. It is read only the first 36;;; read for configuration informations. It is read only the first
37;;; time a cross-reference is asked for, and is not read later. 37;;; time a cross-reference is asked for, and is not read later.
38 38
39;;; You need Emacs >= 20.2 to run this package 39;;; You need Emacs >= 20.2 to run this package
@@ -55,26 +55,25 @@ Otherwise create either a new buffer or a new frame."
55 55
56(defcustom ada-xref-create-ali nil 56(defcustom ada-xref-create-ali nil
57 "*If non-nil, run gcc whenever the cross-references are not up-to-date. 57 "*If non-nil, run gcc whenever the cross-references are not up-to-date.
58If nil, the cross-reference mode will never run gcc." 58If nil, the cross-reference mode never runs gcc."
59 :type 'boolean :group 'ada) 59 :type 'boolean :group 'ada)
60 60
61(defcustom ada-xref-confirm-compile nil 61(defcustom ada-xref-confirm-compile nil
62 "*If non-nil, always ask for user confirmation before compiling or running 62 "*If non-nil, ask for confirmation before compiling or running the application."
63the application."
64 :type 'boolean :group 'ada) 63 :type 'boolean :group 'ada)
65 64
66(defcustom ada-krunch-args "0" 65(defcustom ada-krunch-args "0"
67 "*Maximum number of characters for filenames created by gnatkr. 66 "*Maximum number of characters for filenames created by `gnatkr'.
68Set to 0, if you don't use crunched filenames. This should be a string." 67Set to 0, if you don't use crunched filenames. This should be a string."
69 :type 'string :group 'ada) 68 :type 'string :group 'ada)
70 69
71(defcustom ada-gnatls-args '("-v") 70(defcustom ada-gnatls-args '("-v")
72 "*Arguments to pass to gnatfind when the location of the runtime is searched. 71 "*Arguments to pass to `gnatfind' to find location of the runtime.
73Typical use is to pass --RTS=soft-floats on some systems that support it. 72Typical use is to pass `--RTS=soft-floats' on some systems that support it.
74 73
75You can also add -I- if you do not want the current directory to be included. 74You can also add `-I-' if you do not want the current directory to be included.
76Otherwise, going from specs to bodies and back will first look for files in the 75Otherwise, going from specs to bodies and back will first look for files in the
77current directory. This only has an impact if you are not using project files, 76current directory. This only has an impact if you are not using project files,
78but only ADA_INCLUDE_PATH." 77but only ADA_INCLUDE_PATH."
79 :type '(repeat string) :group 'ada) 78 :type '(repeat string) :group 'ada)
80 79
@@ -91,14 +90,14 @@ but only ADA_INCLUDE_PATH."
91 :type 'string :group 'ada) 90 :type 'string :group 'ada)
92 91
93(defcustom ada-prj-default-gnatmake-opt "-g" 92(defcustom ada-prj-default-gnatmake-opt "-g"
94 "Default options for gnatmake." 93 "Default options for `gnatmake'."
95 :type 'string :group 'ada) 94 :type 'string :group 'ada)
96 95
97(defcustom ada-prj-gnatfind-switches "-rf" 96(defcustom ada-prj-gnatfind-switches "-rf"
98 "Default switches to use for gnatfind. 97 "Default switches to use for `gnatfind'.
99You should modify this variable, for instance to add -a, if you are working 98You should modify this variable, for instance to add `-a', if you are working
100in an environment where most ALI files are write-protected. 99in an environment where most ALI files are write-protected.
101The command gnatfind is used every time you choose the menu 100The command `gnatfind' is used every time you choose the menu
102\"Show all references\"." 101\"Show all references\"."
103 :type 'string :group 'ada) 102 :type 'string :group 'ada)
104 103
@@ -106,12 +105,12 @@ The command gnatfind is used every time you choose the menu
106 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" 105 (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
107 " ${comp_opt}") 106 " ${comp_opt}")
108 "*Default command to be used to compile a single file. 107 "*Default command to be used to compile a single file.
109Emacs will add the filename at the end of this command. This is the same 108Emacs will add the filename at the end of this command. This is the same
110syntax as in the project file." 109syntax as in the project file."
111 :type 'string :group 'ada) 110 :type 'string :group 'ada)
112 111
113(defcustom ada-prj-default-debugger "${cross_prefix}gdb" 112(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
114 "*Default name of the debugger. We recommend either `gdb', 113 "*Default name of the debugger. We recommend either `gdb',
115`gdb --emacs_gdbtk' or `ddd --tty -fullname'." 114`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
116 :type 'string :group 'ada) 115 :type 'string :group 'ada)
117 116
@@ -129,7 +128,7 @@ this string is not empty."
129 :type '(file :must-match t) :group 'ada) 128 :type '(file :must-match t) :group 'ada)
130 129
131(defcustom ada-gnatstub-opts "-q -I${src_dir}" 130(defcustom ada-gnatstub-opts "-q -I${src_dir}"
132 "*List of the options to pass to gnatsub to generate the body of a package. 131 "*List of the options to pass to `gnatsub' to generate the body of a package.
133This has the same syntax as in the project file (with variable substitution)." 132This has the same syntax as in the project file (with variable substitution)."
134 :type 'string :group 'ada) 133 :type 'string :group 'ada)
135 134
@@ -139,7 +138,7 @@ Otherwise, ask the user for the name of the project file to use."
139 :type 'boolean :group 'ada) 138 :type 'boolean :group 'ada)
140 139
141(defconst is-windows (memq system-type (quote (windows-nt))) 140(defconst is-windows (memq system-type (quote (windows-nt)))
142 "True if we are running on windows NT or windows 95.") 141 "True if we are running on Windows NT or Windows 95.")
143 142
144(defcustom ada-tight-gvd-integration nil 143(defcustom ada-tight-gvd-integration nil
145 "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. 144 "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
@@ -149,7 +148,7 @@ If GVD is not the debugger used, nothing happens."
149(defcustom ada-xref-search-with-egrep t 148(defcustom ada-xref-search-with-egrep t
150 "*If non-nil, use egrep to find the possible declarations for an entity. 149 "*If non-nil, use egrep to find the possible declarations for an entity.
151This alternate method is used when the exact location was not found in the 150This alternate method is used when the exact location was not found in the
152information provided by GNAT. However, it might be expensive if you have a lot 151information provided by GNAT. However, it might be expensive if you have a lot
153of sources, since it will search in all the files in your project." 152of sources, since it will search in all the files in your project."
154 :type 'boolean :group 'ada) 153 :type 'boolean :group 'ada)
155 154
@@ -161,8 +160,8 @@ This hook should be used to support new formats for the project files.
161 160
162If the function can load the file with the given filename, it should create a 161If the function can load the file with the given filename, it should create a
163buffer that contains a conversion of the file to the standard format of the 162buffer that contains a conversion of the file to the standard format of the
164project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\" 163project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\"
165lines). It should return nil if it doesn't know how to convert that project 164lines.) It should return nil if it doesn't know how to convert that project
166file.") 165file.")
167 166
168 167
@@ -192,14 +191,13 @@ Used to go back to these positions.")
192 (if (string-match "cmdproxy.exe" shell-file-name) 191 (if (string-match "cmdproxy.exe" shell-file-name)
193 "cd /d" 192 "cd /d"
194 "cd") 193 "cd")
195 "Command to use to change to a specific directory. On windows systems 194 "Command to use to change to a specific directory.
196using cmdproxy.exe as the shell, we need to use /d or the drive is never 195On Windows systems using `cmdproxy.exe' as the shell,
197changed.") 196we need to use `/d' or the drive is never changed.")
198 197
199(defvar ada-command-separator (if is-windows " && " "\n") 198(defvar ada-command-separator (if is-windows " && " "\n")
200 "Separator to use when sending multiple commands to `compile' or 199 "Separator to use between multiple commands to `compile' or `start-process'.
201`start-process'. 200`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
202cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
203\"&&\" for now.") 201\"&&\" for now.")
204 202
205(defconst ada-xref-pos-ring-max 16 203(defconst ada-xref-pos-ring-max 16
@@ -247,12 +245,12 @@ As always, the values of the project file are defined through properties.")
247;; ----------------------------------------------------------------------- 245;; -----------------------------------------------------------------------
248 246
249(defun ada-quote-cmd (cmd) 247(defun ada-quote-cmd (cmd)
250 "Duplicates all \\ characters in CMD so that it can be passed to `compile'" 248 "Duplicate all \\ characters in CMD so that it can be passed to `compile'."
251 (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) 249 (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
252 250
253(defun ada-initialize-runtime-library (cross-prefix) 251(defun ada-initialize-runtime-library (cross-prefix)
254 "Initializes the variables for the runtime library location. 252 "Initialize the variables for the runtime library location.
255CROSS-PREFIX is the prefix to use for the gnatls command" 253CROSS-PREFIX is the prefix to use for the gnatls command."
256 (save-excursion 254 (save-excursion
257 (setq ada-xref-runtime-library-specs-path '() 255 (setq ada-xref-runtime-library-specs-path '()
258 ada-xref-runtime-library-ali-path '()) 256 ada-xref-runtime-library-ali-path '())
@@ -591,7 +589,7 @@ This is overriden on VMS to convert from VMS filenames to Unix filenames."
591(defun ada-set-default-project-file (name &optional keep-existing) 589(defun ada-set-default-project-file (name &optional keep-existing)
592 "Set the file whose name is NAME as the default project file. 590 "Set the file whose name is NAME as the default project file.
593If KEEP-EXISTING is true and a project file has already been loaded, nothing 591If KEEP-EXISTING is true and a project file has already been loaded, nothing
594is done. This is meant to be used from ada-mode-hook, for instance to force 592is done. This is meant to be used from `ada-mode-hook', for instance, to force
595a project file unless the user has already loaded one." 593a project file unless the user has already loaded one."
596 (interactive "fProject file:") 594 (interactive "fProject file:")
597 (if (or (not keep-existing) 595 (if (or (not keep-existing)
@@ -608,7 +606,7 @@ a project file unless the user has already loaded one."
608If NO-USER-QUESTION is non-nil, use a default file if not project file was 606If NO-USER-QUESTION is non-nil, use a default file if not project file was
609found, and do not ask the user. 607found, and do not ask the user.
610If the buffer is not an Ada buffer, associate it with the default project 608If the buffer is not an Ada buffer, associate it with the default project
611file. If none is set, return nil." 609file. If none is set, return nil."
612 610
613 (let (selected) 611 (let (selected)
614 612
@@ -711,7 +709,7 @@ The current buffer should be the ada-file buffer."
711 (ada-xref-set-default-prj-values 'project (current-buffer)) 709 (ada-xref-set-default-prj-values 'project (current-buffer))
712 710
713 ;; Do not use find-file below, since we don't want to show this 711 ;; Do not use find-file below, since we don't want to show this
714 ;; buffer. If the file is open through speedbar, we can't use 712 ;; buffer. If the file is open through speedbar, we can't use
715 ;; find-file anyway, since the speedbar frame is special and does not 713 ;; find-file anyway, since the speedbar frame is special and does not
716 ;; allow the selection of a file in it. 714 ;; allow the selection of a file in it.
717 715
@@ -786,7 +784,7 @@ The current buffer should be the ada-file buffer."
786 ;; Else the file wasn't readable (probably the default project). 784 ;; Else the file wasn't readable (probably the default project).
787 ;; We initialize it with the current environment variables. 785 ;; We initialize it with the current environment variables.
788 ;; We need to add the startup directory in front so that 786 ;; We need to add the startup directory in front so that
789 ;; files locally redefined are properly found. We cannot 787 ;; files locally redefined are properly found. We cannot
790 ;; add ".", which varies too much depending on what the 788 ;; add ".", which varies too much depending on what the
791 ;; current buffer is. 789 ;; current buffer is.
792 (set 'project 790 (set 'project
@@ -836,7 +834,7 @@ The current buffer should be the ada-file buffer."
836 834
837 ;; No prj file ? => Setup default values 835 ;; No prj file ? => Setup default values
838 ;; Note that nil means that all compilation modes will first look in the 836 ;; Note that nil means that all compilation modes will first look in the
839 ;; current directory, and only then in the current file's directory. This 837 ;; current directory, and only then in the current file's directory. This
840 ;; current file is assumed at this point to be in the common source 838 ;; current file is assumed at this point to be in the common source
841 ;; directory. 839 ;; directory.
842 (setq compilation-search-path (list nil default-directory)) 840 (setq compilation-search-path (list nil default-directory))
@@ -846,10 +844,9 @@ The current buffer should be the ada-file buffer."
846(defun ada-find-references (&optional pos arg local-only) 844(defun ada-find-references (&optional pos arg local-only)
847 "Find all references to the entity under POS. 845 "Find all references to the entity under POS.
848Calls gnatfind to find the references. 846Calls gnatfind to find the references.
849if ARG is t, the contents of the old *gnatfind* buffer is preserved. 847If ARG is t, the contents of the old *gnatfind* buffer is preserved.
850if LOCAL-ONLY is t, only the declarations in the current file are returned." 848If LOCAL-ONLY is t, only the declarations in the current file are returned."
851 (interactive "d 849 (interactive "d\nP")
852P")
853 (ada-require-project-file) 850 (ada-require-project-file)
854 851
855 (let* ((identlist (ada-read-identifier pos)) 852 (let* ((identlist (ada-read-identifier pos))
@@ -872,24 +869,23 @@ P")
872 869
873(defun ada-find-local-references (&optional pos arg) 870(defun ada-find-local-references (&optional pos arg)
874 "Find all references to the entity under POS. 871 "Find all references to the entity under POS.
875Calls gnatfind to find the references. 872Calls `gnatfind' to find the references.
876if ARG is t, the contents of the old *gnatfind* buffer is preserved." 873If ARG is t, the contents of the old *gnatfind* buffer is preserved."
877 (interactive "d 874 (interactive "d\nP")
878P")
879 (ada-find-references pos arg t)) 875 (ada-find-references pos arg t))
880 876
881(defun ada-find-any-references 877(defun ada-find-any-references
882 (entity &optional file line column local-only append) 878 (entity &optional file line column local-only append)
883 "Search for references to any entity whose name is ENTITY. 879 "Search for references to any entity whose name is ENTITY.
884ENTITY was first found the location given by FILE, LINE and COLUMN. 880ENTITY was first found the location given by FILE, LINE and COLUMN.
885If LOCAL-ONLY is t, then only the references in file will be listed, which 881If LOCAL-ONLY is t, then list only the references in FILE, which
886is much faster. 882is much faster.
887If APPEND is t, then the output of the command will be append to the existing 883If APPEND is t, then append the output of the command to the existing
888buffer *gnatfind* if it exists." 884buffer `*gnatfind*', if there is one."
889 (interactive "sEntity name: ") 885 (interactive "sEntity name: ")
890 (ada-require-project-file) 886 (ada-require-project-file)
891 887
892 ;; Prepare the gnatfind command. Note that we must protect the quotes 888 ;; Prepare the gnatfind command. Note that we must protect the quotes
893 ;; around operators, so that they are correctly handled and can be 889 ;; around operators, so that they are correctly handled and can be
894 ;; processed (gnatfind \"+\":...). 890 ;; processed (gnatfind \"+\":...).
895 (let* ((quote-entity 891 (let* ((quote-entity
@@ -921,7 +917,8 @@ buffer *gnatfind* if it exists."
921 (set-buffer "*gnatfind*") 917 (set-buffer "*gnatfind*")
922 (setq old-contents (buffer-string)))) 918 (setq old-contents (buffer-string))))
923 919
924 (compile-internal command "No more references" "gnatfind") 920 (let ((compilation-error "reference"))
921 (compilation-start command))
925 922
926 ;; Hide the "Compilation" menu 923 ;; Hide the "Compilation" menu
927 (save-excursion 924 (save-excursion
@@ -941,8 +938,8 @@ buffer *gnatfind* if it exists."
941;; ----- Identifier Completion -------------------------------------------- 938;; ----- Identifier Completion --------------------------------------------
942(defun ada-complete-identifier (pos) 939(defun ada-complete-identifier (pos)
943 "Tries to complete the identifier around POS. 940 "Tries to complete the identifier around POS.
944The feature is only available if the files where compiled not using the -gnatx 941The feature is only available if the files where compiled without
945option." 942the option `-gnatx'."
946 (interactive "d") 943 (interactive "d")
947 (ada-require-project-file) 944 (ada-require-project-file)
948 945
@@ -1026,12 +1023,12 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
1026 ;; entity, whose references are not given by GNAT 1023 ;; entity, whose references are not given by GNAT
1027 (if (and (file-exists-p ali-file) 1024 (if (and (file-exists-p ali-file)
1028 (file-newer-than-file-p ali-file (ada-file-of identlist))) 1025 (file-newer-than-file-p ali-file (ada-file-of identlist)))
1029 (message "No cross-reference found. It might be a predefined entity.") 1026 (message "No cross-reference found--may be a predefined entity.")
1030 1027
1031 ;; Else, look in every ALI file, except if the user doesn't want that 1028 ;; Else, look in every ALI file, except if the user doesn't want that
1032 (if ada-xref-search-with-egrep 1029 (if ada-xref-search-with-egrep
1033 (ada-find-in-src-path identlist other-frame) 1030 (ada-find-in-src-path identlist other-frame)
1034 (message "Cross-referencing information is not up-to-date. Please recompile.") 1031 (message "Cross-referencing information is not up-to-date; please recompile.")
1035 ))))))) 1032 )))))))
1036 1033
1037(defun ada-goto-declaration-other-frame (pos) 1034(defun ada-goto-declaration-other-frame (pos)
@@ -1052,12 +1049,13 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
1052 1049
1053(defun ada-get-absolute-dir-list (dir-list root-dir) 1050(defun ada-get-absolute-dir-list (dir-list root-dir)
1054 "Returns the list of absolute directories found in dir-list. 1051 "Returns the list of absolute directories found in dir-list.
1055If a directory is a relative directory, the value of ROOT-DIR is added in 1052If a directory is a relative directory, add the value of ROOT-DIR in front."
1056front."
1057 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) 1053 (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
1058 1054
1059(defun ada-set-environment () 1055(defun ada-set-environment ()
1060 "Return the new value for process-environment. 1056 "Prepare an environment for Ada compilation.
1057This returns a new value to use for `process-environment',
1058but does not actually put it into use.
1061It modifies the source path and object path with the values found in the 1059It modifies the source path and object path with the values found in the
1062project file." 1060project file."
1063 (let ((include (getenv "ADA_INCLUDE_PATH")) 1061 (let ((include (getenv "ADA_INCLUDE_PATH"))
@@ -1082,7 +1080,7 @@ project file."
1082 process-environment)))) 1080 process-environment))))
1083 1081
1084(defun ada-compile-application (&optional arg) 1082(defun ada-compile-application (&optional arg)
1085 "Compiles the application, using the command found in the project file. 1083 "Compile the application, using the command found in the project file.
1086If ARG is not nil, ask for user confirmation." 1084If ARG is not nil, ask for user confirmation."
1087 (interactive "P") 1085 (interactive "P")
1088 (ada-require-project-file) 1086 (ada-require-project-file)
@@ -1104,7 +1102,7 @@ If ARG is not nil, ask for user confirmation."
1104 (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) 1102 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1105 1103
1106 ;; Insert newlines so as to separate the name of the commands to run 1104 ;; Insert newlines so as to separate the name of the commands to run
1107 ;; and the output of the commands. this doesn't work with cmdproxy.exe, 1105 ;; and the output of the commands. This doesn't work with cmdproxy.exe,
1108 ;; which gets confused by newline characters. 1106 ;; which gets confused by newline characters.
1109 (if (not (string-match ".exe" shell-file-name)) 1107 (if (not (string-match ".exe" shell-file-name))
1110 (setq cmd (concat cmd "\n\n"))) 1108 (setq cmd (concat cmd "\n\n")))
@@ -1137,7 +1135,7 @@ command, and should be either comp_cmd (default) or check_cmd."
1137 (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) 1135 (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
1138 1136
1139 ;; Insert newlines so as to separate the name of the commands to run 1137 ;; Insert newlines so as to separate the name of the commands to run
1140 ;; and the output of the commands. this doesn't work with cmdproxy.exe, 1138 ;; and the output of the commands. This doesn't work with cmdproxy.exe,
1141 ;; which gets confused by newline characters. 1139 ;; which gets confused by newline characters.
1142 (if (not (string-match ".exe" shell-file-name)) 1140 (if (not (string-match ".exe" shell-file-name))
1143 (setq cmd (concat cmd "\n\n"))) 1141 (setq cmd (concat cmd "\n\n")))
@@ -1152,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command."
1152 1150
1153(defun ada-run-application (&optional arg) 1151(defun ada-run-application (&optional arg)
1154 "Run the application. 1152 "Run the application.
1155if ARG is not-nil, asks for user confirmation." 1153if ARG is not-nil, ask for user confirmation."
1156 (interactive) 1154 (interactive)
1157 (ada-require-project-file) 1155 (ada-require-project-file)
1158 1156
@@ -1227,7 +1225,7 @@ If ARG is non-nil, ask the user to confirm the command."
1227 ;; We make sure that gvd swallows the new frame, not the one the 1225 ;; We make sure that gvd swallows the new frame, not the one the
1228 ;; user has been using until now 1226 ;; user has been using until now
1229 ;; The frame is made invisible initially, so that GtkPlug gets a 1227 ;; The frame is made invisible initially, so that GtkPlug gets a
1230 ;; chance to fully manage it. Then it works fine with Enlightenment 1228 ;; chance to fully manage it. Then it works fine with Enlightenment
1231 ;; as well 1229 ;; as well
1232 (let ((frame (make-frame '((visibility . nil))))) 1230 (let ((frame (make-frame '((visibility . nil)))))
1233 (set 'cmd (concat 1231 (set 'cmd (concat
@@ -1297,7 +1295,7 @@ If ARG is non-nil, ask the user to confirm the command."
1297 (end-of-buffer) 1295 (end-of-buffer)
1298 1296
1299 ;; Display both the source window and the debugger window (the former 1297 ;; Display both the source window and the debugger window (the former
1300 ;; above the latter). No need to show the debugger window unless it 1298 ;; above the latter). No need to show the debugger window unless it
1301 ;; is going to have some relevant information. 1299 ;; is going to have some relevant information.
1302 (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) 1300 (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
1303 (string-match "--tty" cmd)) 1301 (string-match "--tty" cmd))
@@ -1328,8 +1326,8 @@ automatically modifies the setup for all the Ada buffer that use this file."
1328 "Update the cross-references for FILE. 1326 "Update the cross-references for FILE.
1329This in fact recompiles FILE to create ALI-FILE-NAME. 1327This in fact recompiles FILE to create ALI-FILE-NAME.
1330This function returns the name of the file that was recompiled to generate 1328This function returns the name of the file that was recompiled to generate
1331the cross-reference information. Note that the ali file can then be deduced by 1329the cross-reference information. Note that the ali file can then be deduced by
1332replacing the file extension with .ali" 1330replacing the file extension with `.ali'."
1333 ;; kill old buffer 1331 ;; kill old buffer
1334 (if (and ali-file-name 1332 (if (and ali-file-name
1335 (get-file-buffer ali-file-name)) 1333 (get-file-buffer ali-file-name))
@@ -1338,7 +1336,7 @@ replacing the file extension with .ali"
1338 (let* ((name (ada-convert-file-name file)) 1336 (let* ((name (ada-convert-file-name file))
1339 (body-name (or (ada-get-body-name name) name))) 1337 (body-name (or (ada-get-body-name name) name)))
1340 1338
1341 ;; Always recompile the body when we can. We thus temporarily switch to a 1339 ;; Always recompile the body when we can. We thus temporarily switch to a
1342 ;; buffer than contains the body of the unit 1340 ;; buffer than contains the body of the unit
1343 (save-excursion 1341 (save-excursion
1344 (let ((body-visible (find-buffer-visiting body-name)) 1342 (let ((body-visible (find-buffer-visiting body-name))
@@ -1347,7 +1345,7 @@ replacing the file extension with .ali"
1347 (set-buffer body-visible) 1345 (set-buffer body-visible)
1348 (find-file body-name)) 1346 (find-file body-name))
1349 1347
1350 ;; Execute the compilation. Note that we must wait for the end of the 1348 ;; Execute the compilation. Note that we must wait for the end of the
1351 ;; process, or the ALI file would still not be available. 1349 ;; process, or the ALI file would still not be available.
1352 ;; Unfortunately, the underlying `compile' command that we use is 1350 ;; Unfortunately, the underlying `compile' command that we use is
1353 ;; asynchronous. 1351 ;; asynchronous.
@@ -1377,13 +1375,13 @@ replacing the file extension with .ali"
1377 found)) 1375 found))
1378 1376
1379(defun ada-find-ali-file-in-dir (file) 1377(defun ada-find-ali-file-in-dir (file)
1380 "Find an .ali file in obj_dir. The current buffer must be the Ada file. 1378 "Find an .ali file in obj_dir. The current buffer must be the Ada file.
1381Adds build_dir in front of the search path to conform to gnatmake's behavior, 1379Adds build_dir in front of the search path to conform to gnatmake's behavior,
1382and the standard runtime location at the end." 1380and the standard runtime location at the end."
1383 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) 1381 (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
1384 1382
1385(defun ada-find-src-file-in-dir (file) 1383(defun ada-find-src-file-in-dir (file)
1386 "Find a source file in src_dir. The current buffer must be the Ada file. 1384 "Find a source file in src_dir. The current buffer must be the Ada file.
1387Adds src_dir in front of the search path to conform to gnatmake's behavior, 1385Adds src_dir in front of the search path to conform to gnatmake's behavior,
1388and the standard runtime location at the end." 1386and the standard runtime location at the end."
1389 (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) 1387 (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
@@ -1400,7 +1398,7 @@ the project file."
1400 ;; and look for this file 1398 ;; and look for this file
1401 ;; 2- If this file is found: 1399 ;; 2- If this file is found:
1402 ;; grep the "^U" lines, and make sure we are not reading the 1400 ;; grep the "^U" lines, and make sure we are not reading the
1403 ;; .ali file for a spec file. If we are, go to step 3. 1401 ;; .ali file for a spec file. If we are, go to step 3.
1404 ;; 3- If the file is not found or step 2 failed: 1402 ;; 3- If the file is not found or step 2 failed:
1405 ;; find the name of the "other file", ie the body, and look 1403 ;; find the name of the "other file", ie the body, and look
1406 ;; for its associated .ali file by subtituing the extension 1404 ;; for its associated .ali file by subtituing the extension
@@ -1408,9 +1406,9 @@ the project file."
1408 ;; We must also handle the case of separate packages and subprograms: 1406 ;; We must also handle the case of separate packages and subprograms:
1409 ;; 4- If no ali file was found, we try to modify the file name by removing 1407 ;; 4- If no ali file was found, we try to modify the file name by removing
1410 ;; everything after the last '-' or '.' character, so as to get the 1408 ;; everything after the last '-' or '.' character, so as to get the
1411 ;; ali file for the parent unit. If we found an ali file, we check that 1409 ;; ali file for the parent unit. If we found an ali file, we check that
1412 ;; it indeed contains the definition for the separate entity by checking 1410 ;; it indeed contains the definition for the separate entity by checking
1413 ;; the 'D' lines. This is done repeatedly, in case the direct parent is 1411 ;; the 'D' lines. This is done repeatedly, in case the direct parent is
1414 ;; also a separate. 1412 ;; also a separate.
1415 1413
1416 (save-excursion 1414 (save-excursion
@@ -1423,7 +1421,7 @@ the project file."
1423 1421
1424 ;; If we have a non-standard file name, and this is a spec, we first 1422 ;; If we have a non-standard file name, and this is a spec, we first
1425 ;; look for the .ali file of the body, since this is the one that 1423 ;; look for the .ali file of the body, since this is the one that
1426 ;; contains the most complete information. If not found, we will do what 1424 ;; contains the most complete information. If not found, we will do what
1427 ;; we can with the .ali file for the spec... 1425 ;; we can with the .ali file for the spec...
1428 1426
1429 (if (not (string= (file-name-extension file) "ads")) 1427 (if (not (string= (file-name-extension file) "ads"))
@@ -1476,8 +1474,8 @@ the project file."
1476 1474
1477 ;; If still not found, try to recompile the file 1475 ;; If still not found, try to recompile the file
1478 (if (not ali-file-name) 1476 (if (not ali-file-name)
1479 ;; recompile only if the user asked for this. and search the ali 1477 ;; Recompile only if the user asked for this, and search the ali
1480 ;; filename again. We avoid a possible infinite recursion by 1478 ;; filename again. We avoid a possible infinite recursion by
1481 ;; temporarily disabling the automatic compilation. 1479 ;; temporarily disabling the automatic compilation.
1482 1480
1483 (if ada-xref-create-ali 1481 (if ada-xref-create-ali
@@ -1485,7 +1483,7 @@ the project file."
1485 (concat (file-name-sans-extension (ada-xref-current file)) 1483 (concat (file-name-sans-extension (ada-xref-current file))
1486 ".ali")) 1484 ".ali"))
1487 1485
1488 (error "Ali file not found. Recompile your file")) 1486 (error "`.ali' file not found; recompile your source file"))
1489 1487
1490 1488
1491 ;; same if the .ali file is too old and we must recompile it 1489 ;; same if the .ali file is too old and we must recompile it
@@ -1499,7 +1497,7 @@ the project file."
1499 1497
1500(defun ada-get-ada-file-name (file original-file) 1498(defun ada-get-ada-file-name (file original-file)
1501 "Create the complete file name (+directory) for FILE. 1499 "Create the complete file name (+directory) for FILE.
1502The original file (where the user was) is ORIGINAL-FILE. Search in project 1500The original file (where the user was) is ORIGINAL-FILE. Search in project
1503file for possible paths." 1501file for possible paths."
1504 1502
1505 (save-excursion 1503 (save-excursion
@@ -1519,7 +1517,7 @@ file for possible paths."
1519 (expand-file-name filename) 1517 (expand-file-name filename)
1520 (error (concat 1518 (error (concat
1521 (file-name-nondirectory file) 1519 (file-name-nondirectory file)
1522 " not found in src_dir. Please check your project file"))) 1520 " not found in src_dir; please check your project file")))
1523 1521
1524 ))) 1522 )))
1525 1523
@@ -1671,13 +1669,13 @@ from the ali file (definition file and places where it is referenced)."
1671 (set 'declaration-found nil)))) 1669 (set 'declaration-found nil))))
1672 1670
1673 ;; Still no success ! The ali file must be too old, and we need to 1671 ;; Still no success ! The ali file must be too old, and we need to
1674 ;; use a basic algorithm based on guesses. Note that this only happens 1672 ;; use a basic algorithm based on guesses. Note that this only happens
1675 ;; if the user does not want us to automatically recompile files 1673 ;; if the user does not want us to automatically recompile files
1676 ;; automatically 1674 ;; automatically
1677 (unless declaration-found 1675 (unless declaration-found
1678 (if (ada-xref-find-in-modified-ali identlist) 1676 (if (ada-xref-find-in-modified-ali identlist)
1679 (set 'declaration-found t) 1677 (set 'declaration-found t)
1680 ;; no more idea to find the declaration. Give up 1678 ;; No more idea to find the declaration. Give up
1681 (progn 1679 (progn
1682 (kill-buffer ali-buffer) 1680 (kill-buffer ali-buffer)
1683 (error (concat "No declaration of " (ada-name-of identlist) 1681 (error (concat "No declaration of " (ada-name-of identlist)
@@ -1911,7 +1909,7 @@ is using."
1911 1909
1912 (save-excursion 1910 (save-excursion
1913 1911
1914 ;; Do the grep in all the directories. We do multiple shell 1912 ;; Do the grep in all the directories. We do multiple shell
1915 ;; commands instead of one in case there is no .ali file in one 1913 ;; commands instead of one in case there is no .ali file in one
1916 ;; of the directory and the shell stops because of that. 1914 ;; of the directory and the shell stops because of that.
1917 1915
@@ -2011,7 +2009,7 @@ is using."
2011 (file line column identlist &optional other-frame) 2009 (file line column identlist &optional other-frame)
2012 "Select and display FILE, at LINE and COLUMN. 2010 "Select and display FILE, at LINE and COLUMN.
2013If we do not end on the same identifier as IDENTLIST, find the closest 2011If we do not end on the same identifier as IDENTLIST, find the closest
2014match. Kills the .ali buffer at the end. 2012match. Kills the .ali buffer at the end.
2015If OTHER-FRAME is non-nil, creates a new frame to show the file." 2013If OTHER-FRAME is non-nil, creates a new frame to show the file."
2016 2014
2017 (let (declaration-buffer) 2015 (let (declaration-buffer)
@@ -2178,7 +2176,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
2178 (unless (buffer-file-name (car (buffer-list))) 2176 (unless (buffer-file-name (car (buffer-list)))
2179 (set-buffer (cadr (buffer-list)))) 2177 (set-buffer (cadr (buffer-list))))
2180 2178
2181 ;; Make sure we have a project file (for parameters to gnatstub). Note that 2179 ;; Make sure we have a project file (for parameters to gnatstub). Note that
2182 ;; this might have already been done if we have been called from the hook, 2180 ;; this might have already been done if we have been called from the hook,
2183 ;; but this is not an expensive call) 2181 ;; but this is not an expensive call)
2184 (ada-require-project-file) 2182 (ada-require-project-file)
@@ -2240,9 +2238,9 @@ find-file...."
2240 2238
2241;; Use gvd or ddd as the default debugger if it was found 2239;; Use gvd or ddd as the default debugger if it was found
2242;; On windows, do not use the --tty switch for GVD, since this is 2240;; On windows, do not use the --tty switch for GVD, since this is
2243;; not supported. Actually, we do not use this on Unix either, since otherwise 2241;; not supported. Actually, we do not use this on Unix either,
2244;; there is no console window left in GVD, and people have to use the 2242;; since otherwise there is no console window left in GVD,
2245;; Emacs one. 2243;; and people have to use the Emacs one.
2246;; This must be done before initializing the Ada menu. 2244;; This must be done before initializing the Ada menu.
2247(if (ada-find-file-in-dir "gvd" exec-path) 2245(if (ada-find-file-in-dir "gvd" exec-path)
2248 (set 'ada-prj-default-debugger "gvd ") 2246 (set 'ada-prj-default-debugger "gvd ")
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index b51a304c531..c5dd091f291 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -121,7 +121,7 @@ Works with: arglist-cont-nonempty, arglist-close."
121 ;; like "({". 121 ;; like "({".
122 (when c-special-brace-lists 122 (when c-special-brace-lists
123 (let ((special-list (c-looking-at-special-brace-list))) 123 (let ((special-list (c-looking-at-special-brace-list)))
124 (when special-list 124 (when (and special-list (< (car (car special-list)) (point)))
125 (goto-char (+ (car (car special-list)) 2))))) 125 (goto-char (+ (car (car special-list)) 2)))))
126 126
127 (let ((savepos (point)) 127 (let ((savepos (point))
@@ -380,9 +380,7 @@ Works with: inher-cont, member-init-cont."
380 (back-to-indentation) 380 (back-to-indentation)
381 (let* ((eol (c-point 'eol)) 381 (let* ((eol (c-point 'eol))
382 (here (point)) 382 (here (point))
383 (char-after-ip (progn 383 (char-after-ip (char-after)))
384 (skip-chars-forward " \t")
385 (char-after))))
386 (if (cdr langelem) (goto-char (cdr langelem))) 384 (if (cdr langelem) (goto-char (cdr langelem)))
387 385
388 ;; This kludge is necessary to support both inher-cont and 386 ;; This kludge is necessary to support both inher-cont and
@@ -392,13 +390,12 @@ Works with: inher-cont, member-init-cont."
392 (backward-char) 390 (backward-char)
393 (c-backward-syntactic-ws)) 391 (c-backward-syntactic-ws))
394 392
395 (skip-chars-forward "^:" eol) 393 (c-syntactic-re-search-forward ":" eol 'move)
396 (if (eq char-after-ip ?,) 394 (if (looking-at c-syntactic-eol)
397 (skip-chars-forward " \t" eol) 395 (c-forward-syntactic-ws here)
398 (skip-chars-forward " \t:" eol)) 396 (if (eq char-after-ip ?,)
399 (if (or (eolp) 397 (backward-char)
400 (looking-at c-comment-start-regexp)) 398 (skip-chars-forward " \t" eol)))
401 (c-forward-syntactic-ws here))
402 (if (< (point) here) 399 (if (< (point) here)
403 (vector (current-column))) 400 (vector (current-column)))
404 ))) 401 )))
@@ -952,11 +949,17 @@ Works with: defun-close, defun-block-intro, block-close,
952brace-list-close, brace-list-intro, statement-block-intro and all in* 949brace-list-close, brace-list-intro, statement-block-intro and all in*
953symbols, e.g. inclass and inextern-lang." 950symbols, e.g. inclass and inextern-lang."
954 (save-excursion 951 (save-excursion
955 (goto-char (cdr langelem)) 952 (+ (progn
956 (back-to-indentation) 953 (back-to-indentation)
957 (if (eq (char-syntax (char-after)) ?\() 954 (if (eq (char-syntax (char-after)) ?\()
958 0 955 c-basic-offset
959 c-basic-offset))) 956 0))
957 (progn
958 (goto-char (cdr langelem))
959 (back-to-indentation)
960 (if (eq (char-syntax (char-after)) ?\()
961 0
962 c-basic-offset)))))
960 963
961(defun c-lineup-cpp-define (langelem) 964(defun c-lineup-cpp-define (langelem)
962 "Line up macro continuation lines according to the indentation of 965 "Line up macro continuation lines according to the indentation of
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index a61369004e8..806fbade693 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -479,7 +479,11 @@ This function does various newline cleanups based on the value of
479 ;; end up before it. 479 ;; end up before it.
480 (setq delete-temp-newline 480 (setq delete-temp-newline
481 (cons (save-excursion 481 (cons (save-excursion
482 (c-backward-syntactic-ws) 482 (end-of-line 0)
483 (if (eq (char-before) ?\\)
484 ;; Ignore a line continuation.
485 (backward-char))
486 (skip-chars-backward " \t")
483 (copy-marker (point) t)) 487 (copy-marker (point) t))
484 (point-marker)))) 488 (point-marker))))
485 (unwind-protect 489 (unwind-protect
@@ -1971,8 +1975,7 @@ If `c-tab-always-indent' is t, always just indent the current line.
1971If nil, indent the current line only if point is at the left margin or 1975If nil, indent the current line only if point is at the left margin or
1972in the line's indentation; otherwise insert some whitespace[*]. If 1976in the line's indentation; otherwise insert some whitespace[*]. If
1973other than nil or t, then some whitespace[*] is inserted only within 1977other than nil or t, then some whitespace[*] is inserted only within
1974literals (comments and strings) and inside preprocessor directives, 1978literals (comments and strings), but the line is always reindented.
1975but the line is always reindented.
1976 1979
1977If `c-syntactic-indentation' is t, indentation is done according to 1980If `c-syntactic-indentation' is t, indentation is done according to
1978the syntactic context. A numeric argument, regardless of its value, 1981the syntactic context. A numeric argument, regardless of its value,
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index ad8b8a92bff..64f3a72f56f 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -48,7 +48,6 @@
48 48
49;; Silence the compiler. 49;; Silence the compiler.
50(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el 50(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
51(cc-bytecomp-defvar c-emacs-features) ; In cc-vars.el
52(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs 51(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
53(cc-bytecomp-defun region-active-p) ; XEmacs 52(cc-bytecomp-defun region-active-p) ; XEmacs
54(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs 53(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
@@ -105,7 +104,7 @@
105 104
106;;; Variables also used at compile time. 105;;; Variables also used at compile time.
107 106
108(defconst c-version "5.30.8" 107(defconst c-version "5.30.9"
109 "CC Mode version number.") 108 "CC Mode version number.")
110 109
111(defconst c-version-sym (intern c-version)) 110(defconst c-version-sym (intern c-version))
@@ -620,20 +619,36 @@ This function does not do any hidden buffer changes."
620 (eq (char-before) ?\\))) 619 (eq (char-before) ?\\)))
621 (backward-char)))) 620 (backward-char))))
622 621
622(eval-and-compile
623 (defvar c-langs-are-parametric nil))
624
623(defmacro c-major-mode-is (mode) 625(defmacro c-major-mode-is (mode)
624 "Return non-nil if the current CC Mode major mode is MODE. 626 "Return non-nil if the current CC Mode major mode is MODE.
625MODE is either a mode symbol or a list of mode symbols. 627MODE is either a mode symbol or a list of mode symbols.
626 628
627This function does not do any hidden buffer changes." 629This function does not do any hidden buffer changes."
628 (if (eq (car-safe mode) 'quote) 630
629 (let ((mode (eval mode))) 631 (if c-langs-are-parametric
630 (if (listp mode) 632 ;; Inside a `c-lang-defconst'.
631 `(memq c-buffer-is-cc-mode ',mode) 633 `(c-lang-major-mode-is ,mode)
632 `(eq c-buffer-is-cc-mode ',mode))) 634
633 `(let ((mode ,mode)) 635 (if (eq (car-safe mode) 'quote)
634 (if (listp mode) 636 (let ((mode (eval mode)))
635 (memq c-buffer-is-cc-mode mode) 637 (if (listp mode)
636 (eq c-buffer-is-cc-mode mode))))) 638 `(memq c-buffer-is-cc-mode ',mode)
639 `(eq c-buffer-is-cc-mode ',mode)))
640
641 `(let ((mode ,mode))
642 (if (listp mode)
643 (memq c-buffer-is-cc-mode mode)
644 (eq c-buffer-is-cc-mode mode))))))
645
646(defmacro c-mode-is-new-awk-p ()
647 ;; Is the current mode the "new" awk mode? It is important for
648 ;; (e.g.) the cc-engine functions do distinguish between the old and
649 ;; new awk-modes.
650 '(and (c-major-mode-is 'awk-mode)
651 (memq 'syntax-properties c-emacs-features)))
637 652
638(defmacro c-parse-sexp-lookup-properties () 653(defmacro c-parse-sexp-lookup-properties ()
639 ;; Return the value of the variable that says whether the 654 ;; Return the value of the variable that says whether the
@@ -968,13 +983,6 @@ the value of the variable with that name.
968This function does not do any hidden buffer changes." 983This function does not do any hidden buffer changes."
969 (symbol-value (c-mode-symbol suffix))) 984 (symbol-value (c-mode-symbol suffix)))
970 985
971(defsubst c-mode-is-new-awk-p ()
972 ;; Is the current mode the "new" awk mode? It is important for
973 ;; (e.g.) the cc-engine functions do distinguish between the old and
974 ;; new awk-modes.
975 (and (c-major-mode-is 'awk-mode)
976 (memq 'syntax-properties c-emacs-features)))
977
978(defsubst c-got-face-at (pos faces) 986(defsubst c-got-face-at (pos faces)
979 "Return non-nil if position POS in the current buffer has any of the 987 "Return non-nil if position POS in the current buffer has any of the
980faces in the list FACES. 988faces in the list FACES.
@@ -1057,11 +1065,155 @@ current language (taken from `c-buffer-is-cc-mode')."
1057(put 'c-make-keywords-re 'lisp-indent-function 1) 1065(put 'c-make-keywords-re 'lisp-indent-function 1)
1058 1066
1059 1067
1068;; Figure out what features this Emacs has
1069
1070(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
1071
1072(defconst c-emacs-features
1073 (let (list)
1074
1075 (if (boundp 'infodock-version)
1076 ;; I've no idea what this actually is, but it's legacy. /mast
1077 (setq list (cons 'infodock list)))
1078
1079 ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
1080 ;; Emacs 19 uses a 1-bit flag. We will have to set up our
1081 ;; syntax tables differently to handle this.
1082 (let ((table (copy-syntax-table))
1083 entry)
1084 (modify-syntax-entry ?a ". 12345678" table)
1085 (cond
1086 ;; XEmacs 19, and beyond Emacs 19.34
1087 ((arrayp table)
1088 (setq entry (aref table ?a))
1089 ;; In Emacs, table entries are cons cells
1090 (if (consp entry) (setq entry (car entry))))
1091 ;; XEmacs 20
1092 ((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
1093 ;; before and including Emacs 19.34
1094 ((and (fboundp 'char-table-p)
1095 (char-table-p table))
1096 (setq entry (car (char-table-range table [?a]))))
1097 ;; incompatible
1098 (t (error "CC Mode is incompatible with this version of Emacs")))
1099 (setq list (cons (if (= (logand (lsh entry -16) 255) 255)
1100 '8-bit
1101 '1-bit)
1102 list)))
1103
1104 (let ((buf (generate-new-buffer " test"))
1105 parse-sexp-lookup-properties
1106 parse-sexp-ignore-comments
1107 lookup-syntax-properties)
1108 (save-excursion
1109 (set-buffer buf)
1110 (set-syntax-table (make-syntax-table))
1111
1112 ;; For some reason we have to set some of these after the
1113 ;; buffer has been made current. (Specifically,
1114 ;; `parse-sexp-ignore-comments' in Emacs 21.)
1115 (setq parse-sexp-lookup-properties t
1116 parse-sexp-ignore-comments t
1117 lookup-syntax-properties t)
1118
1119 ;; Find out if the `syntax-table' text property works.
1120 (modify-syntax-entry ?< ".")
1121 (modify-syntax-entry ?> ".")
1122 (insert "<()>")
1123 (c-mark-<-as-paren 1)
1124 (c-mark->-as-paren 4)
1125 (goto-char 1)
1126 (c-forward-sexp)
1127 (if (= (point) 5)
1128 (setq list (cons 'syntax-properties list)))
1129
1130 ;; Find out if generic comment delimiters work.
1131 (c-safe
1132 (modify-syntax-entry ?x "!")
1133 (if (string-match "\\s!" "x")
1134 (setq list (cons 'gen-comment-delim list))))
1135
1136 ;; Find out if generic string delimiters work.
1137 (c-safe
1138 (modify-syntax-entry ?x "|")
1139 (if (string-match "\\s|" "x")
1140 (setq list (cons 'gen-string-delim list))))
1141
1142 ;; See if POSIX char classes work.
1143 (when (and (string-match "[[:alpha:]]" "a")
1144 ;; All versions of Emacs 21 so far haven't fixed
1145 ;; char classes in `skip-chars-forward' and
1146 ;; `skip-chars-backward'.
1147 (progn
1148 (delete-region (point-min) (point-max))
1149 (insert "foo123")
1150 (skip-chars-backward "[:alnum:]")
1151 (bobp))
1152 (= (skip-chars-forward "[:alpha:]") 3))
1153 (setq list (cons 'posix-char-classes list)))
1154
1155 ;; See if `open-paren-in-column-0-is-defun-start' exists and
1156 ;; isn't buggy.
1157 (when (boundp 'open-paren-in-column-0-is-defun-start)
1158 (let ((open-paren-in-column-0-is-defun-start nil)
1159 (parse-sexp-ignore-comments t))
1160 (delete-region (point-min) (point-max))
1161 (set-syntax-table (make-syntax-table))
1162 (modify-syntax-entry ?\' "\"")
1163 (cond
1164 ;; XEmacs. Afaik this is currently an Emacs-only
1165 ;; feature, but it's good to be prepared.
1166 ((memq '8-bit list)
1167 (modify-syntax-entry ?/ ". 1456")
1168 (modify-syntax-entry ?* ". 23"))
1169 ;; Emacs
1170 ((memq '1-bit list)
1171 (modify-syntax-entry ?/ ". 124b")
1172 (modify-syntax-entry ?* ". 23")))
1173 (modify-syntax-entry ?\n "> b")
1174 (insert "/* '\n () */")
1175 (backward-sexp)
1176 (if (bobp)
1177 (setq list (cons 'col-0-paren list)))))
1178
1179 (set-buffer-modified-p nil))
1180 (kill-buffer buf))
1181
1182 ;; See if `parse-partial-sexp' returns the eighth element.
1183 (when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10))
1184 (setq list (cons 'pps-extended-state list)))
1185
1186 ;;(message "c-emacs-features: %S" list)
1187 list)
1188 "A list of certain features in the (X)Emacs you are using.
1189There are many flavors of Emacs out there, each with different
1190features supporting those needed by CC Mode. The following values
1191might be present:
1192
1193'8-bit 8 bit syntax entry flags (XEmacs style).
1194'1-bit 1 bit syntax entry flags (Emacs style).
1195'syntax-properties It works to override the syntax for specific characters
1196 in the buffer with the 'syntax-table property.
1197'gen-comment-delim Generic comment delimiters work
1198 (i.e. the syntax class `!').
1199'gen-string-delim Generic string delimiters work
1200 (i.e. the syntax class `|').
1201'pps-extended-state `parse-partial-sexp' returns a list with at least 10
1202 elements, i.e. it contains the position of the
1203 start of the last comment or string.
1204'posix-char-classes The regexp engine understands POSIX character classes.
1205'col-0-paren It's possible to turn off the ad-hoc rule that a paren
1206 in column zero is the start of a defun.
1207'infodock This is Infodock (based on XEmacs).
1208
1209'8-bit and '1-bit are mutually exclusive.")
1210
1211
1060;;; Some helper constants. 1212;;; Some helper constants.
1061 1213
1062;; If the regexp engine supports POSIX char classes (e.g. Emacs 21) 1214;; If the regexp engine supports POSIX char classes then we can use
1063;; then we can use them to handle extended charsets correctly. 1215;; them to handle extended charsets correctly.
1064(if (string-match "[[:alpha:]]" "a") ; Can't use c-emacs-features here. 1216(if (memq 'posix-char-classes c-emacs-features)
1065 (progn 1217 (progn
1066 (defconst c-alpha "[:alpha:]") 1218 (defconst c-alpha "[:alpha:]")
1067 (defconst c-alnum "[:alnum:]") 1219 (defconst c-alnum "[:alnum:]")
@@ -1127,8 +1279,8 @@ system."
1127 (error "The mode name symbol `%s' must end with \"-mode\"" mode)) 1279 (error "The mode name symbol `%s' must end with \"-mode\"" mode))
1128 (put mode 'c-mode-prefix (match-string 1 (symbol-name mode))) 1280 (put mode 'c-mode-prefix (match-string 1 (symbol-name mode)))
1129 (unless (get base-mode 'c-mode-prefix) 1281 (unless (get base-mode 'c-mode-prefix)
1130 (error "Unknown base mode `%s'" base-mode) 1282 (error "Unknown base mode `%s'" base-mode))
1131 (put mode 'c-fallback-mode base-mode))) 1283 (put mode 'c-fallback-mode base-mode))
1132 1284
1133(defvar c-lang-constants (make-vector 151 0)) 1285(defvar c-lang-constants (make-vector 151 0))
1134;; This obarray is a cache to keep track of the language constants 1286;; This obarray is a cache to keep track of the language constants
@@ -1144,7 +1296,6 @@ system."
1144;; various other symbols, but those don't have any variable bindings. 1296;; various other symbols, but those don't have any variable bindings.
1145 1297
1146(defvar c-lang-const-expansion nil) 1298(defvar c-lang-const-expansion nil)
1147(defvar c-langs-are-parametric nil)
1148 1299
1149(defsubst c-get-current-file () 1300(defsubst c-get-current-file ()
1150 ;; Return the base name of the current file. 1301 ;; Return the base name of the current file.
@@ -1585,6 +1736,22 @@ This macro does not do any hidden buffer changes."
1585 1736
1586 c-lang-constants))) 1737 c-lang-constants)))
1587 1738
1739(defun c-lang-major-mode-is (mode)
1740 ;; `c-major-mode-is' expands to a call to this function inside
1741 ;; `c-lang-defconst'. Here we also match the mode(s) against any
1742 ;; fallback modes for the one in `c-buffer-is-cc-mode', so that
1743 ;; e.g. (c-major-mode-is 'c++-mode) is true in a derived language
1744 ;; that has c++-mode as base mode.
1745 (unless (listp mode)
1746 (setq mode (list mode)))
1747 (let (match (buf-mode c-buffer-is-cc-mode))
1748 (while (if (memq buf-mode mode)
1749 (progn
1750 (setq match t)
1751 nil)
1752 (setq buf-mode (get buf-mode 'c-fallback-mode))))
1753 match))
1754
1588 1755
1589(cc-provide 'cc-defs) 1756(cc-provide 'cc-defs)
1590 1757
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 2e907589304..ea36064412f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1270,7 +1270,7 @@ This function does not do any hidden buffer changes."
1270 1270
1271 (when (and (= beg end) 1271 (when (and (= beg end)
1272 (get-text-property beg 'c-in-sws) 1272 (get-text-property beg 'c-in-sws)
1273 (not (bobp)) 1273 (> beg (point-min))
1274 (get-text-property (1- beg) 'c-in-sws)) 1274 (get-text-property (1- beg) 'c-in-sws))
1275 ;; Ensure that an `c-in-sws' range gets broken. Note that it isn't 1275 ;; Ensure that an `c-in-sws' range gets broken. Note that it isn't
1276 ;; safe to keep a range that was continuous before the change. E.g: 1276 ;; safe to keep a range that was continuous before the change. E.g:
@@ -1906,7 +1906,7 @@ This function does not do any hidden buffer changes."
1906 (if last-pos 1906 (if last-pos
1907 ;; Prepare to loop, but record the open paren only if it's 1907 ;; Prepare to loop, but record the open paren only if it's
1908 ;; outside a macro or within the same macro as point, and 1908 ;; outside a macro or within the same macro as point, and
1909 ;; if it is a "real" open paren and not some character 1909 ;; if it is a legitimate open paren and not some character
1910 ;; that got an open paren syntax-table property. 1910 ;; that got an open paren syntax-table property.
1911 (progn 1911 (progn
1912 (setq pos last-pos) 1912 (setq pos last-pos)
@@ -1914,7 +1914,11 @@ This function does not do any hidden buffer changes."
1914 (save-excursion 1914 (save-excursion
1915 (goto-char last-pos) 1915 (goto-char last-pos)
1916 (not (c-beginning-of-macro)))) 1916 (not (c-beginning-of-macro))))
1917 (= (char-syntax (char-before last-pos)) ?\()) 1917 ;; Check for known types of parens that we want
1918 ;; to record. The syntax table is not to be
1919 ;; trusted here since the caller might be using
1920 ;; e.g. `c++-template-syntax-table'.
1921 (memq (char-before last-pos) '(?{ ?\( ?\[)))
1918 (setq c-state-cache (cons (1- last-pos) c-state-cache)))) 1922 (setq c-state-cache (cons (1- last-pos) c-state-cache))))
1919 1923
1920 (if (setq last-pos (c-up-list-forward pos)) 1924 (if (setq last-pos (c-up-list-forward pos))
@@ -2124,7 +2128,7 @@ This function does not do any hidden buffer changes."
2124 (when (c-major-mode-is 'pike-mode) 2128 (when (c-major-mode-is 'pike-mode)
2125 ;; Handle the `<operator> syntax in Pike. 2129 ;; Handle the `<operator> syntax in Pike.
2126 (let ((pos (point))) 2130 (let ((pos (point)))
2127 (skip-chars-backward "!%&*+\\-/<=>^|~[]()") 2131 (skip-chars-backward "-!%&*+/<=>^|~[]()")
2128 (and (if (< (skip-chars-backward "`") 0) 2132 (and (if (< (skip-chars-backward "`") 0)
2129 t 2133 t
2130 (goto-char pos) 2134 (goto-char pos)
@@ -2144,7 +2148,7 @@ This function does not do any hidden buffer changes."
2144 (and (c-major-mode-is 'pike-mode) 2148 (and (c-major-mode-is 'pike-mode)
2145 ;; Handle the `<operator> syntax in Pike. 2149 ;; Handle the `<operator> syntax in Pike.
2146 (let ((pos (point))) 2150 (let ((pos (point)))
2147 (if (and (< (skip-chars-backward "!%&*+\\-/<=>^|~[]()") 0) 2151 (if (and (< (skip-chars-backward "-!%&*+/<=>^|~[]()") 0)
2148 (< (skip-chars-backward "`") 0) 2152 (< (skip-chars-backward "`") 0)
2149 (looking-at c-symbol-key) 2153 (looking-at c-symbol-key)
2150 (>= (match-end 0) pos)) 2154 (>= (match-end 0) pos))
@@ -2384,8 +2388,11 @@ outside any comment, macro or string literal, or else the content of
2384that region is taken as syntactically significant text. 2388that region is taken as syntactically significant text.
2385 2389
2386If PAREN-LEVEL is non-nil, an additional restriction is added to 2390If PAREN-LEVEL is non-nil, an additional restriction is added to
2387ignore matches in nested paren sexps, and the search will also not go 2391ignore matches in nested paren sexps. The search will also not go
2388outside the current paren sexp. 2392outside the current list sexp, which has the effect that if the point
2393should be moved to BOUND when no match is found \(i.e. NOERROR is
2394neither nil nor t), then it will be at the closing paren if the end of
2395the current list sexp is encountered first.
2389 2396
2390If NOT-INSIDE-TOKEN is non-nil, matches in the middle of tokens are 2397If NOT-INSIDE-TOKEN is non-nil, matches in the middle of tokens are
2391ignored. Things like multicharacter operators and special symbols 2398ignored. Things like multicharacter operators and special symbols
@@ -2401,11 +2408,15 @@ subexpression is never tested before the starting position, so it
2401might be a good idea to include \\=\\= as a match alternative in it. 2408might be a good idea to include \\=\\= as a match alternative in it.
2402 2409
2403Optimization note: Matches might be missed if the \"look behind\" 2410Optimization note: Matches might be missed if the \"look behind\"
2404subexpression should match the end of nonwhite syntactic whitespace, 2411subexpression can match the end of nonwhite syntactic whitespace,
2405i.e. the end of comments or cpp directives. This since the function 2412i.e. the end of comments or cpp directives. This since the function
2406skips over such things before resuming the search. It's also not safe 2413skips over such things before resuming the search. It's on the other
2407to assume that the \"look behind\" subexpression never can match 2414hand not safe to assume that the \"look behind\" subexpression never
2408syntactic whitespace." 2415matches syntactic whitespace.
2416
2417Bug: Unbalanced parens inside cpp directives are currently not handled
2418correctly \(i.e. they don't get ignored as they should) when
2419PAREN-LEVEL is set."
2409 2420
2410 (or bound (setq bound (point-max))) 2421 (or bound (setq bound (point-max)))
2411 (if paren-level (setq paren-level -1)) 2422 (if paren-level (setq paren-level -1))
@@ -2413,53 +2424,55 @@ syntactic whitespace."
2413 ;;(message "c-syntactic-re-search-forward %s %s %S" (point) bound regexp) 2424 ;;(message "c-syntactic-re-search-forward %s %s %S" (point) bound regexp)
2414 2425
2415 (let ((start (point)) 2426 (let ((start (point))
2416 (pos (point)) 2427 tmp
2428 ;; Start position for the last search.
2429 search-pos
2430 ;; The `parse-partial-sexp' state between the start position
2431 ;; and the point.
2432 state
2433 ;; The current position after the last state update. The next
2434 ;; `parse-partial-sexp' continues from here.
2435 (state-pos (point))
2436 ;; The position at which to check the state and the state
2437 ;; there. This is separate from `state-pos' since we might
2438 ;; need to back up before doing the next search round.
2439 check-pos check-state
2440 ;; Last position known to end a token.
2417 (last-token-end-pos (point-min)) 2441 (last-token-end-pos (point-min))
2418 match-pos found state check-pos check-state tmp) 2442 ;; Set when a valid match is found.
2443 found)
2419 2444
2420 (condition-case err 2445 (condition-case err
2421 (while 2446 (while
2422 (and 2447 (and
2423 (re-search-forward regexp bound noerror) 2448 (progn
2449 (setq search-pos (point))
2450 (re-search-forward regexp bound noerror))
2424 2451
2425 (progn 2452 (progn
2426 (setq match-pos (point) 2453 (setq state (parse-partial-sexp
2427 state (parse-partial-sexp 2454 state-pos (match-beginning 0) paren-level nil state)
2428 pos (match-beginning 0) paren-level nil state) 2455 state-pos (point))
2429 pos (point))
2430 (if (setq check-pos (and lookbehind-submatch 2456 (if (setq check-pos (and lookbehind-submatch
2457 (or (not paren-level)
2458 (>= (car state) 0))
2431 (match-end lookbehind-submatch))) 2459 (match-end lookbehind-submatch)))
2432 (setq check-state (parse-partial-sexp 2460 (setq check-state (parse-partial-sexp
2433 pos check-pos paren-level nil state)) 2461 state-pos check-pos paren-level nil state))
2434 (setq check-pos pos 2462 (setq check-pos state-pos
2435 check-state state)) 2463 check-state state))
2436 2464
2437 ;; If we got a look behind subexpression and get an 2465 ;; NOTE: If we got a look behind subexpression and get
2438 ;; insignificant match in something that isn't 2466 ;; an insignificant match in something that isn't
2439 ;; syntactic whitespace (i.e. strings or in nested 2467 ;; syntactic whitespace (i.e. strings or in nested
2440 ;; parentheses), then we can never skip more than a 2468 ;; parentheses), then we can never skip more than a
2441 ;; single character from the match position before 2469 ;; single character from the match start position
2442 ;; continuing the search. That since the look behind 2470 ;; (i.e. `state-pos' here) before continuing the
2443 ;; subexpression might match the end of the 2471 ;; search. That since the look behind subexpression
2444 ;; insignificant region. 2472 ;; might match the end of the insignificant region in
2473 ;; the next search.
2445 2474
2446 (cond 2475 (cond
2447 ((setq tmp (elt check-state 3))
2448 ;; Match inside a string.
2449 (if (or lookbehind-submatch
2450 (not (integerp tmp)))
2451 (goto-char (min (1+ pos) bound))
2452 ;; Skip to the end of the string before continuing.
2453 (let ((ender (make-string 1 tmp)) (continue t))
2454 (while (if (search-forward ender bound noerror)
2455 (progn
2456 (setq state (parse-partial-sexp
2457 pos (point) nil nil state)
2458 pos (point))
2459 (elt state 3))
2460 (setq continue nil)))
2461 continue)))
2462
2463 ((elt check-state 7) 2476 ((elt check-state 7)
2464 ;; Match inside a line comment. Skip to eol. Use 2477 ;; Match inside a line comment. Skip to eol. Use
2465 ;; `re-search-forward' instead of `skip-chars-forward' to get 2478 ;; `re-search-forward' instead of `skip-chars-forward' to get
@@ -2472,6 +2485,7 @@ syntactic whitespace."
2472 2485
2473 ((and (not (elt check-state 5)) 2486 ((and (not (elt check-state 5))
2474 (eq (char-before check-pos) ?/) 2487 (eq (char-before check-pos) ?/)
2488 (not (c-get-char-property (1- check-pos) 'syntax-table))
2475 (memq (char-after check-pos) '(?/ ?*))) 2489 (memq (char-after check-pos) '(?/ ?*)))
2476 ;; Match in the middle of the opener of a block or line 2490 ;; Match in the middle of the opener of a block or line
2477 ;; comment. 2491 ;; comment.
@@ -2479,20 +2493,57 @@ syntactic whitespace."
2479 (re-search-forward "[\n\r]" bound noerror) 2493 (re-search-forward "[\n\r]" bound noerror)
2480 (search-forward "*/" bound noerror))) 2494 (search-forward "*/" bound noerror)))
2481 2495
2482 ((and not-inside-token 2496 ;; The last `parse-partial-sexp' above might have
2483 (or (< check-pos last-token-end-pos) 2497 ;; stopped short of the real check position if the end
2484 (< check-pos 2498 ;; of the current sexp was encountered in paren-level
2485 (save-excursion 2499 ;; mode. The checks above are always false in that
2486 (goto-char check-pos) 2500 ;; case, and since they can do better skipping in
2487 (save-match-data 2501 ;; lookbehind-submatch mode, we do them before
2488 (c-end-of-current-token last-token-end-pos)) 2502 ;; checking the paren level.
2489 (setq last-token-end-pos (point)))))) 2503
2490 ;; Match inside a token. 2504 ((and paren-level
2491 (cond ((<= (point) bound) 2505 (/= (setq tmp (car check-state)) 0))
2492 (goto-char (min (1+ pos) bound)) 2506 ;; Check the paren level first since we're short of the
2493 t) 2507 ;; syntactic checking position if the end of the
2494 (noerror nil) 2508 ;; current sexp was encountered by `parse-partial-sexp'.
2495 (t (signal 'search-failed "end of token")))) 2509 (if (> tmp 0)
2510
2511 ;; Inside a nested paren sexp.
2512 (if lookbehind-submatch
2513 ;; See the NOTE above.
2514 (progn (goto-char state-pos) t)
2515 ;; Skip out of the paren quickly.
2516 (setq state (parse-partial-sexp state-pos bound 0 nil state)
2517 state-pos (point)))
2518
2519 ;; Have exited the current paren sexp.
2520 (if noerror
2521 (progn
2522 ;; The last `parse-partial-sexp' call above
2523 ;; has left us just after the closing paren
2524 ;; in this case, so we can modify the bound
2525 ;; to leave the point at the right position
2526 ;; upon return.
2527 (setq bound (1- (point)))
2528 nil)
2529 (signal 'search-failed (list regexp)))))
2530
2531 ((setq tmp (elt check-state 3))
2532 ;; Match inside a string.
2533 (if (or lookbehind-submatch
2534 (not (integerp tmp)))
2535 ;; See the NOTE above.
2536 (progn (goto-char state-pos) t)
2537 ;; Skip to the end of the string before continuing.
2538 (let ((ender (make-string 1 tmp)) (continue t))
2539 (while (if (search-forward ender bound noerror)
2540 (progn
2541 (setq state (parse-partial-sexp
2542 state-pos (point) nil nil state)
2543 state-pos (point))
2544 (elt state 3))
2545 (setq continue nil)))
2546 continue)))
2496 2547
2497 ((save-excursion 2548 ((save-excursion
2498 (save-match-data 2549 (save-match-data
@@ -2501,48 +2552,52 @@ syntactic whitespace."
2501 (c-end-of-macro) 2552 (c-end-of-macro)
2502 (cond ((<= (point) bound) t) 2553 (cond ((<= (point) bound) t)
2503 (noerror nil) 2554 (noerror nil)
2504 (t (signal 'search-failed "end of macro")))) 2555 (t (signal 'search-failed (list regexp)))))
2505 2556
2506 ((and paren-level 2557 ((and not-inside-token
2507 (/= (setq tmp (car check-state)) 0)) 2558 (or (< check-pos last-token-end-pos)
2508 (if (> tmp 0) 2559 (< check-pos
2509 ;; Match inside a nested paren sexp. 2560 (save-excursion
2510 (if lookbehind-submatch 2561 (goto-char check-pos)
2511 (goto-char (min (1+ pos) bound)) 2562 (save-match-data
2512 ;; Skip out of the paren quickly. 2563 (c-end-of-current-token last-token-end-pos))
2513 (setq state (parse-partial-sexp pos bound 0 nil state) 2564 (setq last-token-end-pos (point))))))
2514 pos (point))) 2565 ;; Inside a token.
2515 ;; Have exited the current paren sexp. The 2566 (if lookbehind-submatch
2516 ;; `parse-partial-sexp' above has left us just after the 2567 ;; See the NOTE above.
2517 ;; closing paren in this case. Just make 2568 (goto-char state-pos)
2518 ;; `re-search-forward' above fail in the appropriate way; 2569 (goto-char (min last-token-end-pos bound))))
2519 ;; we'll adjust the leave off point below if necessary.
2520 (setq bound (point))))
2521 2570
2522 (t 2571 (t
2523 ;; A real match. 2572 ;; A real match.
2524 (setq found t) 2573 (setq found t)
2525 nil))))) 2574 nil)))
2575
2576 ;; Should loop to search again, but take care to avoid
2577 ;; looping on the same spot.
2578 (or (/= search-pos (point))
2579 (if (= (point) bound)
2580 (if noerror
2581 nil
2582 (signal 'search-failed (list regexp)))
2583 (forward-char)
2584 t))))
2526 2585
2527 (error 2586 (error
2528 (goto-char start) 2587 (goto-char start)
2529 (signal (car err) (cdr err)))) 2588 (signal (car err) (cdr err))))
2530 2589
2531 ;;(message "c-syntactic-re-search-forward done %s" (or match-pos (point))) 2590 ;;(message "c-syntactic-re-search-forward done %s" (or (match-end 0) (point)))
2532 2591
2533 (if found 2592 (if found
2534 (progn 2593 (progn
2535 (goto-char match-pos) 2594 (goto-char (match-end 0))
2536 match-pos) 2595 (match-end 0))
2537 2596
2538 ;; Search failed. Set point as appropriate. 2597 ;; Search failed. Set point as appropriate.
2539 (cond ((eq noerror t) 2598 (if (eq noerror t)
2540 (goto-char start)) 2599 (goto-char start)
2541 (paren-level 2600 (goto-char bound))
2542 (if (eq (car (parse-partial-sexp pos bound -1 nil state)) -1)
2543 (backward-char)))
2544 (t
2545 (goto-char bound)))
2546 nil))) 2601 nil)))
2547 2602
2548(defun c-syntactic-skip-backward (skip-chars &optional limit) 2603(defun c-syntactic-skip-backward (skip-chars &optional limit)
@@ -4030,12 +4085,13 @@ This function does not do any hidden buffer changes."
4030(defun c-forward-type () 4085(defun c-forward-type ()
4031 ;; Move forward over a type spec if at the beginning of one, 4086 ;; Move forward over a type spec if at the beginning of one,
4032 ;; stopping at the next following token. Return t if it's a known 4087 ;; stopping at the next following token. Return t if it's a known
4033 ;; type that can't be a name, 'known if it's an otherwise known type 4088 ;; type that can't be a name or other expression, 'known if it's an
4034 ;; (according to `*-font-lock-extra-types'), 'prefix if it's a known 4089 ;; otherwise known type (according to `*-font-lock-extra-types'),
4035 ;; prefix of a type, 'found if it's a type that matches one in 4090 ;; 'prefix if it's a known prefix of a type, 'found if it's a type
4036 ;; `c-found-types', 'maybe if it's an identfier that might be a 4091 ;; that matches one in `c-found-types', 'maybe if it's an identfier
4037 ;; type, or nil if it can't be a type (the point isn't moved then). 4092 ;; that might be a type, or nil if it can't be a type (the point
4038 ;; The point is assumed to be at the beginning of a token. 4093 ;; isn't moved then). The point is assumed to be at the beginning
4094 ;; of a token.
4039 ;; 4095 ;;
4040 ;; Note that this function doesn't skip past the brace definition 4096 ;; Note that this function doesn't skip past the brace definition
4041 ;; that might be considered part of the type, e.g. 4097 ;; that might be considered part of the type, e.g.
@@ -4199,11 +4255,14 @@ This function does not do any hidden buffer changes."
4199 ;; don't let the existence of the operator itself promote two 4255 ;; don't let the existence of the operator itself promote two
4200 ;; uncertain types to a certain one. 4256 ;; uncertain types to a certain one.
4201 (cond ((eq res t)) 4257 (cond ((eq res t))
4202 ((or (eq res 'known) (memq res2 '(t known))) 4258 ((eq res2 t)
4203 (c-add-type id-start id-end) 4259 (c-add-type id-start id-end)
4204 (when c-record-type-identifiers 4260 (when c-record-type-identifiers
4205 (c-record-type-id id-range)) 4261 (c-record-type-id id-range))
4206 (setq res t)) 4262 (setq res t))
4263 ((eq res 'known))
4264 ((eq res2 'known)
4265 (setq res 'known))
4207 ((eq res 'found)) 4266 ((eq res 'found))
4208 ((eq res2 'found) 4267 ((eq res2 'found)
4209 (setq res 'found)) 4268 (setq res 'found))
@@ -4526,7 +4585,8 @@ brace."
4526 4585
4527 ;; `c-beginning-of-statement-1' stops at a block start, but we 4586 ;; `c-beginning-of-statement-1' stops at a block start, but we
4528 ;; want to continue if the block doesn't begin a top level 4587 ;; want to continue if the block doesn't begin a top level
4529 ;; construct, i.e. if it isn't preceded by ';', '}', ':', or bob. 4588 ;; construct, i.e. if it isn't preceded by ';', '}', ':', bob,
4589 ;; or an open paren.
4530 (let ((beg (point)) tentative-move) 4590 (let ((beg (point)) tentative-move)
4531 (while (and 4591 (while (and
4532 ;; Must check with c-opt-method-key in ObjC mode. 4592 ;; Must check with c-opt-method-key in ObjC mode.
@@ -4536,6 +4596,9 @@ brace."
4536 (progn 4596 (progn
4537 (c-backward-syntactic-ws lim) 4597 (c-backward-syntactic-ws lim)
4538 (not (memq (char-before) '(?\; ?} ?: nil)))) 4598 (not (memq (char-before) '(?\; ?} ?: nil))))
4599 (save-excursion
4600 (backward-char)
4601 (not (looking-at "\\s(")))
4539 ;; Check that we don't move from the first thing in a 4602 ;; Check that we don't move from the first thing in a
4540 ;; macro to its header. 4603 ;; macro to its header.
4541 (not (eq (setq tentative-move 4604 (not (eq (setq tentative-move
@@ -4972,33 +5035,44 @@ brace."
4972 (condition-case () 5035 (condition-case ()
4973 (save-excursion 5036 (save-excursion
4974 (let ((beg (point)) 5037 (let ((beg (point))
4975 end type) 5038 inner-beg end type)
4976 (c-forward-syntactic-ws) 5039 (c-forward-syntactic-ws)
4977 (if (eq (char-after) ?\() 5040 (if (eq (char-after) ?\()
4978 (progn 5041 (progn
4979 (forward-char 1) 5042 (forward-char 1)
4980 (c-forward-syntactic-ws) 5043 (c-forward-syntactic-ws)
5044 (setq inner-beg (point))
4981 (setq type (assq (char-after) c-special-brace-lists))) 5045 (setq type (assq (char-after) c-special-brace-lists)))
4982 (if (setq type (assq (char-after) c-special-brace-lists)) 5046 (if (setq type (assq (char-after) c-special-brace-lists))
4983 (progn 5047 (progn
5048 (setq inner-beg (point))
4984 (c-backward-syntactic-ws) 5049 (c-backward-syntactic-ws)
4985 (forward-char -1) 5050 (forward-char -1)
4986 (setq beg (if (eq (char-after) ?\() 5051 (setq beg (if (eq (char-after) ?\()
4987 (point) 5052 (point)
4988 nil))))) 5053 nil)))))
4989 (if (and beg type) 5054 (if (and beg type)
4990 (if (and (c-safe (goto-char beg) 5055 (if (and (c-safe
4991 (c-forward-sexp 1) 5056 (goto-char beg)
4992 (setq end (point)) 5057 (c-forward-sexp 1)
4993 (= (char-before) ?\))) 5058 (setq end (point))
4994 (c-safe (goto-char beg) 5059 (= (char-before) ?\)))
4995 (forward-char 1) 5060 (c-safe
5061 (goto-char inner-beg)
5062 (if (looking-at "\\s(")
5063 ;; Check balancing of the inner paren
5064 ;; below.
5065 (progn
4996 (c-forward-sexp 1) 5066 (c-forward-sexp 1)
4997 ;; Kludges needed to handle inner 5067 t)
4998 ;; chars both with and without 5068 ;; If the inner char isn't a paren then
4999 ;; paren syntax. 5069 ;; we can't check balancing, so just
5000 (or (/= (char-syntax (char-before)) ?\)) 5070 ;; check the char before the outer
5001 (= (char-before) (cdr type))))) 5071 ;; closing paren.
5072 (goto-char end)
5073 (backward-char)
5074 (c-backward-syntactic-ws)
5075 (= (char-before) (cdr type)))))
5002 (if (or (/= (char-syntax (char-before)) ?\)) 5076 (if (or (/= (char-syntax (char-before)) ?\))
5003 (= (progn 5077 (= (progn
5004 (c-forward-syntactic-ws) 5078 (c-forward-syntactic-ws)
@@ -6272,7 +6346,7 @@ This function does not do any hidden buffer changes."
6272 (goto-char containing-sexp) 6346 (goto-char containing-sexp)
6273 (setq placeholder (c-point 'boi)) 6347 (setq placeholder (c-point 'boi))
6274 (if (and (c-safe (backward-up-list 1) t) 6348 (if (and (c-safe (backward-up-list 1) t)
6275 (> (point) placeholder)) 6349 (>= (point) placeholder))
6276 (progn 6350 (progn
6277 (forward-char) 6351 (forward-char)
6278 (skip-chars-forward " \t")) 6352 (skip-chars-forward " \t"))
@@ -6313,7 +6387,7 @@ This function does not do any hidden buffer changes."
6313 (goto-char containing-sexp) 6387 (goto-char containing-sexp)
6314 (setq placeholder (c-point 'boi)) 6388 (setq placeholder (c-point 'boi))
6315 (when (and (c-safe (backward-up-list 1) t) 6389 (when (and (c-safe (backward-up-list 1) t)
6316 (> (point) placeholder)) 6390 (>= (point) placeholder))
6317 (forward-char) 6391 (forward-char)
6318 (skip-chars-forward " \t") 6392 (skip-chars-forward " \t")
6319 (setq placeholder (point))) 6393 (setq placeholder (point)))
@@ -6354,7 +6428,7 @@ This function does not do any hidden buffer changes."
6354 (goto-char containing-sexp) 6428 (goto-char containing-sexp)
6355 (setq placeholder (c-point 'boi)) 6429 (setq placeholder (c-point 'boi))
6356 (if (and (c-safe (backward-up-list 1) t) 6430 (if (and (c-safe (backward-up-list 1) t)
6357 (> (point) placeholder)) 6431 (>= (point) placeholder))
6358 (progn 6432 (progn
6359 (forward-char) 6433 (forward-char)
6360 (skip-chars-forward " \t")) 6434 (skip-chars-forward " \t"))
@@ -6830,6 +6904,10 @@ This function does not do any hidden buffer changes."
6830 ((vectorp offset) offset) 6904 ((vectorp offset) offset)
6831 ((null offset) nil) 6905 ((null offset) nil)
6832 ((listp offset) 6906 ((listp offset)
6907 (if (eq (car offset) 'quote)
6908 (error
6909"Setting in c-offsets-alist element \"(%s . '%s)\" was mistakenly quoted"
6910 symbol (cadr offset)))
6833 (let (done) 6911 (let (done)
6834 (while (and (not done) offset) 6912 (while (and (not done) offset)
6835 (setq done (c-evaluate-offset (car offset) langelem symbol) 6913 (setq done (c-evaluate-offset (car offset) langelem symbol)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 27c604b3f33..c5bbfaf86dd 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -574,33 +574,65 @@ casts and declarations are fontified. Used on level 2 and higher."
574 ;; Fontify leading identifiers in fully qualified names like 574 ;; Fontify leading identifiers in fully qualified names like
575 ;; "foo::bar" in languages that supports such things. 575 ;; "foo::bar" in languages that supports such things.
576 ,@(when (c-lang-const c-opt-identifier-concat-key) 576 ,@(when (c-lang-const c-opt-identifier-concat-key)
577 `((,(byte-compile 577 (if (c-major-mode-is 'java-mode)
578 ;; Must use a function here since we match longer 578 ;; Java needs special treatment since "." is used both to
579 ;; than we want to move before doing a new search. 579 ;; qualify names and in normal indexing. Here we look for
580 ;; This is not necessary for XEmacs >= 20 since it 580 ;; capital characters at the beginning of an identifier to
581 ;; restarts the search from the end of the first 581 ;; recognize the class. "*" is also recognized to cover
582 ;; highlighted submatch (something that causes 582 ;; wildcard import declarations. All preceding dot separated
583 ;; problems in other places). 583 ;; identifiers are taken as package names and therefore
584 `(lambda (limit) 584 ;; fontified as references.
585 (while (re-search-forward 585 `(,(c-make-font-lock-search-function
586 ,(concat "\\(\\<" ; 1 586 ;; Search for class identifiers preceded by ".". The
587 "\\(" (c-lang-const c-symbol-key) "\\)" ; 2 587 ;; anchored matcher takes it from there.
588 "[ \t\n\r\f\v]*" 588 (concat (c-lang-const c-opt-identifier-concat-key)
589 (c-lang-const c-opt-identifier-concat-key) 589 "[ \t\n\r\f\v]*"
590 "[ \t\n\r\f\v]*" 590 (concat "\\("
591 "\\)" 591 "[" c-upper "][" (c-lang-const c-symbol-chars) "]*"
592 "\\(" 592 "\\|"
593 (c-lang-const c-opt-after-id-concat-key) 593 "\\*"
594 "\\)") 594 "\\)"))
595 limit t) 595 `((let (id-end)
596 (unless (progn 596 (goto-char (1+ (match-beginning 0)))
597 (goto-char (match-beginning 0)) 597 (while (and (eq (char-before) ?.)
598 (c-skip-comments-and-strings limit)) 598 (progn
599 (or (get-text-property (match-beginning 2) 'face) 599 (backward-char)
600 (c-put-font-lock-face (match-beginning 2) 600 (c-backward-syntactic-ws)
601 (match-end 2) 601 (setq id-end (point))
602 c-reference-face-name)) 602 (< (skip-chars-backward
603 (goto-char (match-end 1))))))))) 603 ,(c-lang-const c-symbol-chars)) 0))
604 (not (get-text-property (point) 'face)))
605 (c-put-font-lock-face (point) id-end c-reference-face-name)
606 (c-backward-syntactic-ws)))
607 nil
608 (goto-char (match-end 0)))))
609
610 `((,(byte-compile
611 ;; Must use a function here since we match longer than we
612 ;; want to move before doing a new search. This is not
613 ;; necessary for XEmacs >= 20 since it restarts the search
614 ;; from the end of the first highlighted submatch (something
615 ;; that causes problems in other places).
616 `(lambda (limit)
617 (while (re-search-forward
618 ,(concat "\\(\\<" ; 1
619 "\\(" (c-lang-const c-symbol-key) "\\)" ; 2
620 "[ \t\n\r\f\v]*"
621 (c-lang-const c-opt-identifier-concat-key)
622 "[ \t\n\r\f\v]*"
623 "\\)"
624 "\\("
625 (c-lang-const c-opt-after-id-concat-key)
626 "\\)")
627 limit t)
628 (unless (progn
629 (goto-char (match-beginning 0))
630 (c-skip-comments-and-strings limit))
631 (or (get-text-property (match-beginning 2) 'face)
632 (c-put-font-lock-face (match-beginning 2)
633 (match-end 2)
634 c-reference-face-name))
635 (goto-char (match-end 1))))))))))
604 636
605 ;; Fontify the special declarations in Objective-C. 637 ;; Fontify the special declarations in Objective-C.
606 ,@(when (c-major-mode-is 'objc-mode) 638 ,@(when (c-major-mode-is 'objc-mode)
@@ -787,17 +819,19 @@ casts and declarations are fontified. Used on level 2 and higher."
787 (<= (point) limit) 819 (<= (point) limit)
788 820
789 ;; Search syntactically to the end of the declarator (";", 821 ;; Search syntactically to the end of the declarator (";",
790 ;; ",", ")", ">" (for <> arglists), eob etc) or to the 822 ;; ",", a closen paren, eob etc) or to the beginning of an
791 ;; beginning of an initializer or function prototype ("=" 823 ;; initializer or function prototype ("=" or "\\s\(").
792 ;; or "\\s\("). 824 ;; Note that the open paren will match array specs in
825 ;; square brackets, and we treat them as initializers too.
793 (c-syntactic-re-search-forward 826 (c-syntactic-re-search-forward
794 "[\];,\{\}\[\)>]\\|\\'\\|\\(=\\|\\(\\s\(\\)\\)" limit t t)) 827 "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t))
795 828
796 (setq next-pos (match-beginning 0) 829 (setq next-pos (match-beginning 0)
797 id-face (if (match-beginning 2) 830 id-face (if (eq (char-after next-pos) ?\()
798 'font-lock-function-name-face 831 'font-lock-function-name-face
799 'font-lock-variable-name-face) 832 'font-lock-variable-name-face)
800 got-init (match-beginning 1)) 833 got-init (and (match-beginning 1)
834 (char-after (match-beginning 1))))
801 835
802 (if types 836 (if types
803 ;; Register and fontify the identifer as a type. 837 ;; Register and fontify the identifer as a type.
@@ -828,9 +862,17 @@ casts and declarations are fontified. Used on level 2 and higher."
828 (goto-char limit))) 862 (goto-char limit)))
829 863
830 (got-init 864 (got-init
831 ;; Skip an initializer expression. 865 ;; Skip an initializer expression. If we're at a '='
832 (if (c-syntactic-re-search-forward "[;,]" limit 'move t) 866 ;; then accept a brace list directly after it to cope
833 (backward-char))) 867 ;; with array initializers. Otherwise stop at braces
868 ;; to avoid going past full function and class blocks.
869 (and (if (and (eq got-init ?=)
870 (= (c-forward-token-2) 0)
871 (looking-at "{"))
872 (c-safe (c-forward-sexp) t)
873 t)
874 (c-syntactic-re-search-forward "[;,{]" limit 'move t)
875 (backward-char)))
834 876
835 (t (c-forward-syntactic-ws limit))) 877 (t (c-forward-syntactic-ws limit)))
836 878
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 19555b37527..6aeb70ba4e3 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -374,6 +374,12 @@ identifiers, or nil in languages that don't have such things. Does
374not contain a \\| operator at the top level." 374not contain a \\| operator at the top level."
375 t nil 375 t nil
376 c++ "::" 376 c++ "::"
377 ;; Java has "." to concatenate identifiers but it's also used for
378 ;; normal indexing. There's special code in the Java font lock
379 ;; rules to fontify qualified identifiers based on the standard
380 ;; naming conventions. We still define "." here to make
381 ;; `c-forward-name' move over as long names as possible which is
382 ;; necessary to e.g. handle throws clauses correctly.
377 java "\\." 383 java "\\."
378 idl "::" 384 idl "::"
379 pike "\\(::\\|\\.\\)") 385 pike "\\(::\\|\\.\\)")
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 13ffd310fce..1a26e54bf06 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -355,6 +355,8 @@ when used elsewhere."
355 (completing-read prompt c-style-alist nil t 355 (completing-read prompt c-style-alist nil t
356 (cons c-indentation-style 0) 356 (cons c-indentation-style 0)
357 'c-set-style-history)))))) 357 'c-set-style-history))))))
358 (or (stringp stylename)
359 (error "Argument to c-set-style was not a string"))
358 (c-initialize-builtin-style) 360 (c-initialize-builtin-style)
359 (let ((vars (c-get-style-variables stylename nil))) 361 (let ((vars (c-get-style-variables stylename nil)))
360 (unless dont-override 362 (unless dont-override
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index f21531c2f22..2ed23f8ef86 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -271,12 +271,12 @@ nil."
271 271
272(defcustom c-tab-always-indent t 272(defcustom c-tab-always-indent t
273 "*Controls the operation of the TAB key. 273 "*Controls the operation of the TAB key.
274If t, hitting TAB always just indents the current line. If nil, 274If t, hitting TAB always just indents the current line. If nil, hitting
275hitting TAB indents the current line if point is at the left margin or 275TAB indents the current line if point is at the left margin or in the
276in the line's indentation, otherwise it insert a `real' tab character 276line's indentation, otherwise it inserts a `real' tab character \(see
277\(see note\). If the symbol `other', then tab is inserted only within 277note\). If some other value (not nil or t), then tab is inserted only
278literals -- defined as comments and strings -- and inside preprocessor 278within literals \(comments and strings), but the line is always
279directives, but the line is always reindented. 279reindented.
280 280
281Note: The value of `indent-tabs-mode' will determine whether a real 281Note: The value of `indent-tabs-mode' will determine whether a real
282tab character will be inserted, or the equivalent number of spaces. 282tab character will be inserted, or the equivalent number of spaces.
@@ -1546,140 +1546,6 @@ Set from `c-comment-prefix-regexp' at mode initialization.")
1546(make-variable-buffer-local 'c-current-comment-prefix) 1546(make-variable-buffer-local 'c-current-comment-prefix)
1547 1547
1548 1548
1549;; Figure out what features this Emacs has
1550
1551(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
1552
1553(defconst c-emacs-features
1554 (let (list)
1555
1556 (if (boundp 'infodock-version)
1557 ;; I've no idea what this actually is, but it's legacy. /mast
1558 (setq list (cons 'infodock list)))
1559
1560 ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags.
1561 ;; Emacs 19 uses a 1-bit flag. We will have to set up our
1562 ;; syntax tables differently to handle this.
1563 (let ((table (copy-syntax-table))
1564 entry)
1565 (modify-syntax-entry ?a ". 12345678" table)
1566 (cond
1567 ;; XEmacs 19, and beyond Emacs 19.34
1568 ((arrayp table)
1569 (setq entry (aref table ?a))
1570 ;; In Emacs, table entries are cons cells
1571 (if (consp entry) (setq entry (car entry))))
1572 ;; XEmacs 20
1573 ((fboundp 'get-char-table) (setq entry (get-char-table ?a table)))
1574 ;; before and including Emacs 19.34
1575 ((and (fboundp 'char-table-p)
1576 (char-table-p table))
1577 (setq entry (car (char-table-range table [?a]))))
1578 ;; incompatible
1579 (t (error "CC Mode is incompatible with this version of Emacs")))
1580 (setq list (cons (if (= (logand (lsh entry -16) 255) 255)
1581 '8-bit
1582 '1-bit)
1583 list)))
1584
1585 (let ((buf (generate-new-buffer " test"))
1586 parse-sexp-lookup-properties
1587 parse-sexp-ignore-comments
1588 lookup-syntax-properties)
1589 (save-excursion
1590 (set-buffer buf)
1591 (set-syntax-table (make-syntax-table))
1592
1593 ;; For some reason we have to set some of these after the
1594 ;; buffer has been made current. (Specifically,
1595 ;; `parse-sexp-ignore-comments' in Emacs 21.)
1596 (setq parse-sexp-lookup-properties t
1597 parse-sexp-ignore-comments t
1598 lookup-syntax-properties t)
1599
1600 ;; Find out if the `syntax-table' text property works.
1601 (modify-syntax-entry ?< ".")
1602 (modify-syntax-entry ?> ".")
1603 (insert "<()>")
1604 (c-mark-<-as-paren 1)
1605 (c-mark->-as-paren 4)
1606 (goto-char 1)
1607 (c-forward-sexp)
1608 (if (= (point) 5)
1609 (setq list (cons 'syntax-properties list)))
1610
1611 ;; Find out if generic comment delimiters work.
1612 (c-safe
1613 (modify-syntax-entry ?x "!")
1614 (if (string-match "\\s!" "x")
1615 (setq list (cons 'gen-comment-delim list))))
1616
1617 ;; Find out if generic string delimiters work.
1618 (c-safe
1619 (modify-syntax-entry ?x "|")
1620 (if (string-match "\\s|" "x")
1621 (setq list (cons 'gen-string-delim list))))
1622
1623 ;; See if `open-paren-in-column-0-is-defun-start' exists and
1624 ;; isn't buggy.
1625 (when (boundp 'open-paren-in-column-0-is-defun-start)
1626 (let ((open-paren-in-column-0-is-defun-start nil)
1627 (parse-sexp-ignore-comments t))
1628 (set-syntax-table (make-syntax-table))
1629 (modify-syntax-entry ?\' "\"")
1630 (cond
1631 ;; XEmacs. Afaik this is currently an Emacs-only
1632 ;; feature, but it's good to be prepared.
1633 ((memq '8-bit list)
1634 (modify-syntax-entry ?/ ". 1456")
1635 (modify-syntax-entry ?* ". 23"))
1636 ;; Emacs
1637 ((memq '1-bit list)
1638 (modify-syntax-entry ?/ ". 124b")
1639 (modify-syntax-entry ?* ". 23")))
1640 (modify-syntax-entry ?\n "> b")
1641 (insert "/* '\n () */")
1642 (backward-sexp)
1643 (if (bobp)
1644 (setq list (cons 'col-0-paren list))))
1645 (kill-buffer buf))
1646
1647 (set-buffer-modified-p nil))
1648 (kill-buffer buf))
1649
1650 ;; See if `parse-partial-sexp' returns the eighth element.
1651 (when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10))
1652 (setq list (cons 'pps-extended-state list)))
1653
1654 ;; See if POSIX char classes work.
1655 (when (string-match "[[:alpha:]]" "a")
1656 (setq list (cons 'posix-char-classes list)))
1657
1658 list)
1659 "A list of certain features in the (X)Emacs you are using.
1660There are many flavors of Emacs out there, each with different
1661features supporting those needed by CC Mode. The following values
1662might be present:
1663
1664'8-bit 8 bit syntax entry flags (XEmacs style).
1665'1-bit 1 bit syntax entry flags (Emacs style).
1666'syntax-properties It works to override the syntax for specific characters
1667 in the buffer with the 'syntax-table property.
1668'gen-comment-delim Generic comment delimiters work
1669 (i.e. the syntax class `!').
1670'gen-string-delim Generic string delimiters work
1671 (i.e. the syntax class `|').
1672'pps-extended-state `parse-partial-sexp' returns a list with at least 10
1673 elements, i.e. it contains the position of the
1674 start of the last comment or string.
1675'posix-char-classes The regexp engine understands POSIX character classes.
1676'col-0-paren It's possible to turn off the ad-hoc rule that a paren
1677 in column zero is the start of a defun.
1678'infodock This is Infodock (based on XEmacs).
1679
1680'8-bit and '1-bit are mutually exclusive.")
1681
1682
1683(cc-provide 'cc-vars) 1549(cc-provide 'cc-vars)
1684 1550
1685;;; arch-tag: d62e9a55-c9fe-409b-b5b6-050b6aa202c9 1551;;; arch-tag: d62e9a55-c9fe-409b-b5b6-050b6aa202c9
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 033ce883e5f..32fa246b9f6 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1101,7 +1101,9 @@ from a different message."
1101move point to the error message line and type \\[compile-goto-error]. 1101move point to the error message line and type \\[compile-goto-error].
1102To kill the compilation, type \\[kill-compilation]. 1102To kill the compilation, type \\[kill-compilation].
1103 1103
1104Runs `compilation-mode-hook' with `run-hooks' (which see)." 1104Runs `compilation-mode-hook' with `run-hooks' (which see).
1105
1106\\{compilation-mode-map}"
1105 (interactive) 1107 (interactive)
1106 (kill-all-local-variables) 1108 (kill-all-local-variables)
1107 (use-local-map compilation-mode-map) 1109 (use-local-map compilation-mode-map)
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 7bf9e935710..ecf8da2e509 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -32,7 +32,7 @@
32;; a major mode including an approriate syntax table, keymap, and a 32;; a major mode including an approriate syntax table, keymap, and a
33;; mode-specific pull-down menu. It also provides a sophisticated set 33;; mode-specific pull-down menu. It also provides a sophisticated set
34;; of font-lock patterns, a fancy indentation function adapted from 34;; of font-lock patterns, a fancy indentation function adapted from
35;; AUC-TeX's latex.el, and some basic mode-specific editing functions 35;; AUCTeX's latex.el, and some basic mode-specific editing functions
36;; such as functions to move to the beginning or end of the enclosing 36;; such as functions to move to the beginning or end of the enclosing
37;; environment, or to mark, re-indent, or comment-out environments. 37;; environment, or to mark, re-indent, or comment-out environments.
38;; On the other hand, it doesn't yet provide any functionality for 38;; On the other hand, it doesn't yet provide any functionality for
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index adb5f7b402a..fea1f35a004 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -353,6 +353,11 @@ the car and cdr are the same symbol.")
353(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file)) 353(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
354 "The shell being programmed. This is set by \\[sh-set-shell].") 354 "The shell being programmed. This is set by \\[sh-set-shell].")
355 355
356(defvar sh-mode-abbrev-table nil)
357
358(define-abbrev-table 'sh-mode-abbrev-table ())
359
360
356;; I turned off this feature because it doesn't permit typing commands 361;; I turned off this feature because it doesn't permit typing commands
357;; in the usual way without help. 362;; in the usual way without help.
358;;(defvar sh-abbrevs 363;;(defvar sh-abbrevs
@@ -1483,7 +1488,7 @@ Calls the value of `sh-set-shell-hook' if set."
1483 (setq require-final-newline tem))) 1488 (setq require-final-newline tem)))
1484 (setq 1489 (setq
1485 comment-start-skip "#+[\t ]*" 1490 comment-start-skip "#+[\t ]*"
1486;;; local-abbrev-table (sh-feature sh-abbrevs) 1491 local-abbrev-table sh-mode-abbrev-table
1487 mode-line-process (format "[%s]" sh-shell) 1492 mode-line-process (format "[%s]" sh-shell)
1488 sh-shell-variables nil 1493 sh-shell-variables nil
1489 sh-shell-variables-initialized nil 1494 sh-shell-variables-initialized nil
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 87df0769314..845c995371d 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -186,7 +186,7 @@ It creates the Imenu index for the buffer, if necessary."
186 (which-func-update-1 (selected-window))) 186 (which-func-update-1 (selected-window)))
187 187
188(defun which-func-update-1 (window) 188(defun which-func-update-1 (window)
189 "Update the Which-Function mode display for window WINDOW." 189 "Update the Which Function mode display for window WINDOW."
190 (with-selected-window window 190 (with-selected-window window
191 (when which-func-mode 191 (when which-func-mode
192 (condition-case info 192 (condition-case info
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 1f43e011c62..65106948b67 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -204,69 +204,6 @@ Any other value is treated as nil."
204 (const bdf-font-except-latin) (const :tag "nil" nil)) 204 (const bdf-font-except-latin) (const :tag "nil" nil))
205 :group 'ps-print-font) 205 :group 'ps-print-font)
206 206
207
208(eval-and-compile
209 ;; For Emacs 20.2 and the earlier version.
210 (if (and (boundp 'mule-version)
211 (not (string< (symbol-value 'mule-version) "4.0")))
212 ;; mule package is loaded
213 (progn
214 (defalias 'ps-mule-next-point '1+)
215 (defalias 'ps-mule-chars-in-string 'length)
216 (defalias 'ps-mule-string-char 'aref)
217 (defsubst ps-mule-next-index (str i) (1+ i)))
218 ;; mule package isn't loaded or mule version lesser than 4.0
219 (defun ps-mule-next-point (arg)
220 (save-excursion (goto-char arg) (forward-char 1) (point)))
221 (defun ps-mule-chars-in-string (string)
222 (/ (length string)
223 (charset-bytes (char-charset (string-to-char string)))))
224 (defun ps-mule-string-char (string idx)
225 (string-to-char (substring string idx)))
226 (defun ps-mule-next-index (string i)
227 (+ i (charset-bytes (char-charset (string-to-char string)))))
228 )
229 (if (boundp 'mule-version)
230 ;; For Emacs 20.4 and the earlier version.
231 (if (string< (symbol-value 'mule-version) "5.0")
232 ;; mule package is loaded and mule version is lesser than 5.0
233 (progn
234 (defun encode-composition-rule (rule)
235 (if (= (car rule) 4) (setcar rule 10))
236 (if (= (cdr rule) 4) (setcdr rule 10))
237 (+ (* (car rule) 12) (cdr rule)))
238 (defun ps-mule-search-composition (from to)
239 (save-excursion
240 (goto-char from)
241 (search-forward "\200" to t)))
242 (defun ps-mule-get-composition (pos)
243 (let ((ch (char-after pos)))
244 (and ch (eq (char-charset ch) 'composition)
245 (let ((components
246 (decompose-composite-char ch 'vector t)))
247 (list pos (ps-mule-next-point pos) components
248 (integerp (aref components 1)) nil
249 (char-width ch)))))))
250 (defun ps-mule-search-composition (from to)
251 (let (cmp-info)
252 (while (and (< from to)
253 (setq cmp-info (find-composition from to))
254 (not (nth 2 cmp-info)))
255 (setq from (nth 1 cmp-info)))
256 (< from to)))
257 (defun ps-mule-get-composition (pos)
258 (find-composition pos nil nil t)))
259
260 ;; mule package isn't loaded
261 (or (fboundp 'encode-composition-rule)
262 (defun encode-composition-rule (rule)
263 130))
264 (defun ps-mule-search-composition (&rest ignore)
265 nil)
266 (defun ps-mule-get-composition (&rest ignore)
267 nil)
268 ))
269
270(defvar ps-mule-font-info-database 207(defvar ps-mule-font-info-database
271 nil 208 nil
272 "Alist of charsets with the corresponding font information. 209 "Alist of charsets with the corresponding font information.
diff --git a/lisp/simple.el b/lisp/simple.el
index 8039ed26b39..325fbd8e702 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1628,7 +1628,7 @@ and only used if a buffer is displayed."
1628 1628
1629(defun shell-command-on-region (start end command 1629(defun shell-command-on-region (start end command
1630 &optional output-buffer replace 1630 &optional output-buffer replace
1631 error-buffer) 1631 error-buffer display-error-buffer)
1632 "Execute string COMMAND in inferior shell with region as input. 1632 "Execute string COMMAND in inferior shell with region as input.
1633Normally display output (if any) in temp buffer `*Shell Command Output*'; 1633Normally display output (if any) in temp buffer `*Shell Command Output*';
1634Prefix arg means replace the region with it. Return the exit code of 1634Prefix arg means replace the region with it. Return the exit code of
@@ -1641,10 +1641,10 @@ is encoded in the same coding system that will be used to save the file,
1641`buffer-file-coding-system'. If the output is going to replace the region, 1641`buffer-file-coding-system'. If the output is going to replace the region,
1642then it is decoded from that same coding system. 1642then it is decoded from that same coding system.
1643 1643
1644The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, 1644The noninteractive arguments are START, END, COMMAND,
1645REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding 1645OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
1646systems by binding `coding-system-for-read' and 1646Noninteractive callers can specify coding systems by binding
1647`coding-system-for-write'. 1647`coding-system-for-read' and `coding-system-for-write'.
1648 1648
1649If the command generates output, the output may be displayed 1649If the command generates output, the output may be displayed
1650in the echo area or in a buffer. 1650in the echo area or in a buffer.
@@ -1674,6 +1674,8 @@ around it.
1674If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer 1674If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
1675or buffer name to which to direct the command's standard error output. 1675or buffer name to which to direct the command's standard error output.
1676If it is nil, error output is mingled with regular output. 1676If it is nil, error output is mingled with regular output.
1677If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
1678were any errors. (This is always t, interactively.)
1677In an interactive call, the variable `shell-command-default-error-buffer' 1679In an interactive call, the variable `shell-command-default-error-buffer'
1678specifies the value of ERROR-BUFFER." 1680specifies the value of ERROR-BUFFER."
1679 (interactive (let (string) 1681 (interactive (let (string)
@@ -1691,7 +1693,8 @@ specifies the value of ERROR-BUFFER."
1691 string 1693 string
1692 current-prefix-arg 1694 current-prefix-arg
1693 current-prefix-arg 1695 current-prefix-arg
1694 shell-command-default-error-buffer))) 1696 shell-command-default-error-buffer
1697 t)))
1695 (let ((error-file 1698 (let ((error-file
1696 (if error-buffer 1699 (if error-buffer
1697 (make-temp-file 1700 (make-temp-file
@@ -1800,7 +1803,8 @@ specifies the value of ERROR-BUFFER."
1800 (format-insert-file error-file nil) 1803 (format-insert-file error-file nil)
1801 ;; Put point after the inserted errors. 1804 ;; Put point after the inserted errors.
1802 (goto-char (- (point-max) pos-from-end))) 1805 (goto-char (- (point-max) pos-from-end)))
1803 (display-buffer (current-buffer)))) 1806 (and display-error-buffer
1807 (display-buffer (current-buffer)))))
1804 (delete-file error-file)) 1808 (delete-file error-file))
1805 exit-status)) 1809 exit-status))
1806 1810
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index f8e9386585d..db16f2f78f3 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -92,7 +92,7 @@
92;; into sub-lists. A long flat list can be used instead if needed. 92;; into sub-lists. A long flat list can be used instead if needed.
93;; Other filters can be easily added. 93;; Other filters can be easily added.
94;; 94;;
95;; AUC-TEX users: The imenu tags for AUC-TEX mode doesn't work very 95;; AUCTEX users: The imenu tags for AUCTEX mode doesn't work very
96;; well. Use the imenu keywords from tex-mode.el for better results. 96;; well. Use the imenu keywords from tex-mode.el for better results.
97;; 97;;
98;; This file requires the library package assoc (association lists) 98;; This file requires the library package assoc (association lists)
@@ -665,6 +665,9 @@ useful, such as version control."
665 "*Regexp matching files we don't want displayed in a speedbar buffer. 665 "*Regexp matching files we don't want displayed in a speedbar buffer.
666It is generated from the variable `completion-ignored-extensions'") 666It is generated from the variable `completion-ignored-extensions'")
667 667
668;; Compiler silencing trick. The real defvar comes later in this file.
669(defvar speedbar-file-regexp)
670
668;; this is dangerous to customize, because the defaults will probably 671;; this is dangerous to customize, because the defaults will probably
669;; change in the future. 672;; change in the future.
670(defcustom speedbar-supported-extension-expressions 673(defcustom speedbar-supported-extension-expressions
@@ -689,8 +692,7 @@ file."
689 :type '(repeat (regexp :tag "Extension Regexp")) 692 :type '(repeat (regexp :tag "Extension Regexp"))
690 :set (lambda (sym val) 693 :set (lambda (sym val)
691 (setq speedbar-supported-extension-expressions val 694 (setq speedbar-supported-extension-expressions val
692 speedbar-file-regexp (speedbar-extension-list-to-regex val))) 695 speedbar-file-regexp (speedbar-extension-list-to-regex val))))
693 )
694 696
695(defvar speedbar-file-regexp 697(defvar speedbar-file-regexp
696 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions) 698 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
@@ -698,6 +700,15 @@ file."
698Created from `speedbar-supported-extension-expression' with the 700Created from `speedbar-supported-extension-expression' with the
699function `speedbar-extension-list-to-regex'") 701function `speedbar-extension-list-to-regex'")
700 702
703(defcustom speedbar-scan-subdirs nil
704 "*Non-nil means speedbar will check if subdirs are empty.
705That way you don't have to click on them to find out. But this
706incurs extra I/O, hence it slows down directory display
707proportionally to the number of subdirs."
708 :group 'speedbar
709 :type 'boolean
710 :version 21.4)
711
701(defun speedbar-add-supported-extension (extension) 712(defun speedbar-add-supported-extension (extension)
702 "Add EXTENSION as a new supported extension for speedbar tagging. 713 "Add EXTENSION as a new supported extension for speedbar tagging.
703This should start with a `.' if it is not a complete file name, and 714This should start with a `.' if it is not a complete file name, and
@@ -1287,8 +1298,9 @@ in the selected file.
1287 (toggle-read-only 1) 1298 (toggle-read-only 1)
1288 (speedbar-set-mode-line-format) 1299 (speedbar-set-mode-line-format)
1289 (if speedbar-xemacsp 1300 (if speedbar-xemacsp
1290 (set (make-local-variable 'mouse-motion-handler) 1301 (with-no-warnings
1291 'speedbar-track-mouse-xemacs) 1302 (set (make-local-variable 'mouse-motion-handler)
1303 'speedbar-track-mouse-xemacs))
1292 (if speedbar-track-mouse-flag 1304 (if speedbar-track-mouse-flag
1293 (set (make-local-variable 'track-mouse) t)) ;this could be messy. 1305 (set (make-local-variable 'track-mouse) t)) ;this could be messy.
1294 (setq auto-show-mode nil)) ;no auto-show for Emacs 1306 (setq auto-show-mode nil)) ;no auto-show for Emacs
@@ -1337,7 +1349,8 @@ This gives visual indications of what is up. It EXPECTS the speedbar
1337frame and window to be the currently active frame and window." 1349frame and window to be the currently active frame and window."
1338 (if (and (frame-live-p speedbar-frame) 1350 (if (and (frame-live-p speedbar-frame)
1339 (or (not speedbar-xemacsp) 1351 (or (not speedbar-xemacsp)
1340 (specifier-instance has-modeline-p))) 1352 (with-no-warnings
1353 (specifier-instance has-modeline-p))))
1341 (save-excursion 1354 (save-excursion
1342 (set-buffer speedbar-buffer) 1355 (set-buffer speedbar-buffer)
1343 (let* ((w (or (speedbar-frame-width) 20)) 1356 (let* ((w (or (speedbar-frame-width) 20))
@@ -1538,9 +1551,7 @@ Must be bound to event E."
1538 ;; This gets the cursor where the user can see it. 1551 ;; This gets the cursor where the user can see it.
1539 (if (not (bolp)) (forward-char -1)) 1552 (if (not (bolp)) (forward-char -1))
1540 (sit-for 0) 1553 (sit-for 0)
1541 (if (< emacs-major-version 20) 1554 (mouse-major-mode-menu e nil)))
1542 (mouse-major-mode-menu e)
1543 (mouse-major-mode-menu e nil))))
1544 1555
1545(defun speedbar-hack-buffer-menu (e) 1556(defun speedbar-hack-buffer-menu (e)
1546 "Control mouse 1 is buffer menu. 1557 "Control mouse 1 is buffer menu.
@@ -2185,21 +2196,17 @@ the file-system."
2185 ;; find the directory, either in the cache, or build it. 2196 ;; find the directory, either in the cache, or build it.
2186 (or (cdr-safe (assoc directory speedbar-directory-contents-alist)) 2197 (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
2187 (let ((default-directory directory) 2198 (let ((default-directory directory)
2188 (dir (directory-files directory nil)) 2199 (case-fold-search read-file-name-completion-ignore-case)
2189 (dirs nil) 2200 dirs files)
2190 (files nil)) 2201 (dolist (file (directory-files directory nil))
2191 (while dir 2202 (or (string-match speedbar-file-unshown-regexp file)
2192 (if (not 2203 (string-match speedbar-directory-unshown-regexp file)
2193 (or (string-match speedbar-file-unshown-regexp (car dir)) 2204 (if (file-directory-p file)
2194 (string-match speedbar-directory-unshown-regexp (car dir)))) 2205 (setq dirs (cons file dirs))
2195 (if (file-directory-p (car dir)) 2206 (setq files (cons file files)))))
2196 (setq dirs (cons (car dir) dirs)) 2207 (let ((nl `(,(nreverse dirs) ,(nreverse files))))
2197 (setq files (cons (car dir) files))))
2198 (setq dir (cdr dir)))
2199 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
2200 (aput 'speedbar-directory-contents-alist directory nl) 2208 (aput 'speedbar-directory-contents-alist directory nl)
2201 nl)) 2209 nl))))
2202 ))
2203 2210
2204(defun speedbar-directory-buttons (directory index) 2211(defun speedbar-directory-buttons (directory index)
2205 "Insert a single button group at point for DIRECTORY. 2212 "Insert a single button group at point for DIRECTORY.
@@ -2343,34 +2350,40 @@ position to insert a new item, and that the new item will end with a CR."
2343 2350
2344;;; Build button lists 2351;;; Build button lists
2345;; 2352;;
2346(defun speedbar-insert-files-at-point (files level) 2353(defun speedbar-insert-files-at-point (files level directory)
2347 "Insert list of FILES starting at point, and indenting all files to LEVEL. 2354 "Insert list of FILES starting at point, and indenting all files to LEVEL.
2348Tag expandable items with a +, otherwise a ?. Don't highlight ? as we 2355Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
2349don't know how to manage them. The input parameter FILES is a cons 2356don't know how to manage them. The input parameter FILES is a cons
2350cell of the form ( 'DIRLIST . 'FILELIST )." 2357cell of the form ( 'DIRLIST . 'FILELIST )."
2351 ;; Start inserting all the directories 2358 ;; Start inserting all the directories
2352 (let ((dirs (car files))) 2359 (dolist (dir (car files))
2353 (while dirs 2360 (if (if speedbar-scan-subdirs
2354 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) 2361 (condition-case nil
2355 (car dirs) 'speedbar-dir-follow nil 2362 (let ((l (speedbar-file-lists (concat directory dir))))
2356 'speedbar-directory-face level) 2363 (or (car l) (cadr l)))
2357 (setq dirs (cdr dirs)))) 2364 (file-error))
2358 (let ((lst (car (cdr files))) 2365 (file-readable-p (concat directory dir)))
2359 (case-fold-search t)) 2366 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir
2360 (while lst 2367 dir 'speedbar-dir-follow nil
2361 (let* ((known (string-match speedbar-file-regexp (car lst))) 2368 'speedbar-directory-face level)
2369 (speedbar-make-tag-line 'angle ? nil dir
2370 dir 'speedbar-dir-follow nil
2371 'speedbar-directory-face level)))
2372 (let ((case-fold-search read-file-name-completion-ignore-case))
2373 (dolist (file (cadr files))
2374 (let* ((known (and (file-readable-p (concat directory file))
2375 (string-match speedbar-file-regexp file)))
2362 (expchar (if known ?+ ??)) 2376 (expchar (if known ?+ ??))
2363 (fn (if known 'speedbar-tag-file nil))) 2377 (fn (if known 'speedbar-tag-file nil)))
2364 (if (or speedbar-show-unknown-files (/= expchar ??)) 2378 (if (or speedbar-show-unknown-files (/= expchar ??))
2365 (speedbar-make-tag-line 'bracket expchar fn (car lst) 2379 (speedbar-make-tag-line 'bracket expchar fn file
2366 (car lst) 'speedbar-find-file nil 2380 file 'speedbar-find-file nil
2367 'speedbar-file-face level))) 2381 'speedbar-file-face level))))))
2368 (setq lst (cdr lst)))))
2369 2382
2370(defun speedbar-default-directory-list (directory index) 2383(defun speedbar-default-directory-list (directory index)
2371 "Insert files for DIRECTORY with level INDEX at point." 2384 "Insert files for DIRECTORY with level INDEX at point."
2372 (speedbar-insert-files-at-point 2385 (speedbar-insert-files-at-point
2373 (speedbar-file-lists directory) index) 2386 (speedbar-file-lists directory) index directory)
2374 (speedbar-reset-scanners) 2387 (speedbar-reset-scanners)
2375 (if (= index 0) 2388 (if (= index 0)
2376 ;; If the shown files variable has extra directories, then 2389 ;; If the shown files variable has extra directories, then
@@ -2918,7 +2931,7 @@ updated."
2918 (newcf (if newcfd newcfd)) 2931 (newcf (if newcfd newcfd))
2919 (lastb (current-buffer)) 2932 (lastb (current-buffer))
2920 (sucf-recursive (boundp 'sucf-recursive)) 2933 (sucf-recursive (boundp 'sucf-recursive))
2921 (case-fold-search t)) 2934 (case-fold-search read-file-name-completion-ignore-case))
2922 (if (and newcf 2935 (if (and newcf
2923 ;; check here, that way we won't refresh to newcf until 2936 ;; check here, that way we won't refresh to newcf until
2924 ;; its been written, thus saving ourselves some time 2937 ;; its been written, thus saving ourselves some time
@@ -4235,9 +4248,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
4235 (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec))) 4248 (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
4236 'buffer) 4249 'buffer)
4237 (error nil)) 4250 (error nil))
4238 ,docstring)) 4251 ,docstring)))))
4239
4240)))
4241 4252
4242(defimage-speedbar speedbar-directory-plus 4253(defimage-speedbar speedbar-directory-plus
4243 ((:type xpm :file "sb-dir-plus.xpm" :ascent center)) 4254 ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
@@ -4247,6 +4258,10 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
4247 ((:type xpm :file "sb-dir-minus.xpm" :ascent center)) 4258 ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
4248 "Image used for open directories with stuff in them.") 4259 "Image used for open directories with stuff in them.")
4249 4260
4261(defimage-speedbar speedbar-directory
4262 ((:type xpm :file "sb-dir.xpm" :ascent center))
4263 "Image used for empty or unreadable directories.")
4264
4250(defimage-speedbar speedbar-page-plus 4265(defimage-speedbar speedbar-page-plus
4251 ((:type xpm :file "sb-pg-plus.xpm" :ascent center)) 4266 ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
4252 "Image used for closed files with stuff in them.") 4267 "Image used for closed files with stuff in them.")
@@ -4290,6 +4305,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
4290(defvar speedbar-expand-image-button-alist 4305(defvar speedbar-expand-image-button-alist
4291 '(("<+>" . speedbar-directory-plus) 4306 '(("<+>" . speedbar-directory-plus)
4292 ("<->" . speedbar-directory-minus) 4307 ("<->" . speedbar-directory-minus)
4308 ("< >" . speedbar-directory)
4293 ("[+]" . speedbar-page-plus) 4309 ("[+]" . speedbar-page-plus)
4294 ("[-]" . speedbar-page-minus) 4310 ("[-]" . speedbar-page-minus)
4295 ("[?]" . speedbar-page) 4311 ("[?]" . speedbar-page)
diff --git a/lisp/startup.el b/lisp/startup.el
index b06b3094769..1a37a471c61 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -220,7 +220,7 @@ Setting `init-file-user' does not prevent Emacs from loading
220 "File containing site-wide run-time initializations. 220 "File containing site-wide run-time initializations.
221This file is loaded at run-time before `~/.emacs'. It contains inits 221This file is loaded at run-time before `~/.emacs'. It contains inits
222that need to be in place for the entire site, but which, due to their 222that need to be in place for the entire site, but which, due to their
223higher incidence of change, don't make sense to load into emacs' 223higher incidence of change, don't make sense to load into Emacs's
224dumped image. Thus, the run-time load order is: 1. file described in 224dumped image. Thus, the run-time load order is: 1. file described in
225this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. 225this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
226 226
@@ -293,8 +293,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
293 (let* ((this-dir (car dirs)) 293 (let* ((this-dir (car dirs))
294 (contents (directory-files this-dir)) 294 (contents (directory-files this-dir))
295 (default-directory this-dir) 295 (default-directory this-dir)
296 (canonicalized (and (eq system-type 'windows-nt) 296 (canonicalized (if (fboundp 'untranslated-canonical-name)
297 (untranslated-canonical-name this-dir)))) 297 (untranslated-canonical-name this-dir))))
298 ;; The Windows version doesn't report meaningful inode 298 ;; The Windows version doesn't report meaningful inode
299 ;; numbers, so use the canonicalized absolute file name of the 299 ;; numbers, so use the canonicalized absolute file name of the
300 ;; directory instead. 300 ;; directory instead.
@@ -343,12 +343,14 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
343 ;; Give *Messages* the same default-directory as *scratch*, 343 ;; Give *Messages* the same default-directory as *scratch*,
344 ;; just to keep things predictable. 344 ;; just to keep things predictable.
345 (let ((dir default-directory)) 345 (let ((dir default-directory))
346 (save-excursion 346 (with-current-buffer "*Messages*"
347 (set-buffer (get-buffer "*Messages*"))
348 (setq default-directory dir))) 347 (setq default-directory dir)))
349 ;; `user-full-name' is now known; reset its standard-value here. 348 ;; `user-full-name' is now known; reset its standard-value here.
350 (put 'user-full-name 'standard-value 349 (put 'user-full-name 'standard-value
351 (list (default-value 'user-full-name))) 350 (list (default-value 'user-full-name)))
351 ;; Subprocesses of Emacs do not have direct access to the terminal,
352 ;; so unless told otherwise they should only assume a dumb terminal.
353 (setenv "TERM" "dumb")
352 ;; For root, preserve owner and group when editing files. 354 ;; For root, preserve owner and group when editing files.
353 (if (equal (user-uid) 0) 355 (if (equal (user-uid) 0)
354 (setq backup-by-copying-when-mismatch t)) 356 (setq backup-by-copying-when-mismatch t))
@@ -357,32 +359,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
357 ;; of that dir into load-path, 359 ;; of that dir into load-path,
358 ;; Look for a leim-list.el file too. Loading it will register 360 ;; Look for a leim-list.el file too. Loading it will register
359 ;; available input methods. 361 ;; available input methods.
360 (let ((tail load-path) 362 (dolist (dir load-path)
361 new) 363 (let ((default-directory dir))
362 (while tail 364 (load (expand-file-name "subdirs.el") t t t))
363 (push (car tail) new) 365 (let ((default-directory dir))
364 (condition-case nil 366 (load (expand-file-name "leim-list.el") t t t)))
365 (let ((default-directory (car tail))) 367 (unless (eq system-type 'vax-vms)
366 (load (expand-file-name "subdirs.el" (car tail)) t t t))) 368 ;; If the PWD environment variable isn't accurate, delete it.
367 (condition-case nil 369 (let ((pwd (getenv "PWD")))
368 (let ((default-directory (car tail))) 370 (and (stringp pwd)
369 (load (expand-file-name "leim-list.el" (car tail)) t t t))) 371 ;; Use FOO/., so that if FOO is a symlink, file-attributes
370 (setq tail (cdr tail)))) 372 ;; describes the directory linked to, not FOO itself.
371 (if (not (eq system-type 'vax-vms)) 373 (or (equal (file-attributes
372 (progn 374 (concat (file-name-as-directory pwd) "."))
373 ;; If the PWD environment variable isn't accurate, delete it. 375 (file-attributes
374 (let ((pwd (getenv "PWD"))) 376 (concat (file-name-as-directory default-directory)
375 (and (stringp pwd) 377 ".")))
376 ;; Use FOO/., so that if FOO is a symlink, file-attributes 378 (setq process-environment
377 ;; describes the directory linked to, not FOO itself. 379 (delete (concat "PWD=" pwd)
378 (or (equal (file-attributes 380 process-environment))))))
379 (concat (file-name-as-directory pwd) "."))
380 (file-attributes
381 (concat (file-name-as-directory default-directory)
382 ".")))
383 (setq process-environment
384 (delete (concat "PWD=" pwd)
385 process-environment)))))))
386 (setq default-directory (abbreviate-file-name default-directory)) 381 (setq default-directory (abbreviate-file-name default-directory))
387 (let ((menubar-bindings-done nil)) 382 (let ((menubar-bindings-done nil))
388 (unwind-protect 383 (unwind-protect
diff --git a/lisp/subr.el b/lisp/subr.el
index 5548bf5e590..cadfa3fde34 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1196,7 +1196,7 @@ Optional args SENTINEL and FILTER specify the sentinel and filter
1196 1196
1197(make-obsolete 'process-kill-without-query 1197(make-obsolete 'process-kill-without-query
1198 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'." 1198 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
1199 "21.5") 1199 "21.4")
1200(defun process-kill-without-query (process &optional flag) 1200(defun process-kill-without-query (process &optional flag)
1201 "Say no query needed if PROCESS is running when Emacs is exited. 1201 "Say no query needed if PROCESS is running when Emacs is exited.
1202Optional second argument if non-nil says to require a query. 1202Optional second argument if non-nil says to require a query.
diff --git a/lisp/term.el b/lisp/term.el
index 2e0e3efc189..75b61ea84e9 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -705,18 +705,18 @@ Buffer local variable.")
705 705
706;;; faces -mm 706;;; faces -mm
707 707
708(defcustom term-default-fg-color nil 708(defcustom term-default-fg-color 'unspecified
709 "Default color for foreground in `term'." 709 "Default color for foreground in `term'."
710 :group 'term 710 :group 'term
711 :type 'string) 711 :type 'string)
712 712
713(defcustom term-default-bg-color nil 713(defcustom term-default-bg-color 'unspecified
714 "Default color for background in `term'." 714 "Default color for background in `term'."
715 :group 'term 715 :group 'term
716 :type 'string) 716 :type 'string)
717 717
718(defvar ansi-term-color-vector 718(defvar ansi-term-color-vector
719 [nil "black" "red" "green" "yellow" "blue" 719 [unspecified "black" "red" "green" "yellow" "blue"
720 "magenta" "cyan" "white"]) 720 "magenta" "cyan" "white"])
721 721
722;;; Inspiration came from comint.el -mm 722;;; Inspiration came from comint.el -mm
@@ -3078,8 +3078,7 @@ See `term-prompt-regexp'."
3078 (setq term-current-face 3078 (setq term-current-face
3079 (append '(:underline t) term-current-face)))))) 3079 (append '(:underline t) term-current-face))))))
3080 3080
3081; (message "Debug %S" term-current-face) 3081;;; (message "Debug %S" term-current-face)
3082
3083 (setq term-ansi-face-already-done 0)) 3082 (setq term-ansi-face-already-done 0))
3084 3083
3085 3084
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index ed5bce00f44..83402a68afe 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2213,7 +2213,8 @@ order until succeed.")
2213 (if utf8 2213 (if utf8
2214 (setq text (x-select-utf8-or-ctext utf8 ctext)) 2214 (setq text (x-select-utf8-or-ctext utf8 ctext))
2215 ;; Othewise, choose CTEXT. 2215 ;; Othewise, choose CTEXT.
2216 (setq text ctext)))) 2216 (setq text ctext))
2217 (setq text utf8)))
2217 ;; If not yet decided, try STRING. 2218 ;; If not yet decided, try STRING.
2218 (or text 2219 (or text
2219 (setq text (condition-case nil 2220 (setq text (condition-case nil
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 5238e131ab6..43671f0f725 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1011,8 +1011,7 @@ Mostly we check word delimiters."
1011 (concat "^" word "\n")) 1011 (concat "^" word "\n"))
1012 ;; we mark the ispell process so it can be killed 1012 ;; we mark the ispell process so it can be killed
1013 ;; when emacs is exited without query 1013 ;; when emacs is exited without query
1014 (if (fboundp 'process-kill-without-query) 1014 (set-process-query-on-exit-flag ispell-process nil)
1015 (process-kill-without-query ispell-process))
1016 ;; wait until ispell has processed word 1015 ;; wait until ispell has processed word
1017 (while (progn 1016 (while (progn
1018 (accept-process-output ispell-process) 1017 (accept-process-output ispell-process)
@@ -1065,7 +1064,7 @@ Mostly we check word delimiters."
1065 flyspell-duplicate-distance) 1064 flyspell-duplicate-distance)
1066 t))))) 1065 t)))))
1067 (if flyspell-highlight-flag 1066 (if flyspell-highlight-flag
1068 (flyspell-highlight-duplicate-region start end) 1067 (flyspell-highlight-duplicate-region start end poss)
1069 (message (format "duplicate `%s'" word)))) 1068 (message (format "duplicate `%s'" word))))
1070 (t 1069 (t
1071 ;; incorrect highlight the location 1070 ;; incorrect highlight the location
@@ -1540,8 +1539,9 @@ for the overlay."
1540;*---------------------------------------------------------------------*/ 1539;*---------------------------------------------------------------------*/
1541;* flyspell-highlight-duplicate-region ... */ 1540;* flyspell-highlight-duplicate-region ... */
1542;*---------------------------------------------------------------------*/ 1541;*---------------------------------------------------------------------*/
1543(defun flyspell-highlight-duplicate-region (beg end) 1542(defun flyspell-highlight-duplicate-region (beg end poss)
1544 "Set up an overlay on a duplicated word, in the buffer from BEG to END." 1543 "Set up an overlay on a duplicated word, in the buffer from BEG to END.
1544??? What does POSS mean?"
1545 (let ((inhibit-read-only t)) 1545 (let ((inhibit-read-only t))
1546 (unless (run-hook-with-args-until-success 1546 (unless (run-hook-with-args-until-success
1547 'flyspell-incorrect-hook beg end poss) 1547 'flyspell-incorrect-hook beg end poss)
@@ -1947,7 +1947,6 @@ The word checked is the word at the mouse position."
1947 mouse-pos 1947 mouse-pos
1948 (set-mouse-position (car mouse-pos) 1948 (set-mouse-position (car mouse-pos)
1949 (/ (frame-width) 2) 2) 1949 (/ (frame-width) 2) 2)
1950 (unfocus-frame)
1951 (mouse-position)))) 1950 (mouse-position))))
1952 (setq event (list (list (car (cdr mouse-pos)) 1951 (setq event (list (list (car (cdr mouse-pos))
1953 (1+ (cdr (cdr mouse-pos)))) 1952 (1+ (cdr (cdr mouse-pos))))
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 7b9ad8348ca..534e4e7b27b 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,4 +1,4 @@
1;;; reftex-auc.el --- RefTeX's interface to AUC TeX 1;;; reftex-auc.el --- RefTeX's interface to AUCTeX
2;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc. 2;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc.
3 3
4;; Author: Carsten Dominik <dominik@science.uva.nl> 4;; Author: Carsten Dominik <dominik@science.uva.nl>
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index c35ba53dbaa..7cab20ef81f 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1141,10 +1141,13 @@ on the line for the invalidity you want to see."
1141 'occur-target tem))))) 1141 'occur-target tem)))))
1142 (goto-char prev-end)))) 1142 (goto-char prev-end))))
1143 (with-current-buffer standard-output 1143 (with-current-buffer standard-output
1144 (if (eq num-matches 0) 1144 (let ((no-matches (zerop num-matches)))
1145 (insert "None!\n")) 1145 (if no-matches
1146 (if (interactive-p) 1146 (insert "None!\n"))
1147 (message "%d mismatches found" num-matches)))))) 1147 (if (interactive-p)
1148 (message "%s mismatch%s found"
1149 (if no-matches "No" num-matches)
1150 (if (> num-matches 1) "es" ""))))))))
1148 1151
1149(defun tex-validate-region (start end) 1152(defun tex-validate-region (start end)
1150 "Check for mismatched braces or $'s in region. 1153 "Check for mismatched braces or $'s in region.
@@ -1459,7 +1462,7 @@ Mark is left at original location."
1459 nil) 1462 nil)
1460 (let ((proc (get-process "tex-shell"))) 1463 (let ((proc (get-process "tex-shell")))
1461 (set-process-sentinel proc 'tex-shell-sentinel) 1464 (set-process-sentinel proc 'tex-shell-sentinel)
1462 (process-kill-without-query proc) 1465 (set-process-query-on-exit-flag proc nil)
1463 (tex-shell) 1466 (tex-shell)
1464 (while (zerop (buffer-size)) 1467 (while (zerop (buffer-size))
1465 (sleep-for 1))))) 1468 (sleep-for 1)))))
@@ -1928,7 +1931,7 @@ for the error messages."
1928 (re-search-forward 1931 (re-search-forward
1929 "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move)) 1932 "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move))
1930 (let* ((this-error (copy-marker begin-of-error)) 1933 (let* ((this-error (copy-marker begin-of-error))
1931 (linenum (string-to-int (match-string 1))) 1934 (linenum (string-to-number (match-string 1)))
1932 (error-text (regexp-quote (match-string 3))) 1935 (error-text (regexp-quote (match-string 3)))
1933 (filename 1936 (filename
1934 (save-excursion 1937 (save-excursion
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 82c09cbd435..fafb5eff7cd 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -1,6 +1,7 @@
1;;; vc-svn.el --- non-resident support for Subversion version-control 1;;; vc-svn.el --- non-resident support for Subversion version-control
2 2
3;; Copyright (C) 1995,98,99,2000,2001,02,2003 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004
4;; Free Software Foundation, Inc.
4 5
5;; Author: FSF (see vc.el for full credits) 6;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Stefan Monnier <monnier@gnu.org> 7;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -363,7 +364,10 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
363 (append (vc-switches nil 'diff) '("/dev/null"))) 364 (append (vc-switches nil 'diff) '("/dev/null")))
364 ;; Even if it's empty, it's locally modified. 365 ;; Even if it's empty, it's locally modified.
365 1) 366 1)
366 (let* ((switches (vc-switches 'SVN 'diff)) 367 (let* ((switches
368 (if vc-svn-diff-switches
369 (vc-switches 'SVN 'diff)
370 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
367 (async (and (vc-stay-local-p file) 371 (async (and (vc-stay-local-p file)
368 (or oldvers newvers) ; Svn diffs those locally. 372 (or oldvers newvers) ; Svn diffs those locally.
369 (fboundp 'start-process)))) 373 (fboundp 'start-process))))
@@ -371,8 +375,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
371 (if async 'async 0) 375 (if async 'async 0)
372 file "diff" 376 file "diff"
373 (append 377 (append
374 (when switches 378 switches
375 (list "-x" (mapconcat 'identity switches " ")))
376 (when oldvers 379 (when oldvers
377 (list "-r" (if newvers (concat oldvers ":" newvers) 380 (list "-r" (if newvers (concat oldvers ":" newvers)
378 oldvers))))) 381 oldvers)))))
@@ -504,5 +507,5 @@ essential information."
504 507
505(provide 'vc-svn) 508(provide 'vc-svn)
506 509
507;;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d 510;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
508;;; vc-svn.el ends here 511;;; vc-svn.el ends here
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index e330febf938..40a234f02d6 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -820,6 +820,9 @@ If timer is not set, then set it to scan the files in
820 (setq whitespace-rescan-timer nil)))) 820 (setq whitespace-rescan-timer nil))))
821 821
822;;;###autoload 822;;;###autoload
823(defalias 'global-whitespace-mode 'whitespace-global-mode)
824
825;;;###autoload
823(define-minor-mode whitespace-global-mode 826(define-minor-mode whitespace-global-mode
824 "Toggle using Whitespace mode in new buffers. 827 "Toggle using Whitespace mode in new buffers.
825With ARG, turn the mode on iff ARG is positive. 828With ARG, turn the mode on iff ARG is positive.