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