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