diff options
| author | Bill Carpenter | 2011-05-14 11:30:21 -0700 |
|---|---|---|
| committer | Glenn Morris | 2011-05-14 11:30:21 -0700 |
| commit | 215cda7c79dce98ed62fb5b82cf13f067f14c94a (patch) | |
| tree | dc9f920d5d7c164b64659397bde325134cbdfe5d | |
| parent | bc039a3b7dee37fa86932a54af083b2c7ac37fd3 (diff) | |
| download | emacs-215cda7c79dce98ed62fb5b82cf13f067f14c94a.tar.gz emacs-215cda7c79dce98ed62fb5b82cf13f067f14c94a.zip | |
Update from version on author's website.
* lisp/mail/feedmail.el (feedmail-patch-level): Increase.
(feedmail-debug): New custom group.
(feedmail-confirm-outgoing-timeout)
(feedmail-sendmail-f-doesnt-sell-me-out)
(feedmail-queue-slug-suspect-regexp, feedmail-debug)
(feedmail-debug-sit-for, feedmail-queue-express-hook): New options.
(feedmail-sender-line, feedmail-from-line)
(feedmail-fiddle-headers-upwardly, feedmail-enable-spray)
(feedmail-spray-this-address, )
(feedmail-spray-address-fiddle-plex-list)
(feedmail-queue-use-send-time-for-date)
(feedmail-queue-use-send-time-for-message-id)
(feedmail-last-chance-hook, feedmail-queue-runner-mode-setter)
(feedmail-buffer-eating-function):
Doc fixes.
(feedmail-spray-via-bbdb, feedmail-buffer-to-smtp)
(feedmail-vm-mail-mode, feedmail-message-action-scroll-up)
(feedmail-message-action-scroll-down): New functions.
(feedmail-queue-directory, feedmail-queue-draft-directory):
Use expand-file-name.
(feedmail-prompt-before-queue-standard-alist): Add scroll entries.
Remove C-v help entry.
(feedmail-queue-buffer-file-name): New variable.
(feedmail-mail-send-hook-splitter, feedmail-buffer-to-binmail)
(feedmail-buffer-to-smtpmail, feedmail-queue-express-to-draft)
(feedmail-message-action-send-strong, feedmail-message-action-edit)
(feedmail-message-action-draft, feedmail-message-action-draft-strong)
(feedmail-message-action-queue, feedmail-message-action-queue-strong)
(feedmail-message-action-toggle-spray)
(feedmail-run-the-queue-no-prompts)
(feedmail-run-the-queue-global-prompt, feedmail-queue-reminder)
(feedmail-look-at-queue-directory, feedmail-queue-subject-slug-maker)
(feedmail-create-queue-filename, feedmail-rfc822-time-zone):
(feedmail-fiddle-header, feedmail-give-it-to-buffer-eater)
(feedmail-envelope-deducer, feedmail-fiddle-from)
(feedmail-fiddle-sender, feedmail-default-date-generator)
(feedmail-fiddle-date, feedmail-fiddle-message-id)
(feedmail-fiddle-spray-address)
(feedmail-fiddle-list-of-spray-fiddle-plexes)
(feedmail-fiddle-list-of-fiddle-plexes)
(feedmail-fill-to-cc-function, feedmail-fill-this-one)
(feedmail-one-last-look, feedmail-fqm-p): Add debug calls.
(feedmail-queue-runner-message-sender, feedmail-binmail-template):
Change default. Doc fix.
(feedmail-queue-runner-cleaner-upper): Use feedmail-say-chatter.
(feedmail-binmail-linuxish-template): New constant.
(feedmail-buffer-to-sendmail): Doc fix. Add debug call.
Respect feedmail-sendmail-f-doesnt-sell-me-out.
(feedmail-send-it): Add debug call.
Use feedmail-queue-buffer-file-name, and
feedmail-send-it-immediately-wrapper.
(feedmail-message-action-send): Add debug call.
Use feedmail-send-it-immediately-wrapper.
(feedmail-queue-express-to-queue): Add debug call.
Run feedmail-queue-express-hook.
(feedmail-message-action-help): Add debug call. Use feedmail-p-h-b-n.
(feedmail-message-action-help-blat):
Rename from feedmail-queue-send-edit-prompt-help-first.
(feedmail-run-the-queue): Add debug call. Set buffer-file-type.
Check line-endings. Handle errors better.
(feedmail-queue-reminder-brief, feedmail-queue-reminder-medium):
Doc fix. Add debug call.
(feedmail-queue-send-edit-prompt): Doc fix. Add debug call.
Use feedmail-queue-send-edit-prompt-inner.
(feedmail-queue-runner-prompt, feedmail-scroll-buffer): New functions.
(feedmail-queue-send-edit-prompt-inner): New function, extracted
from feedmail-queue-send-edit-prompt.
(feedmail-queue-send-edit-prompt-help)
(feedmail-queue-send-edit-prompt-help-later): Remove functions.
(feedmail-tidy-up-slug): Add debug call.
Respect feedmail-queue-slug-suspect-regexp.
(feedmail-queue-subject-slug-maker): Use buffer-substring-no-properties.
(feedmail-dump-message-to-queue): Add debug call.
Expand queue-directory.
(feedmail-dump-message-to-queue): Change message slightly.
Use feedmail-say-chatter.
(feedmail-rfc822-date): Add debug call. Bind system-time-locale.
(feedmail-send-it-immediately-wrapper): New function.
(feedmail-send-it-immediately): Add debug calls. Use let not let*.
Insert empty string rather than newline. Handle full-frame case.
Use catch/throw. Use feedmail-say-chatter.
(feedmail-fiddle-from): Try mail-host-address.
(feedmail-default-message-id-generator): Doc fix.
Bind system-time-locale. Handle missing end.
(feedmail-fiddle-x-mailer): Add debug call.
Handle feedmail-x-mailer-line being nil.
(feedmail-accume-n-nuke-header, feedmail-deduce-address-list):
Add debug call. Use buffer-substring-no-properties.
(feedmail-say-debug, feedmail-say-chatter): New functions.
(feedmail-find-eoh): Give an explicit error.
| -rw-r--r-- | lisp/ChangeLog | 93 | ||||
| -rw-r--r-- | lisp/mail/feedmail.el | 940 |
2 files changed, 815 insertions, 218 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 997092d939c..e7b7b729489 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,96 @@ | |||
| 1 | 2011-05-14 Bill Carpenter <bill@carpenter.org> | ||
| 2 | |||
| 3 | * mail/feedmail.el (feedmail-patch-level): Increase. | ||
| 4 | (feedmail-debug): New custom group. | ||
| 5 | (feedmail-confirm-outgoing-timeout) | ||
| 6 | (feedmail-sendmail-f-doesnt-sell-me-out) | ||
| 7 | (feedmail-queue-slug-suspect-regexp, feedmail-debug) | ||
| 8 | (feedmail-debug-sit-for, feedmail-queue-express-hook): New options. | ||
| 9 | (feedmail-sender-line, feedmail-from-line) | ||
| 10 | (feedmail-fiddle-headers-upwardly, feedmail-enable-spray) | ||
| 11 | (feedmail-spray-this-address, ) | ||
| 12 | (feedmail-spray-address-fiddle-plex-list) | ||
| 13 | (feedmail-queue-use-send-time-for-date) | ||
| 14 | (feedmail-queue-use-send-time-for-message-id) | ||
| 15 | (feedmail-last-chance-hook, feedmail-queue-runner-mode-setter) | ||
| 16 | (feedmail-buffer-eating-function): | ||
| 17 | Doc fixes. | ||
| 18 | (feedmail-spray-via-bbdb, feedmail-buffer-to-smtp) | ||
| 19 | (feedmail-vm-mail-mode, feedmail-message-action-scroll-up) | ||
| 20 | (feedmail-message-action-scroll-down): New functions. | ||
| 21 | (feedmail-queue-directory, feedmail-queue-draft-directory): | ||
| 22 | Use expand-file-name. | ||
| 23 | (feedmail-prompt-before-queue-standard-alist): Add scroll entries. | ||
| 24 | Remove C-v help entry. | ||
| 25 | (feedmail-queue-buffer-file-name): New variable. | ||
| 26 | (feedmail-mail-send-hook-splitter, feedmail-buffer-to-binmail) | ||
| 27 | (feedmail-buffer-to-smtpmail, feedmail-queue-express-to-draft) | ||
| 28 | (feedmail-message-action-send-strong, feedmail-message-action-edit) | ||
| 29 | (feedmail-message-action-draft, feedmail-message-action-draft-strong) | ||
| 30 | (feedmail-message-action-queue, feedmail-message-action-queue-strong) | ||
| 31 | (feedmail-message-action-toggle-spray) | ||
| 32 | (feedmail-run-the-queue-no-prompts) | ||
| 33 | (feedmail-run-the-queue-global-prompt, feedmail-queue-reminder) | ||
| 34 | (feedmail-look-at-queue-directory, feedmail-queue-subject-slug-maker) | ||
| 35 | (feedmail-create-queue-filename, feedmail-rfc822-time-zone): | ||
| 36 | (feedmail-fiddle-header, feedmail-give-it-to-buffer-eater) | ||
| 37 | (feedmail-envelope-deducer, feedmail-fiddle-from) | ||
| 38 | (feedmail-fiddle-sender, feedmail-default-date-generator) | ||
| 39 | (feedmail-fiddle-date, feedmail-fiddle-message-id) | ||
| 40 | (feedmail-fiddle-spray-address) | ||
| 41 | (feedmail-fiddle-list-of-spray-fiddle-plexes) | ||
| 42 | (feedmail-fiddle-list-of-fiddle-plexes) | ||
| 43 | (feedmail-fill-to-cc-function, feedmail-fill-this-one) | ||
| 44 | (feedmail-one-last-look, feedmail-fqm-p): Add debug calls. | ||
| 45 | (feedmail-queue-runner-message-sender, feedmail-binmail-template): | ||
| 46 | Change default. Doc fix. | ||
| 47 | (feedmail-queue-runner-cleaner-upper): Use feedmail-say-chatter. | ||
| 48 | (feedmail-binmail-linuxish-template): New constant. | ||
| 49 | (feedmail-buffer-to-sendmail): Doc fix. Add debug call. | ||
| 50 | Respect feedmail-sendmail-f-doesnt-sell-me-out. | ||
| 51 | (feedmail-send-it): Add debug call. | ||
| 52 | Use feedmail-queue-buffer-file-name, and | ||
| 53 | feedmail-send-it-immediately-wrapper. | ||
| 54 | (feedmail-message-action-send): Add debug call. | ||
| 55 | Use feedmail-send-it-immediately-wrapper. | ||
| 56 | (feedmail-queue-express-to-queue): Add debug call. | ||
| 57 | Run feedmail-queue-express-hook. | ||
| 58 | (feedmail-message-action-help): Add debug call. Use feedmail-p-h-b-n. | ||
| 59 | (feedmail-message-action-help-blat): | ||
| 60 | Rename from feedmail-queue-send-edit-prompt-help-first. | ||
| 61 | (feedmail-run-the-queue): Add debug call. Set buffer-file-type. | ||
| 62 | Check line-endings. Handle errors better. | ||
| 63 | (feedmail-queue-reminder-brief, feedmail-queue-reminder-medium): | ||
| 64 | Doc fix. Add debug call. | ||
| 65 | (feedmail-queue-send-edit-prompt): Doc fix. Add debug call. | ||
| 66 | Use feedmail-queue-send-edit-prompt-inner. | ||
| 67 | (feedmail-queue-runner-prompt, feedmail-scroll-buffer): New functions. | ||
| 68 | (feedmail-queue-send-edit-prompt-inner): New function, extracted | ||
| 69 | from feedmail-queue-send-edit-prompt. | ||
| 70 | (feedmail-queue-send-edit-prompt-help) | ||
| 71 | (feedmail-queue-send-edit-prompt-help-later): Remove functions. | ||
| 72 | (feedmail-tidy-up-slug): Add debug call. | ||
| 73 | Respect feedmail-queue-slug-suspect-regexp. | ||
| 74 | (feedmail-queue-subject-slug-maker): Use buffer-substring-no-properties. | ||
| 75 | (feedmail-dump-message-to-queue): Add debug call. | ||
| 76 | Expand queue-directory. | ||
| 77 | (feedmail-dump-message-to-queue): Change message slightly. | ||
| 78 | Use feedmail-say-chatter. | ||
| 79 | (feedmail-rfc822-date): Add debug call. Bind system-time-locale. | ||
| 80 | (feedmail-send-it-immediately-wrapper): New function. | ||
| 81 | (feedmail-send-it-immediately): Add debug calls. Use let not let*. | ||
| 82 | Insert empty string rather than newline. Handle full-frame case. | ||
| 83 | Use catch/throw. Use feedmail-say-chatter. | ||
| 84 | (feedmail-fiddle-from): Try mail-host-address. | ||
| 85 | (feedmail-default-message-id-generator): Doc fix. | ||
| 86 | Bind system-time-locale. Handle missing end. | ||
| 87 | (feedmail-fiddle-x-mailer): Add debug call. | ||
| 88 | Handle feedmail-x-mailer-line being nil. | ||
| 89 | (feedmail-accume-n-nuke-header, feedmail-deduce-address-list): | ||
| 90 | Add debug call. Use buffer-substring-no-properties. | ||
| 91 | (feedmail-say-debug, feedmail-say-chatter): New functions. | ||
| 92 | (feedmail-find-eoh): Give an explicit error. | ||
| 93 | |||
| 1 | 2011-05-13 Ulf Jasper <ulf.jasper@web.de> | 94 | 2011-05-13 Ulf Jasper <ulf.jasper@web.de> |
| 2 | 95 | ||
| 3 | * net/newst-treeview.el (newsticker-treeview-face): Changed default | 96 | * net/newst-treeview.el (newsticker-treeview-face): Changed default |
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 56936e88efe..c66b4050b2c 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | ;; This file is part of GNU Emacs. | 4 | ;; This file is part of GNU Emacs. |
| 5 | 5 | ||
| 6 | ;; Author: Bill Carpenter <bill@carpenter.ORG> | 6 | ;; Author: Bill Carpenter <bill@carpenter.ORG> |
| 7 | ;; Version: 8 | 7 | ;; Version: 11 |
| 8 | ;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft | 8 | ;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft |
| 9 | ;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html> | 9 | ;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html> |
| 10 | 10 | ||
| @@ -15,12 +15,19 @@ | |||
| 15 | ;; mode). See below for a list of additional features, including the | 15 | ;; mode). See below for a list of additional features, including the |
| 16 | ;; ability to queue messages for later sending. If you are using | 16 | ;; ability to queue messages for later sending. If you are using |
| 17 | ;; fakemail as a subprocess, you can switch to feedmail and eliminate | 17 | ;; fakemail as a subprocess, you can switch to feedmail and eliminate |
| 18 | ;; the use of fakemail. feedmail works with recent versions of | 18 | ;; the use of fakemail. |
| 19 | ;; Emacs (mostly, but not exclusively, tested against 19.34 on | 19 | |
| 20 | ;; Win95; some testing on 20.x) and XEmacs (tested with 20.4 and | 20 | ;; feedmail works with recent versions of Emacs (20.x series) and |
| 21 | ;; later betas). It probably no longer works with Emacs 18, | 21 | ;; XEmacs (tested with 20.4 and later betas). It probably no longer |
| 22 | ;; though I haven't tried that in a long time. Sorry, no manual yet | 22 | ;; works with Emacs v18, though I haven't tried that in a long |
| 23 | ;; in this release. Look for one with the next release. | 23 | ;; time. Makoto.Nakagawa@jp.compaq.com reports: "I have a report |
| 24 | ;; that with a help of APEL library, feedmail works fine under emacs | ||
| 25 | ;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/. | ||
| 26 | ;; you need apel-10.2 or later to make feedmail work under emacs | ||
| 27 | ;; 19.28." | ||
| 28 | |||
| 29 | ;; Sorry, no manual yet in this release. Look for one with the next | ||
| 30 | ;; release. Or the one after that. Or maybe later. | ||
| 24 | 31 | ||
| 25 | ;; As far as I'm concerned, anyone can do anything they want with | 32 | ;; As far as I'm concerned, anyone can do anything they want with |
| 26 | ;; this specific piece of code. No warranty or promise of support is | 33 | ;; this specific piece of code. No warranty or promise of support is |
| @@ -68,7 +75,8 @@ | |||
| 68 | ;; This file requires the mail-utils library. | 75 | ;; This file requires the mail-utils library. |
| 69 | ;; | 76 | ;; |
| 70 | ;; This file requires the smtpmail library if you use | 77 | ;; This file requires the smtpmail library if you use |
| 71 | ;; feedmail-buffer-to-smtpmail. | 78 | ;; feedmail-buffer-to-smtpmail. It requires the smtp library if |
| 79 | ;; you use feedmail-buffer-smtp. | ||
| 72 | ;; | 80 | ;; |
| 73 | ;; This file requires the custom library. Unfortunately, there are | 81 | ;; This file requires the custom library. Unfortunately, there are |
| 74 | ;; two incompatible versions of the custom library. If you don't have | 82 | ;; two incompatible versions of the custom library. If you don't have |
| @@ -147,6 +155,32 @@ | |||
| 147 | ;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail") | 155 | ;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail") |
| 148 | ;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist)) | 156 | ;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist)) |
| 149 | ;; | 157 | ;; |
| 158 | ;; though VM users might find it more comfortable to use this instead of | ||
| 159 | ;; the above example's last line: | ||
| 160 | ;; | ||
| 161 | ;; (setq auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist)) | ||
| 162 | ;; | ||
| 163 | ;; If you end up getting asked about killing modified buffers all the time | ||
| 164 | ;; you are probably being prompted from outside feedmail. You can probably | ||
| 165 | ;; get cured by doing the defadvice stuff described in the documentation | ||
| 166 | ;; for the variable feedmail-queue-buffer-file-name below. | ||
| 167 | ;; | ||
| 168 | ;; If you are wondering how to send your messages to some SMTP server | ||
| 169 | ;; (which is not really a feedmail-specific issue), you are probably | ||
| 170 | ;; looking for smtpmail.el, and it is probably already present in your | ||
| 171 | ;; emacs installation. Look at smtpmail.el for how to set that up, and | ||
| 172 | ;; then do this to hook it into feedmail: | ||
| 173 | ;; | ||
| 174 | ;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t) | ||
| 175 | ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail) | ||
| 176 | ;; | ||
| 177 | ;; Alternatively, the FLIM <http://www.m17n.org/FLIM/> project | ||
| 178 | ;; provides a library called smtp.el. If you want to use that, the above lines | ||
| 179 | ;; would be: | ||
| 180 | ;; | ||
| 181 | ;; (autoload 'feedmail-buffer-to-smtp "feedmail" nil t) | ||
| 182 | ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtp) | ||
| 183 | ;; | ||
| 150 | ;; If you are using the desktop.el library to restore your sessions, you might | 184 | ;; If you are using the desktop.el library to restore your sessions, you might |
| 151 | ;; like to add the suffix ".fqm" to the list of non-saved things via the variable | 185 | ;; like to add the suffix ".fqm" to the list of non-saved things via the variable |
| 152 | ;; desktop-files-not-to-save. | 186 | ;; desktop-files-not-to-save. |
| @@ -174,13 +208,27 @@ | |||
| 174 | ;; (setq message-send-mail-function 'feedmail-send-it) | 208 | ;; (setq message-send-mail-function 'feedmail-send-it) |
| 175 | ;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter) | 209 | ;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter) |
| 176 | ;; | 210 | ;; |
| 211 | ;; If you use message-mode and you make use of feedmail's queueing | ||
| 212 | ;; stuff, you might also like to adjust these variables to appropriate | ||
| 213 | ;; values for message-mode: | ||
| 214 | ;; | ||
| 215 | ;; feedmail-queue-runner-mode-setter | ||
| 216 | ;; feedmail-queue-runner-message-sender | ||
| 217 | ;; | ||
| 218 | ;; If you are using the "cmail" email package, there is some built-in | ||
| 219 | ;; support for feedmail in recent versions. To enable it, you should: | ||
| 220 | ;; | ||
| 221 | ;; (setq cmail-use-feedmail t) | ||
| 222 | ;; | ||
| 223 | ;;;;;;;; | ||
| 224 | ;; | ||
| 177 | ;; I think the LCD is no longer being updated, but if it were, this | 225 | ;; I think the LCD is no longer being updated, but if it were, this |
| 178 | ;; would be a proper LCD record. There is an old version of | 226 | ;; would be a proper LCD record. There is an old version of |
| 179 | ;; feedmail.el in the LCD archive. It works but is missing a lot of | 227 | ;; feedmail.el in the LCD archive. It works but is missing a lot of |
| 180 | ;; features. | 228 | ;; features. |
| 181 | ;; | 229 | ;; |
| 182 | ;; LCD record: | 230 | ;; LCD record: |
| 183 | ;; feedmail|Bill Carpenter|bill@bubblegum.net,bill@carpenter.ORG|Outbound mail queue handling|98-06-15|8|feedmail.el | 231 | ;; feedmail|WJCarpenter|bill-feedmail@carpenter.ORG|Outbound mail queue handling|01-??-??|11-beta-??|feedmail.el |
| 184 | ;; | 232 | ;; |
| 185 | ;; Change log: | 233 | ;; Change log: |
| 186 | ;; original, 31 March 1991 | 234 | ;; original, 31 March 1991 |
| @@ -277,14 +325,51 @@ | |||
| 277 | ;; feedmail-queue-auto-file-nuke | 325 | ;; feedmail-queue-auto-file-nuke |
| 278 | ;; feedmail-queue-express-to-queue and feedmail-queue-express-to-draft | 326 | ;; feedmail-queue-express-to-queue and feedmail-queue-express-to-draft |
| 279 | ;; strong versions of "q"ueue and "d"raft answers (always make a new file) | 327 | ;; strong versions of "q"ueue and "d"raft answers (always make a new file) |
| 328 | ;; patchlevel 9, 23 March 2001 | ||
| 329 | ;; feedmail-queue-buffer-file-name to work around undesirable mail-send prompt | ||
| 330 | ;; at message action prompt, can scroll message buffer with "<" and ">"; | ||
| 331 | ;; C-v no longer scrolls help buffer | ||
| 332 | ;; conditionalize (discard-input) in message action prompt to avoid killing | ||
| 333 | ;; define-kbd-macro | ||
| 334 | ;; fixed error if feedmail-x-mailer-line was nil | ||
| 335 | ;; feedmail-binmail-template only uses /bin/rmail if it exists | ||
| 336 | ;; relocate feedmail-queue-alternative-mail-header-separator stuff | ||
| 337 | ;; added feedmail-vm-mail-mode, which make a good auto-mode-alist entry | ||
| 338 | ;; for FQM files if you're a VM user | ||
| 339 | ;; change buffer-substring calls to buffer-substring-no-properties for | ||
| 340 | ;; speed-up (suggested by Howard Melman <howard@silverstream.com>) | ||
| 341 | ;; feedmail-sendmail-f-doesnt-sell-me-out to contol "-f" in call to sendmail | ||
| 342 | ;; in feedmail-buffer-to-sendmail | ||
| 343 | ;; better trapping of odd conditions during the running of the queue; | ||
| 344 | ;; thanks to Yigal Hochberg for helping me test much of this by remote | ||
| 345 | ;; control | ||
| 346 | ;; feedmail-debug and feedmail-debug-sit-for | ||
| 347 | ;; feedmail-display-full-frame | ||
| 348 | ;; feedmail-queue-express-hook | ||
| 349 | ;; added example function feedmail-spray-via-bbdb | ||
| 350 | ;; use expand-file-name for setting default directory names | ||
| 351 | ;; define feedmail-binmail-linuxish-template as a suggestion for | ||
| 352 | ;; the value of feedmail-binmail-template on Linux and maybe other | ||
| 353 | ;; systems with non-classic /bin/[r]mail behavior | ||
| 354 | ;; guard against nil user-mail-address in generating MESSAGE-ID: | ||
| 355 | ;; feedmail-queue-slug-suspect-regexp is now a variable to | ||
| 356 | ;; accomodate non-ASCII environments (thanks to | ||
| 357 | ;; Makoto.Nakagawa@jp.compaq.com for this suggestion) | ||
| 358 | ;; feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail | ||
| 359 | ;; patchlevel 10, 22 April 2001 | ||
| 360 | ;; DATE: and MESSAGE-ID stuff now forces system-time-locale to "C" | ||
| 361 | ;; (brought to my attention by Makoto.Nakagawa@jp.compaq.com) | ||
| 362 | ;; patchlevel 11 | ||
| 363 | ;; tweak default FROM: calculation to look at mail-host-address | ||
| 364 | ;; (suggested by "Jason Eisner" <jason@cs.jhu.edu>) | ||
| 280 | ;; | 365 | ;; |
| 281 | ;; todo (probably in patchlevel 9): | 366 | ;; todo: |
| 282 | ;; write texinfo manual | 367 | ;; write texinfo manual |
| 283 | ;; maybe partition into multiple files, including files of examples | 368 | ;; maybe partition into multiple files, including files of examples |
| 284 | ;; | 369 | ;; |
| 285 | ;;; Code: | 370 | ;;; Code: |
| 286 | 371 | ||
| 287 | (defconst feedmail-patch-level "8") | 372 | (defconst feedmail-patch-level "11-beta-1") |
| 288 | 373 | ||
| 289 | (require 'mail-utils) ; pick up mail-strip-quoted-names | 374 | (require 'mail-utils) ; pick up mail-strip-quoted-names |
| 290 | 375 | ||
| @@ -312,6 +397,10 @@ | |||
| 312 | "Options related to queuing messages for later sending." | 397 | "Options related to queuing messages for later sending." |
| 313 | :group 'feedmail) | 398 | :group 'feedmail) |
| 314 | 399 | ||
| 400 | (defgroup feedmail-debug nil | ||
| 401 | "Options related to debug messages for later sending." | ||
| 402 | :group 'feedmail) | ||
| 403 | |||
| 315 | 404 | ||
| 316 | (defcustom feedmail-confirm-outgoing nil | 405 | (defcustom feedmail-confirm-outgoing nil |
| 317 | "If non-nil, give a y-or-n confirmation prompt before sending mail. | 406 | "If non-nil, give a y-or-n confirmation prompt before sending mail. |
| @@ -329,6 +418,23 @@ cases. You can give a timeout for the prompt; see variable | |||
| 329 | ) | 418 | ) |
| 330 | 419 | ||
| 331 | 420 | ||
| 421 | (defcustom feedmail-display-full-frame 'queued | ||
| 422 | "If non-nil, show prepped messages in a full frame. | ||
| 423 | If nil, the prepped message will be shown, for confirmation or | ||
| 424 | otherwise, in some window in the current frame without resizing | ||
| 425 | anything. That may or may not display enough of the message to | ||
| 426 | distinguish it from others. If set to the symbol 'queued, take | ||
| 427 | this action only when running the queue. If set to the symbol | ||
| 428 | 'immediate, take this action only when sending immediately. For | ||
| 429 | any other non-nil value, take the action in both cases. Even if | ||
| 430 | you're not confirming the sending of immediate or queued messages, | ||
| 431 | it can still be interesting to see a lot about them as they are | ||
| 432 | shuttled robotically onward." | ||
| 433 | :group 'feedmail-misc | ||
| 434 | :type 'boolean | ||
| 435 | ) | ||
| 436 | |||
| 437 | |||
| 332 | (defcustom feedmail-confirm-outgoing-timeout nil | 438 | (defcustom feedmail-confirm-outgoing-timeout nil |
| 333 | "If non-nil, a timeout in seconds at the send confirmation prompt. | 439 | "If non-nil, a timeout in seconds at the send confirmation prompt. |
| 334 | If a positive number, it's a timeout before sending. If a negative | 440 | If a positive number, it's a timeout before sending. If a negative |
| @@ -472,11 +578,11 @@ itself nor the trailing newline. If a function, it will be called | |||
| 472 | with no arguments. For an explanation of fiddle-plexes, see the | 578 | with no arguments. For an explanation of fiddle-plexes, see the |
| 473 | documentation for the variable `feedmail-fiddle-plex-blurb'. In all | 579 | documentation for the variable `feedmail-fiddle-plex-blurb'. In all |
| 474 | cases the name element of the fiddle-plex is ignored and is hardwired | 580 | cases the name element of the fiddle-plex is ignored and is hardwired |
| 475 | by feedmail to either \"X-Sender\" or \"X-Resent-Sender\". | 581 | by feedmail to either \"Sender\" or \"Resent-Sender\". |
| 476 | 582 | ||
| 477 | You can probably leave this nil, but if you feel like using it, a good | 583 | You can probably leave this nil, but if you feel like using it, a good |
| 478 | value would be a string of a fully-qualified domain name form of your | 584 | value would be a string of a fully-qualified domain name form of your |
| 479 | address. For example, \"bill@bubblegum.net (WJCarpenter)\". The Sender: | 585 | address. For example, \"bill@example.net (WJCarpenter)\". The Sender: |
| 480 | header is fiddled after the From: header is fiddled." | 586 | header is fiddled after the From: header is fiddled." |
| 481 | :group 'feedmail-headers | 587 | :group 'feedmail-headers |
| 482 | :type '(choice (const nil) string) | 588 | :type '(choice (const nil) string) |
| @@ -511,10 +617,10 @@ itself nor the trailing newline. If a function, it will be called | |||
| 511 | with no arguments. For an explanation of fiddle-plexes, see the | 617 | with no arguments. For an explanation of fiddle-plexes, see the |
| 512 | documentation for the variable `feedmail-fiddle-plex-blurb'. In all | 618 | documentation for the variable `feedmail-fiddle-plex-blurb'. In all |
| 513 | cases the name element of the fiddle-plex is ignored and is hardwired | 619 | cases the name element of the fiddle-plex is ignored and is hardwired |
| 514 | by feedmail to either \"X-From\" or \"X-Resent-From\". | 620 | by feedmail to either \"From\" or \"Resent-From\". |
| 515 | 621 | ||
| 516 | A good value would be a string fully-qualified domain name form of | 622 | A good value would be a string fully-qualified domain name form of |
| 517 | your address. For example, \"bill@bubblegum.net (WJCarpenter)\". The | 623 | your address. For example, \"bill@example.net (WJCarpenter)\". The |
| 518 | default value of this variable uses the standard elisp variable | 624 | default value of this variable uses the standard elisp variable |
| 519 | `user-mail-address' which should be set on every system but has a decent | 625 | `user-mail-address' which should be set on every system but has a decent |
| 520 | chance of being wrong. It also honors `mail-from-style'. Better to set | 626 | chance of being wrong. It also honors `mail-from-style'. Better to set |
| @@ -525,6 +631,28 @@ to arrange for the message to get a From: line." | |||
| 525 | ) | 631 | ) |
| 526 | 632 | ||
| 527 | 633 | ||
| 634 | (defcustom feedmail-sendmail-f-doesnt-sell-me-out nil | ||
| 635 | "Says whether the sendmail program issues a warning header if called with \"-f\". | ||
| 636 | The sendmail program has a useful feature to let you set the envelope FROM | ||
| 637 | address via a command line option, \"-f\". Unfortunately, it also has a widely | ||
| 638 | disliked default behavior of selling you out if you do that by inserting | ||
| 639 | an unattractive warning in the headers. It looks something like this: | ||
| 640 | |||
| 641 | X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f | ||
| 642 | |||
| 643 | It is possible to configure sendmail to not do this, but such a reconfiguration | ||
| 644 | is not an option for many users. As this is the default behavior of most | ||
| 645 | sendmail installations, one can mostly only wish it were otherwise. If feedmail | ||
| 646 | believes the sendmail program will sell you out this way, it won't use the \"-f\" | ||
| 647 | option when calling sendmail. If it doesn't think sendmail will sell you out, | ||
| 648 | it will use the \"-f\" \(since it is a handy feature\). You control what | ||
| 649 | feedmail thinks with this variable. The default is nil, meaning that feedmail | ||
| 650 | will believe that sendmail will sell you out." | ||
| 651 | :group 'feedmail-headers | ||
| 652 | :type 'boolean | ||
| 653 | ) | ||
| 654 | |||
| 655 | |||
| 528 | (defcustom feedmail-deduce-envelope-from t | 656 | (defcustom feedmail-deduce-envelope-from t |
| 529 | "If non-nil, deduce message envelope \"from\" from header From: or Sender:. | 657 | "If non-nil, deduce message envelope \"from\" from header From: or Sender:. |
| 530 | In other words, if there is a Sender: header in the message, temporarily | 658 | In other words, if there is a Sender: header in the message, temporarily |
| @@ -674,7 +802,7 @@ in the saved message if you use Fcc:." | |||
| 674 | "Non-nil means fiddled header fields should go at the top of the header. | 802 | "Non-nil means fiddled header fields should go at the top of the header. |
| 675 | nil means insert them at the bottom. This is mostly a novelty issue since | 803 | nil means insert them at the bottom. This is mostly a novelty issue since |
| 676 | the standards define the ordering of header fields to be immaterial and it's | 804 | the standards define the ordering of header fields to be immaterial and it's |
| 677 | fairly likely that some MTA along the way will have its own idea of what the | 805 | fairly likely that some MTA/MUA along the way will have its own idea of what the |
| 678 | order should be, regardless of what you specify." | 806 | order should be, regardless of what you specify." |
| 679 | :group 'feedmail-headers | 807 | :group 'feedmail-headers |
| 680 | :type 'boolean | 808 | :type 'boolean |
| @@ -718,19 +846,21 @@ headers of a message. Another use is to do a crude form of mailmerge, for | |||
| 718 | which see `feedmail-spray-address-fiddle-plex-list'. | 846 | which see `feedmail-spray-address-fiddle-plex-list'. |
| 719 | 847 | ||
| 720 | If one of the calls to the buffer-eating function results in an error, | 848 | If one of the calls to the buffer-eating function results in an error, |
| 721 | what happens next is carelessly defined, so beware." | 849 | what happens next is carelessly defined, so beware. This should get ironed |
| 850 | out in some future release, and there could be other API changes for spraying | ||
| 851 | as well." | ||
| 722 | :group 'feedmail-spray | 852 | :group 'feedmail-spray |
| 723 | :type 'boolean | 853 | :type 'boolean |
| 724 | ) | 854 | ) |
| 725 | 855 | ||
| 726 | (defvar feedmail-spray-this-address nil | 856 | (defvar feedmail-spray-this-address nil |
| 727 | "Do not set or change this variable. See `feedmail-spray-address-fiddle-plex-list'.") | 857 | "Do not set this variable, except via `feedmail-spray-address-fiddle-plex-list'.") |
| 728 | 858 | ||
| 729 | (defcustom feedmail-spray-address-fiddle-plex-list nil | 859 | (defcustom feedmail-spray-address-fiddle-plex-list nil |
| 730 | "User-supplied specification for a crude form of mailmerge capability. | 860 | "User-supplied specification for a crude form of mailmerge capability. |
| 731 | When spraying is enabled, feedmail composes a list of envelope addresses. | 861 | When spraying is enabled, feedmail composes a list of envelope addresses. |
| 732 | In turn, `feedmail-spray-this-address' is temporarily set to each address | 862 | In turn, `feedmail-spray-this-address' is temporarily set to each address |
| 733 | \(stripped of any comments and angle brackets\) and calls a function which | 863 | \(stripped of any comments and angle brackets\) and a function is called which |
| 734 | fiddles message headers according to this variable. See the documentation for | 864 | fiddles message headers according to this variable. See the documentation for |
| 735 | `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures. | 865 | `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures. |
| 736 | 866 | ||
| @@ -747,16 +877,20 @@ The fiddle-plex operator is 'supplement. | |||
| 747 | 877 | ||
| 748 | May be a function, in which case it is called with no arguments and is | 878 | May be a function, in which case it is called with no arguments and is |
| 749 | expected to return nil, t, a string, another function, or a fiddle-plex. | 879 | expected to return nil, t, a string, another function, or a fiddle-plex. |
| 750 | The result is used recursively. | 880 | The result is used recursively. The function may alter the value of the |
| 881 | variable feedmail-spray-this-address, perhaps to embellish it with a | ||
| 882 | human name. It would be logical in such a case to return as a value a | ||
| 883 | string naming a message header like \"TO\" or an appropriately constructed | ||
| 884 | fiddle-plex. For an example, see feedmail-spray-via-bbdb. | ||
| 751 | 885 | ||
| 752 | May be a list of any combination of the foregoing and fiddle-plexes. (A | 886 | May be a list of any combination of the foregoing and/or |
| 753 | value for this variable which consists of a single fiddle-plex must be | 887 | fiddle-plexes. (A value for this variable which consists of a single |
| 754 | nested inside another list to avoid ambiguity.) If a list, each item | 888 | fiddle-plex must be nested inside another list to avoid ambiguity.) |
| 755 | is acted on in turn as described above. | 889 | If a list, each item is acted on in turn as described above. |
| 756 | 890 | ||
| 757 | For example, | 891 | For example, |
| 758 | 892 | ||
| 759 | (setq feedmail-spray-address-fiddle-plex-list 'my-address-embellisher) | 893 | (setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb) |
| 760 | 894 | ||
| 761 | The idea of the example is that, during spray mode, as each message is | 895 | The idea of the example is that, during spray mode, as each message is |
| 762 | about to be transmitted to an individual address, the function will be | 896 | about to be transmitted to an individual address, the function will be |
| @@ -776,6 +910,22 @@ you are at accomplishing inherently inefficient things." | |||
| 776 | ) | 910 | ) |
| 777 | 911 | ||
| 778 | 912 | ||
| 913 | (defun feedmail-spray-via-bbdb () | ||
| 914 | "Example function for use with feedmail spray mode. | ||
| 915 | NB: it's up to the user to have the BBDB environment already set up properly | ||
| 916 | before using this." | ||
| 917 | (let (net-rec q-net-addy embellish) | ||
| 918 | (setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$")) | ||
| 919 | (setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy)) | ||
| 920 | (if (and (car net-rec) (not (cdr net-rec))) | ||
| 921 | (setq net-rec (car net-rec)) | ||
| 922 | (setq net-rec nil)) | ||
| 923 | (if net-rec (setq embellish (bbdb-dwim-net-address net-rec))) | ||
| 924 | (if embellish | ||
| 925 | (list "To" embellish 'supplement) | ||
| 926 | (list "To" feedmail-spray-this-address 'supplement)))) | ||
| 927 | |||
| 928 | |||
| 779 | (defcustom feedmail-enable-queue nil | 929 | (defcustom feedmail-enable-queue nil |
| 780 | "If non-nil, provide for stashing outgoing messages in a queue. | 930 | "If non-nil, provide for stashing outgoing messages in a queue. |
| 781 | This is the master on/off switch for feedmail message queuing. | 931 | This is the master on/off switch for feedmail message queuing. |
| @@ -813,20 +963,20 @@ without having to answer no to the individual message prompts." | |||
| 813 | 963 | ||
| 814 | 964 | ||
| 815 | (defcustom feedmail-queue-directory | 965 | (defcustom feedmail-queue-directory |
| 816 | (concat (getenv "HOME") "/mail/q") | 966 | (expand-file-name "~/mail/q") |
| 817 | "Name of a directory where messages will be queued. | 967 | "Name of a directory where messages will be queued. |
| 818 | Directory will be created if necessary. Should be a string that | 968 | Directory will be created if necessary. Should be a string that |
| 819 | doesn't end with a slash. Default is \"$HOME/mail/q\"." | 969 | doesn't end with a slash. Default is \"~/mail/q\"." |
| 820 | :group 'feedmail-queue | 970 | :group 'feedmail-queue |
| 821 | :type 'string | 971 | :type 'string |
| 822 | ) | 972 | ) |
| 823 | 973 | ||
| 824 | 974 | ||
| 825 | (defcustom feedmail-queue-draft-directory | 975 | (defcustom feedmail-queue-draft-directory |
| 826 | (concat (getenv "HOME") "/mail/draft") | 976 | (expand-file-name "~/mail/draft") |
| 827 | "Name of a directory where draft messages will be queued. | 977 | "Name of a directory where draft messages will be queued. |
| 828 | Directory will be created if necessary. Should be a string that | 978 | Directory will be created if necessary. Should be a string that |
| 829 | doesn't end with a slash. Default is \"$HOME/mail/draft\"." | 979 | doesn't end with a slash. Default is \"~/mail/draft\"." |
| 830 | :group 'feedmail-queue | 980 | :group 'feedmail-queue |
| 831 | :type 'string | 981 | :type 'string |
| 832 | ) | 982 | ) |
| @@ -894,7 +1044,10 @@ the help for the message action prompt." | |||
| 894 | 1044 | ||
| 895 | (?* . feedmail-message-action-toggle-spray) | 1045 | (?* . feedmail-message-action-toggle-spray) |
| 896 | 1046 | ||
| 897 | (?\C-v . feedmail-message-action-help) | 1047 | (?> . feedmail-message-action-scroll-up) |
| 1048 | (?< . feedmail-message-action-scroll-down) | ||
| 1049 | (? . feedmail-message-action-scroll-up) | ||
| 1050 | ;; (?\C-v . feedmail-message-action-help) | ||
| 898 | (?? . feedmail-message-action-help)) | 1051 | (?? . feedmail-message-action-help)) |
| 899 | "An alist of choices for the message action prompt. | 1052 | "An alist of choices for the message action prompt. |
| 900 | All of the values are function names, except help, which is a special | 1053 | All of the values are function names, except help, which is a special |
| @@ -987,7 +1140,10 @@ This variable is used by the default date generating function, | |||
| 987 | feedmail-default-date-generator. If nil, the default, the | 1140 | feedmail-default-date-generator. If nil, the default, the |
| 988 | last-modified timestamp of the queue file is used to create the | 1141 | last-modified timestamp of the queue file is used to create the |
| 989 | message Date: header; if there is no queue file, the current time is | 1142 | message Date: header; if there is no queue file, the current time is |
| 990 | used." | 1143 | used. If you are using VM, it might be supplying this header for |
| 1144 | you. To suppress VM's version | ||
| 1145 | |||
| 1146 | (setq vm-mail-header-insert-date nil)" | ||
| 991 | :group 'feedmail-queue | 1147 | :group 'feedmail-queue |
| 992 | :type 'boolean | 1148 | :type 'boolean |
| 993 | ) | 1149 | ) |
| @@ -999,7 +1155,10 @@ This variable is used by the default Message-Id: generating function, | |||
| 999 | `feedmail-default-message-id-generator'. If nil, the default, the | 1155 | `feedmail-default-message-id-generator'. If nil, the default, the |
| 1000 | last-modified timestamp of the queue file is used to create the | 1156 | last-modified timestamp of the queue file is used to create the |
| 1001 | message Message-Id: header; if there is no queue file, the current time is | 1157 | message Message-Id: header; if there is no queue file, the current time is |
| 1002 | used." | 1158 | used. If you are using VM, it might be supplying this header for |
| 1159 | you. To suppress VM's version | ||
| 1160 | |||
| 1161 | (setq vm-mail-header-insert-date nil)" | ||
| 1003 | :group 'feedmail-queue | 1162 | :group 'feedmail-queue |
| 1004 | :type 'boolean | 1163 | :type 'boolean |
| 1005 | ) | 1164 | ) |
| @@ -1035,6 +1194,21 @@ any." | |||
| 1035 | ) | 1194 | ) |
| 1036 | 1195 | ||
| 1037 | 1196 | ||
| 1197 | (defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+" | ||
| 1198 | "Regular expression for characters/substrings to be replaced. | ||
| 1199 | When feedmail creates a filename from a subject string, it puts hyphens | ||
| 1200 | in place of strings which may cause problems in filenames. By default, | ||
| 1201 | only alphanumeric and hyphen characters are kept, and all others are | ||
| 1202 | converted. In non-ASCII environments, it may be more helpful to | ||
| 1203 | tweak this regular expression to reflect local or personal language | ||
| 1204 | conventions. Substitutions are done repeatedly until the regular expression | ||
| 1205 | no longer matches to transformed string. Used by function | ||
| 1206 | feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker." | ||
| 1207 | :group 'feedmail-queue | ||
| 1208 | :type 'string | ||
| 1209 | ) | ||
| 1210 | |||
| 1211 | |||
| 1038 | (defcustom feedmail-queue-default-file-slug t | 1212 | (defcustom feedmail-queue-default-file-slug t |
| 1039 | "Indicates what to use for subject-less messages when forming a file name. | 1213 | "Indicates what to use for subject-less messages when forming a file name. |
| 1040 | When feedmail queues a message, it creates a unique file name. By default, | 1214 | When feedmail queues a message, it creates a unique file name. By default, |
| @@ -1095,6 +1269,59 @@ the file without bothering you." | |||
| 1095 | ) | 1269 | ) |
| 1096 | 1270 | ||
| 1097 | 1271 | ||
| 1272 | (defcustom feedmail-debug nil | ||
| 1273 | "If non-nil, blat a debug messages and such in the mini-buffer. | ||
| 1274 | This is intended as an aid to tracing what's going on but is probably | ||
| 1275 | of casual real use only to the feedmail developer." | ||
| 1276 | :group 'feedmail-debug | ||
| 1277 | :type 'boolean | ||
| 1278 | ) | ||
| 1279 | |||
| 1280 | |||
| 1281 | (defcustom feedmail-debug-sit-for 0 | ||
| 1282 | "Duration of pause after feedmail-debug messages. | ||
| 1283 | After some messages are divulged, it may be helpful to pause before | ||
| 1284 | something else obliterates them. This value controls the duration of | ||
| 1285 | the pause. If the value is nil or 0, the sit-for is not done, which | ||
| 1286 | has the effect of not pausing at all. Debug messages can be seen after | ||
| 1287 | the fact in the messages buffer." | ||
| 1288 | :group 'feedmail-debug | ||
| 1289 | :type 'integer | ||
| 1290 | ) | ||
| 1291 | |||
| 1292 | |||
| 1293 | (defvar feedmail-queue-buffer-file-name nil | ||
| 1294 | "If non-nil, has the value normally expected of 'buffer-file-name'. | ||
| 1295 | You are not intended to set this to something in your configuration. Rather, | ||
| 1296 | you might programmatically set it to something via a hook or function | ||
| 1297 | advice or whatever. You might like to do this if you are using a mail | ||
| 1298 | composition program that eventually uses sendmail.el's 'mail-send' | ||
| 1299 | function to process the message. If there is a filename associated | ||
| 1300 | with the message buffer, 'mail-send' will ask you for confirmation. | ||
| 1301 | There's no trivial way to avoid it. It's unwise to just set the value | ||
| 1302 | of 'buffer-file-name' to nil because that will defeat feedmail's file | ||
| 1303 | management features. Instead, arrange for this variable to be set to | ||
| 1304 | the value of 'buffer-file-name' before setting that to nil. An easy way | ||
| 1305 | to do that would be with defadvice on 'mail-send' \(undoing the | ||
| 1306 | assignments in a later advice\). | ||
| 1307 | |||
| 1308 | feedmail will pretend that 'buffer-file-name', if nil, has the value | ||
| 1309 | assigned of 'feedmail-queue-buffer-file-name' and carry out its normal | ||
| 1310 | activities. feedmail does not restore the non-nil value of | ||
| 1311 | 'buffer-file-name'. For safe bookkeeping, the user should insure that | ||
| 1312 | feedmail-queue-buffer-file-name is restored to nil. | ||
| 1313 | |||
| 1314 | Example 'defadvice' for mail-send: | ||
| 1315 | |||
| 1316 | (defadvice mail-send (before feedmail-mail-send-before-advice activate) | ||
| 1317 | (setq feedmail-queue-buffer-file-name buffer-file-name) | ||
| 1318 | (setq buffer-file-name nil)) | ||
| 1319 | |||
| 1320 | (defadvice mail-send (after feedmail-mail-send-after-advice activate) | ||
| 1321 | (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name)) | ||
| 1322 | (setq feedmail-queue-buffer-file-name nil)) | ||
| 1323 | ") | ||
| 1324 | |||
| 1098 | ;; defvars to make byte-compiler happy(er) | 1325 | ;; defvars to make byte-compiler happy(er) |
| 1099 | (defvar feedmail-error-buffer nil) | 1326 | (defvar feedmail-error-buffer nil) |
| 1100 | (defvar feedmail-prepped-text-buffer nil) | 1327 | (defvar feedmail-prepped-text-buffer nil) |
| @@ -1126,6 +1353,7 @@ buffer (typically by typing C-c C-c), whether the message is sent immediately | |||
| 1126 | or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is | 1353 | or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is |
| 1127 | called when messages are being sent from the queue directory, typically via a | 1354 | called when messages are being sent from the queue directory, typically via a |
| 1128 | call to `feedmail-run-the-queue'." | 1355 | call to `feedmail-run-the-queue'." |
| 1356 | (feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active) | ||
| 1129 | (if feedmail-queue-runner-is-active | 1357 | (if feedmail-queue-runner-is-active |
| 1130 | (run-hooks 'feedmail-mail-send-hook-queued) | 1358 | (run-hooks 'feedmail-mail-send-hook-queued) |
| 1131 | (run-hooks 'feedmail-mail-send-hook)) | 1359 | (run-hooks 'feedmail-mail-send-hook)) |
| @@ -1155,21 +1383,32 @@ It shows the simple addresses and gets a confirmation. Use as: | |||
| 1155 | 1383 | ||
| 1156 | (defcustom feedmail-last-chance-hook nil | 1384 | (defcustom feedmail-last-chance-hook nil |
| 1157 | "User's last opportunity to modify the message on its way out. | 1385 | "User's last opportunity to modify the message on its way out. |
| 1158 | It has already had all the header prepping from the standard package. | 1386 | When this hook runs, the current buffer is already the appropriate |
| 1159 | The next step after running the hook will be to push the buffer into a | 1387 | buffer. It has already had all the header prepping from the standard |
| 1160 | subprocess that mails the mail. The hook might be interested in | 1388 | package. The next step after running the hook will be to save the |
| 1161 | these: (1) `feedmail-prepped-text-buffer' contains the header and body | 1389 | message via FCC: processing. The hook might be interested in these: |
| 1162 | of the message, ready to go; (2) `feedmail-address-list' contains a list | 1390 | \(1) `feedmail-prepped-text-buffer' contains the header and body of the |
| 1391 | message, ready to go; (2) `feedmail-address-list' contains a list | ||
| 1163 | of simplified recipients of addresses which are to be given to the | 1392 | of simplified recipients of addresses which are to be given to the |
| 1164 | subprocess (the hook may change the list); (3) `feedmail-error-buffer' | 1393 | subprocess (the hook may change the list); (3) `feedmail-error-buffer' |
| 1165 | is an empty buffer intended to soak up errors for display to the user. | 1394 | is an empty buffer intended to soak up errors for display to the user. |
| 1166 | If the hook allows interactive activity, the user should not send more | 1395 | If the hook allows interactive activity, the user should not send more |
| 1167 | mail while in the hook since some of the internal buffers will be | 1396 | mail while in the hook since some of the internal buffers will be |
| 1168 | reused and things will get confused." | 1397 | reused and things will get confused. It's not necessary to |
| 1398 | arrange for the undoing of any changes you make to the buffer." | ||
| 1169 | :group 'feedmail-misc | 1399 | :group 'feedmail-misc |
| 1170 | :type 'hook | 1400 | :type 'hook |
| 1171 | ) | 1401 | ) |
| 1172 | 1402 | ||
| 1403 | (defcustom feedmail-queue-express-hook nil | ||
| 1404 | "Chance to modify a message being sent directly to a queue. | ||
| 1405 | Run by feedmail-queue-express-to-queue and feedmail-queue-express-to-draft. | ||
| 1406 | For example, you might want to run vm-mime-encode-composition to take | ||
| 1407 | care of attachments. If you subsequently edit the message buffer, you | ||
| 1408 | can undo the encoding." | ||
| 1409 | :group 'feedmail-queue | ||
| 1410 | :type 'hook | ||
| 1411 | ) | ||
| 1173 | 1412 | ||
| 1174 | (defcustom feedmail-before-fcc-hook nil | 1413 | (defcustom feedmail-before-fcc-hook nil |
| 1175 | "User's last opportunity to modify the message before Fcc action. | 1414 | "User's last opportunity to modify the message before Fcc action. |
| @@ -1197,6 +1436,9 @@ argument, the optional argument used in the call to | |||
| 1197 | Most people want `mail-mode', so the default value is an anonymous | 1436 | Most people want `mail-mode', so the default value is an anonymous |
| 1198 | function which is just a wrapper to ignore the supplied argument when | 1437 | function which is just a wrapper to ignore the supplied argument when |
| 1199 | calling it, but here's your chance to have something different. | 1438 | calling it, but here's your chance to have something different. |
| 1439 | If you are a VM user, you might like feedmail-vm-mail-mode, though you | ||
| 1440 | really don't need that (and it's not particularly well-tested). | ||
| 1441 | |||
| 1200 | Called with funcall, not `call-interactively'." | 1442 | Called with funcall, not `call-interactively'." |
| 1201 | :group 'feedmail-queue | 1443 | :group 'feedmail-queue |
| 1202 | :type 'function | 1444 | :type 'function |
| @@ -1220,15 +1462,18 @@ set `mail-header-separator' to the value of | |||
| 1220 | ) | 1462 | ) |
| 1221 | 1463 | ||
| 1222 | 1464 | ||
| 1223 | (defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit | 1465 | (defcustom feedmail-queue-runner-message-sender |
| 1466 | '(lambda (&optional arg) (mail-send)) | ||
| 1224 | "Function to initiate sending a message file. | 1467 | "Function to initiate sending a message file. |
| 1225 | Called for each message read back out of the queue directory with a | 1468 | Called for each message read back out of the queue directory with a |
| 1226 | single argument, the optional argument used in the call to | 1469 | single argument, the optional argument used in the call to |
| 1227 | `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. | 1470 | `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. |
| 1228 | Interactively, that argument will be the prefix argument. Most people | 1471 | Interactively, that argument will be the prefix argument. |
| 1229 | want `mail-send-and-exit' (bound to C-c C-c in mail-mode), but here's | 1472 | Most people want `mail-send' (bound to C-c C-s in mail-mode), but here's |
| 1230 | your chance to have something different. Called with `funcall', not | 1473 | your chance to have something different. The default value is just a |
| 1231 | `call-interactively'." | 1474 | wrapper function which discards the optional argument and calls |
| 1475 | mail-send. If you are a VM user, you might like vm-mail-send, though | ||
| 1476 | you really don't need that. Called with funcall, not call-interactively." | ||
| 1232 | :group 'feedmail-queue | 1477 | :group 'feedmail-queue |
| 1233 | :type 'function | 1478 | :type 'function |
| 1234 | ) | 1479 | ) |
| @@ -1237,7 +1482,7 @@ your chance to have something different. Called with `funcall', not | |||
| 1237 | (defcustom feedmail-queue-runner-cleaner-upper | 1482 | (defcustom feedmail-queue-runner-cleaner-upper |
| 1238 | '(lambda (fqm-file &optional arg) | 1483 | '(lambda (fqm-file &optional arg) |
| 1239 | (delete-file fqm-file) | 1484 | (delete-file fqm-file) |
| 1240 | (if (and arg feedmail-queue-chatty) (message "FQM: Nuked %s" fqm-file))) | 1485 | (if arg (feedmail-say-chatter "Nuked %s" fqm-file))) |
| 1241 | "Function that will be called after a message has been sent. | 1486 | "Function that will be called after a message has been sent. |
| 1242 | Not called in the case of errors. This function is called with two | 1487 | Not called in the case of errors. This function is called with two |
| 1243 | arguments: the name of the message queue file for the message just sent, | 1488 | arguments: the name of the message queue file for the message just sent, |
| @@ -1269,31 +1514,61 @@ variable, but may depend on its value as described here.") | |||
| 1269 | The function's three (mandatory) arguments are: (1) the buffer | 1514 | The function's three (mandatory) arguments are: (1) the buffer |
| 1270 | containing the prepped message; (2) a buffer where errors should be | 1515 | containing the prepped message; (2) a buffer where errors should be |
| 1271 | directed; and (3) a list containing the addresses individually as | 1516 | directed; and (3) a list containing the addresses individually as |
| 1272 | strings. Three popular choices for this are | 1517 | strings. Popular choices for this are `feedmail-buffer-to-binmail', |
| 1273 | `feedmail-buffer-to-binmail', `feedmail-buffer-to-smtpmail', and | 1518 | `feedmail-buffer-to-smtpmail', `feedmail-buffer-to-sendmail', and |
| 1274 | `feedmail-buffer-to-sendmail'. If you use the sendmail form, you | 1519 | `feedmail-buffer-to-smtp'. If you use the sendmail form, you probably |
| 1275 | probably want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc' | 1520 | want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc to nil'. |
| 1276 | to nil. If you use the binmail form, check the value of | 1521 | If you use the binmail form, check the value of `feedmail-binmail-template'." |
| 1277 | `feedmail-binmail-template'." | ||
| 1278 | :group 'feedmail-misc | 1522 | :group 'feedmail-misc |
| 1279 | :type 'function | 1523 | :type 'function |
| 1280 | ) | 1524 | ) |
| 1281 | 1525 | ||
| 1526 | (defconst feedmail-binmail-linuxish-template | ||
| 1527 | (concat | ||
| 1528 | "(echo From " | ||
| 1529 | (if (boundp 'user-login-name) user-login-name "feedmail") | ||
| 1530 | " ; cat -) | /usr/bin/rmail %s") | ||
| 1531 | "Good candidate for Linux systems and maybe others. | ||
| 1532 | You may need to modify this if your \"rmail\" is in a different place. | ||
| 1533 | For example, I hear that in some Debian systems, it's /usr/sbin/rmail. | ||
| 1534 | See feedmail-binmail-template documentation." | ||
| 1535 | ) | ||
| 1282 | 1536 | ||
| 1283 | (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") | 1537 | (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" |
| 1538 | (if (file-exists-p "/bin/rmail") | ||
| 1539 | "/bin/rmail %s" "/bin/mail %s")) | ||
| 1284 | "Command template for the subprocess which will get rid of the mail. | 1540 | "Command template for the subprocess which will get rid of the mail. |
| 1285 | It can result in any command understandable by /bin/sh. Might not | 1541 | It can result in any command understandable by /bin/sh. Might not |
| 1286 | work at all in non-Unix environments. The single '%s', if present, | 1542 | work at all in non-UNIX environments. The single '%s', if present, |
| 1287 | gets replaced by the space-separated, simplified list of addressees. | 1543 | gets replaced by the space-separated, simplified list of addressees. |
| 1288 | Used in `feedmail-buffer-to-binmail' to form the shell command which | 1544 | Used in `feedmail-buffer-to-binmail' to form the shell command which |
| 1289 | will receive the contents of the prepped buffer as stdin. If you'd | 1545 | will receive the contents of the prepped buffer as stdin. The default |
| 1290 | like your errors to come back as mail instead of immediately in a | 1546 | value uses /bin/rmail (if it exists) unless `mail-interactive' has been |
| 1291 | buffer, try /bin/rmail instead of /bin/mail (this can be accomplished | 1547 | set non-nil. |
| 1292 | by keeping the default nil setting of `mail-interactive'). You might | 1548 | |
| 1293 | also like to consult local mail experts for any other interesting | 1549 | If you'd like your errors to come back as mail instead of immediately |
| 1294 | command line possibilities." | 1550 | in a buffer, try /bin/rmail instead of /bin/mail. If /bin/rmail |
| 1295 | :group 'feedmail-misc | 1551 | exists, this can be accomplished by keeping the default nil setting of |
| 1296 | :type 'string | 1552 | `mail-interactive'. You might also like to consult local mail experts |
| 1553 | for any other interesting command line possibilities. Some versions | ||
| 1554 | of UNIX have an rmail program which behaves differently than | ||
| 1555 | /bin/rmail and complains if feedmail gives it a message on stdin. If | ||
| 1556 | you don't know about such things and if there is no local expert to | ||
| 1557 | consult, stick with /bin/mail or use one of the other buffer eating | ||
| 1558 | functions. | ||
| 1559 | |||
| 1560 | The above description applies to \"classic\" UNIX /bin/mail and /bin/rmail. | ||
| 1561 | On most Linux systems and perhaps other places, /bin/mail behaves | ||
| 1562 | completely differently and shouldn't be used at all in this template. | ||
| 1563 | Instead of /bin/rmail, there is a /usr/bin/rmail, and it can be used | ||
| 1564 | with a wrapper. The wrapper is necessary because /usr/bin/rmail on such | ||
| 1565 | systems requires that the first line of the message appearing on standard | ||
| 1566 | input have a UNIX-style From_ postmark. If you have such a system, the | ||
| 1567 | wrapping can be accomplished by setting the value of `feedmail-binmail-template' | ||
| 1568 | to `feedmail-binmail-linuxish-template'. You should then send some test | ||
| 1569 | messages to make sure it works as expected." | ||
| 1570 | :group 'feedmail-misc | ||
| 1571 | :type 'string | ||
| 1297 | ) | 1572 | ) |
| 1298 | 1573 | ||
| 1299 | 1574 | ||
| @@ -1304,6 +1579,7 @@ command line possibilities." | |||
| 1304 | (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid) | 1579 | (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid) |
| 1305 | "Function which actually calls /bin/mail as a subprocess. | 1580 | "Function which actually calls /bin/mail as a subprocess. |
| 1306 | Feeds the buffer to it." | 1581 | Feeds the buffer to it." |
| 1582 | (feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid) | ||
| 1307 | (set-buffer prepped) | 1583 | (set-buffer prepped) |
| 1308 | (apply | 1584 | (apply |
| 1309 | 'call-process-region | 1585 | 'call-process-region |
| @@ -1317,14 +1593,18 @@ Feeds the buffer to it." | |||
| 1317 | (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid) | 1593 | (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid) |
| 1318 | "Function which actually calls sendmail as a subprocess. | 1594 | "Function which actually calls sendmail as a subprocess. |
| 1319 | Feeds the buffer to it. Probably has some flaws for Resent-* and other | 1595 | Feeds the buffer to it. Probably has some flaws for Resent-* and other |
| 1320 | complicated cases." | 1596 | complicated cases. Takes addresses from message headers and |
| 1597 | might disappoint you with BCC: handling. In case of odd results, consult | ||
| 1598 | local gurus." | ||
| 1321 | (require 'sendmail) | 1599 | (require 'sendmail) |
| 1600 | (feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid) | ||
| 1322 | (set-buffer prepped) | 1601 | (set-buffer prepped) |
| 1323 | (apply 'call-process-region | 1602 | (apply 'call-process-region |
| 1324 | (append (list (point-min) (point-max) sendmail-program | 1603 | (append (list (point-min) (point-max) sendmail-program |
| 1325 | nil errors-to nil "-oi" "-t") | 1604 | nil errors-to nil "-oi" "-t") |
| 1326 | ;; provide envelope "from" to sendmail; results will vary | 1605 | ;; provide envelope "from" to sendmail; results will vary |
| 1327 | (list "-f" user-mail-address) | 1606 | (if feedmail-sendmail-f-doesnt-sell-me-out |
| 1607 | (list "-f" user-mail-address)) | ||
| 1328 | ;; These mean "report errors by mail" and "deliver in background". | 1608 | ;; These mean "report errors by mail" and "deliver in background". |
| 1329 | (if (null mail-interactive) '("-oem" "-odb"))))) | 1609 | (if (null mail-interactive) '("-oem" "-odb"))))) |
| 1330 | 1610 | ||
| @@ -1339,6 +1619,7 @@ complicated cases." | |||
| 1339 | ;; I'm not sure smtpmail.el is careful about the following | 1619 | ;; I'm not sure smtpmail.el is careful about the following |
| 1340 | ;; return value, but it also uses it internally, so I will fear | 1620 | ;; return value, but it also uses it internally, so I will fear |
| 1341 | ;; no evil. | 1621 | ;; no evil. |
| 1622 | (feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid) | ||
| 1342 | (require 'smtpmail) | 1623 | (require 'smtpmail) |
| 1343 | (if (not (smtpmail-via-smtp addr-listoid prepped)) | 1624 | (if (not (smtpmail-via-smtp addr-listoid prepped)) |
| 1344 | (progn | 1625 | (progn |
| @@ -1357,6 +1638,27 @@ complicated cases." | |||
| 1357 | (insert "\n\n")))) | 1638 | (insert "\n\n")))) |
| 1358 | (buffer-list)))))) | 1639 | (buffer-list)))))) |
| 1359 | 1640 | ||
| 1641 | ;; FLIM's smtp.el pointed out to me by Kenichi Handa <handa@etl.go.jp> | ||
| 1642 | (defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid) | ||
| 1643 | "Function which actually calls smtp-via-smtp to send buffer as e-mail." | ||
| 1644 | (feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid) | ||
| 1645 | (require 'smtp) | ||
| 1646 | (if (not (smtp-via-smtp user-mail-address addr-listoid prepped)) | ||
| 1647 | (progn | ||
| 1648 | (set-buffer errors-to) | ||
| 1649 | (insert "Send via smtp failed. Probable SMTP protocol error.\n") | ||
| 1650 | (insert "Look for details below or in the *Messages* buffer.\n\n") | ||
| 1651 | (let ((case-fold-search t) | ||
| 1652 | ;; don't be overconfident about the name of the trace buffer | ||
| 1653 | (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server)))) | ||
| 1654 | (mapcar | ||
| 1655 | '(lambda (buffy) | ||
| 1656 | (if (string-match tracer (buffer-name buffy)) | ||
| 1657 | (progn | ||
| 1658 | (insert "SMTP Trace from " (buffer-name buffy) "\n---------------") | ||
| 1659 | (insert-buffer buffy) | ||
| 1660 | (insert "\n\n")))) | ||
| 1661 | (buffer-list)))))) | ||
| 1360 | 1662 | ||
| 1361 | ;; just a place to park a docstring | 1663 | ;; just a place to park a docstring |
| 1362 | (defconst feedmail-fiddle-plex-blurb nil | 1664 | (defconst feedmail-fiddle-plex-blurb nil |
| @@ -1414,34 +1716,78 @@ FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is | |||
| 1414 | non-nil, feedmail \"smart filling\" is done on VALUE just before | 1716 | non-nil, feedmail \"smart filling\" is done on VALUE just before |
| 1415 | insertion.") | 1717 | insertion.") |
| 1416 | 1718 | ||
| 1719 | (defun feedmail-vm-mail-mode (&optional arg) | ||
| 1720 | "Make something like a buffer that has been created via `vm-mail'. | ||
| 1721 | The optional argument is ignored and is just for argument compatibility with | ||
| 1722 | `feedmail-queue-runner-mode-setter'. This function is suitable for being | ||
| 1723 | applied to a file after you've just read it from disk: for example, a | ||
| 1724 | feedmail FQM message file from a queue. You could use something like | ||
| 1725 | this: | ||
| 1726 | |||
| 1727 | \(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\) | ||
| 1728 | " | ||
| 1729 | (feedmail-say-debug ">in-> feedmail-vm-mail-mode") | ||
| 1730 | (let ((the-buf (current-buffer))) | ||
| 1731 | (vm-mail) | ||
| 1732 | (delete-region (point-min) (point-max)) | ||
| 1733 | (insert-buffer the-buf) | ||
| 1734 | (setq buffer-file-name (buffer-file-name the-buf)) | ||
| 1735 | (set-buffer-modified-p (buffer-modified-p the-buf)) | ||
| 1736 | ;; For some versions of emacs, saving the message to a queue | ||
| 1737 | ;; triggers running the mode function on the buffer, and that | ||
| 1738 | ;; leads (through a series of events I don't really understand) | ||
| 1739 | ;; to this function being called while the buffer is still | ||
| 1740 | ;; marked modified even though it is in the process of being | ||
| 1741 | ;; saved. I guess the function gets called during the renaming | ||
| 1742 | ;; that takes place en route to the save. | ||
| 1743 | ;; | ||
| 1744 | ;; This clearing of the marker probably wastes a buffer copy | ||
| 1745 | ;; but it's easy to do and more reliable than figuring out what | ||
| 1746 | ;; each variant of emacs does in this strange case. | ||
| 1747 | (with-current-buffer the-buf | ||
| 1748 | (set-buffer-modified-p nil)) | ||
| 1749 | (kill-buffer the-buf) | ||
| 1750 | )) | ||
| 1751 | |||
| 1417 | ;;;###autoload | 1752 | ;;;###autoload |
| 1418 | (defun feedmail-send-it () | 1753 | (defun feedmail-send-it () |
| 1419 | "Send the current mail buffer using the Feedmail package. | 1754 | "Send the current mail buffer using the Feedmail package. |
| 1420 | This is a suitable value for `send-mail-function'. It can be used | 1755 | This is a suitable value for `send-mail-function'. It can be used |
| 1421 | with various lower-level mechanisms to provide features such as queueing." | 1756 | with various lower-level mechanisms to provide features such as queueing." |
| 1422 | 1757 | (feedmail-say-debug ">in-> feedmail-send-it") | |
| 1758 | (save-excursion | ||
| 1759 | (let ((bfn-jiggle nil)) | ||
| 1760 | ;; if buffer-file-name is nil, temporarily use the stashed value | ||
| 1761 | (if (and (not buffer-file-name) feedmail-queue-buffer-file-name) | ||
| 1762 | (setq buffer-file-name feedmail-queue-buffer-file-name | ||
| 1763 | bfn-jiggle t)) | ||
| 1423 | ;; avoid matching trouble over slash vs backslash by getting canonical | 1764 | ;; avoid matching trouble over slash vs backslash by getting canonical |
| 1424 | (if feedmail-queue-directory | 1765 | (if feedmail-queue-directory |
| 1425 | (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) | 1766 | (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) |
| 1426 | (if feedmail-queue-draft-directory | 1767 | (if feedmail-queue-draft-directory |
| 1427 | (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory))) | 1768 | (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory))) |
| 1428 | (if (not feedmail-enable-queue) (feedmail-send-it-immediately) | 1769 | (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper) |
| 1429 | ;; else, queuing is enabled, should we ask about it or just do it? | 1770 | ;; else, queuing is enabled, should we ask about it or just do it? |
| 1430 | (if feedmail-ask-before-queue | 1771 | (if feedmail-ask-before-queue |
| 1431 | (funcall (feedmail-queue-send-edit-prompt)) | 1772 | (funcall (feedmail-queue-send-edit-prompt)) |
| 1432 | (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))) | 1773 | (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))) |
| 1433 | 1774 | ;; put this back | |
| 1775 | (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name)) | ||
| 1776 | ))) | ||
| 1434 | 1777 | ||
| 1435 | (defun feedmail-message-action-send () | 1778 | (defun feedmail-message-action-send () |
| 1436 | ;; hooks can make this take a while so clear the prompt | 1779 | ;; hooks can make this take a while so clear the prompt |
| 1780 | (feedmail-say-debug ">in-> feedmail-message-action-send") | ||
| 1437 | (message "FQM: Immediate send...") | 1781 | (message "FQM: Immediate send...") |
| 1438 | (feedmail-send-it-immediately)) | 1782 | (feedmail-send-it-immediately-wrapper)) |
| 1439 | 1783 | ||
| 1440 | 1784 | ||
| 1441 | ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu> | 1785 | ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu> |
| 1442 | (defun feedmail-queue-express-to-queue () | 1786 | (defun feedmail-queue-express-to-queue () |
| 1443 | "Send message directly to the queue, with a minimum of fuss and bother." | 1787 | "Send message directly to the queue, with a minimum of fuss and bother." |
| 1444 | (interactive) | 1788 | (interactive) |
| 1789 | (feedmail-say-debug ">in-> feedmail-queue-express-to-queue") | ||
| 1790 | (run-hooks 'feedmail-queue-express-hook) | ||
| 1445 | (let ((feedmail-enable-queue t) | 1791 | (let ((feedmail-enable-queue t) |
| 1446 | (feedmail-ask-before-queue nil) | 1792 | (feedmail-ask-before-queue nil) |
| 1447 | (feedmail-queue-reminder-alist nil) | 1793 | (feedmail-queue-reminder-alist nil) |
| @@ -1454,6 +1800,7 @@ with various lower-level mechanisms to provide features such as queueing." | |||
| 1454 | (defun feedmail-queue-express-to-draft () | 1800 | (defun feedmail-queue-express-to-draft () |
| 1455 | "Send message directly to the draft queue, with a minimum of fuss and bother." | 1801 | "Send message directly to the draft queue, with a minimum of fuss and bother." |
| 1456 | (interactive) | 1802 | (interactive) |
| 1803 | (feedmail-say-debug ">in-> feedmail-queue-express-to-draft") | ||
| 1457 | (let ((feedmail-queue-directory feedmail-queue-draft-directory)) | 1804 | (let ((feedmail-queue-directory feedmail-queue-draft-directory)) |
| 1458 | (feedmail-queue-express-to-queue) | 1805 | (feedmail-queue-express-to-queue) |
| 1459 | ) | 1806 | ) |
| @@ -1461,32 +1808,39 @@ with various lower-level mechanisms to provide features such as queueing." | |||
| 1461 | 1808 | ||
| 1462 | 1809 | ||
| 1463 | (defun feedmail-message-action-send-strong () | 1810 | (defun feedmail-message-action-send-strong () |
| 1811 | (feedmail-say-debug ">in-> feedmail-message-action-send-strong") | ||
| 1464 | (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send))) | 1812 | (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send))) |
| 1465 | 1813 | ||
| 1466 | 1814 | ||
| 1467 | (defun feedmail-message-action-edit () | 1815 | (defun feedmail-message-action-edit () |
| 1816 | (feedmail-say-debug ">in-> feedmail-message-action-edit") | ||
| 1468 | (error "FQM: Message not queued; returning to edit")) | 1817 | (error "FQM: Message not queued; returning to edit")) |
| 1469 | 1818 | ||
| 1470 | 1819 | ||
| 1471 | (defun feedmail-message-action-draft () | 1820 | (defun feedmail-message-action-draft () |
| 1821 | (feedmail-say-debug ">in-> feedmail-message-action-draft") | ||
| 1472 | (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft)) | 1822 | (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft)) |
| 1473 | 1823 | ||
| 1474 | 1824 | ||
| 1475 | (defun feedmail-message-action-draft-strong () | 1825 | (defun feedmail-message-action-draft-strong () |
| 1826 | (feedmail-say-debug ">in-> feedmail-message-action-draft-strong") | ||
| 1476 | (let ((buffer-file-name nil)) | 1827 | (let ((buffer-file-name nil)) |
| 1477 | (feedmail-message-action-draft))) | 1828 | (feedmail-message-action-draft))) |
| 1478 | 1829 | ||
| 1479 | 1830 | ||
| 1480 | (defun feedmail-message-action-queue () | 1831 | (defun feedmail-message-action-queue () |
| 1832 | (feedmail-say-debug ">in-> feedmail-message-action-queue") | ||
| 1481 | (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)) | 1833 | (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)) |
| 1482 | 1834 | ||
| 1483 | 1835 | ||
| 1484 | (defun feedmail-message-action-queue-strong () | 1836 | (defun feedmail-message-action-queue-strong () |
| 1837 | (feedmail-say-debug ">in-> feedmail-message-action-queue-strong") | ||
| 1485 | (let ((buffer-file-name nil)) | 1838 | (let ((buffer-file-name nil)) |
| 1486 | (feedmail-message-action-queue))) | 1839 | (feedmail-message-action-queue))) |
| 1487 | 1840 | ||
| 1488 | 1841 | ||
| 1489 | (defun feedmail-message-action-toggle-spray () | 1842 | (defun feedmail-message-action-toggle-spray () |
| 1843 | (feedmail-say-debug ">in-> feedmail-message-action-toggle-spray") | ||
| 1490 | (let ((feedmail-enable-spray (not feedmail-enable-spray))) | 1844 | (let ((feedmail-enable-spray (not feedmail-enable-spray))) |
| 1491 | (if feedmail-enable-spray | 1845 | (if feedmail-enable-spray |
| 1492 | (message "FQM: For this message, spray toggled ON") | 1846 | (message "FQM: For this message, spray toggled ON") |
| @@ -1496,20 +1850,79 @@ with various lower-level mechanisms to provide features such as queueing." | |||
| 1496 | (feedmail-send-it))) | 1850 | (feedmail-send-it))) |
| 1497 | 1851 | ||
| 1498 | 1852 | ||
| 1853 | (defconst feedmail-p-h-b-n "*FQM Help*") | ||
| 1854 | |||
| 1499 | (defun feedmail-message-action-help () | 1855 | (defun feedmail-message-action-help () |
| 1500 | (let ((d-string " ")) | 1856 | (feedmail-say-debug ">in-> feedmail-message-action-help") |
| 1857 | (let ((d-string " ") | ||
| 1858 | (fqm-help (get-buffer feedmail-p-h-b-n))) | ||
| 1501 | (if (stringp feedmail-ask-before-queue-default) | 1859 | (if (stringp feedmail-ask-before-queue-default) |
| 1502 | (setq d-string feedmail-ask-before-queue-default) | 1860 | (setq d-string feedmail-ask-before-queue-default) |
| 1503 | (setq d-string (char-to-string feedmail-ask-before-queue-default))) | 1861 | (setq d-string (char-to-string feedmail-ask-before-queue-default))) |
| 1504 | (feedmail-queue-send-edit-prompt-help d-string) | 1862 | (if (and fqm-help (get-buffer-window fqm-help)) |
| 1863 | (feedmail-scroll-buffer 'up fqm-help) | ||
| 1864 | (feedmail-message-action-help-blat d-string)) | ||
| 1505 | ;; recursive, but no worries (it goes deeper on user action) | 1865 | ;; recursive, but no worries (it goes deeper on user action) |
| 1506 | (feedmail-send-it))) | 1866 | (feedmail-send-it))) |
| 1507 | 1867 | ||
| 1868 | (defun feedmail-message-action-help-blat (d-string) | ||
| 1869 | (feedmail-say-debug ">in-> feedmail-message-action-help-blat") | ||
| 1870 | (with-output-to-temp-buffer feedmail-p-h-b-n | ||
| 1871 | (princ "You're dispatching a message and feedmail queuing is enabled. | ||
| 1872 | Typing ? again will normally scroll this help buffer. | ||
| 1873 | |||
| 1874 | Choices: | ||
| 1875 | q QUEUE for later sending \(via feedmail-run-the-queue\) | ||
| 1876 | Q QUEUE! like \"q\", but always make a new file | ||
| 1877 | i IMMEDIATELY send this \(but not the other queued messages\) | ||
| 1878 | I IMMEDIATELY! like \"i\", but skip following confirmation prompt | ||
| 1879 | d DRAFT queue in the draft directory | ||
| 1880 | D DRAFT! like \"d\", but always make a new file | ||
| 1881 | e EDIT return to the message edit buffer \(don't send or queue\) | ||
| 1882 | * SPRAY toggle spray mode \(individual message transmissions\) | ||
| 1883 | > SCROLL UP scroll message up \(toward end of message\) | ||
| 1884 | < SCROLL DOWN scroll message down \(toward beginning of message\) | ||
| 1885 | ? HELP show or scroll this help buffer | ||
| 1886 | |||
| 1887 | Synonyms: | ||
| 1888 | s SEND immediately \(same as \"i\"\) | ||
| 1889 | S SEND! immediately \(same as \"I\"\) | ||
| 1890 | r ROUGH draft \(same as \"d\"\) | ||
| 1891 | R ROUGH! draft \(same as \"D\"\) | ||
| 1892 | n NOPE didn't mean it \(same as \"e\"\) | ||
| 1893 | y YUP do the default behavior \(same as \"C-m\"\) | ||
| 1894 | SPC SCROLL UP \(same as \">\"\) | ||
| 1895 | |||
| 1896 | The user-configurable default is currently \"") | ||
| 1897 | (princ d-string) | ||
| 1898 | (princ "\". For other possibilities, | ||
| 1899 | see the variable feedmail-prompt-before-queue-user-alist. | ||
| 1900 | ") | ||
| 1901 | (and (stringp feedmail-prompt-before-queue-help-supplement) | ||
| 1902 | (princ feedmail-prompt-before-queue-help-supplement)) | ||
| 1903 | (with-current-buffer standard-output | ||
| 1904 | (if (fboundp 'help-mode) (help-mode))))) | ||
| 1905 | |||
| 1906 | |||
| 1907 | (defun feedmail-message-action-scroll-up () | ||
| 1908 | (feedmail-say-debug ">in-> feedmail-message-action-scroll-up") | ||
| 1909 | (feedmail-scroll-buffer 'up) | ||
| 1910 | ;; recursive, but no worries (it goes deeper on user action) | ||
| 1911 | (feedmail-send-it)) | ||
| 1912 | |||
| 1913 | |||
| 1914 | (defun feedmail-message-action-scroll-down () | ||
| 1915 | (feedmail-say-debug ">in-> feedmail-message-action-scroll-down") | ||
| 1916 | (feedmail-scroll-buffer 'down) | ||
| 1917 | ;; recursive, but no worries (it goes deeper on user action) | ||
| 1918 | (feedmail-send-it)) | ||
| 1919 | |||
| 1508 | 1920 | ||
| 1509 | ;;;###autoload | 1921 | ;;;###autoload |
| 1510 | (defun feedmail-run-the-queue-no-prompts (&optional arg) | 1922 | (defun feedmail-run-the-queue-no-prompts (&optional arg) |
| 1511 | "Like `feedmail-run-the-queue', but suppress confirmation prompts." | 1923 | "Like `feedmail-run-the-queue', but suppress confirmation prompts." |
| 1512 | (interactive "p") | 1924 | (interactive "p") |
| 1925 | (feedmail-say-debug ">in-> feedmail-run-the-queue-no-prompts") | ||
| 1513 | (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg))) | 1926 | (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg))) |
| 1514 | 1927 | ||
| 1515 | ;;;###autoload | 1928 | ;;;###autoload |
| @@ -1518,6 +1931,7 @@ with various lower-level mechanisms to provide features such as queueing." | |||
| 1518 | This is generally most useful if run non-interactively, since you can | 1931 | This is generally most useful if run non-interactively, since you can |
| 1519 | bail out with an appropriate answer to the global confirmation prompt." | 1932 | bail out with an appropriate answer to the global confirmation prompt." |
| 1520 | (interactive "p") | 1933 | (interactive "p") |
| 1934 | (feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts") | ||
| 1521 | (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg))) | 1935 | (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg))) |
| 1522 | 1936 | ||
| 1523 | ;; letf fools the byte-compiler. | 1937 | ;; letf fools the byte-compiler. |
| @@ -1530,6 +1944,7 @@ Return value is a list of three things: number of messages sent, number of | |||
| 1530 | messages skipped, and number of non-message things in the queue (commonly | 1944 | messages skipped, and number of non-message things in the queue (commonly |
| 1531 | backup file names and the like)." | 1945 | backup file names and the like)." |
| 1532 | (interactive "p") | 1946 | (interactive "p") |
| 1947 | (feedmail-say-debug ">in-> feedmail-run-the-queue") | ||
| 1533 | ;; avoid matching trouble over slash vs backslash by getting canonical | 1948 | ;; avoid matching trouble over slash vs backslash by getting canonical |
| 1534 | (if feedmail-queue-directory | 1949 | (if feedmail-queue-directory |
| 1535 | (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) | 1950 | (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) |
| @@ -1546,7 +1961,6 @@ backup file names and the like)." | |||
| 1546 | (messages-skipped 0) | 1961 | (messages-skipped 0) |
| 1547 | (blobby-buffer) | 1962 | (blobby-buffer) |
| 1548 | (already-buffer) | 1963 | (already-buffer) |
| 1549 | (this-mhsep) | ||
| 1550 | (do-the-run t) | 1964 | (do-the-run t) |
| 1551 | (list-of-possible-fqms)) | 1965 | (list-of-possible-fqms)) |
| 1552 | (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global) | 1966 | (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global) |
| @@ -1590,38 +2004,34 @@ backup file names and the like)." | |||
| 1590 | (setq buffer-offer-save nil) | 2004 | (setq buffer-offer-save nil) |
| 1591 | (buffer-disable-undo blobby-buffer) | 2005 | (buffer-disable-undo blobby-buffer) |
| 1592 | (insert-file-contents-literally maybe-file) | 2006 | (insert-file-contents-literally maybe-file) |
| 1593 | ;; work around text-vs-binary weirdness and also around rmail-resend's creative | 2007 | (setq buffer-file-type t) ; binary |
| 1594 | ;; manipulation of mail-header-separator | 2008 | (goto-char (point-min)) |
| 1595 | ;; | 2009 | ;; if at least two line-endings with CRLF, translate the file |
| 1596 | ;; if we don't find the normal M-H-S, and the alternative is defined but also | 2010 | (if (looking-at ".*\r\n.*\r\n") |
| 1597 | ;; not found, try reading the file a different way | 2011 | (while (search-forward "\r\n" nil t) |
| 1598 | ;; | 2012 | (replace-match "\n" nil t))) |
| 1599 | ;; if M-H-S not found and (a-M-H-S is nil or not found) | 2013 | ;; ;; work around text-vs-binary wierdness |
| 1600 | (if (and (not (feedmail-find-eoh t)) | 2014 | ;; ;; if we don't find the normal M-H-S, try reading the file a different way |
| 1601 | (or (not feedmail-queue-alternative-mail-header-separator) | 2015 | ;; (if (not (feedmail-find-eoh t)) |
| 1602 | (not | 2016 | ;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil)) |
| 1603 | (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator)) | 2017 | ;; (erase-buffer) |
| 1604 | (feedmail-find-eoh t))))) | 2018 | ;; (insert-file-contents maybe-file))) |
| 1605 | (letf ((file-name-buffer-file-type-alist nil) | ||
| 1606 | ((default-value 'buffer-file-type) nil)) | ||
| 1607 | (erase-buffer) (insert-file-contents maybe-file))) | ||
| 1608 | ;; if M-H-S not found and (a-M-H-S is non-nil and is found) | ||
| 1609 | ;; temporarily set M-H-S to the value of a-M-H-S | ||
| 1610 | (if (and (not (feedmail-find-eoh t)) | ||
| 1611 | feedmail-queue-alternative-mail-header-separator | ||
| 1612 | (let ((mail-header-separator feedmail-queue-alternative-mail-header-separator)) | ||
| 1613 | (feedmail-find-eoh t))) | ||
| 1614 | (setq this-mhsep feedmail-queue-alternative-mail-header-separator) | ||
| 1615 | (setq this-mhsep mail-header-separator)) | ||
| 1616 | (funcall feedmail-queue-runner-mode-setter arg) | 2019 | (funcall feedmail-queue-runner-mode-setter arg) |
| 1617 | (condition-case nil ; don't give up the loop if user skips some | 2020 | (condition-case signal-stuff ; don't give up the loop if user skips some |
| 1618 | (let ((feedmail-enable-queue nil) | 2021 | (let ((feedmail-enable-queue nil) |
| 1619 | (mail-header-separator this-mhsep) | ||
| 1620 | (feedmail-queue-runner-is-active maybe-file)) | 2022 | (feedmail-queue-runner-is-active maybe-file)) |
| 1621 | (funcall feedmail-queue-runner-message-sender arg) | 2023 | ;; if can't find EOH, this is no message! |
| 2024 | (unless (feedmail-find-eoh t) | ||
| 2025 | (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file) | ||
| 2026 | (error "FQM: you should never see this message")) | ||
| 2027 | (feedmail-say-debug "Prepping %s" maybe-file) | ||
| 2028 | ;; the catch is a way out for users to voluntarily skip sending a message | ||
| 2029 | (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg)) | ||
| 1622 | (set-buffer blobby-buffer) | 2030 | (set-buffer blobby-buffer) |
| 1623 | (if (buffer-modified-p) ; still modified, means wasn't sent | 2031 | (if (buffer-modified-p) ; still modified, means wasn't sent |
| 1624 | (setq messages-skipped (1+ messages-skipped)) | 2032 | (progn |
| 2033 | (setq messages-skipped (1+ messages-skipped)) | ||
| 2034 | (feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function)) | ||
| 1625 | (setq messages-sent (1+ messages-sent)) | 2035 | (setq messages-sent (1+ messages-sent)) |
| 1626 | (funcall feedmail-queue-runner-cleaner-upper maybe-file arg) | 2036 | (funcall feedmail-queue-runner-cleaner-upper maybe-file arg) |
| 1627 | (if (and already-buffer (not (file-exists-p maybe-file))) | 2037 | (if (and already-buffer (not (file-exists-p maybe-file))) |
| @@ -1629,20 +2039,25 @@ backup file names and the like)." | |||
| 1629 | ;; buffer, so update the buffer's notion of that | 2039 | ;; buffer, so update the buffer's notion of that |
| 1630 | (with-current-buffer already-buffer | 2040 | (with-current-buffer already-buffer |
| 1631 | (setq buffer-file-name nil))))) | 2041 | (setq buffer-file-name nil))))) |
| 1632 | (error (setq messages-skipped (1+ messages-skipped)))) | 2042 | ;; the handler for the condition-case |
| 2043 | (error (setq messages-skipped (1+ messages-skipped)) | ||
| 2044 | (ding t) | ||
| 2045 | (message "FQM: Trapped '%s', message left in queue." (car signal-stuff)) | ||
| 2046 | (sit-for 3) | ||
| 2047 | (message "FQM: Trap details: \"%s\"" | ||
| 2048 | (mapconcat 'identity (cdr signal-stuff) "\" \"")) | ||
| 2049 | (sit-for 3))) | ||
| 1633 | (kill-buffer blobby-buffer) | 2050 | (kill-buffer blobby-buffer) |
| 1634 | (if feedmail-queue-chatty | 2051 | (feedmail-say-chatter |
| 1635 | (progn | 2052 | "%d to go, %d sent, %d skipped (%d other files ignored)" |
| 1636 | (message "FQM: %d to go, %d sent, %d skipped (%d other files ignored)" | 2053 | (- q-cnt messages-sent messages-skipped) |
| 1637 | (- q-cnt messages-sent messages-skipped) | 2054 | messages-sent messages-skipped q-oth) |
| 1638 | messages-sent messages-skipped q-oth) | 2055 | ))) |
| 1639 | (sit-for feedmail-queue-chatty-sit-for)))))) | ||
| 1640 | list-of-possible-fqms))) | 2056 | list-of-possible-fqms))) |
| 1641 | (if feedmail-queue-chatty | 2057 | (if feedmail-queue-chatty |
| 1642 | (progn | 2058 | (progn |
| 1643 | (message "FQM: %d sent, %d skipped (%d other files ignored)" | 2059 | (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)" |
| 1644 | messages-sent messages-skipped q-oth) | 2060 | messages-sent messages-skipped q-oth) |
| 1645 | (sit-for feedmail-queue-chatty-sit-for) | ||
| 1646 | (feedmail-queue-reminder 'after-run) | 2061 | (feedmail-queue-reminder 'after-run) |
| 1647 | (sit-for feedmail-queue-chatty-sit-for))) | 2062 | (sit-for feedmail-queue-chatty-sit-for))) |
| 1648 | (list messages-sent messages-skipped q-oth))) | 2063 | (list messages-sent messages-skipped q-oth))) |
| @@ -1668,6 +2083,7 @@ to perform the reminder activity. You can supply your own reminder functions | |||
| 1668 | by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders, | 2083 | by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders, |
| 1669 | you can set `feedmail-queue-reminder-alist' to nil." | 2084 | you can set `feedmail-queue-reminder-alist' to nil." |
| 1670 | (interactive "p") | 2085 | (interactive "p") |
| 2086 | (feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event) | ||
| 1671 | (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder) | 2087 | (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder) |
| 1672 | (setq entry (assoc key feedmail-queue-reminder-alist)) | 2088 | (setq entry (assoc key feedmail-queue-reminder-alist)) |
| 1673 | (setq reminder (cdr entry)) | 2089 | (setq reminder (cdr entry)) |
| @@ -1676,8 +2092,9 @@ you can set `feedmail-queue-reminder-alist' to nil." | |||
| 1676 | 2092 | ||
| 1677 | 2093 | ||
| 1678 | (defun feedmail-queue-reminder-brief () | 2094 | (defun feedmail-queue-reminder-brief () |
| 1679 | "Brief display of draft and queued message counts in modeline." | 2095 | "Brief display of draft and queued message counts in minibuffer." |
| 1680 | (interactive) | 2096 | (interactive) |
| 2097 | (feedmail-say-debug ">in-> feedmail-queue-reminder-brief") | ||
| 1681 | (let (q-cnt d-cnt q-lis d-lis) | 2098 | (let (q-cnt d-cnt q-lis d-lis) |
| 1682 | (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory)) | 2099 | (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory)) |
| 1683 | (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory)) | 2100 | (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory)) |
| @@ -1690,8 +2107,9 @@ you can set `feedmail-queue-reminder-alist' to nil." | |||
| 1690 | 2107 | ||
| 1691 | 2108 | ||
| 1692 | (defun feedmail-queue-reminder-medium () | 2109 | (defun feedmail-queue-reminder-medium () |
| 1693 | "Verbose display of draft and queued message counts in modeline." | 2110 | "Verbose display of draft and queued message counts in minibuffer." |
| 1694 | (interactive) | 2111 | (interactive) |
| 2112 | (feedmail-say-debug ">in-> feedmail-queue-reminder-medium") | ||
| 1695 | (let (q-cnt d-cnt q-oth d-oth q-lis d-lis) | 2113 | (let (q-cnt d-cnt q-oth d-oth q-lis d-lis) |
| 1696 | (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory)) | 2114 | (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory)) |
| 1697 | (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory)) | 2115 | (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory)) |
| @@ -1708,25 +2126,49 @@ you can set `feedmail-queue-reminder-alist' to nil." | |||
| 1708 | 2126 | ||
| 1709 | 2127 | ||
| 1710 | (defun feedmail-queue-send-edit-prompt () | 2128 | (defun feedmail-queue-send-edit-prompt () |
| 1711 | "Ask whether to queue, send immediately, or return to editing a message." | 2129 | "Ask whether to queue, send immediately, or return to editing a message, etc." |
| 2130 | (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt") | ||
| 2131 | (feedmail-queue-send-edit-prompt-inner | ||
| 2132 | feedmail-ask-before-queue-default | ||
| 2133 | feedmail-ask-before-queue-prompt | ||
| 2134 | feedmail-ask-before-queue-reprompt | ||
| 2135 | 'feedmail-message-action-help | ||
| 2136 | feedmail-prompt-before-queue-standard-alist | ||
| 2137 | feedmail-prompt-before-queue-user-alist | ||
| 2138 | )) | ||
| 2139 | |||
| 2140 | (defun feedmail-queue-runner-prompt () | ||
| 2141 | "Ask whether to queue, send immediately, or return to editing a message, etc." | ||
| 2142 | (feedmail-say-debug ">in-> feedmail-queue-runner-prompt") | ||
| 2143 | (feedmail-queue-send-edit-prompt-inner | ||
| 2144 | feedmail-ask-before-queue-default | ||
| 2145 | feedmail-ask-before-queue-prompt | ||
| 2146 | feedmail-ask-before-queue-reprompt | ||
| 2147 | 'feedmail-message-action-help | ||
| 2148 | feedmail-prompt-before-queue-standard-alist | ||
| 2149 | feedmail-prompt-before-queue-user-alist | ||
| 2150 | )) | ||
| 2151 | (defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper | ||
| 2152 | standard-alist user-alist) | ||
| 2153 | (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner") | ||
| 1712 | ;; Some implementation ideas here came from the userlock.el code | 2154 | ;; Some implementation ideas here came from the userlock.el code |
| 1713 | (discard-input) | 2155 | (or defining-kbd-macro (discard-input)) |
| 1714 | (save-window-excursion | 2156 | (save-window-excursion |
| 1715 | (let ((answer) (d-char) (d-string " ")) | 2157 | (let ((answer) (d-char) (d-string " ")) |
| 1716 | (if (stringp feedmail-ask-before-queue-default) | 2158 | (if (stringp default) |
| 1717 | (progn | 2159 | (progn |
| 1718 | (setq d-char (string-to-char feedmail-ask-before-queue-default)) | 2160 | (setq d-char (string-to-char default) |
| 1719 | (setq d-string feedmail-ask-before-queue-default)) | 2161 | d-string default)) |
| 1720 | (setq d-string (char-to-string feedmail-ask-before-queue-default)) | 2162 | (setq d-string (char-to-string default)) |
| 1721 | (setq d-char feedmail-ask-before-queue-default) | 2163 | (setq d-char default) |
| 1722 | ) | 2164 | ) |
| 1723 | (while (null answer) | 2165 | (while (null answer) |
| 1724 | (message feedmail-ask-before-queue-prompt d-string) | 2166 | (message prompt d-string) |
| 1725 | (let ((user-sez | 2167 | (let ((user-sez |
| 1726 | (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0)) | 2168 | (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0)) |
| 1727 | (read-char-exclusive)))) | 2169 | (read-char-exclusive)))) |
| 1728 | (if (= user-sez help-char) | 2170 | (if (= user-sez help-char) |
| 1729 | (setq answer '(^ . feedmail-message-action-help)) | 2171 | (setq answer '(^ . helper)) |
| 1730 | (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) | 2172 | (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) |
| 1731 | (setq user-sez d-char)) | 2173 | (setq user-sez d-char)) |
| 1732 | ;; these char-to-int things are because of some | 2174 | ;; these char-to-int things are because of some |
| @@ -1734,73 +2176,39 @@ you can set `feedmail-queue-reminder-alist' to nil." | |||
| 1734 | ;; byte-compiled stuff between Emacs and XEmacs | 2176 | ;; byte-compiled stuff between Emacs and XEmacs |
| 1735 | ;; (well, I'm sure someone could comprehend it, | 2177 | ;; (well, I'm sure someone could comprehend it, |
| 1736 | ;; but I say 'uncle') | 2178 | ;; but I say 'uncle') |
| 1737 | (setq answer (or (assoc user-sez feedmail-prompt-before-queue-user-alist) | 2179 | (setq answer (or (assoc user-sez user-alist) |
| 1738 | (and (fboundp 'char-to-int) | 2180 | (and (fboundp 'char-to-int) |
| 1739 | (assoc (char-to-int user-sez) feedmail-prompt-before-queue-user-alist)) | 2181 | (assoc (char-to-int user-sez) user-alist)) |
| 1740 | (assoc user-sez feedmail-prompt-before-queue-standard-alist) | 2182 | (assoc user-sez standard-alist) |
| 1741 | (and (fboundp 'char-to-int) | 2183 | (and (fboundp 'char-to-int) |
| 1742 | (assoc (char-to-int user-sez) feedmail-prompt-before-queue-standard-alist)))) | 2184 | (assoc (char-to-int user-sez) standard-alist)))) |
| 1743 | (if (or (null answer) (null (cdr answer))) | 2185 | (if (or (null answer) (null (cdr answer))) |
| 1744 | (progn | 2186 | (progn |
| 1745 | (beep) | 2187 | (beep) |
| 1746 | (message feedmail-ask-before-queue-reprompt d-string) | 2188 | (message reprompt d-string) |
| 1747 | (sit-for 3))) | 2189 | (sit-for 3))) |
| 1748 | ))) | 2190 | ))) |
| 1749 | (cdr answer) | 2191 | (cdr answer) |
| 1750 | ))) | 2192 | ))) |
| 1751 | 2193 | ||
| 1752 | (defconst feedmail-p-h-b-n "*FQM Help*") | 2194 | (defun feedmail-scroll-buffer (direction &optional buffy) |
| 1753 | |||
| 1754 | (defun feedmail-queue-send-edit-prompt-help (d-string) | ||
| 1755 | (let ((fqm-help (get-buffer feedmail-p-h-b-n))) | ||
| 1756 | (if (and fqm-help (get-buffer-window fqm-help 'visible)) | ||
| 1757 | (feedmail-queue-send-edit-prompt-help-later fqm-help d-string) | ||
| 1758 | (feedmail-queue-send-edit-prompt-help-first d-string)))) | ||
| 1759 | |||
| 1760 | (defun feedmail-queue-send-edit-prompt-help-later (fqm-help d-string) | ||
| 1761 | ;; scrolling fun | 2195 | ;; scrolling fun |
| 2196 | ;; emacs convention is that scroll-up moves text up, window down | ||
| 2197 | (feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction) | ||
| 1762 | (save-selected-window | 2198 | (save-selected-window |
| 1763 | (let ((signal-error-on-buffer-boundary nil) | 2199 | (let ((signal-error-on-buffer-boundary nil) |
| 1764 | (fqm-window (display-buffer fqm-help))) | 2200 | (fqm-window (display-buffer (if buffy buffy (current-buffer))))) |
| 1765 | (select-window fqm-window) | 2201 | (select-window fqm-window) |
| 2202 | (if (eq direction 'up) | ||
| 1766 | (if (pos-visible-in-window-p (point-max) fqm-window) | 2203 | (if (pos-visible-in-window-p (point-max) fqm-window) |
| 1767 | (feedmail-queue-send-edit-prompt-help-first d-string) | 2204 | ;; originally just (goto-char (point-min)), but |
| 1768 | ;;(goto-char (point-min)) | 2205 | ;; pos-visible-in-window-p seems oblivious to that |
| 1769 | (scroll-up nil) | 2206 | (scroll-down 999999) |
| 1770 | )))) | 2207 | (scroll-up)) |
| 1771 | 2208 | (if (pos-visible-in-window-p (point-min) fqm-window) | |
| 1772 | (defun feedmail-queue-send-edit-prompt-help-first (d-string) | 2209 | (scroll-up 999999) |
| 1773 | (with-output-to-temp-buffer feedmail-p-h-b-n | 2210 | (scroll-down)))))) |
| 1774 | (princ "You're dispatching a message and feedmail queuing is enabled. | ||
| 1775 | Typing ? or C-v will normally scroll this help buffer. | ||
| 1776 | |||
| 1777 | Choices: | ||
| 1778 | q QUEUE for later sending (via feedmail-run-the-queue) | ||
| 1779 | Q QUEUE! like \"q\", but always make a new file | ||
| 1780 | i IMMEDIATELY send this (but not the other queued messages) | ||
| 1781 | I IMMEDIATELY! like \"i\", but skip following confirmation prompt | ||
| 1782 | d DRAFT queue in the draft directory | ||
| 1783 | D DRAFT! like \"d\", but always make a new file | ||
| 1784 | e EDIT return to the message edit buffer (don't send or queue) | ||
| 1785 | * SPRAY toggle spray mode (individual message transmissions) | ||
| 1786 | |||
| 1787 | Synonyms: | ||
| 1788 | s SEND immediately (same as \"i\") | ||
| 1789 | S SEND! immediately (same as \"I\") | ||
| 1790 | r ROUGH draft (same as \"d\") | ||
| 1791 | R ROUGH! draft (same as \"D\") | ||
| 1792 | n NOPE didn't mean it (same as \"e\") | ||
| 1793 | y YUP do the default behavior (same as \"C-m\") | ||
| 1794 | 2211 | ||
| 1795 | The user-configurable default is currently \"") | ||
| 1796 | (princ d-string) | ||
| 1797 | (princ "\". For other possibilities, | ||
| 1798 | see the variable feedmail-prompt-before-queue-user-alist. | ||
| 1799 | ") | ||
| 1800 | (and (stringp feedmail-prompt-before-queue-help-supplement) | ||
| 1801 | (princ feedmail-prompt-before-queue-help-supplement)) | ||
| 1802 | (with-current-buffer standard-output | ||
| 1803 | (if (fboundp 'help-mode) (help-mode))))) | ||
| 1804 | 2212 | ||
| 1805 | (defun feedmail-look-at-queue-directory (queue-directory) | 2213 | (defun feedmail-look-at-queue-directory (queue-directory) |
| 1806 | "Find out some things about a queue directory. | 2214 | "Find out some things about a queue directory. |
| @@ -1808,6 +2216,7 @@ Result is a list containing a count of queued messages in the | |||
| 1808 | directory, a count of other files in the directory, and a high water | 2216 | directory, a count of other files in the directory, and a high water |
| 1809 | mark for prefix sequence numbers. Subdirectories are not included in | 2217 | mark for prefix sequence numbers. Subdirectories are not included in |
| 1810 | the counts." | 2218 | the counts." |
| 2219 | (feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory) | ||
| 1811 | (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet)) | 2220 | (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet)) |
| 1812 | ;; iterate, counting things we find along the way in the directory | 2221 | ;; iterate, counting things we find along the way in the directory |
| 1813 | (if (file-directory-p queue-directory) | 2222 | (if (file-directory-p queue-directory) |
| @@ -1829,10 +2238,11 @@ the counts." | |||
| 1829 | 2238 | ||
| 1830 | (defun feedmail-tidy-up-slug (slug) | 2239 | (defun feedmail-tidy-up-slug (slug) |
| 1831 | "Utility for mapping out suspect characters in a potential filename." | 2240 | "Utility for mapping out suspect characters in a potential filename." |
| 2241 | (feedmail-say-debug ">in-> feedmail-tidy-up-slug %s" slug) | ||
| 1832 | ;; even programmers deserve a break sometimes, so cover nil for them | 2242 | ;; even programmers deserve a break sometimes, so cover nil for them |
| 1833 | (if (null slug) (setq slug "")) | 2243 | (if (null slug) (setq slug "")) |
| 1834 | ;; replace all non-alphanumerics with hyphen for safety | 2244 | ;; replace all non-alphanumerics with hyphen for safety |
| 1835 | (while (string-match "[^a-z0-9-]+" slug) (setq slug (replace-match "-" nil nil slug))) | 2245 | (while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug))) |
| 1836 | ;; collapse multiple hyphens to one | 2246 | ;; collapse multiple hyphens to one |
| 1837 | (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug))) | 2247 | (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug))) |
| 1838 | ;; for tidyness, peel off leading hyphens | 2248 | ;; for tidyness, peel off leading hyphens |
| @@ -1849,6 +2259,7 @@ file will be placed. The name is based on the Subject: header (if | |||
| 1849 | there is one). If there is no subject, | 2259 | there is one). If there is no subject, |
| 1850 | `feedmail-queue-default-file-slug' is consulted. Special characters are | 2260 | `feedmail-queue-default-file-slug' is consulted. Special characters are |
| 1851 | mapped to mostly alphanumerics for safety." | 2261 | mapped to mostly alphanumerics for safety." |
| 2262 | (feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory) | ||
| 1852 | (let ((eoh-marker) (case-fold-search t) (subject "") (s-point)) | 2263 | (let ((eoh-marker) (case-fold-search t) (subject "") (s-point)) |
| 1853 | (setq eoh-marker (feedmail-find-eoh)) | 2264 | (setq eoh-marker (feedmail-find-eoh)) |
| 1854 | (goto-char (point-min)) | 2265 | (goto-char (point-min)) |
| @@ -1856,7 +2267,7 @@ mapped to mostly alphanumerics for safety." | |||
| 1856 | (if (re-search-forward "^Subject:" eoh-marker t) | 2267 | (if (re-search-forward "^Subject:" eoh-marker t) |
| 1857 | (progn (setq s-point (point)) | 2268 | (progn (setq s-point (point)) |
| 1858 | (end-of-line) | 2269 | (end-of-line) |
| 1859 | (setq subject (buffer-substring s-point (point))))) | 2270 | (setq subject (buffer-substring-no-properties s-point (point))))) |
| 1860 | (setq subject (feedmail-tidy-up-slug subject)) | 2271 | (setq subject (feedmail-tidy-up-slug subject)) |
| 1861 | (if (zerop (length subject)) | 2272 | (if (zerop (length subject)) |
| 1862 | (setq subject | 2273 | (setq subject |
| @@ -1876,6 +2287,7 @@ mapped to mostly alphanumerics for safety." | |||
| 1876 | 2287 | ||
| 1877 | 2288 | ||
| 1878 | (defun feedmail-create-queue-filename (queue-directory) | 2289 | (defun feedmail-create-queue-filename (queue-directory) |
| 2290 | (feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory) | ||
| 1879 | (let ((slug "wjc")) | 2291 | (let ((slug "wjc")) |
| 1880 | (cond | 2292 | (cond |
| 1881 | (feedmail-queue-slug-maker | 2293 | (feedmail-queue-slug-maker |
| @@ -1894,6 +2306,7 @@ mapped to mostly alphanumerics for safety." | |||
| 1894 | 2306 | ||
| 1895 | 2307 | ||
| 1896 | (defun feedmail-dump-message-to-queue (queue-directory what-event) | 2308 | (defun feedmail-dump-message-to-queue (queue-directory what-event) |
| 2309 | (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event) | ||
| 1897 | (or (file-accessible-directory-p queue-directory) | 2310 | (or (file-accessible-directory-p queue-directory) |
| 1898 | ;; progn to get nil result no matter what | 2311 | ;; progn to get nil result no matter what |
| 1899 | (progn (make-directory queue-directory t) nil) | 2312 | (progn (make-directory queue-directory t) nil) |
| @@ -1907,7 +2320,8 @@ mapped to mostly alphanumerics for safety." | |||
| 1907 | (progn | 2320 | (progn |
| 1908 | (setq is-fqm (feedmail-fqm-p buffer-file-name)) | 2321 | (setq is-fqm (feedmail-fqm-p buffer-file-name)) |
| 1909 | (setq is-in-this-dir (string-equal | 2322 | (setq is-in-this-dir (string-equal |
| 1910 | (directory-file-name queue-directory) | 2323 | (directory-file-name |
| 2324 | (expand-file-name queue-directory)) | ||
| 1911 | (directory-file-name (expand-file-name (file-name-directory buffer-file-name))))))) | 2325 | (directory-file-name (expand-file-name (file-name-directory buffer-file-name))))))) |
| 1912 | ;; if visiting a queued message, just save | 2326 | ;; if visiting a queued message, just save |
| 1913 | (if (and is-fqm is-in-this-dir) | 2327 | (if (and is-fqm is-in-this-dir) |
| @@ -1918,7 +2332,14 @@ mapped to mostly alphanumerics for safety." | |||
| 1918 | (write-file filename)) | 2332 | (write-file filename)) |
| 1919 | ;; convenient for moving from draft to q, for example | 2333 | ;; convenient for moving from draft to q, for example |
| 1920 | (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir)) | 2334 | (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir)) |
| 1921 | (y-or-n-p (format "FQM: Was previously %s; delete that? " previous-buffer-file-name))) | 2335 | (let (d b s) |
| 2336 | (setq b (file-name-nondirectory previous-buffer-file-name)) | ||
| 2337 | (setq d (file-name-directory previous-buffer-file-name)) | ||
| 2338 | (setq s (substring d (1- (length d)))) | ||
| 2339 | (setq d (substring d 0 (1- (length d)))) | ||
| 2340 | (setq d (file-name-nondirectory d)) | ||
| 2341 | (y-or-n-p (format "FQM: Was previously %s%s%s; delete that? " | ||
| 2342 | d s b)))) | ||
| 1922 | (delete-file previous-buffer-file-name)) | 2343 | (delete-file previous-buffer-file-name)) |
| 1923 | (if feedmail-nuke-buffer-after-queue | 2344 | (if feedmail-nuke-buffer-after-queue |
| 1924 | (let ((a-s-file-name buffer-auto-save-file-name)) | 2345 | (let ((a-s-file-name buffer-auto-save-file-name)) |
| @@ -1927,9 +2348,7 @@ mapped to mostly alphanumerics for safety." | |||
| 1927 | delete-auto-save-files | 2348 | delete-auto-save-files |
| 1928 | (file-exists-p a-s-file-name) | 2349 | (file-exists-p a-s-file-name) |
| 1929 | (delete-file a-s-file-name)))) | 2350 | (delete-file a-s-file-name)))) |
| 1930 | (if feedmail-queue-chatty | 2351 | (feedmail-say-chatter "Queued in %s" filename) |
| 1931 | (progn (message "%s" (concat "FQM: Queued in " filename)) | ||
| 1932 | (sit-for feedmail-queue-chatty-sit-for))) | ||
| 1933 | (if feedmail-queue-chatty | 2352 | (if feedmail-queue-chatty |
| 1934 | (progn | 2353 | (progn |
| 1935 | (feedmail-queue-reminder what-event) | 2354 | (feedmail-queue-reminder what-event) |
| @@ -1938,37 +2357,46 @@ mapped to mostly alphanumerics for safety." | |||
| 1938 | 2357 | ||
| 1939 | ;; from a similar function in mail-utils.el | 2358 | ;; from a similar function in mail-utils.el |
| 1940 | (defun feedmail-rfc822-time-zone (time) | 2359 | (defun feedmail-rfc822-time-zone (time) |
| 2360 | (feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time) | ||
| 1941 | (let* ((sec (or (car (current-time-zone time)) 0)) | 2361 | (let* ((sec (or (car (current-time-zone time)) 0)) |
| 1942 | (absmin (/ (abs sec) 60))) | 2362 | (absmin (/ (abs sec) 60))) |
| 1943 | (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) | 2363 | (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) |
| 1944 | 2364 | ||
| 1945 | (defun feedmail-rfc822-date (arg-time) | 2365 | (defun feedmail-rfc822-date (arg-time) |
| 1946 | (let ((time (if arg-time arg-time (current-time)))) | 2366 | (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time) |
| 2367 | (let ((time (if arg-time arg-time (current-time))) | ||
| 2368 | (system-time-locale "C")) | ||
| 1947 | (concat | 2369 | (concat |
| 1948 | (format-time-string "%a, %e %b %Y %T " time) | 2370 | (format-time-string "%a, %e %b %Y %T " time) |
| 1949 | (feedmail-rfc822-time-zone time) | 2371 | (feedmail-rfc822-time-zone time) |
| 1950 | ))) | 2372 | ))) |
| 1951 | 2373 | ||
| 2374 | (defun feedmail-send-it-immediately-wrapper () | ||
| 2375 | "Wrapper to catch skip-me-i" | ||
| 2376 | (if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately))) | ||
| 2377 | (error "FQM: Sending...abandoned!"))) | ||
| 2378 | |||
| 1952 | (declare-function expand-mail-aliases "mailalias" (beg end &optional exclude)) | 2379 | (declare-function expand-mail-aliases "mailalias" (beg end &optional exclude)) |
| 1953 | 2380 | ||
| 1954 | (defun feedmail-send-it-immediately () | 2381 | (defun feedmail-send-it-immediately () |
| 1955 | "Handle immediate sending, including during a queue run." | 2382 | "Handle immediate sending, including during a queue run." |
| 1956 | (let* ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*")) | 2383 | (feedmail-say-debug ">in-> feedmail-send-it-immediately") |
| 1957 | (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*")) | 2384 | (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*")) |
| 1958 | (feedmail-raw-text-buffer (current-buffer)) | 2385 | (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*")) |
| 1959 | (feedmail-address-list) | 2386 | (feedmail-raw-text-buffer (current-buffer)) |
| 1960 | (eoh-marker) | 2387 | (feedmail-address-list) |
| 1961 | (bcc-holder) | 2388 | (eoh-marker) |
| 1962 | (resent-bcc-holder) | 2389 | (bcc-holder) |
| 1963 | (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):") | 2390 | (resent-bcc-holder) |
| 1964 | (a-re-rtc "^Resent-\\(To\\|Cc\\):") | 2391 | (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):") |
| 1965 | (a-re-rb "^Resent-Bcc:") | 2392 | (a-re-rtc "^Resent-\\(To\\|Cc\\):") |
| 1966 | (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):") | 2393 | (a-re-rb "^Resent-Bcc:") |
| 1967 | (a-re-dtc "^\\(To\\|Cc\\):") | 2394 | (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):") |
| 1968 | (a-re-db "^Bcc:") | 2395 | (a-re-dtc "^\\(To\\|Cc\\):") |
| 1969 | ;; to get a temporary changable copy | 2396 | (a-re-db "^Bcc:") |
| 1970 | (mail-header-separator mail-header-separator) | 2397 | ;; to get a temporary changable copy |
| 1971 | ) | 2398 | (mail-header-separator mail-header-separator) |
| 2399 | ) | ||
| 1972 | (unwind-protect | 2400 | (unwind-protect |
| 1973 | (save-current-buffer | 2401 | (save-current-buffer |
| 1974 | (set-buffer feedmail-error-buffer) (erase-buffer) | 2402 | (set-buffer feedmail-error-buffer) (erase-buffer) |
| @@ -1984,11 +2412,16 @@ mapped to mostly alphanumerics for safety." | |||
| 1984 | (let ((case-fold-search nil)) | 2412 | (let ((case-fold-search nil)) |
| 1985 | ;; Change header-delimiter to be what mailers expect (empty line). | 2413 | ;; Change header-delimiter to be what mailers expect (empty line). |
| 1986 | ;; leaves match data in place or signals error | 2414 | ;; leaves match data in place or signals error |
| 2415 | (feedmail-say-debug "looking for m-h-s \"%s\"" | ||
| 2416 | mail-header-separator) | ||
| 1987 | (setq eoh-marker (feedmail-find-eoh)) | 2417 | (setq eoh-marker (feedmail-find-eoh)) |
| 1988 | (replace-match "\n") | 2418 | (feedmail-say-debug "found m-h-s %s" eoh-marker) |
| 1989 | (setq mail-header-separator "")) | 2419 | (setq mail-header-separator "") |
| 2420 | (replace-match "")) | ||
| 2421 | ;; (replace-match "\\1")) ;; might be empty or "\r" | ||
| 1990 | 2422 | ||
| 1991 | ;; mail-aliases nil = mail-abbrevs.el | 2423 | ;; mail-aliases nil = mail-abbrevs.el |
| 2424 | (feedmail-say-debug "expanding mail aliases") | ||
| 1992 | (if (or feedmail-force-expand-mail-aliases | 2425 | (if (or feedmail-force-expand-mail-aliases |
| 1993 | (and (fboundp 'expand-mail-aliases) mail-aliases)) | 2426 | (and (fboundp 'expand-mail-aliases) mail-aliases)) |
| 1994 | (expand-mail-aliases (point-min) eoh-marker)) | 2427 | (expand-mail-aliases (point-min) eoh-marker)) |
| @@ -2060,18 +2493,31 @@ mapped to mostly alphanumerics for safety." | |||
| 2060 | (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t) | 2493 | (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t) |
| 2061 | (replace-match "")))) | 2494 | (replace-match "")))) |
| 2062 | 2495 | ||
| 2496 | (feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook) | ||
| 2063 | (run-hooks 'feedmail-last-chance-hook) | 2497 | (run-hooks 'feedmail-last-chance-hook) |
| 2064 | 2498 | ||
| 2499 | (save-window-excursion | ||
| 2065 | (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:")) | 2500 | (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:")) |
| 2066 | (also-file) | 2501 | (also-file) |
| 2067 | (confirm (cond | 2502 | (confirm (cond |
| 2068 | ((eq feedmail-confirm-outgoing 'immediate) | 2503 | ((eq feedmail-confirm-outgoing 'immediate) |
| 2069 | (not feedmail-queue-runner-is-active)) | 2504 | (not feedmail-queue-runner-is-active)) |
| 2070 | ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active) | 2505 | ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active) |
| 2071 | (t feedmail-confirm-outgoing)))) | 2506 | (t feedmail-confirm-outgoing))) |
| 2507 | (fullframe (cond | ||
| 2508 | ((eq feedmail-display-full-frame 'immediate) | ||
| 2509 | (not feedmail-queue-runner-is-active)) | ||
| 2510 | ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active) | ||
| 2511 | (t feedmail-display-full-frame)))) | ||
| 2512 | (if fullframe | ||
| 2513 | (progn | ||
| 2514 | (switch-to-buffer feedmail-prepped-text-buffer t) | ||
| 2515 | (delete-other-windows))) | ||
| 2072 | (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer)) | 2516 | (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer)) |
| 2073 | (let ((user-mail-address (feedmail-envelope-deducer eoh-marker))) | 2517 | (let ((user-mail-address (feedmail-envelope-deducer eoh-marker))) |
| 2518 | (feedmail-say-debug "give it to buffer-eater") | ||
| 2074 | (feedmail-give-it-to-buffer-eater) | 2519 | (feedmail-give-it-to-buffer-eater) |
| 2520 | (feedmail-say-debug "gave it to buffer-eater") | ||
| 2075 | (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer))) | 2521 | (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer))) |
| 2076 | (progn ; if a file but not running the queue, offer to delete it | 2522 | (progn ; if a file but not running the queue, offer to delete it |
| 2077 | (setq also-file (expand-file-name also-file)) | 2523 | (setq also-file (expand-file-name also-file)) |
| @@ -2105,8 +2551,11 @@ mapped to mostly alphanumerics for safety." | |||
| 2105 | )) | 2551 | )) |
| 2106 | (mail-do-fcc eoh-marker) | 2552 | (mail-do-fcc eoh-marker) |
| 2107 | ))) | 2553 | ))) |
| 2108 | (error "FQM: Sending...abandoned") ; user bailed out of one-last-look | 2554 | ;; user bailed out of one-last-look |
| 2109 | ))) ; unwind-protect body (save-excursion) | 2555 | (if feedmail-queue-runner-is-active |
| 2556 | (throw 'skip-me-q 'skip-me-q) | ||
| 2557 | (throw 'skip-me-i 'skip-me-i)) | ||
| 2558 | )))) ; unwind-protect body (save-excursion) | ||
| 2110 | 2559 | ||
| 2111 | ;; unwind-protect cleanup forms | 2560 | ;; unwind-protect cleanup forms |
| 2112 | (kill-buffer feedmail-prepped-text-buffer) | 2561 | (kill-buffer feedmail-prepped-text-buffer) |
| @@ -2114,8 +2563,10 @@ mapped to mostly alphanumerics for safety." | |||
| 2114 | (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer) | 2563 | (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer) |
| 2115 | (progn (display-buffer feedmail-error-buffer) | 2564 | (progn (display-buffer feedmail-error-buffer) |
| 2116 | ;; read fast ... the meter is running | 2565 | ;; read fast ... the meter is running |
| 2117 | (if (and feedmail-queue-runner-is-active feedmail-queue-chatty) | 2566 | (if feedmail-queue-runner-is-active |
| 2118 | (progn (message "FQM: Sending...failed") (ding t) (sit-for 3))) | 2567 | (progn |
| 2568 | (ding t) | ||
| 2569 | (feedmail-say-chatter "Sending...failed"))) | ||
| 2119 | (error "FQM: Sending...failed"))) | 2570 | (error "FQM: Sending...failed"))) |
| 2120 | (set-buffer feedmail-raw-text-buffer)) | 2571 | (set-buffer feedmail-raw-text-buffer)) |
| 2121 | ) ; let | 2572 | ) ; let |
| @@ -2131,6 +2582,8 @@ mapped to mostly alphanumerics for safety." | |||
| 2131 | NAME, VALUE, ACTION, and FOLDING are the four elements of a | 2582 | NAME, VALUE, ACTION, and FOLDING are the four elements of a |
| 2132 | fiddle-plex, as described in the documentation for the variable | 2583 | fiddle-plex, as described in the documentation for the variable |
| 2133 | `feedmail-fiddle-plex-blurb'." | 2584 | `feedmail-fiddle-plex-blurb'." |
| 2585 | (feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s" | ||
| 2586 | name value action folding) | ||
| 2134 | (let ((case-fold-search t) | 2587 | (let ((case-fold-search t) |
| 2135 | (header-colon (concat (regexp-quote name) ":")) | 2588 | (header-colon (concat (regexp-quote name) ":")) |
| 2136 | header-regexp eoh-marker has-like ag-like val-like that-point) | 2589 | header-regexp eoh-marker has-like ag-like val-like that-point) |
| @@ -2191,6 +2644,7 @@ fiddle-plex, as described in the documentation for the variable | |||
| 2191 | )) | 2644 | )) |
| 2192 | 2645 | ||
| 2193 | (defun feedmail-give-it-to-buffer-eater () | 2646 | (defun feedmail-give-it-to-buffer-eater () |
| 2647 | (feedmail-say-debug ">in-> feedmail-give-it-to-buffer-eater") | ||
| 2194 | (save-excursion | 2648 | (save-excursion |
| 2195 | (if feedmail-enable-spray | 2649 | (if feedmail-enable-spray |
| 2196 | (mapcar | 2650 | (mapcar |
| @@ -2221,6 +2675,8 @@ fiddle-plex, as described in the documentation for the variable | |||
| 2221 | (kill-buffer spray-buffer) | 2675 | (kill-buffer spray-buffer) |
| 2222 | )) | 2676 | )) |
| 2223 | feedmail-address-list) | 2677 | feedmail-address-list) |
| 2678 | (feedmail-say-debug "calling buffer-eater %s" | ||
| 2679 | feedmail-buffer-eating-function) | ||
| 2224 | (funcall feedmail-buffer-eating-function | 2680 | (funcall feedmail-buffer-eating-function |
| 2225 | feedmail-prepped-text-buffer | 2681 | feedmail-prepped-text-buffer |
| 2226 | feedmail-error-buffer | 2682 | feedmail-error-buffer |
| @@ -2231,6 +2687,7 @@ fiddle-plex, as described in the documentation for the variable | |||
| 2231 | "If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'. | 2687 | "If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'. |
| 2232 | Else, look for Sender: or From: (or Resent-*) and | 2688 | Else, look for Sender: or From: (or Resent-*) and |
| 2233 | return that value." | 2689 | return that value." |
| 2690 | (feedmail-say-debug ">in-> feedmail-envelope-deducer %s" eoh-marker) | ||
| 2234 | (if (not feedmail-deduce-envelope-from) | 2691 | (if (not feedmail-deduce-envelope-from) |
| 2235 | user-mail-address | 2692 | user-mail-address |
| 2236 | (let ((from-list)) | 2693 | (let ((from-list)) |
| @@ -2248,6 +2705,7 @@ return that value." | |||
| 2248 | 2705 | ||
| 2249 | (defun feedmail-fiddle-from () | 2706 | (defun feedmail-fiddle-from () |
| 2250 | "Fiddle From:." | 2707 | "Fiddle From:." |
| 2708 | (feedmail-say-debug ">in-> feedmail-fiddle-from") | ||
| 2251 | ;; default is to fall off the end of the list and do nothing | 2709 | ;; default is to fall off the end of the list and do nothing |
| 2252 | (cond | 2710 | (cond |
| 2253 | ;; nil means do nothing | 2711 | ;; nil means do nothing |
| @@ -2256,10 +2714,14 @@ return that value." | |||
| 2256 | ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins) | 2714 | ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins) |
| 2257 | ;; improvement using user-mail-address suggested by | 2715 | ;; improvement using user-mail-address suggested by |
| 2258 | ;; gray@austin.apc.slb.com (Douglas Gray Stephens) | 2716 | ;; gray@austin.apc.slb.com (Douglas Gray Stephens) |
| 2717 | ;; improvement using mail-host-address suggested by "Jason Eisner" <jason@cs.jhu.edu> | ||
| 2718 | ;; ((this situation really is hopeless, though) | ||
| 2259 | ((eq t feedmail-from-line) | 2719 | ((eq t feedmail-from-line) |
| 2260 | (let ((feedmail-from-line | 2720 | (let ((feedmail-from-line |
| 2261 | (let ((at-stuff | 2721 | (let ((at-stuff |
| 2262 | (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name))))) | 2722 | (if user-mail-address user-mail-address |
| 2723 | (concat (user-login-name) "@" | ||
| 2724 | (or mail-host-address (system-name)))))) | ||
| 2263 | (cond | 2725 | (cond |
| 2264 | ((eq mail-from-style nil) at-stuff) | 2726 | ((eq mail-from-style nil) at-stuff) |
| 2265 | ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")")) | 2727 | ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")")) |
| @@ -2288,6 +2750,7 @@ return that value." | |||
| 2288 | 2750 | ||
| 2289 | (defun feedmail-fiddle-sender () | 2751 | (defun feedmail-fiddle-sender () |
| 2290 | "Fiddle Sender:." | 2752 | "Fiddle Sender:." |
| 2753 | (feedmail-say-debug ">in-> feedmail-fiddle-sender") | ||
| 2291 | ;; default is to fall off the end of the list and do nothing | 2754 | ;; default is to fall off the end of the list and do nothing |
| 2292 | (cond | 2755 | (cond |
| 2293 | ;; nil means do nothing | 2756 | ;; nil means do nothing |
| @@ -2316,6 +2779,11 @@ return that value." | |||
| 2316 | 2779 | ||
| 2317 | (defun feedmail-default-date-generator (maybe-file) | 2780 | (defun feedmail-default-date-generator (maybe-file) |
| 2318 | "Default function for generating Date: header contents." | 2781 | "Default function for generating Date: header contents." |
| 2782 | (feedmail-say-debug ">in-> feedmail-default-date-generator") | ||
| 2783 | (when maybe-file | ||
| 2784 | (feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (nth 4 (file-attributes maybe-file))))) | ||
| 2785 | (feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (nth 5 (file-attributes maybe-file))))) | ||
| 2786 | (feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (nth 6 (file-attributes maybe-file)))))) | ||
| 2319 | (let ((date-time)) | 2787 | (let ((date-time)) |
| 2320 | (if (and (not feedmail-queue-use-send-time-for-date) maybe-file) | 2788 | (if (and (not feedmail-queue-use-send-time-for-date) maybe-file) |
| 2321 | (setq date-time (nth 5 (file-attributes maybe-file)))) | 2789 | (setq date-time (nth 5 (file-attributes maybe-file)))) |
| @@ -2325,6 +2793,7 @@ return that value." | |||
| 2325 | 2793 | ||
| 2326 | (defun feedmail-fiddle-date (maybe-file) | 2794 | (defun feedmail-fiddle-date (maybe-file) |
| 2327 | "Fiddle Date:. See documentation of `feedmail-date-generator'." | 2795 | "Fiddle Date:. See documentation of `feedmail-date-generator'." |
| 2796 | (feedmail-say-debug ">in-> feedmail-fiddle-date") | ||
| 2328 | ;; default is to fall off the end of the list and do nothing | 2797 | ;; default is to fall off the end of the list and do nothing |
| 2329 | (cond | 2798 | (cond |
| 2330 | ;; nil means do nothing | 2799 | ;; nil means do nothing |
| @@ -2357,9 +2826,14 @@ return that value." | |||
| 2357 | "Default function for generating Message-Id: header contents. | 2826 | "Default function for generating Message-Id: header contents. |
| 2358 | Based on a date and a sort of random number for tie breaking. Unless | 2827 | Based on a date and a sort of random number for tie breaking. Unless |
| 2359 | `feedmail-message-id-suffix' is defined, uses `user-mail-address', so be | 2828 | `feedmail-message-id-suffix' is defined, uses `user-mail-address', so be |
| 2360 | sure it's set." | 2829 | sure it's set. If both are nil, creates a quasi-random suffix that is |
| 2830 | probably not appropriate for you." | ||
| 2831 | (feedmail-say-debug ">in-> feedmail-default-message-id-generator %s" | ||
| 2832 | maybe-file) | ||
| 2361 | (let ((date-time) | 2833 | (let ((date-time) |
| 2834 | (system-time-locale "C") | ||
| 2362 | (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address))) | 2835 | (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address))) |
| 2836 | (if (not end-stuff) (setq end-stuff (format "%d.example.com" (random)))) | ||
| 2363 | (if (string-match "^\\(.*\\)@" end-stuff) | 2837 | (if (string-match "^\\(.*\\)@" end-stuff) |
| 2364 | (setq end-stuff | 2838 | (setq end-stuff |
| 2365 | (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff)) | 2839 | (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff)) |
| @@ -2375,6 +2849,7 @@ sure it's set." | |||
| 2375 | 2849 | ||
| 2376 | (defun feedmail-fiddle-message-id (maybe-file) | 2850 | (defun feedmail-fiddle-message-id (maybe-file) |
| 2377 | "Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'." | 2851 | "Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'." |
| 2852 | (feedmail-say-debug ">in-> feedmail-fiddle-message-id %s" maybe-file) | ||
| 2378 | ;; default is to fall off the end of the list and do nothing | 2853 | ;; default is to fall off the end of the list and do nothing |
| 2379 | (cond | 2854 | (cond |
| 2380 | ;; nil means do nothing | 2855 | ;; nil means do nothing |
| @@ -2416,8 +2891,11 @@ sure it's set." | |||
| 2416 | 2891 | ||
| 2417 | (defun feedmail-fiddle-x-mailer () | 2892 | (defun feedmail-fiddle-x-mailer () |
| 2418 | "Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'." | 2893 | "Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'." |
| 2894 | (feedmail-say-debug ">in-> feedmail-fiddle-x-mailer") | ||
| 2419 | ;; default is to fall off the end of the list and do nothing | 2895 | ;; default is to fall off the end of the list and do nothing |
| 2420 | (cond | 2896 | (cond |
| 2897 | ;; nil means do nothing | ||
| 2898 | ((eq nil feedmail-x-mailer-line) nil) | ||
| 2421 | ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse | 2899 | ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse |
| 2422 | ((eq t feedmail-x-mailer-line) | 2900 | ((eq t feedmail-x-mailer-line) |
| 2423 | (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator))) | 2901 | (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator))) |
| @@ -2444,6 +2922,7 @@ sure it's set." | |||
| 2444 | 2922 | ||
| 2445 | (defun feedmail-fiddle-spray-address (addy-plex) | 2923 | (defun feedmail-fiddle-spray-address (addy-plex) |
| 2446 | "Fiddle header for single spray address. Uses `feedmail-spray-this-address'." | 2924 | "Fiddle header for single spray address. Uses `feedmail-spray-this-address'." |
| 2925 | (feedmail-say-debug ">in-> feedmail-fiddle-spray-address %s" addy-plex) | ||
| 2447 | ;; default is to fall off the end of the list and do nothing | 2926 | ;; default is to fall off the end of the list and do nothing |
| 2448 | (cond | 2927 | (cond |
| 2449 | ;; nil means do nothing | 2928 | ;; nil means do nothing |
| @@ -2475,6 +2954,7 @@ sure it's set." | |||
| 2475 | 2954 | ||
| 2476 | (defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes) | 2955 | (defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes) |
| 2477 | "Fiddling based on a list of fiddle-plexes for spraying." | 2956 | "Fiddling based on a list of fiddle-plexes for spraying." |
| 2957 | (feedmail-say-debug ">in-> feedmail-fiddle-list-of-spray-fiddle-plexes") | ||
| 2478 | ;; default is to fall off the end of the list and do nothing | 2958 | ;; default is to fall off the end of the list and do nothing |
| 2479 | (let ((lofp list-of-fiddle-plexes) fp) | 2959 | (let ((lofp list-of-fiddle-plexes) fp) |
| 2480 | (if (listp lofp) | 2960 | (if (listp lofp) |
| @@ -2487,6 +2967,7 @@ sure it's set." | |||
| 2487 | 2967 | ||
| 2488 | (defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes) | 2968 | (defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes) |
| 2489 | "Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless." | 2969 | "Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless." |
| 2970 | (feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes") | ||
| 2490 | ;; default is to fall off the end of the list and do nothing | 2971 | ;; default is to fall off the end of the list and do nothing |
| 2491 | (let ((lofp list-of-fiddle-plexes) fp) | 2972 | (let ((lofp list-of-fiddle-plexes) fp) |
| 2492 | (while lofp | 2973 | (while lofp |
| @@ -2512,18 +2993,20 @@ sure it's set." | |||
| 2512 | There may be multiple such lines, and each may have arbitrarily | 2993 | There may be multiple such lines, and each may have arbitrarily |
| 2513 | many continuation lines. Return an accumulation of the deleted | 2994 | many continuation lines. Return an accumulation of the deleted |
| 2514 | headers, including the intervening newlines." | 2995 | headers, including the intervening newlines." |
| 2996 | (feedmail-say-debug ">in-> feedmail-accume-n-nuke-header %s %s" | ||
| 2997 | header-end header-regexp) | ||
| 2515 | (let ((case-fold-search t) (dropout)) | 2998 | (let ((case-fold-search t) (dropout)) |
| 2516 | (save-excursion | 2999 | (save-excursion |
| 2517 | (goto-char (point-min)) | 3000 | (goto-char (point-min)) |
| 2518 | ;; iterate over all matching lines | 3001 | ;; iterate over all matching lines |
| 2519 | (while (re-search-forward header-regexp header-end t) | 3002 | (while (re-search-forward header-regexp header-end t) |
| 2520 | (forward-line 1) | 3003 | (forward-line 1) |
| 2521 | (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point)))) | 3004 | (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point)))) |
| 2522 | (delete-region (match-beginning 0) (point)) | 3005 | (delete-region (match-beginning 0) (point)) |
| 2523 | ;; get rid of any continuation lines | 3006 | ;; get rid of any continuation lines |
| 2524 | (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) | 3007 | (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) |
| 2525 | (forward-line 1) | 3008 | (forward-line 1) |
| 2526 | (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point)))) | 3009 | (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point)))) |
| 2527 | (replace-match "")))) | 3010 | (replace-match "")))) |
| 2528 | (identity dropout))) | 3011 | (identity dropout))) |
| 2529 | 3012 | ||
| @@ -2533,6 +3016,7 @@ The filling tries to avoid splitting lines except at commas. This | |||
| 2533 | avoids, in particular, splitting within parenthesized comments in | 3016 | avoids, in particular, splitting within parenthesized comments in |
| 2534 | addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:, | 3017 | addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:, |
| 2535 | Resent-To:, Resent-Cc:, and Resent-Bcc:." | 3018 | Resent-To:, Resent-Cc:, and Resent-Bcc:." |
| 3019 | (feedmail-say-debug ">in-> feedmail-fill-to-cc-function") | ||
| 2536 | (let ((case-fold-search t) | 3020 | (let ((case-fold-search t) |
| 2537 | this-line | 3021 | this-line |
| 2538 | this-line-end) | 3022 | this-line-end) |
| @@ -2557,6 +3041,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:." | |||
| 2557 | 3041 | ||
| 2558 | (defun feedmail-fill-this-one (this-line this-line-end) | 3042 | (defun feedmail-fill-this-one (this-line this-line-end) |
| 2559 | "In-place smart filling of the region bounded by the two arguments." | 3043 | "In-place smart filling of the region bounded by the two arguments." |
| 3044 | (feedmail-say-debug ">in-> feedmail-fill-this-one") | ||
| 2560 | (let ((fill-prefix "\t") | 3045 | (let ((fill-prefix "\t") |
| 2561 | (fill-column feedmail-fill-to-cc-fill-column)) | 3046 | (fill-column feedmail-fill-to-cc-fill-column)) |
| 2562 | ;; The general idea is to break only on commas. Collapse | 3047 | ;; The general idea is to break only on commas. Collapse |
| @@ -2587,6 +3072,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:." | |||
| 2587 | Addresses are collected only from headers whose names match the fourth | 3072 | Addresses are collected only from headers whose names match the fourth |
| 2588 | argument. Returns a list of strings. Duplicate addresses will have | 3073 | argument. Returns a list of strings. Duplicate addresses will have |
| 2589 | been weeded out." | 3074 | been weeded out." |
| 3075 | (feedmail-say-debug ">in-> feedmail-deduce-address-list %s %s" addr-regexp address-list) | ||
| 2590 | (let ((simple-address) | 3076 | (let ((simple-address) |
| 2591 | (address-blob) | 3077 | (address-blob) |
| 2592 | (this-line) | 3078 | (this-line) |
| @@ -2607,7 +3093,7 @@ been weeded out." | |||
| 2607 | (setq this-line-end (point-marker)) | 3093 | (setq this-line-end (point-marker)) |
| 2608 | ;; only keep if we don't have it already | 3094 | ;; only keep if we don't have it already |
| 2609 | (setq address-blob | 3095 | (setq address-blob |
| 2610 | (mail-strip-quoted-names (buffer-substring this-line this-line-end))) | 3096 | (mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end))) |
| 2611 | (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob) | 3097 | (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob) |
| 2612 | (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) | 3098 | (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) |
| 2613 | (setq address-blob (replace-match "" t t address-blob)) | 3099 | (setq address-blob (replace-match "" t t address-blob)) |
| @@ -2620,6 +3106,7 @@ been weeded out." | |||
| 2620 | 3106 | ||
| 2621 | (defun feedmail-one-last-look (feedmail-prepped-text-buffer) | 3107 | (defun feedmail-one-last-look (feedmail-prepped-text-buffer) |
| 2622 | "Offer the user one last chance to give it up." | 3108 | "Offer the user one last chance to give it up." |
| 3109 | (feedmail-say-debug ">in-> feedmail-one-last-look") | ||
| 2623 | (save-excursion | 3110 | (save-excursion |
| 2624 | (save-window-excursion | 3111 | (save-window-excursion |
| 2625 | (switch-to-buffer feedmail-prepped-text-buffer) | 3112 | (switch-to-buffer feedmail-prepped-text-buffer) |
| @@ -2633,26 +3120,43 @@ been weeded out." | |||
| 2633 | 3120 | ||
| 2634 | (defun feedmail-fqm-p (might-be) | 3121 | (defun feedmail-fqm-p (might-be) |
| 2635 | "Internal; does filename end with FQM suffix?" | 3122 | "Internal; does filename end with FQM suffix?" |
| 3123 | (feedmail-say-debug ">in-> feedmail-fqm-p %s" might-be) | ||
| 2636 | (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be)) | 3124 | (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be)) |
| 2637 | 3125 | ||
| 3126 | (defun feedmail-say-debug (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9) | ||
| 3127 | "Internal; emits debug messages in standard format." | ||
| 3128 | (when feedmail-debug | ||
| 3129 | (funcall 'message (concat "FQM DB: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9) | ||
| 3130 | (and feedmail-debug-sit-for (not (= 0 feedmail-debug-sit-for)) | ||
| 3131 | (sit-for feedmail-debug-sit-for)))) | ||
| 3132 | |||
| 3133 | (defun feedmail-say-chatter (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9) | ||
| 3134 | "Internal; emits queue chatter messages in standard format." | ||
| 3135 | (when feedmail-queue-chatty | ||
| 3136 | (funcall 'message (concat "FQM: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9) | ||
| 3137 | (and feedmail-queue-chatty-sit-for (not (= 0 feedmail-queue-chatty-sit-for)) | ||
| 3138 | (sit-for feedmail-queue-chatty-sit-for)))) | ||
| 2638 | 3139 | ||
| 2639 | (defun feedmail-find-eoh (&optional noerror) | 3140 | (defun feedmail-find-eoh (&optional noerror) |
| 2640 | "Internal; finds the end of message header fields, returns mark just before it" | 3141 | "Internal; finds the end of message header fields, returns mark just before it" |
| 3142 | ;; all this funny business with line endings is to account for CRLF | ||
| 3143 | ;; weirdness that I don't think I'll ever figure out | ||
| 3144 | (feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror) | ||
| 3145 | (let ((mhs mail-header-separator) | ||
| 3146 | (alt-mhs feedmail-queue-alternative-mail-header-separator) | ||
| 3147 | r-mhs r-alt-mhs) | ||
| 3148 | (setq r-mhs (concat "^" (regexp-quote mhs) "$")) | ||
| 3149 | (setq r-alt-mhs (concat "^" (regexp-quote (or alt-mhs "")) "$")) | ||
| 2641 | (save-excursion | 3150 | (save-excursion |
| 2642 | (goto-char (point-min)) | 3151 | (goto-char (point-min)) |
| 2643 | (when (or (re-search-forward (concat "^" | 3152 | (if (or (re-search-forward r-mhs nil t) |
| 2644 | (regexp-quote mail-header-separator) | 3153 | (and alt-mhs (re-search-forward r-alt-mhs nil t))) |
| 2645 | "\n") | 3154 | (progn |
| 2646 | nil noerror) | 3155 | (beginning-of-line) |
| 2647 | (and feedmail-queue-alternative-mail-header-separator | 3156 | (point-marker)) |
| 2648 | (re-search-forward | 3157 | (if noerror |
| 2649 | (concat "^" | 3158 | nil |
| 2650 | (regexp-quote | 3159 | (error "FQM: Can't find message-header-separator or alternate")))))) |
| 2651 | feedmail-queue-alternative-mail-header-separator) | ||
| 2652 | "\n") | ||
| 2653 | nil noerror))) | ||
| 2654 | (forward-line -1) | ||
| 2655 | (point-marker)))) | ||
| 2656 | 3160 | ||
| 2657 | (provide 'feedmail) | 3161 | (provide 'feedmail) |
| 2658 | 3162 | ||