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