Merge semi21-D20010129.
[elisp/lemi.git] / mail / feedmail.el
1 ;;; feedmail.el --- assist other email packages to massage outgoing messages
2 ;;; This file is in the public domain.
3
4 ;; Author: Bill Carpenter <bill@bubblegum.net>, <bill@carpenter.ORG>
5 ;; Version: 8
6 ;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
7 ;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html>
8
9 ;;; Commentary:
10
11 ;; A replacement for parts of Emacs' sendmail.el (specifically,
12 ;; it's what handles your outgoing mail after you hit C-c C-c in mail
13 ;; mode).  See below for a list of additional features, including the
14 ;; ability to queue messages for later sending.  If you are using
15 ;; fakemail as a subprocess, you can switch to feedmail and eliminate
16 ;; the use of fakemail.  feedmail works with recent versions of
17 ;; Emacs (mostly, but not exclusively, tested against 19.34 on
18 ;; Win95; some testing on 20.x) and XEmacs (tested with 20.4 and
19 ;; later betas).  It probably no longer works with Emacs 18,
20 ;; though I haven't tried that in a long time.  Sorry, no manual yet
21 ;; in this release.  Look for one with the next release.
22
23 ;; As far as I'm concerned, anyone can do anything they want with
24 ;; this specific piece of code.  No warranty or promise of support is
25 ;; offered.  This code is hereby released into the public domain.
26
27 ;; Thanks: My thanks to the many people who have sent me suggestions
28 ;;    and fixes over time, as well as those who have tested many beta
29 ;;    iterations.  Some are cited in comments in code fragments below,
30 ;;    but that doesn't correlate well with the list of folks who have
31 ;;    actually helped me along the way.
32
33 ;; If you use feedmail, I invite you to send me some email about it.
34 ;; I appreciate feedback about problems you find or suggestions for
35 ;; improvements or added features (even though I can't predict when
36 ;; I'll incorporate changes).  It's also OK with me if you send me a
37 ;; note along the lines of "I use feedmail and find it useful" or "I
38 ;; tried feedmail and didn't find it useful, so I stopped using it".
39 ;;
40 ;; It is most useful, when sending a bug report, if you tell me what
41 ;; version of Emacs you are using, what version of feedmail you are
42 ;; using, and what versions of other email-related elisp packages you
43 ;; are using.  If in doubt about any of that, send the bug report
44 ;; anyhow.
45 ;;
46 ;; =====
47 ;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE...  Since it is PD,
48 ;; you're within your rights to do whatever you want.  If you do
49 ;; publish a new version with your changes in it, please (1) insert
50 ;; lisp comments describing the changes, (2) insert lisp comments
51 ;; that clearly delimit where your changes are, (3) email me a copy
52 ;; (I can't always consistently follow the relevant usenet groups),
53 ;; and (4) use a version number that is based on the version you're
54 ;; changing along with something that indicates you changed it.  For
55 ;; example,
56 ;;
57 ;;        (defconst feedmail-patch-level "123")
58 ;;        (defconst feedmail-patch-level "123-XYZ-mods")
59 ;;
60 ;; The point of the last item, of course, is to try to minimize
61 ;; confusion.  Odds are good that if your idea makes sense to me that
62 ;; it will show up in some future version of feedmail, though it's
63 ;; hard to say when releases will tumble out.
64 ;; =====
65 ;;
66 ;; This file requires the mail-utils library.
67 ;;
68 ;; This file requires the smtpmail library if you use
69 ;; feedmail-buffer-to-smtpmail.
70 ;;
71 ;; This file requires the custom library.  Unfortunately, there are
72 ;; two incompatible versions of the custom library.  If you don't have
73 ;; custom or you have the old version, this file will still load and
74 ;; work properly.  If you don't know what custom is all about and want
75 ;; to edit your user option elisp variables the old fashioned way,
76 ;; just imagine that all the "defcustom" stuff you see below is really
77 ;; "defvar", and ignore everthing else.  For info about custom, see
78 ;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
79 ;;
80 ;; This code does in elisp a superset of the stuff that used to be done
81 ;; by the separate program "fakemail" for processing outbound email.
82 ;; In other words, it takes over after you hit "C-c C-c" in mail mode.
83 ;; By appropriate setting of options, you can still use "fakemail",
84 ;; or you can even revert to sendmail (which is not too popular
85 ;; locally).  See the variables at the top of the elisp for how to
86 ;; achieve these effects (there are more features than in this bullet
87 ;; list, so trolling through the variable and function doc strings may
88 ;; be worth your while):
89 ;;
90 ;;    --- you can park outgoing messages into a disk-based queue and
91 ;;        stimulate sending them all later (handy for laptop users);
92 ;;        there is also a queue for draft messages
93 ;;
94 ;;    --- you can get one last look at the prepped outbound message and
95 ;;        be prompted for confirmation
96 ;;
97 ;;    --- removes Bcc:/Resent-Bcc: headers after getting address info
98 ;;
99 ;;    --- does smart filling of address headers
100 ;;
101 ;;    --- calls a routine to process Fcc: lines and removes them
102 ;;
103 ;;    --- empty headers are removed
104 ;;
105 ;;    --- can force From: or Sender: line
106 ;;
107 ;;    --- can generate a Message-Id: line
108 ;;
109 ;;    --- can generate a Date: line; the date can be the time the
110 ;;        message was written or the time it is being sent
111 ;;
112 ;;    --- strips comments from address info (both "()" and "<>" are
113 ;;        handled via a call to mail-strip-quoted-names); the
114 ;;        comments are stripped in the simplified address list given
115 ;;        to a subprocess, not in the headers in the mail itself
116 ;;        (they are left unchanged, modulo smart filling)
117 ;;
118 ;;    --- error info is pumped into a normal buffer instead of the
119 ;;        minibuffer
120 ;;
121 ;;    --- just before the optional prompt for confirmation, lets you
122 ;;        run a hook on the prepped message and simplified address
123 ;;        list
124 ;;
125 ;;    --- you can specify something other than /bin/mail for the
126 ;;        subprocess
127 ;;
128 ;;    --- you can generate/modify an X-Mailer: message header
129 ;;
130 ;; After a long list of options below, you will find the function
131 ;; feedmail-send-it. Hers's the best way to use the stuff in this
132 ;; file:
133 ;;
134 ;; Save this file as feedmail.el somewhere on your elisp
135 ;; loadpath; byte-compile it.  Put the following lines somewhere in
136 ;; your ~/.emacs stuff:
137 ;;
138 ;;     (setq send-mail-function 'feedmail-send-it)
139 ;;     (autoload 'feedmail-send-it "feedmail")
140 ;;
141 ;; If you plan to use the queue stuff, also use this:
142 ;;
143 ;;     (setq feedmail-enable-queue t)
144 ;;     (autoload 'feedmail-run-the-queue "feedmail")
145 ;;     (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
146 ;;     (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
147 ;;
148 ;; If you are using the desktop.el library to restore your sessions, you might
149 ;; like to add the suffix ".fqm" to the list of non-saved things via the variable
150 ;; desktop-files-not-to-save.
151 ;;
152 ;; If you are planning to call feedmail-queue-reminder from your .emacs or
153 ;; something similar, you might need this:
154 ;;
155 ;;     (autoload 'feedmail-queue-reminder "feedmail")
156 ;;
157 ;; If you ever use rmail-resend and queue messages, you should do this:
158 ;;
159 ;;     (setq feedmail-queue-alternative-mail-header-separator "")
160 ;;
161 ;; If you want to automatically spell-check messages, but not when sending
162 ;; them from the queue, you could do something like this:
163 ;;
164 ;;     (autoload 'feedmail-mail-send-hook-splitter "feedmail")
165 ;;     (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
166 ;;     (add-hook 'feedmail-mail-send-hook 'ispell-message)
167 ;;
168 ;; If you are using message-mode to compose and send mail, feedmail will
169 ;; probably work fine with that (someone else tested it and told me it worked).
170 ;; Follow the directions above, but make these adjustments instead:
171 ;;
172 ;;     (setq message-send-mail-function 'feedmail-send-it)
173 ;;     (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
174 ;;
175 ;; I think the LCD is no longer being updated, but if it were, this
176 ;; would be a proper LCD record.  There is an old version of
177 ;; feedmail.el in the LCD archive.  It works but is missing a lot of
178 ;; features.
179 ;;
180 ;; LCD record:
181 ;; feedmail|Bill Carpenter|bill@bubblegum.net,bill@carpenter.ORG|Outbound mail queue handling|98-06-15|8|feedmail.el
182 ;;
183 ;; Change log:
184 ;; original,      31 March 1991
185 ;; patchlevel 1,   5 April 1991
186 ;; patchlevel 2,  24 May   1991
187 ;; 5-may-92  jwz        Conditionalized calling expand-mail-aliases, since that
188 ;;                      function doesn't exist in Lucid Emacs or when using
189 ;;                      mail-abbrevs.el.
190 ;; patchlevel 3,   3 October 1996
191 ;;         added queue stuff; still works in v18
192 ;; patchlevel 4, issued by someone else
193 ;; patchlevel 5, issued by someone else
194 ;; patchlevel 6, not issued as far as I know
195 ;; patchlevel 7,  20 May 1997
196 ;;         abandon futile support of Emacs 18 (sorry if that hurts you)
197 ;;         provide a Date: header by default
198 ;;         provide a default for generating Message-Id: header contents
199 ;;            and use it by default (slightly changed API)
200 ;;         return value from feedmail-run-the-queue
201 ;;         new wrapper function feedmail-run-the-queue-no-prompts
202 ;;         user-mail-address as default for From:
203 ;;         properly deal with Resent-{To,Cc,Bcc}
204 ;;         Bcc and Resent-* now included in smart filling
205 ;;         limited support for a "drafts" directory
206 ;;         user-configurable default message action
207 ;;         allow timeout for confirmation prompt (where available)
208 ;;         move Fcc handling to as late as possible to get max
209 ;;            header munging in the saved file
210 ;;         work around sendmail.el's prompts when working from queue
211 ;;         more reliably detect voluntary user bailouts
212 ;;         offer to save modified buffers visiting queue files
213 ;;         offer to delete old file copies of messages being queued
214 ;;         offer to delete queue files when sending immediately
215 ;;         queue filename convention preserves queue order
216 ;;         default queue and draft directory names that work on VMS
217 ;;         deduced address list now really a list, not a string (API change)
218 ;;         no more address buffer
219 ;;         when sending immediately, brief reminder of queue/draft counts
220 ;;         copy trace of smtpmail stuff to feedmail error buffer on no-go
221 ;;         more granularity on when to confirm sending
222 ;;         pause a bit for errors while running queue
223 ;;         try to clean up some pesky auto-save files from the
224 ;;            queue/draft directories
225 ;;         feedmail-force-expand-mail-aliases in case you can't figure
226 ;;            any other way
227 ;;         cleanup some of my sloppiness about case-fold-search (a strange
228 ;;            variable)
229 ;;         best effort following coding conventions from Emacs
230 ;;            elisp manual appendix
231 ;;         "customize" (see custom.el)
232 ;;         when user selects "immediate send", clear action prompt since
233 ;;            hooks may take a while to operate, and user may think the
234 ;;            response didn't take
235 ;;         fixes to the argument conventions for the
236 ;;            feedmail-queue-runner-* functions; allows
237 ;;            feedmail-run-the-queue[-no-prompts] to properly be called
238 ;;            non-interactively
239 ;;         eliminate reliance on directory-sep-char and feedmail-sep-thing
240 ;;         tweak smart filling (reminded of comma problem by levitte@lp.se)
241 ;;         option to control writing in text vs binary mode
242 ;; patchlevel 8, 15 June 1998
243 ;;         reliable re-editing of text-mode (vs binary) queued messages
244 ;;         user option to keep Bcc: in Fcc: copy (keep by default)
245 ;;         user option to delete body from Fcc: copy (keep by default)
246 ;;         feedmail-deduce-bcc-where for envelope (API change for
247 ;;           feedmail-deduce-address list)
248 ;;         feedmail-queue-alternative-mail-header-separator
249 ;;         at message action prompt, "I"/"S" bypass message confirmation prompt
250 ;;         feedmail-mail-send-hook-splitter, feedmail-mail-send-hook,
251 ;;           feedmail-mail-send-hook-queued
252 ;;         user can supply stuff for message action prompt
253 ;;         variable feedmail-queue-runner-confirm-global, function feedmail-run-the-queue-global-prompt
254 ;;         bugfix: absolute argument to directory-files (tracked down for me
255 ;;           by gray@austin.apc.slb.com (Douglas Gray Stephens)); relative
256 ;;           pathnames can tickle stuff in ange-ftp remote directories
257 ;;           (perhaps because feedmail is careless about its working
258 ;;           directory)
259 ;;         feedmail-deduce-envelope-from
260 ;;         always supply envelope "from" (user-mail-address) to sendmail
261 ;;         feedmail-message-id-suffix
262 ;;         feedmail-queue-reminder, feedmail-queue-reminder-alist (after suggestions
263 ;;           and/or code fragments from tonyl@Eng.Sun.COM (Tony Lam) and
264 ;;           burge@newvision.com (Shane Burgess); bumped up the default value of
265 ;;           feedmail-queue-chatty-sit-for since info is more complex sometimes
266 ;;         feedmail-enable-spray (individual transmissions, crude mailmerge)
267 ;;         blank Subject: no longer a special case; see feedmail-nuke-empty-headers
268 ;;         fiddle-plexes data structure used lots of places; see feedmail-fiddle-plex-blurb
269 ;;         feedmail-fiddle-plex-user-list
270 ;;         feedmail-is-a-resend
271 ;;         honor mail-from-style in constructing default for feedmail-from-line
272 ;;         re-implement feedmail-from-line and feedmail-sender-line with
273 ;;           fiddle-plexes; slightly modified semantics for feedmail-sender-line
274 ;;         feedmail-queue-default-file-slug; tidy up some other slug details
275 ;;         feedmail-queue-auto-file-nuke
276 ;;         feedmail-queue-express-to-queue and feedmail-queue-express-to-draft
277 ;;         strong versions of "q"ueue and "d"raft answers (always make a new file)
278 ;;
279 ;; todo (probably in patchlevel 9):
280 ;;         write texinfo manual
281 ;;         maybe partition into multiple files, including files of examples
282 ;;
283 ;;; Code:
284
285 (defconst feedmail-patch-level "8")
286
287
288 ;; from <URL:http://www.dina.kvl.dk/~abraham/custom/>:
289 ;; If you write software that must work without the new custom, you
290 ;; can use this hack stolen from w3-cus.el:
291 (eval-and-compile
292   (condition-case ()
293       (require 'custom)
294     (error nil))
295   (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
296       nil ;; We've got what we needed
297     ;; We have the old custom-library, hack around it!
298     (defmacro defgroup (&rest args)
299       nil)
300     (defmacro defcustom (var value doc &rest args)
301       (` (defvar (, var) (, value) (, doc))))))
302
303 (eval-when-compile (require 'smtpmail))
304 (autoload 'mail-do-fcc "sendmail")
305
306 (defgroup feedmail nil
307   "Assist other email packages to massage outgoing messages."
308   :link '(url-link "http://www.carpenter.org/feedmail/feedmail.html")
309   :link '(emacs-commentary "feedmail")
310   :group 'mail)
311
312 (defgroup feedmail-misc nil
313   "Miscellaneous feedmail options that don't fit in other groups."
314   :group 'feedmail)
315
316 (defgroup feedmail-headers nil
317   "Options related to manipulating specific headers or types of headers."
318   :group 'feedmail)
319
320 (defgroup feedmail-queue nil
321   "Options related to queuing messages for later sending."
322   :group 'feedmail)
323
324
325 (defcustom feedmail-confirm-outgoing nil
326   "*If non-nil, give a y-or-n confirmation prompt before sending mail.
327 This is done after the message is completely prepped, and you'll be
328 looking at the top of the message in a buffer when you get the prompt.
329 If set to the symbol 'queued, give the confirmation prompt only while
330 running the queue (however, the prompt is always suppressed if you are
331 processing the queue via feedmail-run-the-queue-no-prompts).  If set
332 to the symbol 'immediate, give the confirmation prompt only when
333 sending immediately.  For any other non-nil value, prompt in both
334 cases.  You can give a timeout for the prompt; see variable
335 feedmail-confirm-outgoing-timeout."
336   :group 'feedmail-misc
337   :type 'boolean
338   )
339
340
341 (defcustom feedmail-confirm-outgoing-timeout nil
342   "*If non-nil, a timeout in seconds at the send confirmation prompt.
343 If a positive number, it's a timeout before sending.  If a negative
344 number, it's a timeout before not sending.  This will not work if your
345 version of Emacs doesn't include the function y-or-n-p-with-timeout
346 \(e.g., some versions of XEmacs\)."
347   :group 'feedmail-misc
348   :type '(choice (const nil) integer)
349   )
350
351
352 (defcustom feedmail-nuke-bcc t
353   "*If non-nil remove Bcc: lines from the message headers.
354 In any case, the Bcc: lines do participate in the composed address
355 list.  You may want to leave them in if you're using sendmail
356 \(see feedmail-buffer-eating-function\)."
357   :group 'feedmail-headers
358   :type 'boolean
359   )
360
361
362 (defcustom feedmail-nuke-resent-bcc t
363   "*If non-nil remove Resent-Bcc: lines from the message headers.
364 In any case, the Resent-Bcc: lines do participate in the composed
365 address list.  You may want to leave them in if you're using sendmail
366 \(see feedmail-buffer-eating-function\)."
367   :group 'feedmail-headers
368   :type 'boolean
369   )
370
371
372 (defcustom feedmail-deduce-bcc-where nil
373   "*Where Bcc:/Resent-Bcc: addresses should appear in the envelope list.
374 Addresses for the message envelope are deduced by examining
375 appropriate address headers in the message.  Generally, they will show
376 up in the list of deduced addresses in the order that the headers
377 happen to appear (duplicate addresses are eliminated in any case).
378 This variable can be set to the symbol 'first, in which case the
379 Bcc:/Resent-Bcc: addresses will appear at the beginning in the list;
380 or, it can be set to the symbol 'last, in which case they will appear
381 at the end of the list.
382
383 Why should you care?  Well, maybe you don't, and certainly the same
384 things could be accomplished by affecting the order of message headers
385 in the outgoing message.  Some people use Bcc: as a way of getting
386 their own \"come back\" copy of each message they send.  If Bcc:
387 addresses are not handled first, there can be substantial delays in
388 seeing the message again.  Some configurations of sendmail, for example,
389 seem to try to deliver to each addressee at least once, immediately
390 and serially, so slow SMTP conversations can add up to a delay.  There
391 is an option for either 'first or 'last because you might have a
392 delivery agent that processes the addresses backwards."
393   :group 'feedmail-headers
394   :type 'boolean
395   )
396
397
398 (defcustom feedmail-fill-to-cc t
399   "*If non-nil do smart filling of addressee header lines.
400 Smart filling means breaking long lines at appropriate points and
401 making continuation lines.  Despite the function name, it includes
402 To:, Cc:, Bcc: (and their Resent-* forms), as well as From: and
403 Reply-To: (though they seldom need it).  If nil, the lines are left
404 as-is.  The filling is done after mail address alias expansion."
405   :group 'feedmail-headers
406   :type 'boolean
407   )
408
409
410 (defcustom feedmail-fill-to-cc-fill-column default-fill-column
411   "*Fill column used by feedmail-fill-to-cc."
412   :group 'feedmail-headers
413   :type 'integer
414   )
415
416
417 (defcustom feedmail-nuke-bcc-in-fcc nil
418   "*If non-nil remove [Resent-]Bcc: lines in message copies saved via Fcc:.
419 This is independent of whether the Bcc: header lines are actually sent
420 with the message (see feedmail-nuke-bcc).  Though not implied in the name,
421 the same Fcc: treatment applies to both Bcc: and Resent-Bcc: lines."
422   :group 'feedmail-headers
423   :type 'boolean
424   )
425
426
427 (defcustom feedmail-nuke-body-in-fcc nil
428   "*If non-nil remove body of message in copies saved via Fcc:.
429 If an positive integer value, leave (up to) that many lines of the
430 beginning of the body intact.  The result is that the Fcc: copy will
431 consist only of the message headers, serving as a sort of an outgoing
432 message log."
433   :group 'feedmail-headers
434   :type '(choice (const nil) (const t) integer)
435   )
436
437
438 (defcustom feedmail-force-expand-mail-aliases nil
439   "*If non-nil, force the calling of `expand-mail-aliases'.
440 Normally, feedmail tries to figure out if you're using mailalias or
441 mailabbrevs and only calls `expand-mail-aliases' if it thinks you're
442 using the mailalias package.  This user option can be used to force
443 the issue since there are configurations which fool the figuring
444 out."
445   :group 'feedmail-headers
446   :type 'boolean
447   )
448
449
450 (defcustom feedmail-nuke-empty-headers t
451   "*If non-nil, remove header lines which have no contents.
452 A completely empty Subject: header is always removed, regardless of
453 the setting of this variable.  The only time you would want them left
454 in would be if you used some headers whose presence indicated
455 something rather than their contents.  This is rare in Internet email
456 but common in some proprietary systems."
457   :group 'feedmail-headers
458   :type 'boolean
459   )
460
461 ;; wjc sez:  I think the use of the Sender: line is pretty pointless,
462 ;; but I left it in to be compatible with sendmail.el and because
463 ;; maybe some distant mail system needs it.  Really, though, if you
464 ;; want a sender line in your mail, just put one in there and don't
465 ;; wait for feedmail to do it for you.  (Yes, I know all about
466 ;; RFC-822 and RFC-1123, but are you *really* one of those cases
467 ;; they're talking about?  I doubt it.)
468 (defcustom feedmail-sender-line nil
469   "*If non-nil and the email has no Sender: header, use this value.
470 May be nil, in which case nothing in particular is done with respect
471 to Sender: lines.  By design, will not replace an existing Sender:
472 line, but you can achieve that with a fiddle-plex 'replace action.
473 NB: it makes no sense to use the value t since there is no sensible
474 default for Sender:.
475
476 If not nil, it may be a string, a fiddle-plex, or a function which
477 returns either nil, t, a string, or a fiddle-plex (or, in fact,
478 another function, but let's not be ridiculous).  If a string, it
479 should be just the contents of the header, not the name of the header
480 itself nor the trailing newline.  If a function, it will be called
481 with no arguments.  For an explanation of fiddle-plexes, see the
482 documentation for the variable feedmail-fiddle-plex-blurb.  In all
483 cases the name element of the fiddle-plex is ignored and is hardwired
484 by feedmail to either \"X-Sender\" or \"X-Resent-Sender\".
485
486 You can probably leave this nil, but if you feel like using it, a good
487 value would be a string of a fully-qualified domain name form of your
488 address.  For example, \"bill@bubblegum.net (WJCarpenter)\".  The Sender:
489 header is fiddled after the From: header is fiddled."
490   :group 'feedmail-headers
491   :type '(choice (const nil) string)
492   )
493
494
495 (defcustom feedmail-force-binary-write t
496   "*If non-nil, force writing file as binary (this applies to queues and Fcc:).
497 On systems where there is a difference between binary and text files,
498 feedmail will temporarily manipulate the values of `buffer-file-type'
499 and/or default-buffer-file-type to make the writing as binary.  If
500 nil, writing will be in text mode.  On systems where there is no
501 distinction or where it is controlled by other variables or other
502 means, this option has no effect."
503   :group 'feedmail-misc
504   :type 'boolean
505   )
506
507
508 (defcustom feedmail-from-line t
509   "*If non-nil and the email has no From: header, use this value.
510 May be t, in which case a default is computed (and you probably won't
511 be happy with it).  May be nil, in which case nothing in particular is
512 done with respect to From: lines.  By design, will not replace an
513 existing From: line, but you can achieve that with a fiddle-plex 'replace
514 action.
515
516 If neither nil nor t, it may be a string, a fiddle-plex, or a function
517 which returns either nil, t, a string, or a fiddle-plex (or, in fact,
518 another function, but let's not be ridiculous).  If a string, it
519 should be just the contents of the header, not the name of the header
520 itself nor the trailing newline.  If a function, it will be called
521 with no arguments.  For an explanation of fiddle-plexes, see the
522 documentation for the variable feedmail-fiddle-plex-blurb.  In all
523 cases the name element of the fiddle-plex is ignored and is hardwired
524 by feedmail to either \"X-From\" or \"X-Resent-From\".
525
526 A good value would be a string fully-qualified domain name form of
527 your address.  For example, \"bill@bubblegum.net (WJCarpenter)\".  The
528 default value of this variable uses the standard elisp variable
529 `user-mail-address' which should be set on every system but has a decent
530 chance of being wrong.  It also honors `mail-from-style'.  Better to set
531 this variable explicitly to the string you want or find some other way
532 to arrange for the message to get a From: line."
533   :group 'feedmail-headers
534   :type '(choice (const t) (const nil) string)
535   )
536
537
538 (defcustom feedmail-deduce-envelope-from t
539   "*If non-nil, deduce message envelope \"from\" from header From: or Sender:.
540 In other words, if there is a Sender: header in the message, temporarily
541 change the value of `user-mail-address' to be the same while the message
542 is being sent.  If there is no Sender: header, use the From: header,
543 if any.  Address values are taken from the actual message just before
544 it is sent, and the process is independent of the values of
545 feedmail-from-line and/or feedmail-sender-line.
546
547 There are many and good reasons for having the message header
548 From:/Sender: be different from the message envelope \"from\"
549 information.  However, for most people and for most circumstances, it
550 is usual for them to be the same (this is probably especially true for
551 the case where the user doesn't understand the difference between the
552 two in the first place).
553
554 The idea behind this feature is that you can have everything set up
555 some normal way for yourself.  If for some reason you want to send a
556 message with another From: line, you can just type it at the top of
557 the message, and feedmail will take care of \"fixing up\" the envelope
558 \"from\".  This only works for mail senders which make use of
559 `user-mail-address' as the envelope \"from\" value.  For some mail
560 senders (e.g., feedmail-buffer-to-bin-mail), there is no simple way to
561 influence what they will use as the envelope."
562   :group 'feedmail-headers
563   :type 'boolean
564   )
565
566
567 (defcustom feedmail-x-mailer-line-user-appendage nil
568   "*See feedmail-x-mailer-line."
569   :group 'feedmail-headers
570   :type '(choice (const nil) (const t) string)
571   )
572
573
574 (defcustom feedmail-x-mailer-line t
575   "*Control the form of an X-Mailer: header in an outgoing message.
576 Moderately useful for debugging, keeping track of your correspondents'
577 mailer preferences, or just wearing your MUA on your sleeve.  You
578 should probably know that some people are fairly emotional about the
579 presence of X-Mailer: lines in email.
580
581 If nil, nothing is done about X-Mailer:.
582
583 If t, an X-Mailer: header of a predetermined format is produced,
584 combining its efforts with any existing X-Mailer: header.  If you want
585 to take the default construct and just add a little blob of your own
586 at the end, define the variable feedmail-x-mailer-line-user-appendage
587 as that blob string.  A value of t is equivalent to using the function
588 feedmail-default-x-mailer-generator.
589
590 If neither nil nor t, it may be a string, a fiddle-plex, or a function
591 which returns either nil, t, a string, or a fiddle-plex (or, in fact,
592 another function, but let's not be ridiculous).  If a string, it
593 should be just the contents of the header, not the name of the header
594 itself nor the trailing newline.  If a function, it will be called
595 with no arguments.  For an explanation of fiddle-plexes, see the
596 documentation for the variable feedmail-fiddle-plex-blurb.  In all
597 cases the name element of the fiddle-plex is ignored and is hardwired
598 by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
599   :group 'feedmail-headers
600   :type '(choice (const t) (const nil) string function)
601   )
602
603
604 (defcustom feedmail-message-id-generator t
605   "*Specifies the creation of a Message-Id: header field.
606
607 If nil, nothing is done about Message-Id:.
608
609 If t, a Message-Id: header of a predetermined format is produced, but
610 only if there is not already a Message-Id: in the message.  A value of
611 t is equivalent to using the function feedmail-default-message-id-generator.
612
613 If neither nil nor t, it may be a string, a fiddle-plex, or a function
614 which returns either nil, t, a string, or a fiddle-plex (or, in fact,
615 another function, but let's not be ridiculous).  If a string, it
616 should be just the contents of the header, not the name of the header
617 itself nor the trailing newline.  If a function, it will be called
618 with one argument: the possibly-nil name of the file associated with
619 the message buffer.  For an explanation of fiddle-plexes, see the
620 documentation for the variable feedmail-fiddle-plex-blurb.  In all
621 cases the name element of the fiddle-plex is ignored and is hardwired
622 by feedmail to either \"Message-Id\" or \"Resent-Message-Id\".
623
624 You should let feedmail generate a Message-Id: for you unless you are sure
625 that whatever you give your messages to will do it for you (e.g., most
626 configurations of sendmail).  Even if the latter case is true, it
627 probably won't hurt you to generate your own, and it will then show up
628 in the saved message if you use Fcc:."
629   :group 'feedmail-headers
630   :type '(choice (const nil) function)
631   )
632
633
634 (defcustom feedmail-message-id-suffix nil
635   "*If non-nil, used as a suffix for generating unique Message-Id: headers.
636 The function `feedmail-default-message-id-generator' creates its work based
637 on a formatted date-time string, a random number, and a domain-looking suffix.
638 You can control the suffix used by assigning a string value to this variable.
639 If you don't supply one, the value of the variable `user-mail-address' will be
640 used.  If the value of `feedmail-message-id-suffix' contains an \"@\" character,
641 the string will be used verbatim, else an \"@\" character will be prepended
642 automatically."
643   :group 'feedmail-headers
644   :type '(choice (const nil) string)
645   )
646
647 ;; this was suggested in various forms by several people; first was
648 ;; Tony DeSimone in Oct 1992; sorry to be so tardy
649 (defcustom feedmail-date-generator t
650   "*Specifies the creation of a Date: header field.
651
652 If nil, nothing is done about Date:.
653
654 If t, a Date: header of a predetermined format is produced, but only
655 if there is not already a Date: in the message.  A value of t is
656 equivalent to using the function feedmail-default-date-generator.
657
658 If neither nil nor t, it may be a string, a fiddle-plex, or a function
659 which returns either nil, t, a string, or a fiddle-plex (or, in fact,
660 another function, but let's not be ridiculous).  If a string, it
661 should be just the contents of the header, not the name of the header
662 itself nor the trailing newline.  If a function, it will be called
663 with one argument: the possibly-nil name of the file associated with
664 the message buffer.  For an explanation of fiddle-plexes, see the
665 documentation for the variable feedmail-fiddle-plex-blurb.  In all
666 cases the name element of the fiddle-plex is ignored and is hardwired
667 by feedmail to either \"Date\" or \"Resent-Date\".
668
669 If you decide to format your own date field, do us all a favor and know
670 what you're doing.  Study the relevant parts of RFC-822 and RFC-1123.
671 Don't make me come up there!
672
673 You should let feedmail generate a Date: for you unless you are sure
674 that whatever you give your messages to will do it for you (e.g., most
675 configurations of sendmail).  Even if the latter case is true, it
676 probably won't hurt you to generate your own, and it will then show up
677 in the saved message if you use Fcc:."
678   :group 'feedmail-headers
679   :type '(choice (const nil) function)
680   )
681
682
683 (defcustom feedmail-fiddle-headers-upwardly t
684   "*Non-nil means fiddled header fields should go at the top of the header.
685 Nil means insert them at the bottom.  This is mostly a novelty issue since
686 the standards define the ordering of header fields to be immaterial and it's
687 fairly likely that some MTA along the way will have its own idea of what the
688 order should be, regardless of what you specify."
689   :group 'feedmail-header
690   :type 'boolean
691   )
692
693
694 (defcustom feedmail-fiddle-plex-user-list nil
695   "If non-nil, should be a list of one or more fiddle-plexes.
696 Each element of the list can also be a function which returns a
697 fiddle-plex.
698
699 feedmail will use this list of fiddle-plexes to manipulate user-specified
700 message header fields.  It does this after it has completed all normal
701 message header field manipulation and before calling feedmail-last-chance-hook.
702
703 For an explanation of fiddle-plexes, see the documentation for the
704 variable feedmail-fiddle-plex-blurb.  In contrast to some other fiddle-plex
705 manipulation functions, in this context, it makes no sense to have an element
706 which is nil, t, or a simple string."
707   :group 'feedmail-header
708   :type '(repeat (choice function)
709                  sexp) ; too complex to be described accurately
710   )
711
712
713 (defcustom feedmail-enable-spray nil
714   "If non-nil, transmit message separately to each addressee.
715 feedmail normally accumulates a list of addressees and passes the message
716 along with that list to a buffer-eating function which expects any number
717 of addressees.  If this variable is non-nil, however, feedmail will
718 repeatedly call the same buffer-eating function.  Each time, the list of
719 addressees will be just one item from the original list.  This only affects
720 the message envelope addresses and doesn't affect what appears in the
721 message headers except as noted.
722
723 Spray mode is usually pointless, and if you can't think of a good reason for
724 it, you should avoid it since it is inherently less efficient than normal
725 multiple delivery.  One reason to use it is to overcome mis-featured mail
726 transports which betray your trust by revealing Bcc: addressees in the
727 headers of a message.  Another use is to do a crude form of mailmerge, for
728 which see feedmail-spray-address-fiddle-plex-list.
729
730 If one of the calls to the buffer-eating function results in an error,
731 what happens next is carelessly defined, so beware."
732   :group 'feedmail-spray
733   :type 'boolean
734   )
735
736 (defvar feedmail-spray-this-address nil
737   "Do not set or change this variable.  See feedmail-spray-address-fiddle-plex-list.")
738
739 (defcustom feedmail-spray-address-fiddle-plex-list nil
740   "User-supplied specification for a crude form of mailmerge capability.
741 When spraying is enabled, feedmail composes a list of envelope addresses.
742 In turn, feedmail-spray-this-address is temporarily set to each address
743 \(stripped of any comments and angle brackets\) and calls a function which
744 fiddles message headers according to this variable.  See the documentation for
745 `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
746
747 May be nil, in which case nothing in particular is done about message
748 headers for specific addresses.
749
750 May be t, in which case a \"To:\" header is added to the message with
751 the stripped address as the header contents.  The fiddle-plex operator
752 is 'supplement.
753
754 May be a string, in which case the string is assumed to be the name of
755 a message header field with the stripped address serving as the value.
756 The fiddle-plex operator is 'supplement.
757
758 May be a function, in which case it is called with no arguments and is
759 expected to return nil, t, a string, another function, or a fiddle-plex.
760 The result is used recursively.
761
762 May be a list of any combination of the foregoing and fiddle-plexes.  (A
763 value for this variable which consists of a single fiddle-plex must be
764 nested inside another list to avoid ambiguity.)  If a list, each item
765 is acted on in turn as described above.
766
767 For example,
768
769   (setq feedmail-spray-address-fiddle-plex-list 'my-address-embellisher)
770
771 The idea of the example is that, during spray mode, as each message is
772 about to be transmitted to an individual address, the function will be
773 called and will consult feedmail-spray-this-address to find the
774 stripped envelope email address (no comments or angle brackets).  The
775 function should return an embellished form of the address.
776
777 The recipe for sending form letters is:  (1) create a message with all
778 addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers
779 before sending the message; (3) create a function which will embellish
780 stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list
781 appropriately; (5) send the message with feedmail-enable-spray set
782 non-nil; (6) stand back and watch co-workers wonder at how efficient
783 you are at accomplishing inherently inefficient things."
784   :group 'feedmail-spray
785   :type 'sexp ; too complex to be described accurately
786   )
787
788
789 (defcustom feedmail-enable-queue nil
790   "*If non-nil, provide for stashing outgoing messages in a queue.
791 This is the master on/off switch for feedmail message queuing.
792 Queuing is quite handy for laptop-based users.  It's also handy if you
793 get a lot of mail and process it more or less sequentially.  For
794 example, you might change your mind about contents of a reply based on
795 a message you see a bit later.
796
797 There is a separate queue for draft messages, intended to prevent
798 you from accidentally sending incomplete messages.  The queues are
799 disk-based and intended for later transmission.  The messages are
800 queued in their raw state as they appear in the mail-mode buffer and
801 can be arbitrarily edited later, before sending, by visiting the
802 appropriate file in the queue directory (and setting the buffer to
803 mail-mode or whatever).  If you visit a file in the queue directory
804 and try to queue it again, it will just get saved in its existing file
805 name.  You can move a message from the draft to the main queue or vice
806 versa by pretending to send it and then selecting whichever queue
807 directory you want at the prompt.  The right thing will happen.
808
809 To transmit all the messages in the queue, invoke the command
810 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
811   :group 'feedmail-queue
812   :type 'boolean
813   )
814
815
816 (defcustom feedmail-queue-runner-confirm-global nil
817   "*If non-nil, give a y-or-n confirmation prompt before running the queue.
818 Prompt even if the queue is about to be processed as a result of a call to
819 feedmail-run-the-queue-no-prompts.  This gives you a way to bail out
820 without having to answer no to the individual message prompts."
821   :group 'feedmail-queue
822   :type 'boolean)
823
824
825 ;; I provided a default for VMS because someone asked for it (the
826 ;; normal default doesn't work there), but, puh-lease!, it is a user
827 ;; definable option, so if you don't like the default, change it to
828 ;; whatever you want.  I am unable to directly test the VMS goop
829 ;; provided here by levitte@lp.se (Richard Levitte - VMS Whacker).
830 (defcustom feedmail-queue-directory
831   (if (memq system-type '(axp-vms vax-vms))
832       (expand-file-name (concat (getenv "HOME") "[.MAIL.Q]"))
833     (concat (getenv "HOME") "/mail/q"))
834   "*Name of a directory where messages will be queued.
835 Directory will be created if necessary.  Should be a string that
836 doesn't end with a slash.  Default, except on VMS, is \"$HOME/mail/q\"."
837   :group 'feedmail-queue
838   :type 'string
839   )
840
841
842 (defcustom feedmail-queue-draft-directory
843   (if (memq system-type '(axp-vms vax-vms))
844       (expand-file-name (concat (getenv "HOME") "[.MAIL.DRAFT]"))
845     (concat (getenv "HOME") "/mail/draft"))
846   "*Name of an directory where draft messages will be queued.
847 Directory will be created if necessary.  Should be a string that
848 doesn't end with a slash.  Default, except on VMS, is \"$HOME/mail/draft\"."
849   :group 'feedmail-queue
850   :type 'string
851   )
852
853
854 (defcustom feedmail-ask-before-queue t
855   "*If non-nil, feedmail will ask what you want to do with the message.
856 Default choices for the message action prompt will include sending it
857 immediately, putting it in the main queue, putting it in the draft
858 queue, or returning to the buffer to continue editing.  Only matters if
859 queuing is enabled.  If nil, the message is placed in the main queue
860 without a prompt."
861   :group 'feedmail-queue
862   :type 'boolean
863   )
864
865
866 (defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
867   "*A string which will be used for the message action prompt.
868 If it contains a \"%s\", that will be replaced with the value of
869 feedmail-ask-before-queue-default."
870   :group 'feedmail-queue
871   :type 'string
872   )
873
874
875 (defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
876   "*A string which will be used for repompting after invalid input.
877 If it contains a \"%s\", that will be replaced with the value of
878 feedmail-ask-before-queue-default."
879   :group 'feedmail-queue
880   :type 'string
881   )
882
883
884 (defcustom feedmail-ask-before-queue-default "queue"
885   "*Meaning if user hits return in response to the message action prompt.
886 Should be a character or a string; if a string, only the first
887 character is significant.  Useful values are those described in
888 the help for the message action prompt."
889   :group 'feedmail-queue
890   :type '(choice string integer)        ;use integer to get char
891   )
892
893
894 (defvar feedmail-prompt-before-queue-standard-alist
895   '((?q . feedmail-message-action-queue)
896     (?Q . feedmail-message-action-queue-strong)
897
898     (?d . feedmail-message-action-draft)
899     (?r . feedmail-message-action-draft)
900     (?D . feedmail-message-action-draft-strong)
901     (?R . feedmail-message-action-draft-strong)
902
903     (?e . feedmail-message-action-edit)
904     (?E . feedmail-message-action-edit)
905     (?\C-g . feedmail-message-action-edit)
906     (?n . feedmail-message-action-edit)
907     (?N . feedmail-message-action-edit)
908
909     (?i . feedmail-message-action-send)
910     (?I . feedmail-message-action-send-strong)
911     (?s . feedmail-message-action-send)
912     (?S . feedmail-message-action-send-strong)
913
914     (?* . feedmail-message-action-toggle-spray)
915
916     (?\C-v . feedmail-message-action-help)
917     (?? . feedmail-message-action-help))
918   "An alist of choices for the message action prompt.
919 All of the values are function names, except help, which is a special
920 symbol that calls up help for the prompt (the help describes the
921 actions from the standard alist).  To customize your own choices,
922 define a similar alist called feedmail-prompt-before-queue-user-alist.
923 The actual alist used for message action will be the standard alist
924 overlaid with the user-alist.  To neutralize an item in the standard
925 alist without providing a replacement, define an appropriate element
926 in the user alist with a value of nil." )
927
928
929 (defcustom feedmail-prompt-before-queue-user-alist nil
930   "See feedmail-prompt-before-queue-standard-alist."
931   :group 'feedmail-queue
932   :type '(repeat (cons character function))
933   )
934
935
936 (defcustom feedmail-prompt-before-queue-help-supplement nil
937   "User-provided supplementary help string for the message action prompt.
938 When the message action prompt is shown, the user can as for verbose help,
939 at which point a buffer pops up describing the meaning of possible
940 responses to the prompt.  Through various customizations (see, for
941 example, feedmail-prompt-before-queue-user-alist), the available responses
942 and the prompt itself can be changed.  If this variable is set to a string
943 value, that string is written to the help buffer after the standard info.
944 It may contain embedded line breaks.  It will be printed via princ."
945   :group 'feedmail-queue
946   :type '(choice (const nil) string)
947   )
948
949
950 (defcustom feedmail-queue-reminder-alist
951   '((after-immediate . feedmail-queue-reminder-brief)
952     (after-queue . feedmail-queue-reminder-medium)
953     (after-draft . feedmail-queue-reminder-medium)
954     (after-run . feedmail-queue-reminder-brief)
955     (on-demand . feedmail-run-the-queue-global-prompt))
956   "See feedmail-queue-reminder."
957   :group 'feedmail-queue
958   :type '(repeat (cons (choice :tag "Event"
959                                (const on-demand)
960                                (const after-immediate)
961                                (const after-queue)
962                                (const after-draft)
963                                (const after-run))
964                        function))
965   )
966
967
968 (defcustom feedmail-queue-chatty t
969   "*If non-nil, blat a few status messages and such in the mini-buffer.
970 If nil, just do the work and don't pester people about what's going on.
971 In some cases, though, specific options inspire mini-buffer prompting.
972 That's not affected by this variable setting.  Also does not control
973 reporting of error/abnormal conditions."
974   :group 'feedmail-queue
975   :type 'boolean
976   )
977
978
979 (defcustom feedmail-queue-chatty-sit-for 2
980   "*Duration of pause after most queue-related messages.
981 After some messages are divulged, it is prudent to pause before
982 something else obliterates them.  This value controls the duration of
983 the pause."
984   :group 'feedmail-queue
985   :type 'integer
986   )
987
988
989 (defcustom feedmail-queue-run-orderer nil
990   "*If non-nil, name a function which will sort the queued messages.
991 The function is called during a running of the queue for sending, and
992 takes one argument, a list of the files in the queue directory.  It
993 may contain the names of non-message files, and it's okay to leave
994 them in the list when reordering it; they get skipped over later.
995 When nil, the default action processes the messages in normal sort
996 order by queued file name, which will typically result in the order
997 they were placed in the queue."
998   :group 'feedmail-queue
999   :type '(choice (const nil) function)
1000   )
1001
1002
1003 (defcustom feedmail-queue-use-send-time-for-date nil
1004   "*If non-nil, use send time for the Date: header value.
1005 This variable is used by the default date generating function,
1006 feedmail-default-date-generator.  If nil, the default, the
1007 last-modified timestamp of the queue file is used to create the
1008 message Date: header; if there is no queue file, the current time is
1009 used."
1010   :group 'feedmail-queue
1011   :type 'boolean
1012   )
1013
1014
1015 (defcustom feedmail-queue-use-send-time-for-message-id nil
1016   "*If non-nil, use send time for the Message-Id: header value.
1017 This variable is used by the default Message-Id: generating function,
1018 feedmail-default-message-id-generator.  If nil, the default, the
1019 last-modified timestamp of the queue file is used to create the
1020 message Message-Id: header; if there is no queue file, the current time is
1021 used."
1022   :group 'feedmail-queue
1023   :type 'boolean
1024   )
1025
1026
1027 (defcustom feedmail-ask-for-queue-slug nil
1028   "*If non-nil, prompt user for part of the queue file name.
1029 The file will automatically get the FQM suffix and an embedded
1030 sequence number for uniqueness, so don't specify that.  feedmail will
1031 get rid of all characters other than alphanumeric and hyphen in the
1032 results.  If this variable is nil or if you just hit return in
1033 response to the prompt, feedmail queuing will take care of things
1034 properly.  At the prompt, completion is available if you want to see
1035 what filenames are already in use, though, as noted, you will not be
1036 typing a complete file name.  You probably don't want to be bothered
1037 with this prompting since feedmail, by default, uses queue file names
1038 based on the subjects of the messages."
1039   :group 'feedmail-queue
1040   :type 'boolean
1041   )
1042
1043
1044 (defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
1045   "*If non-nil, a function which creates part of the queued file name.
1046 Takes a single argument giving the name of the directory into
1047 which the message will be queued.  The returned string should be just
1048 the non-directory filename part, without FQM suffix or uniquifying
1049 sequence numbers.  The current buffer holds the raw message.  The
1050 default function creates the slug based on the message subject, if
1051 any."
1052   :group 'feedmail-queue
1053   :type '(choice (const nil) function)
1054   )
1055
1056
1057 (defcustom feedmail-queue-default-file-slug t
1058   "*Indicates what to use for subject-less messages when forming a file name.
1059 When feedmail queues a message, it creates a unique file name.  By default,
1060 the file name is based in part on the subject of the message being queued.
1061 If there is no subject, consult this variable.  See documentation for the
1062 function feedmail-queue-subject-slug-maker.
1063
1064 If t, an innocuous default is used.
1065
1066 If a string, it is used directly.
1067
1068 If a function, it is called with no arguments from the buffer containing the raw
1069 text of the message.  It must return a string (which may be empty).
1070
1071 If the symbol 'ask, you will be prompted for a string in the mini-buffer.
1072 Filename completion is available so that you can inspect what's already been
1073 used, but feedmail will do further manipulation on the string you return, so
1074 it's not expected to be a complete filename."
1075   :group 'feedmail-queue
1076   :type '(choice (const :tag "Default" t) string function (const ask))
1077   )
1078
1079
1080 (defcustom feedmail-queue-fqm-suffix ".fqm"
1081   "*The FQM suffix used to distinguish feedmail queued message files.
1082 You probably want this to be a period followed by some letters and/or
1083 digits.  The distinction is to be able to tell them from other random
1084 files that happen to be in the feedmail-queue-directory or
1085 feedmail-queue-draft-directory. By the way, FQM stands for feedmail
1086 queued message."
1087   :group 'feedmail-queue
1088   :type 'string
1089   )
1090
1091
1092 (defcustom feedmail-nuke-buffer-after-queue nil
1093   "*If non-nil, silently kill the buffer after a message is queued.
1094 You might like that since a side-effect of queueing the message is
1095 that its buffer name gets changed to the filename.  That means that
1096 the buffer won't be reused for the next message you compose.  If you
1097 are using VM for creating messages, you probably want to leave this
1098 nil, since VM has its own options for managing the recycling of
1099 message buffers."
1100   :group 'feedmail-queue
1101   :type 'boolean
1102   )
1103
1104
1105 (defcustom feedmail-queue-auto-file-nuke nil
1106   "*If non-nil, automatically delete queue files when a message is sent.
1107 Normally, feedmail will notice such files when you send a message in
1108 immediate mode (i.e., not when you're running the queue) and will ask if
1109 you want to delete them.  Since the answer is usually yes, setting this
1110 variable to non-nil will tell feedmail to skip the prompt and just delete
1111 the file without bothering you."
1112   :group 'feedmail-queue
1113   :type 'boolean
1114   )
1115
1116
1117 ;; defvars to make byte-compiler happy(er)
1118 (defvar feedmail-error-buffer        nil)
1119 (defvar feedmail-prepped-text-buffer nil)
1120 (defvar feedmail-raw-text-buffer     nil)
1121 (defvar feedmail-address-list        nil)
1122
1123
1124 (defvar feedmail-queue-runner-is-active nil
1125   "*Non-nil means we're inside the logic of the queue-running loop.
1126 That is, iterating over all messages in the queue to send them.  In
1127 that case, the value is the name of the queued message file currently
1128 being processed.  This can be used for differentiating customized code
1129 for different scenarios.  Users shouldn't set or change this
1130 variable, but may depend on its value as described here.")
1131
1132
1133 (defun feedmail-mail-send-hook-splitter ()
1134   "Facilitate dividing mail-send-hook things into queued and immediate cases.
1135 If you have mail-send-hook functions that should only be called for sending/
1136 queueing messages or only be called for the sending of queued messages, this is
1137 for you.  Add this function to mail-send-hook with something like this:
1138
1139         (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
1140
1141 Then add the functions you want called to either feedmail-mail-send-hook-queued
1142 or feedmail-mail-send-hook, as apprpriate.  The distinction is that
1143 feedmail-mail-send-hook will be called when you send mail from a composition
1144 buffer (typically by typing C-c C-c), whether the message is sent immediately
1145 or placed in the queue or drafts directory.  feedmail-mail-send-hook-queued is
1146 called when messages are being sent from the queue directory, typically via a
1147 call to feedmail-run-the-queue."
1148   (if feedmail-queue-runner-is-active
1149       (run-hooks 'feedmail-mail-send-hook-queued)
1150     (run-hooks 'feedmail-mail-send-hook))
1151   )
1152
1153
1154 (defvar feedmail-mail-send-hook nil
1155   "*See documentation for feedmail-mail-send-hook-splitter.")
1156
1157
1158 (defvar feedmail-mail-send-hook-queued nil
1159   "*See documentation for feedmail-mail-send-hook-splitter.")
1160
1161
1162 (defun feedmail-confirm-addresses-hook-example ()
1163   "An example of a feedmail-last-chance-hook.
1164 It shows the simple addresses and gets a confirmation.  Use as:
1165  (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
1166   (save-window-excursion
1167     (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
1168     (erase-buffer)
1169     (insert (mapconcat 'identity feedmail-address-list " "))
1170     (if (not (y-or-n-p "How do you like them apples? "))
1171         (error "FQM: Sending...gave up in last chance hook")
1172       )))
1173
1174
1175 (defcustom feedmail-last-chance-hook nil
1176   "*User's last opportunity to modify the message on its way out.
1177 It has already had all the header prepping from the standard package.
1178 The next step after running the hook will be to push the buffer into a
1179 subprocess that mails the mail.  The hook might be interested in
1180 these: (1) feedmail-prepped-text-buffer contains the header and body
1181 of the message, ready to go; (2) feedmail-address-list contains a list
1182 of simplified recipients of addresses which are to be given to the
1183 subprocess (the hook may change the list); (3) feedmail-error-buffer
1184 is an empty buffer intended to soak up errors for display to the user.
1185 If the hook allows interactive activity, the user should not send more
1186 mail while in the hook since some of the internal buffers will be
1187 reused and things will get confused."
1188   :group 'feedmail-misc
1189   :type 'hook
1190   )
1191
1192
1193 (defcustom feedmail-before-fcc-hook nil
1194   "*User's last opportunity to modify the message before Fcc action.
1195 It has already had all the header prepping from the standard package.
1196 The next step after running the hook will be to save the message via
1197 Fcc: processing. The hook might be interested in these: (1)
1198 feedmail-prepped-text-buffer contains the header and body of the
1199 message, ready to go; (2) feedmail-address-list contains a list of
1200 simplified recipients of addressees to whom the message was sent (3)
1201 feedmail-error-buffer is an empty buffer intended to soak up errors
1202 for display to the user.  If the hook allows interactive activity, the
1203 user should not send more mail while in the hook since some of the
1204 internal buffers will be reused and things will get confused."
1205   :group 'feedmail-misc
1206   :type 'hook
1207   )
1208
1209 (defcustom feedmail-queue-runner-mode-setter
1210   '(lambda (&optional arg) (mail-mode))
1211   "*A function to set the proper mode of a message file.
1212 Called when the message is read back out of the queue directory with a single
1213 argument, the optional argument used in the call to
1214 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
1215
1216 Most people want `mail-mode', so the default value is an anonymous
1217 function which is just a wrapper to ignore the supplied argument when
1218 calling it, but here's your chance to have something different.
1219 Called with funcall, not `call-interactively'."
1220   :group 'feedmail-queue
1221   :type 'function
1222   )
1223
1224
1225 (defcustom feedmail-queue-alternative-mail-header-separator nil
1226   "*Alternative header demarcation for queued messages.
1227 If you sometimes get alternative values for `mail-header-separator' in
1228 queued messages, set the value of this variable to whatever it is.
1229 For example, `rmail-resend' uses a `mail-header-separator' value of empty
1230 string (\"\") when you send/queue a message.
1231
1232 When trying to send a queued message, if the value of this variable is
1233 non-nil, feedmail will first try to send the message using the value
1234 of `mail-header-separator'.  If it can't find that, it will temporarily
1235 set `mail-header-separator' to the value of
1236 feedmail-queue-alternative-mail-header-separator and try again."
1237   :group 'feedmail-queue
1238   :type '(choice (const nil) string)
1239   )
1240
1241
1242 (defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit
1243   "*Function to initiate sending a message file.
1244 Called for each message read back out of the queue directory with a
1245 single argument, the optional argument used in the call to
1246 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
1247 Interactively, that argument will be the prefix argument.  Most people
1248 want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's
1249 your chance to have something different.  Called with funcall, not
1250 call-interactively."
1251   :group 'feedmail-queue
1252   :type 'function
1253   )
1254
1255
1256 (defcustom feedmail-queue-runner-cleaner-upper
1257   '(lambda (fqm-file &optional arg)
1258      (delete-file fqm-file)
1259      (if (and arg feedmail-queue-chatty) (message "FQM: Nuked %s" fqm-file)))
1260   "*Function that will be called after a message has been sent.
1261 Not called in the case of errors.  This function is called with two
1262 arguments: the name of the message queue file for the message just sent,
1263 and the optional argument used in the call to `feedmail-run-the-queue'
1264 or `feedmail-run-the-queue-no-prompts' (prefix arg if interactive).
1265 In any case, the affiliated buffer is killed elsewhere, so don't do that
1266 inside this function.  Return value is ignored.
1267
1268 The default action is an anonymous function which gets rid of the file
1269 from the queue directory.  With a non-nil second argument, a brief
1270 message is give for each file deleted.  You could replace this
1271 function, for example, to archive all of your sent messages someplace
1272 \(though there are better ways to get that particular result\)."
1273   :group 'feedmail-queue
1274   :type 'function
1275   )
1276
1277
1278 (defvar feedmail-is-a-resend nil
1279   "*Non-nil means the the message is a Resend (in the RFC-822 sense).
1280 This affects the composition of certain headers.  feedmail sets this
1281 variable as soon as it starts prepping the message text buffer, so any
1282 user-supplied functions can rely on it.  Users shouldn't set or change this
1283 variable, but may depend on its value as described here.")
1284
1285
1286 (defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail
1287   "*Function used to send the prepped buffer to a subprocess.
1288 The function's three (mandatory) arguments are: (1) the buffer
1289 containing the prepped message; (2) a buffer where errors should be
1290 directed; and (3) a list containing the addresses individually as
1291 strings.  Three popular choices for this are
1292 feedmail-buffer-to-binmail, feedmail-buffer-to-smtpmail, and
1293 feedmail-buffer-to-sendmail.  If you use the sendmail form, you
1294 probably want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc
1295 to nil.  If you use the binmail form, check the value of
1296 feedmail-binmail-template."
1297   :group 'feedmail-misc
1298   :type 'function
1299   )
1300
1301
1302 (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
1303   "*Command template for the subprocess which will get rid of the mail.
1304 It can result in any command understandable by /bin/sh.  Might not
1305 work at all in non-Unix environments.  The single '%s', if present,
1306 gets replaced by the space-separated, simplified list of addressees.
1307 Used in feedmail-buffer-to-binmail to form the shell command which
1308 will receive the contents of the prepped buffer as stdin.  If you'd
1309 like your errors to come back as mail instead of immediately in a
1310 buffer, try /bin/rmail instead of /bin/mail (this can be accomplished
1311 by keeping the default nil setting of `mail-interactive').  You might
1312 also like to consult local mail experts for any other interesting
1313 command line possibilities."
1314   :group 'feedmail-misc
1315   :type 'string
1316   )
1317
1318
1319 ;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
1320 ;; feedmail-buffer-to-smptmail are the only things provided for values
1321 ;; for the variable feedmail-buffer-eating-function.  It's pretty easy
1322 ;; to write your own, though.
1323 (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
1324   "Function which actually calls /bin/mail as a subprocess.
1325 Feeds the buffer to it."
1326   (set-buffer prepped)
1327   (apply
1328    'call-process-region
1329    (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
1330                  (format feedmail-binmail-template
1331                          (mapconcat 'identity addr-listoid " "))))))
1332
1333
1334 (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
1335   "Function which actually calls sendmail as a subprocess.
1336 Feeds the buffer to it.  Probably has some flaws for Resent-* and other
1337 complicated cases."
1338   (set-buffer prepped)
1339   (apply 'call-process-region
1340          (append (list (point-min) (point-max)
1341                        (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail")
1342                        nil errors-to nil "-oi" "-t")
1343                  ;; provide envelope "from" to sendmail; results will vary
1344                  (list "-f" user-mail-address)
1345                  ;; These mean "report errors by mail" and "deliver in background".
1346                  (if (null mail-interactive) '("-oem" "-odb")))))
1347
1348 ;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
1349 ;; simplified by WJC after more feedmail development;
1350 ;; idea (but not implementation) of copying smtpmail trace buffer to
1351 ;; feedmail error buffer from:
1352 ;;   Mon 14-Oct-1996; Douglas Gray Stephens
1353 ;;   modified to insert error for displaying
1354 (defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid)
1355   "Function which actually calls `smtpmail-via-smtp' to send buffer as e-mail."
1356   ;; I'm not sure smtpmail.el is careful about the following
1357   ;; return value, but it also uses it internally, so I will fear
1358   ;; no evil.
1359   (require 'smtp)
1360   (if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
1361       (progn
1362         (set-buffer errors-to)
1363         (insert "Send via smtpmail failed.  Probable SMTP protocol error.\n")
1364         (insert "Look for details below or in the *Messages* buffer.\n\n")
1365         (let ((case-fold-search t)
1366               ;; don't be overconfident about the name of the trace buffer
1367               (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
1368           (mapcar
1369            '(lambda (buffy)
1370               (if (string-match tracer (buffer-name buffy))
1371                   (progn
1372                     (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
1373                     (insert-buffer buffy)
1374                     (insert "\n\n"))))
1375            (buffer-list))))))
1376
1377
1378 ;; just a place to park a docstring
1379 (defconst feedmail-fiddle-plex-blurb nil
1380   "A fiddle-plex is a concise way of specifying header field fiddling.
1381 It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING.  The element
1382 VALUE can also be a list sometimes.
1383
1384 NAME is the name of the header field to be fiddled with.  Although case
1385 doesn't matter in looking for headers, case of NAME is preserved when a header
1386 is inserted via fiddling.  It shouldn't include the trailing colon.
1387
1388 VALUE is either nil, a simple string, a function returning nil or a string, or,
1389 as described below for ACTION `combine', a list of up to three values.
1390
1391 ACTION describes the nature of the fiddling to be done.  Possibilities
1392 for ACTION (default is `supplement'):
1393
1394   `supplement'  Leave other like fields as-is, insert this one.
1395
1396   `replace'     Delete other like fields, if any, and insert this one.
1397
1398   `create'      Insert this one only if no like field exists.
1399
1400   `combine'     Combine aggregate values of like fields with this one.
1401                 In this case, VALUE has a special form.  It is a list
1402                 of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
1403                 VAL-PRE and VAL-POST are strings or nil.  VAL-LIKE may
1404                 be either a string or a function (it may also be nil,
1405                 but there's not much point to that).
1406
1407                 Values of like header fields are aggregated, leading and
1408                 trailing whitespace is removed, and embedded
1409                 whitespace is left as-is.  If there are no like
1410                 fields, or the aggregate value is an empty string,
1411                 VAL-LIKE is not used.  Else, if VAL-LIKE is a function,
1412                 it is called with two arguments: NAME and the
1413                 aggregate like values.  Else, if VAL-LIKE is a string, it is
1414                 used as a format string where a single \%s will be
1415                 replaced by the aggregate values of like fields.
1416
1417                 VAL-PRE, the results of using VAL-LIKE, and VAL-POST
1418                 are concatenated, and the result, if not nil and not
1419                 an empty string, is used as the new value for the
1420                 field.  Although this description sounds a bit
1421                 complicated, the idea is to provide a mechanism for
1422                 combining the old value with a new value in a flexible
1423                 way.  For example, if you wanted to add a new value to
1424                 an existing header field by adding a semi-colon and
1425                 then starting the new value on a continuation line,
1426                 you might specify this:
1427
1428                  (nil \"%s;\\n\\t\" \"This is my new value\")
1429
1430 FOLDING can be nil, in which case VALUE is used as-is.  If FOLDING is
1431 non-nil, feedmail \"smart filling\" is done on VALUE just before
1432 insertion.")
1433
1434 ;;;###autoload
1435 (defun feedmail-send-it ()
1436   "Send the current mail buffer using the Feedmail package.
1437 This is a suitable value for `send-mail-function'.  It can be used
1438 with various lower-level mechanisms to provide features such as queueing."
1439
1440   ;; avoid matching trouble over slash vs backslash by getting canonical
1441   (if feedmail-queue-directory
1442       (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
1443   (if feedmail-queue-draft-directory
1444       (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
1445   (if (not feedmail-enable-queue) (feedmail-send-it-immediately)
1446     ;; else, queuing is enabled, should we ask about it or just do it?
1447     (if feedmail-ask-before-queue
1448         (funcall (feedmail-queue-send-edit-prompt))
1449       (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))))
1450
1451
1452 (defun feedmail-message-action-send ()
1453   ;; hooks can make this take a while so clear the prompt
1454   (message "FQM: Immediate send...")
1455   (feedmail-send-it-immediately))
1456
1457
1458 ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu>
1459 (defun feedmail-queue-express-to-queue ()
1460   "*Send message directly to the queue, with a minimum of fuss and bother."
1461   (interactive)
1462   (let ((feedmail-enable-queue t)
1463         (feedmail-ask-before-queue nil)
1464         (feedmail-queue-reminder-alist nil)
1465         (feedmail-queue-chatty-sit-for 0))
1466     (feedmail-send-it)
1467     )
1468   )
1469
1470
1471 (defun feedmail-queue-express-to-draft ()
1472   "*Send message directly to the draft queue, with a minimum of fuss and bother."
1473   (interactive)
1474   (let ((feedmail-queue-directory feedmail-queue-draft-directory))
1475     (feedmail-queue-express-to-queue)
1476     )
1477   )
1478
1479
1480 (defun feedmail-message-action-send-strong ()
1481   (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
1482
1483
1484 (defun feedmail-message-action-edit ()
1485   (error "FQM: Message not queued; returning to edit"))
1486
1487
1488 (defun feedmail-message-action-draft ()
1489   (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
1490
1491
1492 (defun feedmail-message-action-draft-strong ()
1493   (let ((buffer-file-name nil))
1494     (feedmail-message-action-draft)))
1495
1496
1497 (defun feedmail-message-action-queue ()
1498   (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
1499
1500
1501 (defun feedmail-message-action-queue-strong ()
1502   (let ((buffer-file-name nil))
1503     (feedmail-message-action-queue)))
1504
1505
1506 (defun feedmail-message-action-toggle-spray ()
1507   (let ((feedmail-enable-spray (not feedmail-enable-spray)))
1508     (if feedmail-enable-spray
1509         (message "FQM: For this message, spray toggled ON")
1510       (message "FQM: For this message, spray toggled OFF"))
1511     (sit-for 3)
1512     ;; recursion, but harmless
1513     (feedmail-send-it)))
1514
1515
1516 (defun feedmail-message-action-help ()
1517   (let ((d-string " "))
1518     (if (stringp feedmail-ask-before-queue-default)
1519         (setq d-string feedmail-ask-before-queue-default)
1520       (setq d-string  (char-to-string feedmail-ask-before-queue-default)))
1521     (feedmail-queue-send-edit-prompt-help d-string)
1522     ;; recursive, but no worries (it goes deeper on user action)
1523     (feedmail-send-it)))
1524
1525
1526 ;;;###autoload
1527 (defun feedmail-run-the-queue-no-prompts (&optional arg)
1528   "Like feedmail-run-the-queue, but suppress confirmation prompts."
1529   (interactive "p")
1530   (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
1531
1532 ;;;###autoload
1533 (defun feedmail-run-the-queue-global-prompt (&optional arg)
1534   "Like feedmail-run-the-queue, but with a global confirmation prompt.
1535 This is generally most useful if run non-interactively, since you can
1536 bail out with an appropriate answer to the global confirmation prompt."
1537   (interactive "p")
1538   (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
1539
1540 ;;;###autoload
1541 (defun feedmail-run-the-queue (&optional arg)
1542   "Visit each message in the feedmail queue directory and send it out.
1543 Return value is a list of three things: number of messages sent, number of
1544 messages skipped, and number of non-message things in the queue (commonly
1545 backup file names and the like)."
1546   (interactive "p")
1547   ;; avoid matching trouble over slash vs backslash by getting canonical
1548   (if feedmail-queue-directory
1549       (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
1550   (if feedmail-queue-draft-directory
1551       (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
1552   (let* ((maybe-file)
1553          (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
1554          (dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1555          (q-cnt (nth 0 qlist))
1556          (q-oth (nth 1 qlist))
1557          (d-cnt (nth 0 dlist))
1558          (d-oth (nth 1 dlist))
1559          (messages-sent 0)
1560          (messages-skipped 0)
1561          (blobby-buffer)
1562          (already-buffer)
1563          (this-mhsep)
1564          (do-the-run t)
1565          (list-of-possible-fqms))
1566     (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
1567         (setq do-the-run
1568               (if (fboundp 'y-or-n-p-with-timeout)
1569                   (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d,  Queue: %dm+%d; run the queue? "
1570                                                  d-cnt d-oth q-cnt q-oth)
1571                                          5 nil)
1572                 (y-or-n-p (format "FQM: Draft: %dm+%d,  Queue: %dm+%d; run the queue? "
1573                                   d-cnt d-oth q-cnt q-oth))
1574                 )))
1575     (if (not do-the-run)
1576         (setq messages-skipped q-cnt)
1577       (save-window-excursion
1578         (setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
1579         (if feedmail-queue-run-orderer
1580             (setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
1581         (mapcar
1582          '(lambda (blobby)
1583             (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
1584             (cond
1585              ((file-directory-p maybe-file) nil) ; don't care about subdirs
1586              ((feedmail-fqm-p blobby)
1587               (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
1588               (setq already-buffer
1589                     (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
1590                         (find-buffer-visiting maybe-file)
1591                       (get-file-buffer maybe-file)))
1592               (if (and already-buffer (buffer-modified-p already-buffer))
1593                   (save-window-excursion
1594                     (display-buffer (set-buffer already-buffer))
1595                     (if (fboundp 'y-or-n-p-with-timeout)
1596                         ;; make a guess that the user just forgot to save
1597                         (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
1598                             (save-buffer))
1599                       (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
1600                           (save-buffer))
1601                       )))
1602
1603               (set-buffer blobby-buffer)
1604               (setq buffer-offer-save nil)
1605               (buffer-disable-undo blobby-buffer)
1606               (insert-file-contents-literally maybe-file)
1607               ;; work around text-vs-binary weirdness and also around rmail-resend's creative
1608               ;; manipulation of mail-header-separator
1609               ;;
1610               ;; if we don't find the normal M-H-S, and the alternative is defined but also
1611               ;; not found, try reading the file a different way
1612               ;;
1613               ;; if M-H-S not found and (a-M-H-S is nil or not found)
1614               (if (and (not (feedmail-find-eoh t))
1615                        (or (not feedmail-queue-alternative-mail-header-separator)
1616                            (not
1617                             (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
1618                               (feedmail-find-eoh t)))))
1619                   (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
1620                     (erase-buffer) (insert-file-contents maybe-file))
1621                 )
1622               ;; if M-H-S not found and (a-M-H-S is non-nil and is found)
1623               ;; temporarily set M-H-S to the value of a-M-H-S
1624               (if (and (not (feedmail-find-eoh t))
1625                        feedmail-queue-alternative-mail-header-separator
1626                        (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
1627                          (feedmail-find-eoh t)))
1628                   (setq this-mhsep feedmail-queue-alternative-mail-header-separator)
1629                 (setq this-mhsep mail-header-separator))
1630               (funcall feedmail-queue-runner-mode-setter arg)
1631               (condition-case nil       ; don't give up the loop if user skips some
1632                   (let ((feedmail-enable-queue nil)
1633                         (mail-header-separator this-mhsep)
1634                         (feedmail-queue-runner-is-active maybe-file))
1635                     (funcall feedmail-queue-runner-message-sender arg)
1636                     (set-buffer blobby-buffer)
1637                     (if (buffer-modified-p) ; still modified, means wasn't sent
1638                         (setq messages-skipped (1+ messages-skipped))
1639                       (setq messages-sent (1+ messages-sent))
1640                       (funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
1641                       (if (and already-buffer (not (file-exists-p maybe-file)))
1642                           ;; we have gotten rid of the file associated with the
1643                           ;; buffer, so update the buffer's notion of that
1644                           (save-excursion
1645                             (set-buffer already-buffer)
1646                             (setq buffer-file-name nil)))))
1647                 (error (setq messages-skipped (1+ messages-skipped))))
1648               (kill-buffer blobby-buffer)
1649               (if feedmail-queue-chatty
1650                   (progn
1651                     (message "FQM: %d to go, %d sent, %d skipped (%d other files ignored)"
1652                              (- q-cnt messages-sent messages-skipped)
1653                              messages-sent messages-skipped q-oth)
1654                     (sit-for feedmail-queue-chatty-sit-for))))))
1655          list-of-possible-fqms)))
1656     (if feedmail-queue-chatty
1657         (progn
1658           (message "FQM: %d sent, %d skipped (%d other files ignored)"
1659                    messages-sent messages-skipped q-oth)
1660           (sit-for feedmail-queue-chatty-sit-for)
1661           (feedmail-queue-reminder 'after-run)
1662           (sit-for feedmail-queue-chatty-sit-for)))
1663     (list messages-sent messages-skipped q-oth)))
1664
1665
1666 ;;;###autoload
1667 (defun feedmail-queue-reminder (&optional what-event)
1668   "Perform some kind of reminder activity about queued and draft messages.
1669 Called with an optional symbol argument which says what kind of event
1670 is triggering the reminder activity.  The default is 'on-demand, which
1671 is what you typically would use if you were putting this in your emacs start-up
1672 or mail hook code.  Other recognized values for WHAT-EVENT (these are passed
1673 internally by feedmail):
1674
1675    after-immediate      (a message has just been sent in immediate mode)
1676    after-queue          (a message has just been queued)
1677    after-draft          (a message has just been placed in the draft directory)
1678    after-run            (the queue has just been run, possibly sending messages)
1679
1680 WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist.  If
1681 the associated value is a function, it is called without arguments and is expected
1682 to perform the reminder activity.  You can supply your own reminder functions
1683 by redefining feedmail-queue-reminder-alist.  If you don't want any reminders,
1684 you can set feedmail-queue-reminder-alist to nil."
1685   (interactive "p")
1686   (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
1687     (setq entry (assoc key feedmail-queue-reminder-alist))
1688     (setq reminder (cdr entry))
1689     (if (fboundp reminder) (funcall reminder)))
1690   )
1691
1692
1693 (defun feedmail-queue-reminder-brief ()
1694   "Brief display of draft and queued message counts in modeline."
1695   (interactive)
1696   (let (q-cnt d-cnt q-lis d-lis)
1697     (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
1698     (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1699     (setq q-cnt (car q-lis))
1700     (setq d-cnt (car d-lis))
1701     (if (or (> q-cnt 0) (> d-cnt 0))
1702         (progn
1703           (message "FQM: [D: %d,  Q: %d]" d-cnt q-cnt))))
1704   )
1705
1706
1707 (defun feedmail-queue-reminder-medium ()
1708   "Verbose display of draft and queued message counts in modeline."
1709   (interactive)
1710   (let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
1711     (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
1712     (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1713     (setq q-cnt (car q-lis))
1714     (setq d-cnt (car d-lis))
1715     (setq q-oth (nth 1 q-lis))
1716     (setq d-oth (nth 1 d-lis))
1717     (if (or (> q-cnt 0) (> d-cnt 0))
1718         (progn
1719           (message "FQM: Draft: %dm+%d in \"%s\",  Queue: %dm+%d in \"%s\""
1720                    d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
1721                    q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
1722   )
1723
1724
1725 (defun feedmail-queue-send-edit-prompt ()
1726   "Ask whether to queue, send immediately, or return to editing a message."
1727   ;; Some implementation ideas here came from the userlock.el code
1728   (discard-input)
1729   (save-window-excursion
1730     (let ((answer) (d-char) (d-string " "))
1731       (if (stringp feedmail-ask-before-queue-default)
1732           (progn
1733             (setq d-char   (string-to-char feedmail-ask-before-queue-default))
1734             (setq d-string feedmail-ask-before-queue-default))
1735         (setq d-string  (char-to-string feedmail-ask-before-queue-default))
1736         (setq d-char    feedmail-ask-before-queue-default)
1737         )
1738       (while (null answer)
1739         (message feedmail-ask-before-queue-prompt d-string)
1740         (let ((user-sez
1741                (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
1742                  (read-char-exclusive))))
1743           (if (= user-sez help-char)
1744               (setq answer '(^ . feedmail-message-action-help))
1745             (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
1746                 (setq user-sez d-char))
1747             ;; these char-to-int things are because of some
1748             ;; incomprensible difference between the two in
1749             ;; byte-compiled stuff between Emacs and XEmacs
1750             ;; (well, I'm sure someone could comprehend it,
1751             ;; but I say 'uncle')
1752             (setq answer (or (assoc user-sez feedmail-prompt-before-queue-user-alist)
1753                              (and (fboundp 'char-to-int)
1754                                   (assoc (char-to-int user-sez) feedmail-prompt-before-queue-user-alist))
1755                              (assoc user-sez feedmail-prompt-before-queue-standard-alist)
1756                              (and (fboundp 'char-to-int)
1757                                   (assoc (char-to-int user-sez) feedmail-prompt-before-queue-standard-alist))))
1758             (if (or (null answer) (null (cdr answer)))
1759                 (progn
1760                   (beep)
1761                   (message feedmail-ask-before-queue-reprompt d-string)
1762                   (sit-for 3)))
1763             )))
1764       (cdr answer)
1765       )))
1766
1767 (defconst feedmail-p-h-b-n "*FQM Help*")
1768
1769 (defun feedmail-queue-send-edit-prompt-help (d-string)
1770   (let ((fqm-help (get-buffer feedmail-p-h-b-n)))
1771     (if (and fqm-help (get-buffer-window fqm-help))
1772         (feedmail-queue-send-edit-prompt-help-later fqm-help d-string)
1773       (feedmail-queue-send-edit-prompt-help-first d-string))))
1774
1775 (defun feedmail-queue-send-edit-prompt-help-later (fqm-help d-string)
1776   ;; scrolling fun
1777   (save-selected-window
1778     (let ((signal-error-on-buffer-boundary nil)
1779           (fqm-window (display-buffer fqm-help)))
1780       (select-window fqm-window)
1781       (if (pos-visible-in-window-p (point-max) fqm-window)
1782           (feedmail-queue-send-edit-prompt-help-first d-string)
1783         ;;(goto-char (point-min))
1784         (scroll-up nil)
1785         ))))
1786
1787 (defun feedmail-queue-send-edit-prompt-help-first (d-string)
1788   (with-output-to-temp-buffer feedmail-p-h-b-n
1789     (princ "You're dispatching a message and feedmail queuing is enabled.
1790 Typing ? or C-v will normally scroll this help buffer.
1791
1792 Choices:
1793    q  QUEUE        for later sending (via feedmail-run-the-queue)
1794    Q  QUEUE!       like \"q\", but always make a new file
1795    i  IMMEDIATELY  send this (but not the other queued messages)
1796    I  IMMEDIATELY! like \"i\", but skip following confirmation prompt
1797    d  DRAFT        queue in the draft directory
1798    D  DRAFT!       like \"d\", but always make a new file
1799    e  EDIT         return to the message edit buffer (don't send or queue)
1800    *  SPRAY        toggle spray mode (individual message transmissions)
1801
1802 Synonyms:
1803    s  SEND         immediately (same as \"i\")
1804    S  SEND!        immediately (same as \"I\")
1805    r  ROUGH        draft (same as \"d\")
1806    R  ROUGH!       draft (same as \"D\")
1807    n  NOPE         didn't mean it (same as \"e\")
1808    y  YUP          do the default behavior (same as \"C-m\")
1809
1810 The user-configurable default is currently \"")
1811     (princ d-string)
1812     (princ "\".  For other possibilities,
1813 see the variable feedmail-prompt-before-queue-user-alist.
1814 ")
1815     (and (stringp feedmail-prompt-before-queue-help-supplement)
1816          (princ feedmail-prompt-before-queue-help-supplement))
1817     (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode)))))
1818
1819 (defun feedmail-look-at-queue-directory (queue-directory)
1820   "Find out some things about a queue directory.
1821 Result is a list containing a count of queued messages in the
1822 directory, a count of other files in the directory, and a high water
1823 mark for prefix sequence numbers.  Subdirectories are not included in
1824 the counts."
1825   (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
1826     ;; iterate, counting things we find along the way in the directory
1827     (if (file-directory-p queue-directory)
1828         (mapcar
1829          '(lambda (blobby)
1830             (cond
1831              ((file-directory-p blobby) nil) ; don't care about subdirs
1832              ((feedmail-fqm-p blobby)
1833               (setq blobbet (file-name-nondirectory blobby))
1834               (if (string-match "^[0-9][0-9][0-9]-" blobbet)
1835                   (let ((water-mark))
1836                     (setq water-mark (string-to-int (substring blobbet 0 3)))
1837                     (if (> water-mark high-water) (setq high-water water-mark))))
1838               (setq q-cnt (1+ q-cnt)))
1839              (t (setq q-oth (1+ q-oth)))
1840              ))
1841          (directory-files queue-directory t)))
1842     (list q-cnt q-oth high-water)))
1843
1844 (defun feedmail-tidy-up-slug (slug)
1845   "Utility for mapping out suspect characters in a potential filename."
1846   ;; even programmers deserve a break sometimes, so cover nil for them
1847   (if (null slug) (setq slug ""))
1848   ;; replace all non-alphanumerics with hyphen for safety
1849   (while (string-match "[^a-z0-9-]+" slug) (setq slug (replace-match "-" nil nil slug)))
1850   ;; collapse multiple hyphens to one
1851   (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
1852   ;; for tidyness, peel off leading hyphens
1853   (if (string-match "^-*" slug) (setq slug (replace-match "" nil nil slug)))
1854   ;; for tidyness, peel off trailing hyphens
1855   (if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
1856   slug
1857   )
1858
1859 (defun feedmail-queue-subject-slug-maker (&optional queue-directory)
1860   "Create a name for storing the message in the queue.
1861 Optional argument QUEUE-DIRECTORY specifies into which directory the
1862 file will be placed.  The name is based on the Subject: header (if
1863 there is one).  If there is no subject,
1864 feedmail-queue-default-file-slug is consulted Special characters are
1865 mapped to mostly alphanumerics for safety."
1866   (let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
1867     (setq eoh-marker (feedmail-find-eoh))
1868     (goto-char (point-min))
1869     ;; get raw subject value (first line, anyhow)
1870     (if (re-search-forward "^Subject:" eoh-marker t)
1871         (progn (setq s-point (point))
1872                (end-of-line)
1873                (setq subject (buffer-substring s-point (point)))))
1874     (setq subject (feedmail-tidy-up-slug subject))
1875     (if (zerop (length subject))
1876         (setq subject
1877               (cond
1878                ((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
1879                ((fboundp feedmail-queue-default-file-slug)
1880                 (save-excursion (funcall feedmail-queue-default-file-slug)))
1881                ((eq feedmail-queue-default-file-slug 'ask)
1882                 (file-name-nondirectory
1883                  (read-file-name "FQM: Message filename slug? "
1884                                  (file-name-as-directory queue-directory) subject nil subject)))
1885                (t "no subject"))
1886               ))
1887     ;; one more time, with feeling
1888     (feedmail-tidy-up-slug subject)
1889     ))
1890
1891
1892 (defun feedmail-create-queue-filename (queue-directory)
1893   (let ((slug "wjc"))
1894     (cond
1895      (feedmail-queue-slug-maker
1896       (save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
1897      (feedmail-ask-for-queue-slug
1898       (setq slug (file-name-nondirectory
1899                   (read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
1900                                   (file-name-as-directory queue-directory) slug nil slug))))
1901      )
1902     (setq slug (feedmail-tidy-up-slug slug))
1903     (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
1904     (concat
1905      (expand-file-name slug queue-directory)
1906      feedmail-queue-fqm-suffix)
1907     ))
1908
1909
1910 (defun feedmail-dump-message-to-queue (queue-directory what-event)
1911   (or (file-accessible-directory-p queue-directory)
1912       ;; progn to get nil result no matter what
1913       (progn (make-directory queue-directory t) nil)
1914       (file-accessible-directory-p queue-directory)
1915       (error (concat "FQM: Message not queued; trouble with directory " queue-directory)))
1916   (let ((filename)
1917         (is-fqm)
1918         (is-in-this-dir)
1919         (previous-buffer-file-name buffer-file-name))
1920     (if buffer-file-name
1921         (progn
1922           (setq is-fqm (feedmail-fqm-p buffer-file-name))
1923           (setq is-in-this-dir (string-equal
1924                                 (directory-file-name queue-directory)
1925                                 (directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
1926     ;; if visiting a queued message, just save
1927     (if (and is-fqm is-in-this-dir)
1928         (setq filename buffer-file-name)
1929       (setq filename (feedmail-create-queue-filename queue-directory)))
1930     ;; make binary file on DOS/Win95/WinNT, etc
1931     (let ((buffer-file-type feedmail-force-binary-write)) (write-file filename))
1932     ;; convenient for moving from draft to q, for example
1933     (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
1934              (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name)))
1935         (delete-file previous-buffer-file-name))
1936     (if feedmail-nuke-buffer-after-queue
1937         (let ((a-s-file-name buffer-auto-save-file-name))
1938           ;; be aggressive in nuking auto-save files
1939           (and (kill-buffer (current-buffer))
1940                delete-auto-save-files
1941                (file-exists-p a-s-file-name)
1942                (delete-file a-s-file-name))))
1943     (if feedmail-queue-chatty
1944         (progn (message (concat "FQM: Queued in " filename))
1945                (sit-for feedmail-queue-chatty-sit-for)))
1946     (if feedmail-queue-chatty
1947         (progn
1948           (feedmail-queue-reminder what-event)
1949           (sit-for feedmail-queue-chatty-sit-for)))))
1950
1951
1952 ;; from a similar function in mail-utils.el
1953 (defun feedmail-rfc822-time-zone (time)
1954   (let* ((sec (or (car (current-time-zone time)) 0))
1955          (absmin (/ (abs sec) 60)))
1956     (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
1957
1958 (defun feedmail-rfc822-date (arg-time)
1959   (let ((time (if arg-time arg-time (current-time))))
1960     (concat
1961      (format-time-string "%a, %e %b %Y %T " time)
1962      (feedmail-rfc822-time-zone time)
1963      )))
1964
1965
1966 (defun feedmail-send-it-immediately ()
1967   "Handle immediate sending, including during a queue run."
1968   (let* ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
1969          (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
1970          (feedmail-raw-text-buffer (current-buffer))
1971          (feedmail-address-list)
1972          (eoh-marker)
1973          (bcc-holder)
1974          (resent-bcc-holder)
1975          (a-re-rtcb  "^Resent-\\(To\\|Cc\\|Bcc\\):")
1976          (a-re-rtc   "^Resent-\\(To\\|Cc\\):")
1977          (a-re-rb    "^Resent-Bcc:")
1978          (a-re-dtcb  "^\\(To\\|Cc\\|Bcc\\):")
1979          (a-re-dtc   "^\\(To\\|Cc\\):")
1980          (a-re-db    "^Bcc:")
1981          ;; to get a temporary changable copy
1982          (mail-header-separator mail-header-separator)
1983          )
1984     (unwind-protect
1985         (save-excursion
1986           (set-buffer feedmail-error-buffer) (erase-buffer)
1987           (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
1988
1989           ;; jam contents of user-supplied mail buffer into our scratch buffer
1990           (insert-buffer feedmail-raw-text-buffer)
1991
1992           ;; require one newline at the end.
1993           (goto-char (point-max))
1994           (or (= (preceding-char) ?\n) (insert ?\n))
1995
1996           (let ((case-fold-search nil))
1997             ;; Change header-delimiter to be what mailers expect (empty line).
1998             ;; leaves match data in place or signals error
1999             (setq eoh-marker (feedmail-find-eoh))
2000             (replace-match "\n")
2001             (setq mail-header-separator ""))
2002
2003           ;; mail-aliases nil = mail-abbrevs.el
2004           (if (or feedmail-force-expand-mail-aliases
2005                   (and (fboundp 'expand-mail-aliases) mail-aliases))
2006               (expand-mail-aliases (point-min) eoh-marker))
2007
2008           ;; make it pretty
2009           (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
2010           ;; ignore any blank lines in the header
2011           (goto-char (point-min))
2012           (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
2013             (replace-match "\n"))
2014
2015           (let ((case-fold-search t) (addr-regexp))
2016             (goto-char (point-min))
2017             ;; there are some RFC-822 combinations/cases missed here,
2018             ;; but probably good enough and what users expect
2019             ;;
2020             ;; use resent-* stuff only if there is at least one non-empty one
2021             (setq feedmail-is-a-resend
2022                   (re-search-forward
2023                    ;; header name, followed by optional whitespace, followed by
2024                    ;; non-whitespace, followed by anything, followed by newline;
2025                    ;; the idea is empty Resent-* headers are ignored
2026                    "^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
2027                    eoh-marker t))
2028             ;; if we say so, gather the Bcc stuff before the main course
2029             (if (eq feedmail-deduce-bcc-where 'first)
2030                 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
2031                        (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2032             ;; the main course
2033             (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
2034                 ;; handled by first or last cases, so don't get Bcc stuff
2035                 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
2036                        (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
2037               ;; not handled by first or last cases, so also get Bcc stuff
2038               (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
2039                      (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2040             ;; if we say so, gather the Bcc stuff after the main course
2041             (if (eq feedmail-deduce-bcc-where 'last)
2042                 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
2043                        (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2044             (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
2045             ;; not needed, but meets user expectations
2046             (setq feedmail-address-list (nreverse feedmail-address-list))
2047             ;; Find and handle any Bcc fields.
2048             (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
2049             (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
2050             (if (and bcc-holder (not feedmail-nuke-bcc))
2051                 (progn (goto-char (point-min))
2052                        (insert bcc-holder)))
2053             (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
2054                 (progn (goto-char (point-min))
2055                        (insert resent-bcc-holder)))
2056             (goto-char (point-min))
2057
2058             ;; fiddle about, fiddle about, fiddle about....
2059             (feedmail-fiddle-from)
2060             (feedmail-fiddle-sender)
2061             (feedmail-fiddle-x-mailer)
2062             (feedmail-fiddle-message-id
2063              (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
2064             (feedmail-fiddle-date
2065              (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
2066             (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
2067
2068             ;; don't send out a blank headers of various sorts
2069             ;; (this loses on continued line with a blank first line)
2070             (goto-char (point-min))
2071             (and feedmail-nuke-empty-headers ; hey, who's an empty-header?
2072                  (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
2073                    (replace-match ""))))
2074
2075           (run-hooks 'feedmail-last-chance-hook)
2076
2077           (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:"))
2078                 (also-file)
2079                 (confirm (cond
2080                           ((eq feedmail-confirm-outgoing 'immediate)
2081                            (not feedmail-queue-runner-is-active))
2082                           ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
2083                           (t feedmail-confirm-outgoing))))
2084             (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
2085                 (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
2086                   (feedmail-give-it-to-buffer-eater)
2087                   (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
2088                       (progn            ; if a file but not running the queue, offer to delete it
2089                         (setq also-file (expand-file-name also-file))
2090                         (if (or feedmail-queue-auto-file-nuke
2091                                 (y-or-n-p (format "FQM: Delete message file %s? " also-file)))
2092                             (save-excursion
2093                               ;; if we delete the affiliated file, get rid
2094                               ;; of the file name association and make sure we
2095                               ;; don't annoy people with a prompt on exit
2096                               (delete-file also-file)
2097                               (set-buffer feedmail-raw-text-buffer)
2098                               (setq buffer-offer-save nil)
2099                               (setq buffer-file-name nil)
2100                               )
2101                           )))
2102                   (goto-char (point-min))
2103                   ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
2104                   (if fcc (let ((default-buffer-file-type feedmail-force-binary-write))
2105                             (insert fcc)
2106                             (if (not feedmail-nuke-bcc-in-fcc)
2107                                 (progn (if bcc-holder (insert bcc-holder))
2108                                        (if resent-bcc-holder (insert resent-bcc-holder))))
2109
2110                             (run-hooks 'feedmail-before-fcc-hook)
2111
2112                             (if feedmail-nuke-body-in-fcc
2113                                 (progn (goto-char eoh-marker)
2114                                        (if (natnump feedmail-nuke-body-in-fcc)
2115                                            (forward-line feedmail-nuke-body-in-fcc))
2116                                        (delete-region (point) (point-max))
2117                                        ))
2118                             (mail-do-fcc eoh-marker)
2119                             )))
2120               (error "FQM: Sending...abandoned") ; user bailed out of one-last-look
2121               )))                       ; unwind-protect body (save-excursion)
2122
2123       ;; unwind-protect cleanup forms
2124       (kill-buffer feedmail-prepped-text-buffer)
2125       (set-buffer feedmail-error-buffer)
2126       (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
2127         (progn (display-buffer feedmail-error-buffer)
2128                ;; read fast ... the meter is running
2129                (if (and feedmail-queue-runner-is-active feedmail-queue-chatty)
2130                    (progn (message "FQM: Sending...failed") (ding t) (sit-for 3)))
2131                (error "FQM: Sending...failed")))
2132       (set-buffer feedmail-raw-text-buffer))
2133     )                                   ; let
2134   (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
2135       (progn
2136         (feedmail-queue-reminder 'after-immediate)
2137         (sit-for feedmail-queue-chatty-sit-for)))
2138   )
2139
2140
2141 (defun feedmail-fiddle-header (name value &optional action folding)
2142   "Internal feedmail function for jamming fields into message header.
2143 NAME, VALUE, ACTION, and FOLDING are the four elements of a
2144 fiddle-plex, as described in the documentation for the variable
2145 feedmail-fiddle-plex-blurb."
2146   (let ((case-fold-search t)
2147         (header-colon (concat (regexp-quote name) ":"))
2148         header-regexp eoh-marker has-like ag-like val-like that-point)
2149     (setq header-regexp (concat "^" header-colon))
2150     (setq eoh-marker (feedmail-find-eoh))
2151     (goto-char (point-min))
2152     (setq has-like (re-search-forward header-regexp eoh-marker t))
2153
2154     (if (not action) (setq action 'supplement))
2155     (cond
2156      ((eq action 'supplement)
2157       ;; trim leading/trailing whitespace
2158       (if (string-match "\\`[ \t\n]+" value)
2159           (setq value (substring value (match-end 0))))
2160       (if (string-match "[ \t\n]+\\'" value)
2161           (setq value (substring value 0 (match-beginning 0))))
2162       (if (> (length value) 0)
2163           (progn
2164             (if feedmail-fiddle-headers-upwardly
2165                 (goto-char (point-min))
2166               (goto-char eoh-marker))
2167             (setq that-point (point))
2168             (insert name ": " value "\n")
2169             (if folding (feedmail-fill-this-one that-point (point))))))
2170
2171      ((eq action 'replace)
2172       (if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
2173       (feedmail-fiddle-header name value 'supplement folding))
2174
2175      ((eq action 'create)
2176       (if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))
2177
2178      ((eq action 'combine)
2179       (setq val-like (nth 1 value))
2180       (setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
2181       ;; get rid of initial header name from first instance (front of string)
2182       (if (string-match (concat header-regexp "[ \t\n]+") ag-like)
2183           (setq ag-like (replace-match "" t t ag-like)))
2184       ;; get rid of embedded header names from subsequent instances
2185       (while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
2186         (setq ag-like (replace-match "\n\t" t t ag-like)))
2187       ;; trim leading/trailing whitespace
2188       (if (string-match "\\`[ \t\n]+" ag-like)
2189           (setq ag-like (substring ag-like (match-end 0))))
2190       (if (string-match "[ \t\n]+\\'" ag-like)
2191           (setq ag-like (substring ag-like 0 (match-beginning 0))))
2192       ;; if ag-like is not nil and not an empty string, transform it via a function
2193       ;; call or format operation
2194       (if (> (length ag-like) 0)
2195           (setq ag-like
2196                 (cond
2197                  ((and (symbolp val-like) (fboundp val-like))
2198                   (funcall val-like name ag-like))
2199                  ((stringp val-like)
2200                   (format val-like ag-like))
2201                  (t nil))))
2202       (feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
2203     ))
2204
2205 (defun feedmail-give-it-to-buffer-eater ()
2206   (save-excursion
2207     (if feedmail-enable-spray
2208         (mapcar
2209          '(lambda (feedmail-spray-this-address)
2210             (let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
2211               (save-excursion
2212                 (set-buffer spray-buffer)
2213                 (erase-buffer)
2214                 ;; not life's most efficient methodology, but spraying isn't
2215                 ;; an every-5-minutes event either
2216                 (insert-buffer feedmail-prepped-text-buffer)
2217                 ;; There's a good case to me made that each separate transmission of
2218                 ;; a message in the spray should have a distinct Message-Id:.  There
2219                 ;; is also a less compelling argument in the other direction.  I think
2220                 ;; they technically should have distinct Message-Id:s, but I doubt that
2221                 ;; anyone cares, practically.  If someone complains about it, I'll add
2222                 ;; it.
2223                 (feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list)
2224                 ;; this (let ) is just in case some buffer eater
2225                 ;; is cheating and using the global variable name instead
2226                 ;; of its argument to find the buffer
2227                 (let ((feedmail-prepped-text-buffer spray-buffer))
2228                   (funcall feedmail-buffer-eating-function
2229                            feedmail-prepped-text-buffer
2230                            feedmail-error-buffer
2231                            (list feedmail-spray-this-address))))
2232               (kill-buffer spray-buffer)
2233               ))
2234          feedmail-address-list)
2235       (funcall feedmail-buffer-eating-function
2236                feedmail-prepped-text-buffer
2237                feedmail-error-buffer
2238                feedmail-address-list))))
2239
2240
2241 (defun feedmail-envelope-deducer (eoh-marker)
2242   "If feedmail-deduce-envelope-from is false, simply return `user-mail-address'.
2243 Else, look for Sender: or From: (or Resent-*) and
2244 return that value."
2245   (if (not feedmail-deduce-envelope-from)
2246       user-mail-address
2247     (let ((from-list))
2248       (setq from-list
2249             (feedmail-deduce-address-list
2250              (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-Sender:" "^Sender:")
2251              from-list))
2252       (if (not from-list)
2253           (setq from-list
2254                 (feedmail-deduce-address-list
2255                  (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-From:" "^From:")
2256                  from-list)))
2257       (if (and from-list (car from-list)) (car from-list) user-mail-address))))
2258
2259
2260 (defun feedmail-fiddle-from ()
2261   "Fiddle From:."
2262   ;; default is to fall off the end of the list and do nothing
2263   (cond
2264    ;; nil means do nothing
2265    ((eq nil feedmail-from-line) nil)
2266    ;; t is the same a using the default computation, so compute it and recurse
2267    ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
2268    ;; improvement using user-mail-address suggested by
2269    ;;   gray@austin.apc.slb.com (Douglas Gray Stephens)
2270    ((eq t feedmail-from-line)
2271     (let ((feedmail-from-line
2272            (let ((at-stuff
2273                   (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name)))))
2274              (cond
2275               ((eq mail-from-style nil) at-stuff)
2276               ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")"))
2277               ((eq mail-from-style 'angles) (concat "\"" (user-full-name) "\" <" at-stuff ">"))
2278               ))))
2279       (feedmail-fiddle-from)))
2280
2281    ;; if it's a string, simply make a fiddle-plex out of it and recurse
2282    ((stringp feedmail-from-line)
2283     (let ((feedmail-from-line (list "ignored" feedmail-from-line 'create)))
2284       (feedmail-fiddle-from)))
2285
2286    ;; if it's a function, call it and recurse with the resulting value
2287    ((and (symbolp feedmail-from-line) (fboundp feedmail-from-line))
2288     (let ((feedmail-from-line (funcall feedmail-from-line)))
2289       (feedmail-fiddle-from)))
2290
2291    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2292    ((listp feedmail-from-line)
2293     (feedmail-fiddle-header
2294      (if feedmail-is-a-resend "Resent-From" "From")
2295      (nth 1 feedmail-from-line)         ; value
2296      (nth 2 feedmail-from-line)         ; action
2297      (nth 3 feedmail-from-line)))))     ; folding
2298
2299
2300 (defun feedmail-fiddle-sender ()
2301   "Fiddle Sender:."
2302   ;; default is to fall off the end of the list and do nothing
2303   (cond
2304    ;; nil means do nothing
2305    ((eq nil feedmail-sender-line) nil)
2306    ;; t is not allowed, but handled it just to avoid bugs later
2307    ((eq t feedmail-sender-line) nil)
2308
2309    ;; if it's a string, simply make a fiddle-plex out of it and recurse
2310    ((stringp feedmail-sender-line)
2311     (let ((feedmail-sender-line (list "ignored" feedmail-sender-line 'create)))
2312       (feedmail-fiddle-sender)))
2313
2314    ;; if it's a function, call it and recurse with the resulting value
2315    ((and (symbolp feedmail-sender-line) (fboundp feedmail-sender-line))
2316     (let ((feedmail-sender-line (funcall feedmail-sender-line)))
2317       (feedmail-fiddle-sender)))
2318
2319    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2320    ((listp feedmail-sender-line)
2321     (feedmail-fiddle-header
2322      (if feedmail-is-a-resend "Resent-Sender" "Sender")
2323      (nth 1 feedmail-sender-line)       ; value
2324      (nth 2 feedmail-sender-line)       ; action
2325      (nth 3 feedmail-sender-line)))))   ; folding
2326
2327
2328 (defun feedmail-default-date-generator (maybe-file)
2329   "Default function for generating Date: header contents."
2330   (let ((date-time))
2331     (if (and (not feedmail-queue-use-send-time-for-date) maybe-file)
2332         (setq date-time (nth 5 (file-attributes maybe-file))))
2333     (feedmail-rfc822-date date-time))
2334   )
2335
2336
2337 (defun feedmail-fiddle-date (maybe-file)
2338   "Fiddle Date:.  See documentation of feedmail-date-generator."
2339   ;; default is to fall off the end of the list and do nothing
2340   (cond
2341    ;; nil means do nothing
2342    ((eq nil feedmail-date-generator) nil)
2343    ;; t is the same a using the function feedmail-default-date-generator, so let it and recurse
2344    ((eq t feedmail-date-generator)
2345     (let ((feedmail-date-generator (feedmail-default-date-generator maybe-file)))
2346       (feedmail-fiddle-date maybe-file)))
2347
2348    ;; if it's a string, simply make a fiddle-plex out of it and recurse
2349    ((stringp feedmail-date-generator)
2350     (let ((feedmail-date-generator (list "ignored" feedmail-date-generator 'create)))
2351       (feedmail-fiddle-date maybe-file)))
2352
2353    ;; if it's a function, call it and recurse with the resulting value
2354    ((and (symbolp feedmail-date-generator) (fboundp feedmail-date-generator))
2355     (let ((feedmail-date-generator (funcall feedmail-date-generator maybe-file)))
2356       (feedmail-fiddle-date maybe-file)))
2357
2358    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2359    ((listp feedmail-date-generator)
2360     (feedmail-fiddle-header
2361      (if feedmail-is-a-resend "Resent-Date" "Date")
2362      (nth 1 feedmail-date-generator)    ; value
2363      (nth 2 feedmail-date-generator)    ; action
2364      (nth 3 feedmail-date-generator))))) ; folding
2365
2366
2367 (defun feedmail-default-message-id-generator (maybe-file)
2368   "Default function for generating Message-Id: header contents.
2369 Based on a date and a sort of random number for tie breaking.  Unless
2370 feedmail-message-id-suffix is defined, uses `user-mail-address', so be
2371 sure it's set."
2372   (let ((date-time)
2373         (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
2374     (if (string-match "^\\(.*\\)@" end-stuff)
2375         (setq end-stuff
2376               (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
2377       (setq end-stuff (concat "@" end-stuff)))
2378     (if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
2379         (setq date-time (nth 5 (file-attributes maybe-file))))
2380     (format "<%d-%s%s%s>"
2381             (mod (random) 10000)
2382             (format-time-string "%a%d%b%Y%H%M%S" date-time)
2383             (feedmail-rfc822-time-zone date-time)
2384             end-stuff))
2385   )
2386
2387 (defun feedmail-fiddle-message-id (maybe-file)
2388   "Fiddle Message-Id:.  See documentation of feedmail-message-id-generator."
2389   ;; default is to fall off the end of the list and do nothing
2390   (cond
2391    ;; nil means do nothing
2392    ((eq nil feedmail-message-id-generator) nil)
2393    ;; t is the same a using the function feedmail-default-message-id-generator, so let it and recurse
2394    ((eq t feedmail-message-id-generator)
2395     (let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file)))
2396       (feedmail-fiddle-message-id maybe-file)))
2397
2398    ;; if it's a string, simply make a fiddle-plex out of it and recurse
2399    ((stringp feedmail-message-id-generator)
2400     (let ((feedmail-message-id-generator (list "ignored" feedmail-message-id-generator 'create)))
2401       (feedmail-fiddle-message-id maybe-file)))
2402
2403    ;; if it's a function, call it and recurse with the resulting value
2404    ((and (symbolp feedmail-message-id-generator) (fboundp feedmail-message-id-generator))
2405     (let ((feedmail-message-id-generator (funcall feedmail-message-id-generator maybe-file)))
2406       (feedmail-fiddle-message-id maybe-file)))
2407
2408    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2409    ((listp feedmail-message-id-generator)
2410     (feedmail-fiddle-header
2411      (if feedmail-is-a-resend "Resent-Message-Id" "Message-Id")
2412      (nth 1 feedmail-message-id-generator) ; value
2413      (nth 2 feedmail-message-id-generator) ; action
2414      (nth 3 feedmail-message-id-generator))))) ; folding
2415
2416
2417 (defun feedmail-default-x-mailer-generator ()
2418   "Default function for generating X-Mailer: header contents."
2419   (concat
2420    (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs "))
2421    emacs-version " (via feedmail " feedmail-patch-level
2422    (if feedmail-queue-runner-is-active " Q" " I")
2423    (if feedmail-enable-spray "S" "")
2424    (if feedmail-x-mailer-line-user-appendage ") " ")")
2425    feedmail-x-mailer-line-user-appendage))
2426
2427
2428 (defun feedmail-fiddle-x-mailer ()
2429   "Fiddle X-Mailer:.  See documentation of feedmail-x-mailer-line."
2430   ;; default is to fall off the end of the list and do nothing
2431   (cond
2432    ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
2433    ((eq t feedmail-x-mailer-line)
2434     (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
2435       (feedmail-fiddle-x-mailer)))
2436
2437    ;; if it's a string, simply make a fiddle-plex out of it and recurse
2438    ((stringp feedmail-x-mailer-line)
2439     (let ((feedmail-x-mailer-line (list "ignored" (list feedmail-x-mailer-line ";\n\t%s") 'combine)))
2440       (feedmail-fiddle-x-mailer)))
2441
2442    ;; if it's a function, call it and recurse with the resulting value
2443    ((and (symbolp feedmail-x-mailer-line) (fboundp feedmail-x-mailer-line))
2444     (let ((feedmail-x-mailer-line (funcall feedmail-x-mailer-line)))
2445       (feedmail-fiddle-x-mailer)))
2446
2447    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2448    ((listp feedmail-x-mailer-line)
2449     (feedmail-fiddle-header
2450      (if feedmail-is-a-resend "X-Resent-Mailer" "X-Mailer")
2451      (nth 1 feedmail-x-mailer-line)     ; value
2452      (nth 2 feedmail-x-mailer-line)     ; action
2453      (nth 3 feedmail-x-mailer-line))))) ; folding
2454
2455
2456 (defun feedmail-fiddle-spray-address (addy-plex)
2457   "Fiddle header for single spray address.  Uses feedmail-spray-this-address."
2458   ;; default is to fall off the end of the list and do nothing
2459   (cond
2460    ;; nil means do nothing
2461    ((eq nil addy-plex) nil)
2462    ;; t means the same as using "To:" and unembellished addy
2463    ((eq t addy-plex)
2464     (let ((addy-plex (list "To" feedmail-spray-this-address)))
2465       (feedmail-fiddle-spray-address addy-plex)))
2466
2467    ;; if it's a string, simply make a fiddle-plex out of it and recurse, assuming
2468    ;; the string names a header field (e.g., "To")
2469    ((stringp addy-plex)
2470     (let ((addy-plex (list addy-plex feedmail-spray-this-address)))
2471       (feedmail-fiddle-spray-address addy-plex)))
2472
2473    ;; if it's a function, call it and recurse with the resulting value
2474    ((and (symbolp addy-plex) (fboundp addy-plex))
2475     (let ((addy-plex (funcall addy-plex)))
2476       (feedmail-fiddle-spray-address addy-plex)))
2477
2478    ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2479    ((listp addy-plex)
2480     (feedmail-fiddle-header
2481      (nth 0 addy-plex)                  ; name
2482      (nth 1 addy-plex)                  ; value
2483      (nth 2 addy-plex)                  ; action
2484      (nth 3 addy-plex)))))              ; folding
2485
2486
2487 (defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
2488   "Fiddling based on a list of fiddle-plexes for spraying."
2489   ;; default is to fall off the end of the list and do nothing
2490   (let ((lofp list-of-fiddle-plexes) fp)
2491     (if (listp lofp)
2492         (while lofp
2493           (setq fp (car lofp))
2494           (setq lofp (cdr lofp))
2495           (feedmail-fiddle-spray-address fp))
2496       (feedmail-fiddle-spray-address lofp))))
2497
2498
2499 (defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
2500   "Fiddling based on a list of fiddle-plexes.  Values t, nil, and string are pointless."
2501   ;; default is to fall off the end of the list and do nothing
2502   (let ((lofp list-of-fiddle-plexes) fp)
2503     (while lofp
2504       (setq fp (car lofp))
2505       (setq lofp (cdr lofp))
2506       (cond
2507
2508        ;; if it's a function, call it and recurse with the resulting value
2509        ((and (symbolp fp) (fboundp fp))
2510         (let ((lofp (list (funcall fp)))) (feedmail-fiddle-list-of-fiddle-plexes lofp)))
2511
2512        ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2513        ((listp fp)
2514         (feedmail-fiddle-header
2515          (nth 0 fp)
2516          (nth 1 fp)                     ; value
2517          (nth 2 fp)                     ; action
2518          (nth 3 fp)))))))               ; folding
2519
2520
2521 (defun feedmail-accume-n-nuke-header (header-end header-regexp)
2522   "Delete headers matching a regexp and their continuation lines.
2523 There may be multiple such lines, and each may have arbitrarily
2524 many continuation lines.  Return an accumulation of the deleted
2525 headers, including the intervening newlines."
2526   (let ((case-fold-search t) (dropout))
2527     (save-excursion
2528       (goto-char (point-min))
2529       ;; iterate over all matching lines
2530       (while (re-search-forward header-regexp header-end t)
2531         (forward-line 1)
2532         (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
2533         (delete-region (match-beginning 0) (point))
2534         ;; get rid of any continuation lines
2535         (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
2536           (forward-line 1)
2537           (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
2538           (replace-match ""))))
2539     (identity dropout)))
2540
2541 (defun feedmail-fill-to-cc-function (header-end)
2542   "Smart filling of address headers (don't be fooled by the name).
2543 The filling tries to avoid splitting lines except at commas.  This
2544 avoids, in particular, splitting within parenthesized comments in
2545 addresses.  Headers filled include From:, Reply-To:, To:, Cc:, Bcc:,
2546 Resent-To:, Resent-Cc:, and Resent-Bcc:."
2547   (let ((case-fold-search t)
2548         this-line
2549         this-line-end)
2550     (save-excursion
2551       (goto-char (point-min))
2552       ;; iterate over all To:/Cc:, etc, lines
2553       (while
2554           (re-search-forward
2555            "^\\(From:\\|Reply-To:\\|To:\\|Cc:\\|Bcc:\\|Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)"
2556            header-end t)
2557         (setq this-line (match-beginning 0))
2558         ;; replace 0 or more leading spaces with a single space
2559         (and (looking-at "[ \t]*") (replace-match " "))
2560         (forward-line 1)
2561         ;; get any continuation lines
2562         (while (and (looking-at "[ \t]+") (< (point) header-end))
2563           (forward-line 1))
2564         (setq this-line-end (point-marker))
2565         (save-excursion (feedmail-fill-this-one this-line this-line-end))
2566         ))))
2567
2568
2569 (defun feedmail-fill-this-one (this-line this-line-end)
2570   "In-place smart filling of the region bounded by the two arguments."
2571   (let ((fill-prefix "\t")
2572         (fill-column feedmail-fill-to-cc-fill-column))
2573     ;; The general idea is to break only on commas.  Collapse
2574     ;; multiple whitespace to a single blank; change
2575     ;; all the blanks to something unprintable; change the
2576     ;; commas to blanks; fill the region; change it back.
2577     (goto-char this-line)
2578     (while (re-search-forward "\\s-+" (1- this-line-end) t)
2579       (replace-match " "))
2580
2581     (subst-char-in-region this-line this-line-end ?   2 t) ; blank->C-b
2582     (subst-char-in-region this-line this-line-end ?, ?  t) ; comma->blank
2583
2584     (fill-region-as-paragraph this-line this-line-end)
2585
2586     (subst-char-in-region this-line this-line-end ?  ?, t) ; comma<-blank
2587     (subst-char-in-region this-line this-line-end  2 ?  t) ; blank<-C-b
2588
2589     ;; look out for missing commas before continuation lines
2590     (goto-char this-line)
2591     (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
2592       (replace-match "\\1,\n\t"))
2593     ))
2594
2595
2596 (require 'mail-utils)                   ; pick up mail-strip-quoted-names
2597 (defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
2598   "Get address list with all comments and other excitement trimmed.
2599 Addresses are collected only from headers whose names match the fourth
2600 argument Returns a list of strings.  Duplicate addresses will have
2601 been weeded out."
2602   (let ((simple-address)
2603         (address-blob)
2604         (this-line)
2605         (this-line-end))
2606     (unwind-protect
2607         (save-excursion
2608           (set-buffer (get-buffer-create " *FQM scratch*")) (erase-buffer)
2609           (insert-buffer-substring message-buffer header-start header-end)
2610           (goto-char (point-min))
2611           (let ((case-fold-search t))
2612             (while (re-search-forward addr-regexp (point-max) t)
2613               (replace-match "")
2614               (setq this-line (match-beginning 0))
2615               (forward-line 1)
2616               ;; get any continuation lines
2617               (while (and (looking-at "^[ \t]+") (< (point) (point-max)))
2618                 (forward-line 1))
2619               (setq this-line-end (point-marker))
2620               ;; only keep if we don't have it already
2621               (setq address-blob
2622                     (mail-strip-quoted-names (buffer-substring this-line this-line-end)))
2623               (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
2624                 (setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
2625                 (setq address-blob (replace-match "" t t address-blob))
2626                 (if (not (member simple-address address-list))
2627                     (add-to-list 'address-list simple-address)))
2628               ))
2629           (kill-buffer nil)))
2630     (identity address-list)))
2631
2632
2633 (defun feedmail-one-last-look (feedmail-prepped-text-buffer)
2634   "Offer the user one last chance to give it up."
2635   (save-excursion
2636     (save-window-excursion
2637       (switch-to-buffer feedmail-prepped-text-buffer)
2638       (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout))
2639           (y-or-n-p-with-timeout
2640            "FQM: Send this email? "
2641            (abs feedmail-confirm-outgoing-timeout)
2642            (> feedmail-confirm-outgoing-timeout 0))
2643         (y-or-n-p "FQM: Send this email? "))
2644       )))
2645
2646 (defun feedmail-fqm-p (might-be)
2647   "Internal; does filename end with FQM suffix?"
2648   (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
2649
2650
2651 (defun feedmail-find-eoh (&optional noerror)
2652   "Internal; finds the end of message header fields, returns mark just before it"
2653   (save-excursion
2654     (goto-char (point-min))
2655     (when (or (re-search-forward (concat "^"
2656                                          (regexp-quote mail-header-separator)
2657                                          "\n")
2658                                  nil noerror)
2659               (and feedmail-queue-alternative-mail-header-separator
2660                    (re-search-forward
2661                     (concat "^"
2662                             (regexp-quote
2663                              feedmail-queue-alternative-mail-header-separator)
2664                             "\n")
2665                     nil noerror)))
2666       (forward-line -1)
2667       (point-marker))))
2668
2669 (provide 'feedmail)
2670 ;;; feedmail.el ends here