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