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