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