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