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