1 ;;; feedmail.el --- assist other email packages to massage outgoing messages
2 ;;; This file is in the public domain.
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.
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.
22 ;; Author: Bill Carpenter <bill@bubblegum.net>, <bill@carpenter.ORG>
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.
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".
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
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
56 ;; (defconst feedmail-patch-level "123")
57 ;; (defconst feedmail-patch-level "123-XYZ-mods")
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.
65 ;; This file requires the mail-utils library.
67 ;; This file requires the smtpmail library if you use
68 ;; feedmail-buffer-to-smtpmail.
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/>.
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):
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
93 ;; --- you can get one last look at the prepped outbound message and
94 ;; be prompted for confirmation
96 ;; --- removes Bcc:/Resent-Bcc: headers after getting address info
98 ;; --- does smart filling of address headers
100 ;; --- calls a routine to process Fcc: lines and removes them
102 ;; --- empty headers are removed
104 ;; --- can force From: or Sender: line
106 ;; --- can generate a Message-Id: line
108 ;; --- can generate a Date: line; the date can be the time the
109 ;; message was written or the time it is being sent
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)
117 ;; --- error info is pumped into a normal buffer instead of the
120 ;; --- just before the optional prompt for confirmation, lets you
121 ;; run a hook on the prepped message and simplified address
124 ;; --- you can specify something other than /bin/mail for the
127 ;; --- you can generate/modify an X-Mailer: message header
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
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:
137 ;; (setq send-mail-function 'feedmail-send-it)
138 ;; (autoload 'feedmail-send-it "feedmail")
140 ;; If you plan to use the queue stuff, also use this:
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))
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.
151 ;; If you are planning to call feedmail-queue-reminder from your .emacs or
152 ;; something similar, you might need this:
154 ;; (autoload 'feedmail-queue-reminder "feedmail")
156 ;; If you ever use rmail-resend and queue messages, you should do this:
158 ;; (setq feedmail-queue-alternative-mail-header-separator "")
160 ;; If you want to automatically spell-check messages, but not when sending
161 ;; them from the queue, you could do something like this:
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)
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:
171 ;; (setq message-send-mail-function 'feedmail-send-it)
172 ;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
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
180 ;; feedmail|Bill Carpenter|bill@bubblegum.net,bill@carpenter.ORG|Outbound mail queue handling|98-06-15|8|feedmail.el
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
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
226 ;; cleanup some of my sloppiness about case-fold-search (a strange
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
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
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)
278 ;; todo (probably in patchlevel 9):
279 ;; write texinfo manual
280 ;; maybe partition into multiple files, including files of examples
284 (defconst feedmail-patch-level "8")
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:
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)
299 (defmacro defcustom (var value doc &rest args)
300 (` (defvar (, var) (, value) (, doc))))))
303 (defgroup feedmail nil
304 "Assist other email packages to massage outgoing messages."
307 (defgroup feedmail-misc nil
308 "Miscellaneous feedmail options that don't fit in other groups."
311 (defgroup feedmail-headers nil
312 "Options related to manipulating specific headers or types of headers."
315 (defgroup feedmail-queue nil
316 "Options related to queuing messages for later sending."
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
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)
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
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
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.
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
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
405 (defcustom feedmail-fill-to-cc-fill-column default-fill-column
406 "*Fill column used by feedmail-fill-to-cc."
407 :group 'feedmail-headers
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
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
428 :group 'feedmail-headers
430 :type '(choice (const nil) (const t) integer)
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
441 :group 'feedmail-headers
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
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
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\".
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)
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
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
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\".
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 nil) string)
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.
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).
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
563 (defcustom feedmail-x-mailer-line-user-appendage nil
564 "*See feedmail-x-mailer-line."
565 :group 'feedmail-headers
566 :type '(choice (const nil) string)
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.
577 If nil, nothing is done about X-Mailer:.
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.
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)
600 (defcustom feedmail-message-id-generator t
601 "*Specifies the creation of a Message-Id: header field.
603 If nil, nothing is done about Message-Id:.
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.
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\".
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)
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
639 :group 'feedmail-headers
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.
648 If nil, nothing is done about Date:.
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.
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\".
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!
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)
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
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
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.
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
708 (defcustom feedmail-enable-spray nil
709 "If non-nil, transmit message separately to each addressee.
710 feedmail normally accumulates a list of addressees and passes the message
711 along with that list to a buffer-eating function which expects any number
712 of addressees. If this variable is non-nil, however, feedmail will
713 repeatedly call the same buffer-eating function. Each time, the list of
714 addressees will be just one item from the original list. This only affects
715 the message envelope addresses and doesn't affect what appears in the
716 message headers except as noted.
718 Spray mode is usually pointless, and if you can't think of a good reason for
719 it, you should avoid it since it is inherently less efficient than normal
720 multiple delivery. One reason to use it is to overcome mis-featured mail
721 transports which betray your trust by revealing Bcc: addressees in the
722 headers of a message. Another use is to do a crude form of mailmerge, for
723 which see feedmail-spray-address-fiddle-plex-list.
725 If one of the calls to the buffer-eating function results in an error,
726 what happens next is carelessly defined, so beware."
727 :group 'feedmail-spray
731 (defvar feedmail-spray-this-address nil
732 "Do not set or change this variable. See feedmail-spray-address-fiddle-plex-list.")
734 (defcustom feedmail-spray-address-fiddle-plex-list nil
735 "User-supplied specification for a crude form of mailmerge capability.
736 When spraying is enabled, feedmail composes a list of envelope addresses.
737 In turn, feedmail-spray-this-address is temporarily set to each address
738 \(stripped of any comments and angle brackets\) and calls a function which
739 fiddles message headers according to this variable. See the documentation for
740 `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
742 May be nil, in which case nothing in particular is done about message
743 headers for specific addresses.
745 May be t, in which case a \"To:\" header is added to the message with
746 the stripped address as the header contents. The fiddle-plex operator
749 May be a string, in which case the string is assumed to be the name of
750 a message header field with the stripped address serving as the value.
751 The fiddle-plex operator is 'supplement.
753 May be a function, in which case it is called with no arguments and is
754 expected to return nil, t, a string, another function, or a fiddle-plex.
755 The result is used recursively.
757 May be a list of any combination of the foregoing and fiddle-plexes. (A
758 value for this variable which consists of a single fiddle-plex must be
759 nested inside another list to avoid ambiguity.) If a list, each item
760 is acted on in turn as described above.
764 (setq feedmail-spray-address-fiddle-plex-list 'my-address-embellisher)
766 The idea of the example is that, during spray mode, as each message is
767 about to be transmitted to an individual address, the function will be
768 called and will consult feedmail-spray-this-address to find the
769 stripped envelope email address (no comments or angle brackets). The
770 function should return an embellished form of the address.
772 The recipe for sending form letters is: (1) create a message with all
773 addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers
774 before sending the message; (3) create a function which will embellish
775 stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list
776 appropriately; (5) send the message with feedmail-enable-spray set
777 non-nil; (6) stand back and watch co-workers wonder at how efficient
778 you are at accomplishing inherently inefficient things."
779 :group 'feedmail-spray
784 (defcustom feedmail-enable-queue nil
785 "*If non-nil, provide for stashing outgoing messages in a queue.
786 This is the master on/off switch for feedmail message queuing.
787 Queuing is quite handy for laptop-based users. It's also handy if you
788 get a lot of mail and process it more or less sequentially. For
789 example, you might change your mind about contents of a reply based on
790 a message you see a bit later.
792 There is a separate queue for draft messages, intended to prevent
793 you from accidentally sending incomplete messages. The queues are
794 disk-based and intended for later transmission. The messages are
795 queued in their raw state as they appear in the mail-mode buffer and
796 can be arbitrarily edited later, before sending, by visiting the
797 appropriate file in the queue directory (and setting the buffer to
798 mail-mode or whatever). If you visit a file in the queue directory
799 and try to queue it again, it will just get saved in its existing file
800 name. You can move a message from the draft to the main queue or vice
801 versa by pretending to send it and then selecting whichever queue
802 directory you want at the prompt. The right thing will happen.
804 To transmit all the messages in the queue, invoke the command
805 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
806 :group 'feedmail-queue
811 (defcustom feedmail-queue-runner-confirm-global nil
812 "*If non-nil, give a y-or-n confirmation prompt before running the queue.
813 Prompt even if the queue is about to be processed as a result of a call to
814 feedmail-run-the-queue-no-prompts. This gives you a way to bail out
815 without having to answer no to the individual message prompts."
816 :group 'feedmail-queue
820 ;; I provided a default for VMS because someone asked for it (the
821 ;; normal default doesn't work there), but, puh-lease!, it is a user
822 ;; definable option, so if you don't like the default, change it to
823 ;; whatever you want. I am unable to directly test the VMS goop
824 ;; provided here by levitte@lp.se (Richard Levitte - VMS Whacker).
825 (defcustom feedmail-queue-directory
826 (if (memq system-type '(axp-vms vax-vms))
827 (expand-file-name (concat (getenv "HOME") "[.MAIL.Q]"))
828 (concat (getenv "HOME") "/mail/q"))
829 "*Name of a directory where messages will be queued.
830 Directory will be created if necessary. Should be a string that
831 doesn't end with a slash. Default, except on VMS, is \"$HOME/mail/q\"."
832 :group 'feedmail-queue
837 (defcustom feedmail-queue-draft-directory
838 (if (memq system-type '(axp-vms vax-vms))
839 (expand-file-name (concat (getenv "HOME") "[.MAIL.DRAFT]"))
840 (concat (getenv "HOME") "/mail/draft"))
841 "*Name of an directory where draft messages will be queued.
842 Directory will be created if necessary. Should be a string that
843 doesn't end with a slash. Default, except on VMS, is \"$HOME/mail/draft\"."
844 :group 'feedmail-queue
849 (defcustom feedmail-ask-before-queue t
850 "*If non-nil, feedmail will ask what you want to do with the message.
851 Default choices for the message action prompt will include sending it
852 immediately, putting it in the main queue, putting it in the draft
853 queue, or returning to the buffer to continue editing. Only matters if
854 queuing is enabled. If nil, the message is placed in the main queue
856 :group 'feedmail-queue
861 (defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
862 "*A string which will be used for the message action prompt.
863 If it contains a \"%s\", that will be replaced with the value of
864 feedmail-ask-before-queue-default."
865 :group 'feedmail-queue
870 (defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
871 "*A string which will be used for repompting after invalid input.
872 If it contains a \"%s\", that will be replaced with the value of
873 feedmail-ask-before-queue-default."
874 :group 'feedmail-queue
879 (defcustom feedmail-ask-before-queue-default "queue"
880 "*Meaning if user hits return in response to the message action prompt.
881 Should be a character or a string; if a string, only the first
882 character is significant. Useful values are those described in
883 the help for the message action prompt."
884 :group 'feedmail-queue
885 :type '(choice string integer) ;use integer to get char
889 (defvar feedmail-prompt-before-queue-standard-alist
890 '((?q . feedmail-message-action-queue)
891 (?Q . feedmail-message-action-queue-strong)
893 (?d . feedmail-message-action-draft)
894 (?r . feedmail-message-action-draft)
895 (?D . feedmail-message-action-draft-strong)
896 (?R . feedmail-message-action-draft-strong)
898 (?e . feedmail-message-action-edit)
899 (?E . feedmail-message-action-edit)
900 (?\C-g . feedmail-message-action-edit)
901 (?n . feedmail-message-action-edit)
902 (?N . feedmail-message-action-edit)
904 (?i . feedmail-message-action-send)
905 (?I . feedmail-message-action-send-strong)
906 (?s . feedmail-message-action-send)
907 (?S . feedmail-message-action-send-strong)
909 (?* . feedmail-message-action-toggle-spray)
911 (?\C-v . feedmail-message-action-help)
912 (?? . feedmail-message-action-help))
913 "An alist of choices for the message action prompt.
914 All of the values are function names, except help, which is a special
915 symbol that calls up help for the prompt (the help describes the
916 actions from the standard alist). To customize your own choices,
917 define a similar alist called feedmail-prompt-before-queue-user-alist.
918 The actual alist used for message action will be the standard alist
919 overlaid with the user-alist. To neutralize an item in the standard
920 alist without providing a replacement, define an appropriate element
921 in the user alist with a value of nil." )
924 (defcustom feedmail-prompt-before-queue-user-alist nil
925 "See feedmail-prompt-before-queue-standard-alist."
926 :group 'feedmail-queue
931 (defcustom feedmail-prompt-before-queue-help-supplement nil
932 "User-provided supplementary help string for the message action prompt.
933 When the message action prompt is shown, the user can as for verbose help,
934 at which point a buffer pops up describing the meaning of possible
935 responses to the prompt. Through various customizations (see, for
936 example, feedmail-prompt-before-queue-user-alist), the available responses
937 and the prompt itself can be changed. If this variable is set to a string
938 value, that string is written to the help buffer after the standard info.
939 It may contain embedded line breaks. It will be printed via princ."
940 :group 'feedmail-queue
945 (defcustom feedmail-queue-reminder-alist
946 '((after-immediate . feedmail-queue-reminder-brief)
947 (after-queue . feedmail-queue-reminder-medium)
948 (after-draft . feedmail-queue-reminder-medium)
949 (after-run . feedmail-queue-reminder-brief)
950 (on-demand . feedmail-run-the-queue-global-prompt))
951 "See feedmail-queue-reminder."
952 :group 'feedmail-queue
957 (defcustom feedmail-queue-chatty t
958 "*If non-nil, blat a few status messages and such in the mini-buffer.
959 If nil, just do the work and don't pester people about what's going on.
960 In some cases, though, specific options inspire mini-buffer prompting.
961 That's not affected by this variable setting. Also does not control
962 reporting of error/abnormal conditions."
963 :group 'feedmail-queue
968 (defcustom feedmail-queue-chatty-sit-for 2
969 "*Duration of pause after most queue-related messages.
970 After some messages are divulged, it is prudent to pause before
971 something else obliterates them. This value controls the duration of
973 :group 'feedmail-queue
978 (defcustom feedmail-queue-run-orderer nil
979 "*If non-nil, name a function which will sort the queued messages.
980 The function is called during a running of the queue for sending, and
981 takes one argument, a list of the files in the queue directory. It
982 may contain the names of non-message files, and it's okay to leave
983 them in the list when reordering it; they get skipped over later.
984 When nil, the default action processes the messages in normal sort
985 order by queued file name, which will typically result in the order
986 they were placed in the queue."
987 :group 'feedmail-queue
988 :type '(choice (const nil) function)
992 (defcustom feedmail-queue-use-send-time-for-date nil
993 "*If non-nil, use send time for the Date: header value.
994 This variable is used by the default date generating function,
995 feedmail-default-date-generator. If nil, the default, the
996 last-modified timestamp of the queue file is used to create the
997 message Date: header; if there is no queue file, the current time is
999 :group 'feedmail-queue
1004 (defcustom feedmail-queue-use-send-time-for-message-id nil
1005 "*If non-nil, use send time for the Message-Id: header value.
1006 This variable is used by the default Message-Id: generating function,
1007 feedmail-default-message-id-generator. If nil, the default, the
1008 last-modified timestamp of the queue file is used to create the
1009 message Message-Id: header; if there is no queue file, the current time is
1011 :group 'feedmail-queue
1016 (defcustom feedmail-ask-for-queue-slug nil
1017 "*If non-nil, prompt user for part of the queue file name.
1018 The file will automatically get the FQM suffix and an embedded
1019 sequence number for uniqueness, so don't specify that. feedmail will
1020 get rid of all characters other than alphanumeric and hyphen in the
1021 results. If this variable is nil or if you just hit return in
1022 response to the prompt, feedmail queuing will take care of things
1023 properly. At the prompt, completion is available if you want to see
1024 what filenames are already in use, though, as noted, you will not be
1025 typing a complete file name. You probably don't want to be bothered
1026 with this prompting since feedmail, by default, uses queue file names
1027 based on the subjects of the messages."
1028 :group 'feedmail-queue
1033 (defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
1034 "*If non-nil, a function which creates part of the queued file name.
1035 Takes a single argument giving the name of the directory into
1036 which the message will be queued. The returned string should be just
1037 the non-directory filename part, without FQM suffix or uniquifying
1038 sequence numbers. The current buffer holds the raw message. The
1039 default function creates the slug based on the message subject, if
1041 :group 'feedmail-queue
1042 :type '(choice (const nil) function)
1046 (defcustom feedmail-queue-default-file-slug t
1047 "*Indicates what to use for subject-less messages when forming a file name.
1048 When feedmail queues a message, it creates a unique file name. By default,
1049 the file name is based in part on the subject of the message being queued.
1050 If there is no subject, consult this variable. See documentation for the
1051 function feedmail-queue-subject-slug-maker.
1053 If t, an innocuous default is used.
1055 If a string, it is used directly.
1057 If a function, it is called with no arguments from the buffer containing the raw
1058 text of the message. It must return a string (which may be empty).
1060 If the symbol 'ask, you will be prompted for a string in the mini-buffer.
1061 Filename completion is available so that you can inspect what's already been
1062 used, but feedmail will do further manipulation on the string you return, so
1063 it's not expected to be a complete filename."
1064 :group 'feedmail-queue
1069 (defcustom feedmail-queue-fqm-suffix ".fqm"
1070 "*The FQM suffix used to distinguish feedmail queued message files.
1071 You probably want this to be a period followed by some letters and/or
1072 digits. The distinction is to be able to tell them from other random
1073 files that happen to be in the feedmail-queue-directory or
1074 feedmail-queue-draft-directory. By the way, FQM stands for feedmail
1076 :group 'feedmail-queue
1081 (defcustom feedmail-nuke-buffer-after-queue nil
1082 "*If non-nil, silently kill the buffer after a message is queued.
1083 You might like that since a side-effect of queueing the message is
1084 that its buffer name gets changed to the filename. That means that
1085 the buffer won't be reused for the next message you compose. If you
1086 are using VM for creating messages, you probably want to leave this
1087 nil, since VM has its own options for managing the recycling of
1089 :group 'feedmail-queue
1094 (defcustom feedmail-queue-auto-file-nuke nil
1095 "*If non-nil, automatically delete queue files when a message is sent.
1096 Normally, feedmail will notice such files when you send a message in
1097 immediate mode (i.e., not when you're running the queue) and will ask if
1098 you want to delete them. Since the answer is usually yes, setting this
1099 variable to non-nil will tell feedmail to skip the prompt and just delete
1100 the file without bothering you."
1101 :group 'feedmail-queue
1106 ;; defvars to make byte-compiler happy(er)
1107 (defvar feedmail-error-buffer nil)
1108 (defvar feedmail-prepped-text-buffer nil)
1109 (defvar feedmail-raw-text-buffer nil)
1110 (defvar feedmail-address-list nil)
1113 (defun feedmail-mail-send-hook-splitter ()
1114 "Facilitate dividing mail-send-hook things into queued and immediate cases.
1115 If you have mail-send-hook functions that should only be called for sending/
1116 queueing messages or only be called for the sending of queued messages, this is
1117 for you. Add this function to mail-send-hook with something like this:
1119 (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
1121 Then add the functions you want called to either feedmail-mail-send-hook-queued
1122 or feedmail-mail-send-hook, as apprpriate. The distinction is that
1123 feedmail-mail-send-hook will be called when you send mail from a composition
1124 buffer (typically by typing C-c C-c), whether the message is sent immediately
1125 or placed in the queue or drafts directory. feedmail-mail-send-hook-queued is
1126 called when messages are being sent from the queue directory, typically via a
1127 call to feedmail-run-the-queue."
1128 (if feedmail-queue-runner-is-active
1129 (run-hooks 'feedmail-mail-send-hook-queued)
1130 (run-hooks 'feedmail-mail-send-hook))
1134 (defvar feedmail-mail-send-hook nil
1135 "*See documentation for feedmail-mail-send-hook-splitter.")
1138 (defvar feedmail-mail-send-hook-queued nil
1139 "*See documentation for feedmail-mail-send-hook-splitter.")
1142 (defun feedmail-confirm-addresses-hook-example ()
1143 "An example of a feedmail-last-chance-hook.
1144 It shows the simple addresses and gets a confirmation. Use as:
1145 (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
1146 (save-window-excursion
1147 (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
1149 (insert (mapconcat 'identity feedmail-address-list " "))
1150 (if (not (y-or-n-p "How do you like them apples? "))
1151 (error "FQM: Sending...gave up in last chance hook")
1155 (defcustom feedmail-last-chance-hook nil
1156 "*User's last opportunity to modify the message on its way out.
1157 It has already had all the header prepping from the standard package.
1158 The next step after running the hook will be to push the buffer into a
1159 subprocess that mails the mail. The hook might be interested in
1160 these: (1) feedmail-prepped-text-buffer contains the header and body
1161 of the message, ready to go; (2) feedmail-address-list contains a list
1162 of simplified recipients of addresses which are to be given to the
1163 subprocess (the hook may change the list); (3) feedmail-error-buffer
1164 is an empty buffer intended to soak up errors for display to the user.
1165 If the hook allows interactive activity, the user should not send more
1166 mail while in the hook since some of the internal buffers will be
1167 reused and things will get confused."
1168 :group 'feedmail-misc
1173 (defcustom feedmail-before-fcc-hook nil
1174 "*User's last opportunity to modify the message before Fcc action.
1175 It has already had all the header prepping from the standard package.
1176 The next step after running the hook will be to save the message via
1177 Fcc: processing. The hook might be interested in these: (1)
1178 feedmail-prepped-text-buffer contains the header and body of the
1179 message, ready to go; (2) feedmail-address-list contains a list of
1180 simplified recipients of addressees to whom the message was sent (3)
1181 feedmail-error-buffer is an empty buffer intended to soak up errors
1182 for display to the user. If the hook allows interactive activity, the
1183 user should not send more mail while in the hook since some of the
1184 internal buffers will be reused and things will get confused."
1185 :group 'feedmail-misc
1189 (defcustom feedmail-queue-runner-mode-setter
1190 '(lambda (&optional arg) (mail-mode))
1191 "*A function to set the proper mode of a message file.
1192 Called when the message is read back out of the queue directory with a single
1193 argument, the optional argument used in the call to
1194 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
1196 Most people want `mail-mode', so the default value is an anonymous
1197 function which is just a wrapper to ignore the supplied argument when
1198 calling it, but here's your chance to have something different.
1199 Called with funcall, not `call-interactively'."
1200 :group 'feedmail-queue
1205 (defcustom feedmail-queue-alternative-mail-header-separator nil
1206 "*Alternative header demarcation for queued messages.
1207 If you sometimes get alternative values for `mail-header-separator' in
1208 queued messages, set the value of this variable to whatever it is.
1209 For example, `rmail-resend' uses a `mail-header-separator' value of empty
1210 string (\"\") when you send/queue a message.
1212 When trying to send a queued message, if the value of this variable is
1213 non-nil, feedmail will first try to send the message using the value
1214 of `mail-header-separator'. If it can't find that, it will temporarily
1215 set `mail-header-separator' to the value of
1216 feedmail-queue-alternative-mail-header-separator and try again."
1217 :group 'feedmail-queue
1222 (defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit
1223 "*Function to initiate sending a message file.
1224 Called for each message read back out of the queue directory with a
1225 single argument, the optional argument used in the call to
1226 feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
1227 Interactively, that argument will be the prefix argument. Most people
1228 want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's
1229 your chance to have something different. Called with funcall, not
1230 call-interactively."
1231 :group 'feedmail-queue
1236 (defcustom feedmail-queue-runner-cleaner-upper
1237 '(lambda (fqm-file &optional arg)
1238 (delete-file fqm-file)
1239 (if (and arg feedmail-queue-chatty) (message "FQM: Nuked %s" fqm-file)))
1240 "*Function that will be called after a message has been sent.
1241 Not called in the case of errors. This function is called with two
1242 arguments: the name of the message queue file for the message just sent,
1243 and the optional argument used in the call to `feedmail-run-the-queue'
1244 or `feedmail-run-the-queue-no-prompts' (prefix arg if interactive).
1245 In any case, the affiliated buffer is killed elsewhere, so don't do that
1246 inside this function. Return value is ignored.
1248 The default action is an anonymous function which gets rid of the file
1249 from the queue directory. With a non-nil second argument, a brief
1250 message is give for each file deleted. You could replace this
1251 function, for example, to archive all of your sent messages someplace
1252 \(though there are better ways to get that particular result\)."
1253 :group 'feedmail-queue
1258 (defvar feedmail-queue-runner-is-active nil
1259 "*Non-nil means we're inside the logic of the queue-running loop.
1260 That is, iterating over all messages in the queue to send them. In
1261 that case, the value is the name of the queued message file currently
1262 being processed. This can be used for differentiating customized code
1263 for different scenarios. Users shouldn't set or change this
1264 variable, but may depend on its value as described here.")
1267 (defvar feedmail-is-a-resend nil
1268 "*Non-nil means the the message is a Resend (in the RFC-822 sense).
1269 This affects the composition of certain headers. feedmail sets this
1270 variable as soon as it starts prepping the message text buffer, so any
1271 user-supplied functions can rely on it. Users shouldn't set or change this
1272 variable, but may depend on its value as described here.")
1275 (defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail
1276 "*Function used to send the prepped buffer to a subprocess.
1277 The function's three (mandatory) arguments are: (1) the buffer
1278 containing the prepped message; (2) a buffer where errors should be
1279 directed; and (3) a list containing the addresses individually as
1280 strings. Three popular choices for this are
1281 feedmail-buffer-to-binmail, feedmail-buffer-to-smtpmail, and
1282 feedmail-buffer-to-sendmail. If you use the sendmail form, you
1283 probably want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc
1284 to nil. If you use the binmail form, check the value of
1285 feedmail-binmail-template."
1286 :group 'feedmail-misc
1291 (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
1292 "*Command template for the subprocess which will get rid of the mail.
1293 It can result in any command understandable by /bin/sh. Might not
1294 work at all in non-Unix environments. The single '%s', if present,
1295 gets replaced by the space-separated, simplified list of addressees.
1296 Used in feedmail-buffer-to-binmail to form the shell command which
1297 will receive the contents of the prepped buffer as stdin. If you'd
1298 like your errors to come back as mail instead of immediately in a
1299 buffer, try /bin/rmail instead of /bin/mail (this can be accomplished
1300 by keeping the default nil setting of `mail-interactive'). You might
1301 also like to consult local mail experts for any other interesting
1302 command line possibilities."
1303 :group 'feedmail-misc
1308 ;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
1309 ;; feedmail-buffer-to-smptmail are the only things provided for values
1310 ;; for the variable feedmail-buffer-eating-function. It's pretty easy
1311 ;; to write your own, though.
1312 (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
1313 "Function which actually calls /bin/mail as a subprocess.
1314 Feeds the buffer to it."
1315 (set-buffer prepped)
1317 'call-process-region
1318 (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
1319 (format feedmail-binmail-template
1320 (mapconcat 'identity addr-listoid " "))))))
1323 (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
1324 "Function which actually calls sendmail as a subprocess.
1325 Feeds the buffer to it. Probably has some flaws for Resent-* and other
1327 (set-buffer prepped)
1328 (apply 'call-process-region
1329 (append (list (point-min) (point-max)
1330 (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail")
1331 nil errors-to nil "-oi" "-t")
1332 ;; provide envelope "from" to sendmail; results will vary
1333 (list "-f" user-mail-address)
1334 ;; These mean "report errors by mail" and "deliver in background".
1335 (if (null mail-interactive) '("-oem" "-odb")))))
1337 ;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
1338 ;; simplified by WJC after more feedmail development;
1339 ;; idea (but not implementation) of copying smtpmail trace buffer to
1340 ;; feedmail error buffer from:
1341 ;; Mon 14-Oct-1996; Douglas Gray Stephens
1342 ;; modified to insert error for displaying
1343 (defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid)
1344 "Function which actually calls smtpmail-via-smtp to send buffer as e-mail."
1345 ;; I'm not sure smtpmail.el is careful about the following
1346 ;; return value, but it also uses it internally, so I will fear
1349 (if (not (smtpmail-via-smtp addr-listoid prepped))
1351 (set-buffer errors-to)
1352 (insert "Send via smtpmail failed. Probable SMTP protocol error.\n")
1353 (insert "Look for details below or in the *Messages* buffer.\n\n")
1354 (let ((case-fold-search t)
1355 ;; don't be overconfident about the name of the trace buffer
1356 (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
1359 (if (string-match tracer (buffer-name buffy))
1361 (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
1362 (insert-buffer buffy)
1367 ;; just a place to park a docstring
1368 (defconst feedmail-fiddle-plex-blurb nil
1369 "A fiddle-plex is a concise way of specifying header field fiddling.
1370 It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING. The element
1371 VALUE can also be a list sometimes.
1373 NAME is the name of the header field to be fiddled with. Although case
1374 doesn't matter in looking for headers, case of NAME is preserved when a header
1375 is inserted via fiddling. It shouldn't include the trailing colon.
1377 VALUE is either nil, a simple string, a function returning nil or a string, or,
1378 as described below for ACTION `combine', a list of up to three values.
1380 ACTION describes the nature of the fiddling to be done. Possibilities
1381 for ACTION (default is `supplement'):
1383 `supplement' Leave other like fields as-is, insert this one.
1385 `replace' Delete other like fields, if any, and insert this one.
1387 `create' Insert this one only if no like field exists.
1389 `combine' Combine aggregate values of like fields with this one.
1390 In this case, VALUE has a special form. It is a list
1391 of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
1392 VAL-PRE and VAL-POST are strings or nil. VAL-LIKE may
1393 be either a string or a function (it may also be nil,
1394 but there's not much point to that).
1396 Values of like header fields are aggregated, leading and
1397 trailing whitespace is removed, and embedded
1398 whitespace is left as-is. If there are no like
1399 fields, or the aggregate value is an empty string,
1400 VAL-LIKE is not used. Else, if VAL-LIKE is a function,
1401 it is called with two arguments: NAME and the
1402 aggregate like values. Else, if VAL-LIKE is a string, it is
1403 used as a format string where a single \%s will be
1404 replaced by the aggregate values of like fields.
1406 VAL-PRE, the results of using VAL-LIKE, and VAL-POST
1407 are concatenated, and the result, if not nil and not
1408 an empty string, is used as the new value for the
1409 field. Although this description sounds a bit
1410 complicated, the idea is to provide a mechanism for
1411 combining the old value with a new value in a flexible
1412 way. For example, if you wanted to add a new value to
1413 an existing header field by adding a semi-colon and
1414 then starting the new value on a continuation line,
1415 you might specify this:
1417 (nil \"%s;\\n\\t\" \"This is my new value\")
1419 FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is
1420 non-nil, feedmail \"smart filling\" is done on VALUE just before
1424 (defun feedmail-send-it ()
1425 "A function which is a suitable value for `send-mail-function'.
1426 To use it, you probably want something like this in your .emacs or
1429 (setq send-mail-function 'feedmail-send-it)
1430 (autoload 'feedmail-send-it \"feedmail\")"
1432 ;; avoid matching trouble over slash vs backslash by getting canonical
1433 (if feedmail-queue-directory
1434 (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
1435 (if feedmail-queue-draft-directory
1436 (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
1437 (if (not feedmail-enable-queue) (feedmail-send-it-immediately)
1438 ;; else, queuing is enabled, should we ask about it or just do it?
1439 (if feedmail-ask-before-queue
1440 (funcall (feedmail-queue-send-edit-prompt))
1441 (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))))
1444 (defun feedmail-message-action-send ()
1445 ;; hooks can make this take a while so clear the prompt
1446 (message "FQM: Immediate send...")
1447 (feedmail-send-it-immediately))
1450 ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu>
1451 (defun feedmail-queue-express-to-queue ()
1452 "*Send message directly to the queue, with a minimum of fuss and bother."
1454 (let ((feedmail-enable-queue t)
1455 (feedmail-ask-before-queue nil)
1456 (feedmail-queue-reminder-alist nil)
1457 (feedmail-queue-chatty-sit-for 0))
1463 (defun feedmail-queue-express-to-draft ()
1464 "*Send message directly to the draft queue, with a minimum of fuss and bother."
1466 (let ((feedmail-queue-directory feedmail-queue-draft-directory))
1467 (feedmail-queue-express-to-queue)
1472 (defun feedmail-message-action-send-strong ()
1473 (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
1476 (defun feedmail-message-action-edit ()
1477 (error "FQM: Message not queued; returning to edit"))
1480 (defun feedmail-message-action-draft ()
1481 (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
1484 (defun feedmail-message-action-draft-strong ()
1485 (let ((buffer-file-name nil))
1486 (feedmail-message-action-draft)))
1489 (defun feedmail-message-action-queue ()
1490 (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
1493 (defun feedmail-message-action-queue-strong ()
1494 (let ((buffer-file-name nil))
1495 (feedmail-message-action-queue)))
1498 (defun feedmail-message-action-toggle-spray ()
1499 (let ((feedmail-enable-spray (not feedmail-enable-spray)))
1500 (if feedmail-enable-spray
1501 (message "FQM: For this message, spray toggled ON")
1502 (message "FQM: For this message, spray toggled OFF"))
1504 ;; recursion, but harmless
1505 (feedmail-send-it)))
1508 (defun feedmail-message-action-help ()
1509 (let ((d-string " "))
1510 (if (stringp feedmail-ask-before-queue-default)
1511 (setq d-string feedmail-ask-before-queue-default)
1512 (setq d-string (char-to-string feedmail-ask-before-queue-default)))
1513 (feedmail-queue-send-edit-prompt-help d-string)
1514 ;; recursive, but no worries (it goes deeper on user action)
1515 (feedmail-send-it)))
1519 (defun feedmail-run-the-queue-no-prompts (&optional arg)
1520 "Like feedmail-run-the-queue, but suppress confirmation prompts."
1522 (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
1525 (defun feedmail-run-the-queue-global-prompt (&optional arg)
1526 "Like feedmail-run-the-queue, but with a global confirmation prompt.
1527 This is generally most useful if run non-interactively, since you can
1528 bail out with an appropriate answer to the global confirmation prompt."
1530 (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
1533 (defun feedmail-run-the-queue (&optional arg)
1534 "Visit each message in the feedmail queue directory and send it out.
1535 Return value is a list of three things: number of messages sent, number of
1536 messages skipped, and number of non-message things in the queue (commonly
1537 backup file names and the like)."
1539 ;; avoid matching trouble over slash vs backslash by getting canonical
1540 (if feedmail-queue-directory
1541 (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
1542 (if feedmail-queue-draft-directory
1543 (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
1545 (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
1546 (dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1547 (q-cnt (nth 0 qlist))
1548 (q-oth (nth 1 qlist))
1549 (d-cnt (nth 0 dlist))
1550 (d-oth (nth 1 dlist))
1552 (messages-skipped 0)
1557 (list-of-possible-fqms))
1558 (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
1560 (if (fboundp 'y-or-n-p-with-timeout)
1561 (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
1562 d-cnt d-oth q-cnt q-oth)
1564 (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
1565 d-cnt d-oth q-cnt q-oth))
1567 (if (not do-the-run)
1568 (setq messages-skipped q-cnt)
1569 (save-window-excursion
1570 (setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
1571 (if feedmail-queue-run-orderer
1572 (setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
1575 (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
1577 ((file-directory-p maybe-file) nil) ; don't care about subdirs
1578 ((feedmail-fqm-p blobby)
1579 (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
1580 (setq already-buffer
1581 (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
1582 (find-buffer-visiting maybe-file)
1583 (get-file-buffer maybe-file)))
1584 (if (and already-buffer (buffer-modified-p already-buffer))
1585 (save-window-excursion
1586 (display-buffer (set-buffer already-buffer))
1587 (if (fboundp 'y-or-n-p-with-timeout)
1588 ;; make a guess that the user just forgot to save
1589 (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
1591 (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
1595 (set-buffer blobby-buffer)
1596 (setq buffer-offer-save nil)
1597 (buffer-disable-undo blobby-buffer)
1598 (insert-file-contents-literally maybe-file)
1599 ;; work around text-vs-binary weirdness and also around rmail-resend's creative
1600 ;; manipulation of mail-header-separator
1602 ;; if we don't find the normal M-H-S, and the alternative is defined but also
1603 ;; not found, try reading the file a different way
1605 ;; if M-H-S not found and (a-M-H-S is nil or not found)
1606 (if (and (not (feedmail-find-eoh t))
1607 (or (not feedmail-queue-alternative-mail-header-separator)
1609 (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
1610 (feedmail-find-eoh t)))))
1611 (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
1612 (erase-buffer) (insert-file-contents maybe-file))
1614 ;; if M-H-S not found and (a-M-H-S is non-nil and is found)
1615 ;; temporarily set M-H-S to the value of a-M-H-S
1616 (if (and (not (feedmail-find-eoh t))
1617 feedmail-queue-alternative-mail-header-separator
1618 (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator))
1619 (feedmail-find-eoh t)))
1620 (setq this-mhsep feedmail-queue-alternative-mail-header-separator)
1621 (setq this-mhsep mail-header-separator))
1622 (funcall feedmail-queue-runner-mode-setter arg)
1623 (condition-case nil ; don't give up the loop if user skips some
1624 (let ((feedmail-enable-queue nil)
1625 (mail-header-separator this-mhsep)
1626 (feedmail-queue-runner-is-active maybe-file))
1627 (funcall feedmail-queue-runner-message-sender arg)
1628 (set-buffer blobby-buffer)
1629 (if (buffer-modified-p) ; still modified, means wasn't sent
1630 (setq messages-skipped (1+ messages-skipped))
1631 (setq messages-sent (1+ messages-sent))
1632 (funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
1633 (if (and already-buffer (not (file-exists-p maybe-file)))
1634 ;; we have gotten rid of the file associated with the
1635 ;; buffer, so update the buffer's notion of that
1637 (set-buffer already-buffer)
1638 (setq buffer-file-name nil)))))
1639 (error (setq messages-skipped (1+ messages-skipped))))
1640 (kill-buffer blobby-buffer)
1641 (if feedmail-queue-chatty
1643 (message "FQM: %d to go, %d sent, %d skipped (%d other files ignored)"
1644 (- q-cnt messages-sent messages-skipped)
1645 messages-sent messages-skipped q-oth)
1646 (sit-for feedmail-queue-chatty-sit-for))))))
1647 list-of-possible-fqms)))
1648 (if feedmail-queue-chatty
1650 (message "FQM: %d sent, %d skipped (%d other files ignored)"
1651 messages-sent messages-skipped q-oth)
1652 (sit-for feedmail-queue-chatty-sit-for)
1653 (feedmail-queue-reminder 'after-run)
1654 (sit-for feedmail-queue-chatty-sit-for)))
1655 (list messages-sent messages-skipped q-oth)))
1659 (defun feedmail-queue-reminder (&optional what-event)
1660 "Perform some kind of reminder activity about queued and draft messages.
1661 Called with an optional symbol argument which says what kind of event
1662 is triggering the reminder activity. The default is 'on-demand, which
1663 is what you typically would use if you were putting this in your emacs start-up
1664 or mail hook code. Other recognized values for WHAT-EVENT (these are passed
1665 internally by feedmail):
1667 after-immediate (a message has just been sent in immediate mode)
1668 after-queue (a message has just been queued)
1669 after-draft (a message has just been placed in the draft directory)
1670 after-run (the queue has just been run, possibly sending messages)
1672 WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist. If
1673 the associated value is a function, it is called without arguments and is expected
1674 to perform the reminder activity. You can supply your own reminder functions
1675 by redefining feedmail-queue-reminder-alist. If you don't want any reminders,
1676 you can set feedmail-queue-reminder-alist to nil."
1678 (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
1679 (setq entry (assoc key feedmail-queue-reminder-alist))
1680 (setq reminder (cdr entry))
1681 (if (fboundp reminder) (funcall reminder)))
1685 (defun feedmail-queue-reminder-brief ()
1686 "Brief display of draft and queued message counts in modeline."
1688 (let (q-cnt d-cnt q-lis d-lis)
1689 (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
1690 (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1691 (setq q-cnt (car q-lis))
1692 (setq d-cnt (car d-lis))
1693 (if (or (> q-cnt 0) (> d-cnt 0))
1695 (message "FQM: [D: %d, Q: %d]" d-cnt q-cnt))))
1699 (defun feedmail-queue-reminder-medium ()
1700 "Verbose display of draft and queued message counts in modeline."
1702 (let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
1703 (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
1704 (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
1705 (setq q-cnt (car q-lis))
1706 (setq d-cnt (car d-lis))
1707 (setq q-oth (nth 1 q-lis))
1708 (setq d-oth (nth 1 d-lis))
1709 (if (or (> q-cnt 0) (> d-cnt 0))
1711 (message "FQM: Draft: %dm+%d in \"%s\", Queue: %dm+%d in \"%s\""
1712 d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
1713 q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
1717 (defun feedmail-queue-send-edit-prompt ()
1718 "Ask whether to queue, send immediately, or return to editing a message."
1719 ;; Some implementation ideas here came from the userlock.el code
1721 (save-window-excursion
1722 (let ((answer) (d-char) (d-string " "))
1723 (if (stringp feedmail-ask-before-queue-default)
1725 (setq d-char (string-to-char feedmail-ask-before-queue-default))
1726 (setq d-string feedmail-ask-before-queue-default))
1727 (setq d-string (char-to-string feedmail-ask-before-queue-default))
1728 (setq d-char feedmail-ask-before-queue-default)
1730 (while (null answer)
1731 (message feedmail-ask-before-queue-prompt d-string)
1733 (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
1734 (read-char-exclusive))))
1735 (if (= user-sez help-char)
1736 (setq answer '(^ . feedmail-message-action-help))
1737 (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
1738 (setq user-sez d-char))
1739 ;; these char-to-int things are because of some
1740 ;; incomprensible difference between the two in
1741 ;; byte-compiled stuff between Emacs and XEmacs
1742 ;; (well, I'm sure someone could comprehend it,
1743 ;; but I say 'uncle')
1744 (setq answer (or (assoc user-sez feedmail-prompt-before-queue-user-alist)
1745 (and (fboundp 'char-to-int)
1746 (assoc (char-to-int user-sez) feedmail-prompt-before-queue-user-alist))
1747 (assoc user-sez feedmail-prompt-before-queue-standard-alist)
1748 (and (fboundp 'char-to-int)
1749 (assoc (char-to-int user-sez) feedmail-prompt-before-queue-standard-alist))))
1750 (if (or (null answer) (null (cdr answer)))
1753 (message feedmail-ask-before-queue-reprompt d-string)
1759 (defconst feedmail-p-h-b-n "*FQM Help*")
1761 (defun feedmail-queue-send-edit-prompt-help (d-string)
1762 (let ((fqm-help (get-buffer feedmail-p-h-b-n)))
1763 (if (and fqm-help (get-buffer-window fqm-help))
1764 (feedmail-queue-send-edit-prompt-help-later fqm-help d-string)
1765 (feedmail-queue-send-edit-prompt-help-first d-string))))
1767 (defun feedmail-queue-send-edit-prompt-help-later (fqm-help d-string)
1769 (save-selected-window
1770 (let ((signal-error-on-buffer-boundary nil)
1771 (fqm-window (display-buffer fqm-help)))
1772 (select-window fqm-window)
1773 (if (pos-visible-in-window-p (point-max) fqm-window)
1774 (feedmail-queue-send-edit-prompt-help-first d-string)
1775 ;;(goto-char (point-min))
1779 (defun feedmail-queue-send-edit-prompt-help-first (d-string)
1780 (with-output-to-temp-buffer feedmail-p-h-b-n
1781 (princ "You're dispatching a message and feedmail queuing is enabled.
1782 Typing ? or C-v will normally scroll this help buffer.
1785 q QUEUE for later sending (via feedmail-run-the-queue)
1786 Q QUEUE! like \"q\", but always make a new file
1787 i IMMEDIATELY send this (but not the other queued messages)
1788 I IMMEDIATELY! like \"i\", but skip following confirmation prompt
1789 d DRAFT queue in the draft directory
1790 D DRAFT! like \"d\", but always make a new file
1791 e EDIT return to the message edit buffer (don't send or queue)
1792 * SPRAY toggle spray mode (individual message transmissions)
1795 s SEND immediately (same as \"i\")
1796 S SEND! immediately (same as \"I\")
1797 r ROUGH draft (same as \"d\")
1798 R ROUGH! draft (same as \"D\")
1799 n NOPE didn't mean it (same as \"e\")
1800 y YUP do the default behavior (same as \"C-m\")
1802 The user-configurable default is currently \"")
1804 (princ "\". For other possibilities,
1805 see the variable feedmail-prompt-before-queue-user-alist.
1807 (and (stringp feedmail-prompt-before-queue-help-supplement)
1808 (princ feedmail-prompt-before-queue-help-supplement))
1809 (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode)))))
1811 (defun feedmail-look-at-queue-directory (queue-directory)
1812 "Find out some things about a queue directory.
1813 Result is a list containing a count of queued messages in the
1814 directory, a count of other files in the directory, and a high water
1815 mark for prefix sequence numbers. Subdirectories are not included in
1817 (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
1818 ;; iterate, counting things we find along the way in the directory
1819 (if (file-directory-p queue-directory)
1823 ((file-directory-p blobby) nil) ; don't care about subdirs
1824 ((feedmail-fqm-p blobby)
1825 (setq blobbet (file-name-nondirectory blobby))
1826 (if (string-match "^[0-9][0-9][0-9]-" blobbet)
1828 (setq water-mark (string-to-int (substring blobbet 0 3)))
1829 (if (> water-mark high-water) (setq high-water water-mark))))
1830 (setq q-cnt (1+ q-cnt)))
1831 (t (setq q-oth (1+ q-oth)))
1833 (directory-files queue-directory t)))
1834 (list q-cnt q-oth high-water)))
1836 (defun feedmail-tidy-up-slug (slug)
1837 "Utility for mapping out suspect characters in a potential filename."
1838 ;; even programmers deserve a break sometimes, so cover nil for them
1839 (if (null slug) (setq slug ""))
1840 ;; replace all non-alphanumerics with hyphen for safety
1841 (while (string-match "[^a-z0-9-]+" slug) (setq slug (replace-match "-" nil nil slug)))
1842 ;; collapse multiple hyphens to one
1843 (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
1844 ;; for tidyness, peel off leading hyphens
1845 (if (string-match "^-*" slug) (setq slug (replace-match "" nil nil slug)))
1846 ;; for tidyness, peel off trailing hyphens
1847 (if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
1851 (defun feedmail-queue-subject-slug-maker (&optional queue-directory)
1852 "Create a name for storing the message in the queue.
1853 Optional argument QUEUE-DIRECTORY specifies into which directory the
1854 file will be placed. The name is based on the Subject: header (if
1855 there is one). If there is no subject,
1856 feedmail-queue-default-file-slug is consulted Special characters are
1857 mapped to mostly alphanumerics for safety."
1858 (let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
1859 (setq eoh-marker (feedmail-find-eoh))
1860 (goto-char (point-min))
1861 ;; get raw subject value (first line, anyhow)
1862 (if (re-search-forward "^Subject:" eoh-marker t)
1863 (progn (setq s-point (point))
1865 (setq subject (buffer-substring s-point (point)))))
1866 (setq subject (feedmail-tidy-up-slug subject))
1867 (if (zerop (length subject))
1870 ((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
1871 ((fboundp feedmail-queue-default-file-slug)
1872 (save-excursion (funcall feedmail-queue-default-file-slug)))
1873 ((eq feedmail-queue-default-file-slug 'ask)
1874 (file-name-nondirectory
1875 (read-file-name "FQM: Message filename slug? "
1876 (file-name-as-directory queue-directory) subject nil subject)))
1879 ;; one more time, with feeling
1880 (feedmail-tidy-up-slug subject)
1884 (defun feedmail-create-queue-filename (queue-directory)
1887 (feedmail-queue-slug-maker
1888 (save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
1889 (feedmail-ask-for-queue-slug
1890 (setq slug (file-name-nondirectory
1891 (read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
1892 (file-name-as-directory queue-directory) slug nil slug))))
1894 (setq slug (feedmail-tidy-up-slug slug))
1895 (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
1897 (expand-file-name slug queue-directory)
1898 feedmail-queue-fqm-suffix)
1902 (defun feedmail-dump-message-to-queue (queue-directory what-event)
1903 (or (file-accessible-directory-p queue-directory)
1904 ;; progn to get nil result no matter what
1905 (progn (make-directory queue-directory t) nil)
1906 (file-accessible-directory-p queue-directory)
1907 (error (concat "FQM: Message not queued; trouble with directory " queue-directory)))
1911 (previous-buffer-file-name buffer-file-name))
1912 (if buffer-file-name
1914 (setq is-fqm (feedmail-fqm-p buffer-file-name))
1915 (setq is-in-this-dir (string-equal
1916 (directory-file-name queue-directory)
1917 (directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
1918 ;; if visiting a queued message, just save
1919 (if (and is-fqm is-in-this-dir)
1920 (setq filename buffer-file-name)
1921 (setq filename (feedmail-create-queue-filename queue-directory)))
1922 ;; make binary file on DOS/Win95/WinNT, etc
1923 (let ((buffer-file-type feedmail-force-binary-write)) (write-file filename))
1924 ;; convenient for moving from draft to q, for example
1925 (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
1926 (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name)))
1927 (delete-file previous-buffer-file-name))
1928 (if feedmail-nuke-buffer-after-queue
1929 (let ((a-s-file-name buffer-auto-save-file-name))
1930 ;; be aggressive in nuking auto-save files
1931 (and (kill-buffer (current-buffer))
1932 delete-auto-save-files
1933 (file-exists-p a-s-file-name)
1934 (delete-file a-s-file-name))))
1935 (if feedmail-queue-chatty
1936 (progn (message (concat "FQM: Queued in " filename))
1937 (sit-for feedmail-queue-chatty-sit-for)))
1938 (if feedmail-queue-chatty
1940 (feedmail-queue-reminder what-event)
1941 (sit-for feedmail-queue-chatty-sit-for)))))
1944 ;; from a similar function in mail-utils.el
1945 (defun feedmail-rfc822-time-zone (time)
1946 (let* ((sec (or (car (current-time-zone time)) 0))
1947 (absmin (/ (abs sec) 60)))
1948 (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
1950 (defun feedmail-rfc822-date (arg-time)
1951 (let ((time (if arg-time arg-time (current-time))))
1953 (format-time-string "%a, %e %b %Y %T " time)
1954 (feedmail-rfc822-time-zone time)
1958 (defun feedmail-send-it-immediately ()
1959 "Handle immediate sending, including during a queue run."
1960 (let* ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
1961 (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
1962 (feedmail-raw-text-buffer (current-buffer))
1963 (feedmail-address-list)
1967 (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):")
1968 (a-re-rtc "^Resent-\\(To\\|Cc\\):")
1969 (a-re-rb "^Resent-Bcc:")
1970 (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
1971 (a-re-dtc "^\\(To\\|Cc\\):")
1973 ;; to get a temporary changable copy
1974 (mail-header-separator mail-header-separator)
1978 (set-buffer feedmail-error-buffer) (erase-buffer)
1979 (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
1981 ;; jam contents of user-supplied mail buffer into our scratch buffer
1982 (insert-buffer feedmail-raw-text-buffer)
1984 ;; require one newline at the end.
1985 (goto-char (point-max))
1986 (or (= (preceding-char) ?\n) (insert ?\n))
1988 (let ((case-fold-search nil))
1989 ;; Change header-delimiter to be what mailers expect (empty line).
1990 ;; leaves match data in place or signals error
1991 (setq eoh-marker (feedmail-find-eoh))
1992 (replace-match "\n")
1993 (setq mail-header-separator ""))
1995 ;; mail-aliases nil = mail-abbrevs.el
1996 (if (or feedmail-force-expand-mail-aliases
1997 (and (fboundp 'expand-mail-aliases) mail-aliases))
1998 (expand-mail-aliases (point-min) eoh-marker))
2001 (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
2002 ;; ignore any blank lines in the header
2003 (goto-char (point-min))
2004 (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
2005 (replace-match "\n"))
2007 (let ((case-fold-search t) (addr-regexp))
2008 (goto-char (point-min))
2009 ;; there are some RFC-822 combinations/cases missed here,
2010 ;; but probably good enough and what users expect
2012 ;; use resent-* stuff only if there is at least one non-empty one
2013 (setq feedmail-is-a-resend
2015 ;; header name, followed by optional whitespace, followed by
2016 ;; non-whitespace, followed by anything, followed by newline;
2017 ;; the idea is empty Resent-* headers are ignored
2018 "^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
2020 ;; if we say so, gather the Bcc stuff before the main course
2021 (if (eq feedmail-deduce-bcc-where 'first)
2022 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
2023 (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2025 (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
2026 ;; handled by first or last cases, so don't get Bcc stuff
2027 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
2028 (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
2029 ;; not handled by first or last cases, so also get Bcc stuff
2030 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
2031 (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2032 ;; if we say so, gather the Bcc stuff after the main course
2033 (if (eq feedmail-deduce-bcc-where 'last)
2034 (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
2035 (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
2036 (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
2037 ;; not needed, but meets user expectations
2038 (setq feedmail-address-list (nreverse feedmail-address-list))
2039 ;; Find and handle any Bcc fields.
2040 (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
2041 (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
2042 (if (and bcc-holder (not feedmail-nuke-bcc))
2043 (progn (goto-char (point-min))
2044 (insert bcc-holder)))
2045 (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
2046 (progn (goto-char (point-min))
2047 (insert resent-bcc-holder)))
2048 (goto-char (point-min))
2050 ;; fiddle about, fiddle about, fiddle about....
2051 (feedmail-fiddle-from)
2052 (feedmail-fiddle-sender)
2053 (feedmail-fiddle-x-mailer)
2054 (feedmail-fiddle-message-id
2055 (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
2056 (feedmail-fiddle-date
2057 (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
2058 (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
2060 ;; don't send out a blank headers of various sorts
2061 ;; (this loses on continued line with a blank first line)
2062 (goto-char (point-min))
2063 (and feedmail-nuke-empty-headers ; hey, who's an empty-header?
2064 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
2065 (replace-match ""))))
2067 (run-hooks 'feedmail-last-chance-hook)
2069 (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:"))
2072 ((eq feedmail-confirm-outgoing 'immediate)
2073 (not feedmail-queue-runner-is-active))
2074 ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
2075 (t feedmail-confirm-outgoing))))
2076 (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
2077 (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
2078 (feedmail-give-it-to-buffer-eater)
2079 (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
2080 (progn ; if a file but not running the queue, offer to delete it
2081 (setq also-file (expand-file-name also-file))
2082 (if (or feedmail-queue-auto-file-nuke
2083 (y-or-n-p (format "FQM: Delete message file %s? " also-file)))
2085 ;; if we delete the affiliated file, get rid
2086 ;; of the file name association and make sure we
2087 ;; don't annoy people with a prompt on exit
2088 (delete-file also-file)
2089 (set-buffer feedmail-raw-text-buffer)
2090 (setq buffer-offer-save nil)
2091 (setq buffer-file-name nil)
2094 (goto-char (point-min))
2095 ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
2096 (if fcc (let ((default-buffer-file-type feedmail-force-binary-write))
2098 (if (not feedmail-nuke-bcc-in-fcc)
2099 (progn (if bcc-holder (insert bcc-holder))
2100 (if resent-bcc-holder (insert resent-bcc-holder))))
2102 (run-hooks 'feedmail-before-fcc-hook)
2104 (if feedmail-nuke-body-in-fcc
2105 (progn (goto-char eoh-marker)
2106 (if (natnump feedmail-nuke-body-in-fcc)
2107 (forward-line feedmail-nuke-body-in-fcc))
2108 (delete-region (point) (point-max))
2110 (mail-do-fcc eoh-marker)
2112 (error "FQM: Sending...abandoned") ; user bailed out of one-last-look
2113 ))) ; unwind-protect body (save-excursion)
2115 ;; unwind-protect cleanup forms
2116 (kill-buffer feedmail-prepped-text-buffer)
2117 (set-buffer feedmail-error-buffer)
2118 (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
2119 (progn (display-buffer feedmail-error-buffer)
2120 ;; read fast ... the meter is running
2121 (if (and feedmail-queue-runner-is-active feedmail-queue-chatty)
2122 (progn (message "FQM: Sending...failed") (ding t) (sit-for 3)))
2123 (error "FQM: Sending...failed")))
2124 (set-buffer feedmail-raw-text-buffer))
2126 (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
2128 (feedmail-queue-reminder 'after-immediate)
2129 (sit-for feedmail-queue-chatty-sit-for)))
2133 (defun feedmail-fiddle-header (name value &optional action folding)
2134 "Internal feedmail function for jamming fields into message header.
2135 NAME, VALUE, ACTION, and FOLDING are the four elements of a
2136 fiddle-plex, as described in the documentation for the variable
2137 feedmail-fiddle-plex-blurb."
2138 (let ((case-fold-search t)
2139 (header-colon (concat (regexp-quote name) ":"))
2140 header-regexp eoh-marker has-like ag-like val-like that-point)
2141 (setq header-regexp (concat "^" header-colon))
2142 (setq eoh-marker (feedmail-find-eoh))
2143 (goto-char (point-min))
2144 (setq has-like (re-search-forward header-regexp eoh-marker t))
2146 (if (not action) (setq action 'supplement))
2148 ((eq action 'supplement)
2149 ;; trim leading/trailing whitespace
2150 (if (string-match "\\`[ \t\n]+" value)
2151 (setq value (substring value (match-end 0))))
2152 (if (string-match "[ \t\n]+\\'" value)
2153 (setq value (substring value 0 (match-beginning 0))))
2154 (if (> (length value) 0)
2156 (if feedmail-fiddle-headers-upwardly
2157 (goto-char (point-min))
2158 (goto-char eoh-marker))
2159 (setq that-point (point))
2160 (insert name ": " value "\n")
2161 (if folding (feedmail-fill-this-one that-point (point))))))
2163 ((eq action 'replace)
2164 (if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
2165 (feedmail-fiddle-header name value 'supplement folding))
2167 ((eq action 'create)
2168 (if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))
2170 ((eq action 'combine)
2171 (setq val-like (nth 1 value))
2172 (setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
2173 ;; get rid of initial header name from first instance (front of string)
2174 (if (string-match (concat header-regexp "[ \t\n]+") ag-like)
2175 (setq ag-like (replace-match "" t t ag-like)))
2176 ;; get rid of embedded header names from subsequent instances
2177 (while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
2178 (setq ag-like (replace-match "\n\t" t t ag-like)))
2179 ;; trim leading/trailing whitespace
2180 (if (string-match "\\`[ \t\n]+" ag-like)
2181 (setq ag-like (substring ag-like (match-end 0))))
2182 (if (string-match "[ \t\n]+\\'" ag-like)
2183 (setq ag-like (substring ag-like 0 (match-beginning 0))))
2184 ;; if ag-like is not nil and not an empty string, transform it via a function
2185 ;; call or format operation
2186 (if (> (length ag-like) 0)
2189 ((and (symbolp val-like) (fboundp val-like))
2190 (funcall val-like name ag-like))
2192 (format val-like ag-like))
2194 (feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
2197 (defun feedmail-give-it-to-buffer-eater ()
2199 (if feedmail-enable-spray
2201 '(lambda (feedmail-spray-this-address)
2202 (let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
2204 (set-buffer spray-buffer)
2206 ;; not life's most efficient methodology, but spraying isn't
2207 ;; an every-5-minutes event either
2208 (insert-buffer feedmail-prepped-text-buffer)
2209 ;; There's a good case to me made that each separate transmission of
2210 ;; a message in the spray should have a distinct Message-Id:. There
2211 ;; is also a less compelling argument in the other direction. I think
2212 ;; they technically should have distinct Message-Id:s, but I doubt that
2213 ;; anyone cares, practically. If someone complains about it, I'll add
2215 (feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list)
2216 ;; this (let ) is just in case some buffer eater
2217 ;; is cheating and using the global variable name instead
2218 ;; of its argument to find the buffer
2219 (let ((feedmail-prepped-text-buffer spray-buffer))
2220 (funcall feedmail-buffer-eating-function
2221 feedmail-prepped-text-buffer
2222 feedmail-error-buffer
2223 (list feedmail-spray-this-address))))
2224 (kill-buffer spray-buffer)
2226 feedmail-address-list)
2227 (funcall feedmail-buffer-eating-function
2228 feedmail-prepped-text-buffer
2229 feedmail-error-buffer
2230 feedmail-address-list))))
2233 (defun feedmail-envelope-deducer (eoh-marker)
2234 "If feedmail-deduce-envelope-from is false, simply return `user-mail-address'.
2235 Else, look for Sender: or From: (or Resent-*) and
2237 (if (not feedmail-deduce-envelope-from)
2241 (feedmail-deduce-address-list
2242 (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-Sender:" "^Sender:")
2246 (feedmail-deduce-address-list
2247 (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-From:" "^From:")
2249 (if (and from-list (car from-list)) (car from-list) user-mail-address))))
2252 (defun feedmail-fiddle-from ()
2254 ;; default is to fall off the end of the list and do nothing
2256 ;; nil means do nothing
2257 ((eq nil feedmail-from-line) nil)
2258 ;; t is the same a using the default computation, so compute it and recurse
2259 ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
2260 ;; improvement using user-mail-address suggested by
2261 ;; gray@austin.apc.slb.com (Douglas Gray Stephens)
2262 ((eq t feedmail-from-line)
2263 (let ((feedmail-from-line
2265 (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name)))))
2267 ((eq mail-from-style nil) at-stuff)
2268 ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")"))
2269 ((eq mail-from-style 'angles) (concat "\"" (user-full-name) "\" <" at-stuff ">"))
2271 (feedmail-fiddle-from)))
2273 ;; if it's a string, simply make a fiddle-plex out of it and recurse
2274 ((stringp feedmail-from-line)
2275 (let ((feedmail-from-line (list "ignored" feedmail-from-line 'create)))
2276 (feedmail-fiddle-from)))
2278 ;; if it's a function, call it and recurse with the resulting value
2279 ((and (symbolp feedmail-from-line) (fboundp feedmail-from-line))
2280 (let ((feedmail-from-line (funcall feedmail-from-line)))
2281 (feedmail-fiddle-from)))
2283 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2284 ((listp feedmail-from-line)
2285 (feedmail-fiddle-header
2286 (if feedmail-is-a-resend "Resent-From" "From")
2287 (nth 1 feedmail-from-line) ; value
2288 (nth 2 feedmail-from-line) ; action
2289 (nth 3 feedmail-from-line))))) ; folding
2292 (defun feedmail-fiddle-sender ()
2294 ;; default is to fall off the end of the list and do nothing
2296 ;; nil means do nothing
2297 ((eq nil feedmail-sender-line) nil)
2298 ;; t is not allowed, but handled it just to avoid bugs later
2299 ((eq t feedmail-sender-line) nil)
2301 ;; if it's a string, simply make a fiddle-plex out of it and recurse
2302 ((stringp feedmail-sender-line)
2303 (let ((feedmail-sender-line (list "ignored" feedmail-sender-line 'create)))
2304 (feedmail-fiddle-sender)))
2306 ;; if it's a function, call it and recurse with the resulting value
2307 ((and (symbolp feedmail-sender-line) (fboundp feedmail-sender-line))
2308 (let ((feedmail-sender-line (funcall feedmail-sender-line)))
2309 (feedmail-fiddle-sender)))
2311 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2312 ((listp feedmail-sender-line)
2313 (feedmail-fiddle-header
2314 (if feedmail-is-a-resend "Resent-Sender" "Sender")
2315 (nth 1 feedmail-sender-line) ; value
2316 (nth 2 feedmail-sender-line) ; action
2317 (nth 3 feedmail-sender-line))))) ; folding
2320 (defun feedmail-default-date-generator (maybe-file)
2321 "Default function for generating Date: header contents."
2323 (if (and (not feedmail-queue-use-send-time-for-date) maybe-file)
2324 (setq date-time (nth 5 (file-attributes maybe-file))))
2325 (feedmail-rfc822-date date-time))
2329 (defun feedmail-fiddle-date (maybe-file)
2330 "Fiddle Date:. See documentation of feedmail-date-generator."
2331 ;; default is to fall off the end of the list and do nothing
2333 ;; nil means do nothing
2334 ((eq nil feedmail-date-generator) nil)
2335 ;; t is the same a using the function feedmail-default-date-generator, so let it and recurse
2336 ((eq t feedmail-date-generator)
2337 (let ((feedmail-date-generator (feedmail-default-date-generator maybe-file)))
2338 (feedmail-fiddle-date maybe-file)))
2340 ;; if it's a string, simply make a fiddle-plex out of it and recurse
2341 ((stringp feedmail-date-generator)
2342 (let ((feedmail-date-generator (list "ignored" feedmail-date-generator 'create)))
2343 (feedmail-fiddle-date maybe-file)))
2345 ;; if it's a function, call it and recurse with the resulting value
2346 ((and (symbolp feedmail-date-generator) (fboundp feedmail-date-generator))
2347 (let ((feedmail-date-generator (funcall feedmail-date-generator maybe-file)))
2348 (feedmail-fiddle-date maybe-file)))
2350 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2351 ((listp feedmail-date-generator)
2352 (feedmail-fiddle-header
2353 (if feedmail-is-a-resend "Resent-Date" "Date")
2354 (nth 1 feedmail-date-generator) ; value
2355 (nth 2 feedmail-date-generator) ; action
2356 (nth 3 feedmail-date-generator))))) ; folding
2359 (defun feedmail-default-message-id-generator (maybe-file)
2360 "Default function for generating Message-Id: header contents.
2361 Based on a date and a sort of random number for tie breaking. Unless
2362 feedmail-message-id-suffix is defined, uses `user-mail-address', so be
2365 (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
2366 (if (string-match "^\\(.*\\)@" end-stuff)
2368 (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
2369 (setq end-stuff (concat "@" end-stuff)))
2370 (if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
2371 (setq date-time (nth 5 (file-attributes maybe-file))))
2372 (format "<%d-%s%s%s>"
2373 (mod (random) 10000)
2374 (format-time-string "%a%d%b%Y%H%M%S" date-time)
2375 (feedmail-rfc822-time-zone date-time)
2379 (defun feedmail-fiddle-message-id (maybe-file)
2380 "Fiddle Message-Id:. See documentation of feedmail-message-id-generator."
2381 ;; default is to fall off the end of the list and do nothing
2383 ;; nil means do nothing
2384 ((eq nil feedmail-message-id-generator) nil)
2385 ;; t is the same a using the function feedmail-default-message-id-generator, so let it and recurse
2386 ((eq t feedmail-message-id-generator)
2387 (let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file)))
2388 (feedmail-fiddle-message-id maybe-file)))
2390 ;; if it's a string, simply make a fiddle-plex out of it and recurse
2391 ((stringp feedmail-message-id-generator)
2392 (let ((feedmail-message-id-generator (list "ignored" feedmail-message-id-generator 'create)))
2393 (feedmail-fiddle-message-id maybe-file)))
2395 ;; if it's a function, call it and recurse with the resulting value
2396 ((and (symbolp feedmail-message-id-generator) (fboundp feedmail-message-id-generator))
2397 (let ((feedmail-message-id-generator (funcall feedmail-message-id-generator maybe-file)))
2398 (feedmail-fiddle-message-id maybe-file)))
2400 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2401 ((listp feedmail-message-id-generator)
2402 (feedmail-fiddle-header
2403 (if feedmail-is-a-resend "Resent-Message-Id" "Message-Id")
2404 (nth 1 feedmail-message-id-generator) ; value
2405 (nth 2 feedmail-message-id-generator) ; action
2406 (nth 3 feedmail-message-id-generator))))) ; folding
2409 (defun feedmail-default-x-mailer-generator ()
2410 "Default function for generating X-Mailer: header contents."
2412 (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs "))
2413 emacs-version " (via feedmail " feedmail-patch-level
2414 (if feedmail-queue-runner-is-active " Q" " I")
2415 (if feedmail-enable-spray "S" "")
2416 (if feedmail-x-mailer-line-user-appendage ") " ")")
2417 feedmail-x-mailer-line-user-appendage))
2420 (defun feedmail-fiddle-x-mailer ()
2421 "Fiddle X-Mailer:. See documentation of feedmail-x-mailer-line."
2422 ;; default is to fall off the end of the list and do nothing
2424 ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
2425 ((eq t feedmail-x-mailer-line)
2426 (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
2427 (feedmail-fiddle-x-mailer)))
2429 ;; if it's a string, simply make a fiddle-plex out of it and recurse
2430 ((stringp feedmail-x-mailer-line)
2431 (let ((feedmail-x-mailer-line (list "ignored" (list feedmail-x-mailer-line ";\n\t%s") 'combine)))
2432 (feedmail-fiddle-x-mailer)))
2434 ;; if it's a function, call it and recurse with the resulting value
2435 ((and (symbolp feedmail-x-mailer-line) (fboundp feedmail-x-mailer-line))
2436 (let ((feedmail-x-mailer-line (funcall feedmail-x-mailer-line)))
2437 (feedmail-fiddle-x-mailer)))
2439 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2440 ((listp feedmail-x-mailer-line)
2441 (feedmail-fiddle-header
2442 (if feedmail-is-a-resend "X-Resent-Mailer" "X-Mailer")
2443 (nth 1 feedmail-x-mailer-line) ; value
2444 (nth 2 feedmail-x-mailer-line) ; action
2445 (nth 3 feedmail-x-mailer-line))))) ; folding
2448 (defun feedmail-fiddle-spray-address (addy-plex)
2449 "Fiddle header for single spray address. Uses feedmail-spray-this-address."
2450 ;; default is to fall off the end of the list and do nothing
2452 ;; nil means do nothing
2453 ((eq nil addy-plex) nil)
2454 ;; t means the same as using "To:" and unembellished addy
2456 (let ((addy-plex (list "To" feedmail-spray-this-address)))
2457 (feedmail-fiddle-spray-address addy-plex)))
2459 ;; if it's a string, simply make a fiddle-plex out of it and recurse, assuming
2460 ;; the string names a header field (e.g., "To")
2461 ((stringp addy-plex)
2462 (let ((addy-plex (list addy-plex feedmail-spray-this-address)))
2463 (feedmail-fiddle-spray-address addy-plex)))
2465 ;; if it's a function, call it and recurse with the resulting value
2466 ((and (symbolp addy-plex) (fboundp addy-plex))
2467 (let ((addy-plex (funcall addy-plex)))
2468 (feedmail-fiddle-spray-address addy-plex)))
2470 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2472 (feedmail-fiddle-header
2473 (nth 0 addy-plex) ; name
2474 (nth 1 addy-plex) ; value
2475 (nth 2 addy-plex) ; action
2476 (nth 3 addy-plex))))) ; folding
2479 (defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
2480 "Fiddling based on a list of fiddle-plexes for spraying."
2481 ;; default is to fall off the end of the list and do nothing
2482 (let ((lofp list-of-fiddle-plexes) fp)
2485 (setq fp (car lofp))
2486 (setq lofp (cdr lofp))
2487 (feedmail-fiddle-spray-address fp))
2488 (feedmail-fiddle-spray-address lofp))))
2491 (defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
2492 "Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless."
2493 ;; default is to fall off the end of the list and do nothing
2494 (let ((lofp list-of-fiddle-plexes) fp)
2496 (setq fp (car lofp))
2497 (setq lofp (cdr lofp))
2500 ;; if it's a function, call it and recurse with the resulting value
2501 ((and (symbolp fp) (fboundp fp))
2502 (let ((lofp (list (funcall fp)))) (feedmail-fiddle-list-of-fiddle-plexes lofp)))
2504 ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
2506 (feedmail-fiddle-header
2510 (nth 3 fp))))))) ; folding
2513 (defun feedmail-accume-n-nuke-header (header-end header-regexp)
2514 "Delete headers matching a regexp and their continuation lines.
2515 There may be multiple such lines, and each may have arbitrarily
2516 many continuation lines. Return an accumulation of the deleted
2517 headers, including the intervening newlines."
2518 (let ((case-fold-search t) (dropout))
2520 (goto-char (point-min))
2521 ;; iterate over all matching lines
2522 (while (re-search-forward header-regexp header-end t)
2524 (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
2525 (delete-region (match-beginning 0) (point))
2526 ;; get rid of any continuation lines
2527 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
2529 (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point))))
2530 (replace-match ""))))
2531 (identity dropout)))
2533 (defun feedmail-fill-to-cc-function (header-end)
2534 "Smart filling of address headers (don't be fooled by the name).
2535 The filling tries to avoid splitting lines except at commas. This
2536 avoids, in particular, splitting within parenthesized comments in
2537 addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:,
2538 Resent-To:, Resent-Cc:, and Resent-Bcc:."
2539 (let ((case-fold-search t)
2543 (goto-char (point-min))
2544 ;; iterate over all To:/Cc:, etc, lines
2547 "^\\(From:\\|Reply-To:\\|To:\\|Cc:\\|Bcc:\\|Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)"
2549 (setq this-line (match-beginning 0))
2550 ;; replace 0 or more leading spaces with a single space
2551 (and (looking-at "[ \t]*") (replace-match " "))
2553 ;; get any continuation lines
2554 (while (and (looking-at "[ \t]+") (< (point) header-end))
2556 (setq this-line-end (point-marker))
2557 (save-excursion (feedmail-fill-this-one this-line this-line-end))
2561 (defun feedmail-fill-this-one (this-line this-line-end)
2562 "In-place smart filling of the region bounded by the two arguments."
2563 (let ((fill-prefix "\t")
2564 (fill-column feedmail-fill-to-cc-fill-column))
2565 ;; The general idea is to break only on commas. Collapse
2566 ;; multiple whitespace to a single blank; change
2567 ;; all the blanks to something unprintable; change the
2568 ;; commas to blanks; fill the region; change it back.
2569 (goto-char this-line)
2570 (while (re-search-forward "\\s-+" (1- this-line-end) t)
2571 (replace-match " "))
2573 (subst-char-in-region this-line this-line-end ? 2 t) ; blank->C-b
2574 (subst-char-in-region this-line this-line-end ?, ? t) ; comma->blank
2576 (fill-region-as-paragraph this-line this-line-end)
2578 (subst-char-in-region this-line this-line-end ? ?, t) ; comma<-blank
2579 (subst-char-in-region this-line this-line-end 2 ? t) ; blank<-C-b
2581 ;; look out for missing commas before continuation lines
2582 (goto-char this-line)
2583 (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
2584 (replace-match "\\1,\n\t"))
2588 (require 'mail-utils) ; pick up mail-strip-quoted-names
2589 (defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
2590 "Get address list with all comments and other excitement trimmed.
2591 Addresses are collected only from headers whose names match the fourth
2592 argument Returns a list of strings. Duplicate addresses will have
2594 (let ((simple-address)
2600 (set-buffer (get-buffer-create " *FQM scratch*")) (erase-buffer)
2601 (insert-buffer-substring message-buffer header-start header-end)
2602 (goto-char (point-min))
2603 (let ((case-fold-search t))
2604 (while (re-search-forward addr-regexp (point-max) t)
2606 (setq this-line (match-beginning 0))
2608 ;; get any continuation lines
2609 (while (and (looking-at "^[ \t]+") (< (point) (point-max)))
2611 (setq this-line-end (point-marker))
2612 ;; only keep if we don't have it already
2614 (mail-strip-quoted-names (buffer-substring this-line this-line-end)))
2615 (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
2616 (setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
2617 (setq address-blob (replace-match "" t t address-blob))
2618 (if (not (member simple-address address-list))
2619 (add-to-list 'address-list simple-address)))
2622 (identity address-list)))
2625 (defun feedmail-one-last-look (feedmail-prepped-text-buffer)
2626 "Offer the user one last chance to give it up."
2628 (save-window-excursion
2629 (switch-to-buffer feedmail-prepped-text-buffer)
2630 (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout))
2631 (y-or-n-p-with-timeout
2632 "FQM: Send this email? "
2633 (abs feedmail-confirm-outgoing-timeout)
2634 (> feedmail-confirm-outgoing-timeout 0))
2635 (y-or-n-p "FQM: Send this email? "))
2638 (defun feedmail-fqm-p (might-be)
2639 "Internal; does filename end with FQM suffix?"
2640 (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
2643 (defun feedmail-find-eoh (&optional noerror)
2644 "Internal; finds the end of message header fields, returns mark just before it"
2646 (goto-char (point-min))
2647 (if (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n") nil noerror)
2653 ;;; feedmail.el ends here