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