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