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