;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; feedmail.el --- assist other email packages to massage outgoing messages ;;; A replacement for parts of GNUemacs' sendmail.el (specifically, ;;; it's what handles your outgoing mail after you hit C-c C-c in ;;; mail mode). It works with recent versions of GNUemacs (mostly ;;; tested against 19.34) and XEmacs (some testing with 19.15 and ;;; 20.2). ;; As far as I'm concerned, anyone can do anything they want with ;; this specific piece of code. No warranty or promise of support is ;; offered. This code is hereby released into the public domain. ;; Author: Bill Carpenter ;; Version: 7 ;; Keywords: email, queue, mail, sendmail, message ;; Thanks: My thanks to the many people who have sent me suggestions ;; and fixes over time, as well as those who have tested many beta ;; iterations. Some are cited in comments in code fragments below, ;; but that doesn't correlate well with the list of folks who have ;; actually helped me along the way. ;;; Commentary: ;; ;; If you use feedmail, I invite you to send me some email about it. ;; I appreciate feedback about problems you find or suggestions for ;; improvements or added features (even though I can't predict when ;; I'll incorporate changes). It's also OK with me if you send me a ;; note along the lines of "I use feedmail and find it useful" or "I ;; tried feedmail and didn't find it useful, so I stopped using it". ;; ;; ===== ;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE... Since it is PD, ;; you're within your rights to do whatever you want. If you do ;; publish a new version with your changes in it, please (1) insert ;; lisp comments describing the changes, (2) insert lisp comments ;; that clearly delimit where your changes are, (3) email me a copy ;; (I can't always consistently follow the relevant usenet groups), ;; and (4) use a version number that is based on the version you're ;; changing along with something that indicates you changed it. For ;; example, ;; ;; (defconst feedmail-patch-level "123") ;; (defconst feedmail-patch-level "123-XYZ-mods") ;; ;; The point of the last item, of course, is to try to minimize ;; confusion. Odds are good that if your idea makes sense to me that ;; it will show up in some future version of feedmail, though it's ;; hard to say when releases will tumble out. ;; ===== ;; ;; This file requires the mail-utils library. ;; ;; This file requires the smtpmail library if you use ;; feedmail-buffer-to-smtpmail. ;; ;; This file requires the custom library. Unfortunately, there are ;; two incompatible versions of the custom library. If you don't have ;; custom or you have the old version, this file will still load and ;; work properly. If you don't know what custom is all about and want ;; to edit your user option elisp variables the old fashioned way, ;; just imagine that all the "defcustom" stuff you see below is really ;; "defvar", and ignore everthing else. For info about custom, see ;; . ;; ;; This code does in elisp the stuff that used to be done ;; by the separate program "fakemail" for processing outbound email. ;; In other words, it takes over after you hit "C-c C-c" in mail mode. ;; By appropriate setting of options, you can still use "fakemail", ;; or you can even revert to sendmail (which is not too popular ;; locally). See the variables at the top of the elisp for how to ;; achieve these effects: ;; ;; --- you can get one last look at the prepped outbound message and ;; be prompted for confirmation ;; ;; --- removes BCC:/RESENT-BCC: headers after getting address info ;; ;; --- does smart filling of address headers ;; ;; --- calls a routine to process FCC: lines and removes them ;; ;; --- empty headers are removed ;; ;; --- can force FROM: or SENDER: line ;; ;; --- can generate a MESSAGE-ID: line ;; ;; --- can generate a DATE: line; the date can be the time the ;; message was written or the time it is being sent ;; ;; --- strips comments from address info (both "()" and "<>" are ;; handled via a call to mail-strip-quoted-names); the ;; comments are stripped in the simplified address list given ;; to a subprocess, not in the headers in the mail itself ;; (they are left unchanged, modulo smart filling) ;; ;; --- error info is pumped into a normal buffer instead of the ;; minibuffer ;; ;; --- just before the optional prompt for confirmation, lets you ;; run a hook on the prepped message and simplified address ;; list ;; ;; --- you can specify something other than /bin/mail for the ;; subprocess ;; ;; --- you can park outgoing messages into a disk-based queue and ;; stimulate sending them all later (handy for laptop users); ;; there is also a queue for draft messages ;; ;; --- you can generate an X-MAILER: message header ;; ;; After a few options below, you will find the function ;; feedmail-send-it. There are two ways you can use the stuff in this ;; file: ;; ;; (1) Put the contents of this file into sendmail.el and change the ;; name of feedmail-send-it to sendmail-send-it, replacing that ;; function in sendmail.el. (I strongly recommend against this.) ;; ;; or ;; ;; (2) Save this file as feedmail.el somewhere on your elisp ;; loadpath; byte-compile it. Put the following lines somewhere in ;; your ~/.emacs stuff: ;; ;; (setq send-mail-function 'feedmail-send-it) ;; (autoload 'feedmail-send-it "feedmail") ;; ;; If you plan to use the queue stuff: ;; ;; (autoload 'feedmail-run-the-queue "feedmail") ;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail") ;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist)) ;; ;; I think the LCD is no longer being updated, but if it were, this ;; would be a proper LCD record. There is an old version of ;; feedmail.el in the LCD archive. It works but is missing a lot of ;; features. ;; ;; LCD record: ;; feedmail|Bill Carpenter|bill@bubblegum.net|Outbound mail handling|97-05-20|7|feedmail.el ;; ;; Change log: ;; original, 31 March 1991 ;; patchlevel 1, 5 April 1991 ;; patchlevel 2, 24 May 1991 ;; 5-may-92 jwz Conditionalized calling expand-mail-aliases, since that ;; function doesn't exist in Lucid GNU Emacs or when using ;; mail-abbrevs.el. ;; patchlevel 3, 3 October 1996 ;; added queue stuff; still works in v18 ;; patchlevel 4, issued by someone else ;; patchlevel 5, issued by someone else ;; patchlevel 6, not issued as far as I know ;; patchlevel 7, 20 May 1997 ;; abandon futile support of GNUemacs v18 (sorry if that hurts you) ;; provide a DATE: header by default ;; provide a default for generating MESSAGE-ID: header contents ;; and use it by default (slightly changed API) ;; return value from feedmail-run-the-queue ;; new wrapper function feedmail-run-the-queue-no-prompts ;; user-mail-address as default for FROM: ;; properly deal with RESENT-{TO,CC,BCC} ;; BCC and RESENT-* now included in smart filling ;; limited support for a "drafts" directory ;; user-configurable default message action ;; allow timeout for confirmation prompt (where available) ;; move FCC handling to as late as possible to get max ;; header munging in the saved file ;; work around sendmail.el's prompts when working from queue ;; more reliably detect voluntary user bailouts ;; offer to save modified buffers visiting queue files ;; offer to delete old file copies of messages being queued ;; offer to delete queue files when sending immediately ;; queue filename convention preserves queue order ;; default queue and draft directory names that work on VMS ;; deduced address list now really a list, not a ;; string (API change) ;; no more address buffer ;; when sending immediately, brief reminder of queue/draft counts ;; copy trace of smtpmail stuff to feedmail error buffer on no-go ;; more granularity on when to confirm sending ;; pause a bit for errors while running queue ;; try to clean up some pesky auto-save files from the ;; queue/draft directories ;; feedmail-force-expand-mail-aliases in case you can't figure ;; any other way ;; cleanup some sloppiness about case-fold-search (a strange ;; variable) ;; best effort following coding conventions from GNUemacs ;; elisp manual appendix ;; "customize" (see custom.el) ;; when user selects "immediate send", clear action prompt since ;; hooks may take a while to operate, and user may think the ;; response didn't take ;; fixes to the argument conventions for the ;; feedmail-queue-runner-* functions; allows ;; feedmail-run-the-queue[-no-prompts] to properly be called ;; non-interactively ;; eliminate reliance on directory-sep-char and feedmail-sep-thing ;; tweak smart filling (reminded of comma problem by ;; levitte@lp.se) ;; option to control writing in text vs binary mode ;;; Code: (defconst feedmail-patch-level "7") ;; from : ;; If you write software that must work without the new custom, you ;; can use this hack stolen from w3-cus.el: (eval-and-compile (condition-case () (require 'custom) (error nil)) (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) nil ;; We've got what we needed ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) (defgroup feedmail nil "Assist other email packages to massage outgoing messages." :group 'mail) (defgroup feedmail-misc nil "Miscellaneous feedmail options that don't fit in other groups." :group 'feedmail) (defgroup feedmail-headers nil "Options related to manipulating specific headers or types of headers." :group 'feedmail) (defgroup feedmail-queue nil "Options related to queuing messages for later sending." :group 'feedmail) (defcustom feedmail-confirm-outgoing nil "*If non-nil, give a y-or-n confirmation prompt before sending mail. This is done after the message is completely prepped, and you'll be looking at the top of the message in a buffer when you get the prompt. If set to the symbol 'queued, give the confirmation prompt only while running the queue (however, the prompt is always suppressed if you are processing the queue via feedmail-run-the-queue-no-prompts). If set to the symbol 'immediate, give the confirmation prompt only when sending immediately. For any other non-nil value, prompt in both cases. You can give a timeout for the prompt; see variable feedmail-confirm-outgoing-timeout." :group 'feedmail-misc :type 'boolean ) (defcustom feedmail-confirm-outgoing-timeout nil "*If non-nil, a timeout in seconds at the send confirmation prompt. If a positive number, it's a timeout before sending. If a negative number, it's a timeout before not sending. This will not work if your version of emacs doesn't include the function y-or-n-p-with-timeout (e.g., some versions of XEmacs)." :group 'feedmail-misc :type '(choice (const nil) integer) ) (defcustom feedmail-nuke-bcc t "*If non-nil remove BCC: lines from the message headers. In any case, the BCC: lines do participate in the composed address list. You may want to leave them in if you're using sendmail (see feedmail-buffer-eating-function)." :group 'feedmail-headers :type 'boolean ) (defcustom feedmail-nuke-resent-bcc t "*If non-nil remove RESENT-BCC: lines from the message headers. In any case, the RESENT-BCC: lines do participate in the composed address list. You may want to leave them in if you're using sendmail (see feedmail-buffer-eating-function)." :group 'feedmail-headers :type 'boolean ) (defcustom feedmail-fill-to-cc t "*If non-nil do smart filling of addressee header lines. Smart filling means breaking long lines at appropriate points and making continuation lines. Despite the function name, it includes TO:, CC:, BCC: (and their RESENT-* forms), as well as FROM: and REPLY-TO: (though they seldom need it). If nil, the lines are left as-is. The filling is done after mail address alias expansion." :group 'feedmail-headers :type 'boolean ) (defcustom feedmail-fill-to-cc-fill-column default-fill-column "*Fill column used by feedmail-fill-to-cc." :group 'feedmail-headers :type 'integer ) (defcustom feedmail-force-expand-mail-aliases nil "*If non-nil force the calling of expand-mail-aliases. Normally, feedmail tries to figure out if you're using mailalias or mailabbrevs and only calls expand-mail-aliases if it thinks you're using the mailalias package. This user option can be used to force the issue since there are configurations which fool the figuring out." :group 'feedmail-headers :type 'boolean ) (defcustom feedmail-nuke-empty-headers t "*If non-nil, remove header lines which have no contents. A completely empty SUBJECT: header is always removed, regardless of the setting of this variable. The only time you would want them left in would be if you used some headers whose presence indicated something rather than their contents. This is rare in Internet email but common in some proprietary systems." :group 'feedmail-headers :type 'boolean ) ;; wjc sez: I think the use of the SENDER: line is pretty pointless, ;; but I left it in to be compatible with sendmail.el and because ;; maybe some distant mail system needs it. Really, though, if you ;; want a sender line in your mail, just put one in there and don't ;; wait for feedmail to do it for you. (Yes, I know all about ;; RFC-822 and RFC-1123, but are you *really* one of those cases ;; they're talking about? I doubt it.) (defcustom feedmail-sender-line nil "*If non-nil and there is a FROM: header, force a SENDER: header. Use the value of this variable as its contents. You can probably leave this nil, but if you feel like using it, a good value would be a fully-qualified domain name form of your address. For example, bill@bubblegum.net. Don't include a trailing newline or the keyword SENDER:. They're automatically provided." :group 'feedmail-headers :type '(choice (const nil) string) ) (defcustom feedmail-force-binary-write t "*If non-nil, force writing file as binary. Applies to queues and FCC:. On systems where there is a difference between binary and text files, feedmail will temporarily manipulate the values of buffer-file-type and/or default-buffer-file-type to make the writing as binary. If nil, writing will be in text mode. On systems where there is no distinction or where it is controlled by other variables or other means, this option has no effect." :group 'feedmail-misc :type 'boolean ) ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins) ;; improvement using user-mail-address suggested by ;; gray@austin.apc.slb.com (Douglas Gray Stephens) (defcustom feedmail-from-line (concat (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name))) " (" (user-full-name) ")") "*If non-nil and the email has no FROM: header, use this value. A good value would be a fully-qualified domain name form of your address. For example, bill@bubblegum.net. The default value of this variable uses the standard elisp variable user-mail-address which should be set on every system but has a decent chance of being wrong. Better to set this variable explicitly to the string you want or find some other way to arrange for the message to get a FROM: line. Don't include a trailing newline or the keyword FROM:. They're automatically provided." :group 'feedmail-headers :type '(choice (const nil) string) ) (defcustom feedmail-x-mailer-line-user-appendage nil "*See feedmail-x-mailer-line." :group 'feedmail-headers :type '(choice (const nil) string) ) ;; an example of something to call from mail-setup-hook or a similar ;; place to wipe out someone else's idea of X-MAILER: (this is not ;; robust, but it works for me and probably works for you) ;; ;; (defun wjc:nuke-x-mailer () ;; "zap X-Mailer: header 'cuz I prefer mine" ;; (let ((xm)) ;; (save-excursion ;; (mail-position-on-field "X-MAILER") ;; (forward-line 0) ;;go to beginning of line ;; (setq xm (point)) ;; (forward-line 1) ;;beginning of next line ;; (delete-region xm (point)) ;; ))) ;; (defcustom feedmail-x-mailer-line t "*Control the form of an X-MAILER: header in an outgoing message. Moderately useful for debugging, keeping track of your correspondents' mailer preferences, or just wearing your MUA on your sleeve. If nil, no X-MAILER: header is produced. If t, an X-MAILER: header of a predetermined format is produced. If neither nil nor t, should be a string which is just the contents of the header, not the header itself or the trailing newline. If you want to take the default construct and just add a little blob of your own at the end, define the variable feedmail-x-mailer-line-user-appendage as that blob string. If the message already has a X-MAILER: line, it is left as-is, so if you want to use this one instead, you'll have to arrange to get rid of the other one. You should probably know that some people are fairly emotional about the presence of X-MAILER: lines in email." :group 'feedmail-headers :type '(choice (const t) (const nil) string) ) (defcustom feedmail-message-id-generator 'feedmail-default-message-id-generator "*If non-nil, should be a function which creates a MESSAGE-ID: value. It will be called with one argument, the associated filename for the message, which might be nil. The message ID should be the return value of the function. Don't include trailing newline, leading space, or the keyword MESSAGE-ID. They're automatically provided. Do include surrounding <> brackets. When called, the current buffer is the prepped outgoing mail buffer. The function may inspect it, but shouldn't modify it. If the returned value doesn't contain any non-whitespace characters, no message ID header is generated, so you could generate them conditionally, based on the contents of the mail. You should let feedmail generate a MESSAGE-ID: for you unless you are sure that whatever you give your messages to will do it for you (e.g., most configurations of sendmail). Even if the latter case is true, it probably won't hurt you to generate your own, and it will then show up in the saved message if you use FCC:." :group 'feedmail-headers :type '(choice (const nil) function) ) ;; this was suggested in various forms by several people; first was ;; Tony DeSimone in Oct 1992; sorry to be so tardy (defcustom feedmail-date-generator 'feedmail-default-date-generator "*If non-nil, should be a function which creates a DATE: value. The function must generate an RFC-822 compliant date which will be inserted on a DATE: header. The date should be the return value of the function. Don't include trailing newline, leading space, or the keyword DATE. They're automatically provided. When called, the current buffer is the prepped outgoing mail buffer. The function may inspect it, but shouldn't modify it. If the returned value doesn't contain any non-whitespace characters, no DATE: header is generated, so you could generate them conditionally, based on the contents of the mail. You should let feedmail generate a DATE: for you unless you are sure that whatever you give your messages to will do it for you (e.g., most configurations of sendmail). Even if the latter case is true, it probably won't hurt you to generate your own, and it will then show up in the saved message if you use FCC:." :group 'feedmail-headers :type '(choice (const nil) function) ) (defcustom feedmail-enable-queue nil "*If non-nil, provide for stashing outgoing messages in a queue. This is the master on/off switch for feedmail message queuing. Queuing is quite handy for laptop-based users. It's also handy if you get a lot of mail and process it more or less sequentially. For example, you might change your mind about contents of a reply based on a message you see a bit later. There is a separate queue for draft messages, intended to prevent you from accidentally sending incomplete messages. The queues are disk-based and intended for later transmission. The messages are queued in their raw state as they appear in the mail-mode buffer and can be arbitrarily edited later, before sending, by visiting the appropriate file in the queue directory (and setting the buffer to mail-mode or whatever). If you visit a file in the queue directory and try to queue it again, it will just get saved in its existing file name. You can move a message from the draft to the main queue or vice versa by pretending to send it and then selecting whichever queue directory you want at the prompt. The right thing will happen. To transmit all the messages in the queue, invoke the command feedmail-run-the-queue or feedmail-run-the-queue-no-prompts." :group 'feedmail-queue :type 'boolean ) ;; I provided a default for VMS because someone asked for it (the ;; normal default doesn't work there), but, puh-lease!, it is a user ;; definable option, so if you don't like the default, change it to ;; whatever you want. I am unable to directly test the VMS goop ;; provided here by levitte@lp.se (Richard Levitte - VMS Whacker). (defcustom feedmail-queue-directory (if (memq system-type '(axp-vms vax-vms)) (expand-file-name (concat (getenv "HOME") "[.MAIL.Q]")) (concat (getenv "HOME") "/mail/q")) "*Name of a directory where messages will be queued. Directory will be created if necessary. Should be a string that doesn't end with a slash. Default, except on VMS, is \"$HOME/mail/q\"." :group 'feedmail-queue :type 'string ) (defcustom feedmail-queue-draft-directory (if (memq system-type '(axp-vms vax-vms)) (expand-file-name (concat (getenv "HOME") "[.MAIL.DRAFT]")) (concat (getenv "HOME") "/mail/draft")) "*Name of an directory where DRAFT messages will be queued. Directory will be created if necessary. Should be a string that doesn't end with a slash. Default, except on VMS, is \"$HOME/mail/draft\"." :group 'feedmail-queue :type 'string ) (defcustom feedmail-ask-before-queue t "*If non-nil, feedmail will ask what you want to do with the message. Choices for the message action prompt will include sending it immediately, putting it in the main queue, putting it in the draft queue, or returning to the buffer to continue editing. Only matter is queuing is enabled. If nil, the message is placed in the main queue without a prompt." :group 'feedmail-queue :type 'boolean ) (defcustom feedmail-ask-before-queue-default "queue" "*Meaning if user hits return in response to the message action prompt. Should be a character or a string; if a string, only the first character is significant. Useful values are those described in the help for the message action prompt." :group 'feedmail-queue :type '(choice string integer) ;use integer to get char ) (defcustom feedmail-queue-chatty t "*If non-nil, blat a few status messages and such in the mini-buffer. If nil, just do the work and don't pester people about what's going on. In some cases, though, specific options inspire mini-buffer prompting. That's not affected by this variable setting. Also does not control reporting of error/abnormal conditions." :group 'feedmail-queue :type 'boolean ) (defcustom feedmail-queue-chatty-sit-for 1 "*Duration of pause after most queue-related messages. After some messages are divulged, it is prudent to pause before something else obliterates them. This value controls the duration of the pause." :group 'feedmail-queue :type 'integer ) (defcustom feedmail-queue-run-orderer nil "*If non-nil, name a function which will sort the queued messages. The function is called during a running of the queue for sending, and takes one argument, a list of the files in the queue directory. It may contain the names of non-message files, and it's okay to leave them in the list when reordering it; they get skipped over later. When nil, the default action processes the messages in normal sort order by queued file name, which will typically result in the order they were placed in the queue." :group 'feedmail-queue :type '(choice (const nil) function) ) (defcustom feedmail-queue-use-send-time-for-date nil "*If non-nil, use send time for the DATE: header value. This variable is used by the default date generating function, feedmail-default-date-generator. If nil, the default, the last-modified timestamp of the queue file is used to create the message DATE: header; if there is no queue file, the current time is used." :group 'feedmail-queue :type 'boolean ) (defcustom feedmail-queue-use-send-time-for-message-id nil "*If non-nil, use send time for the MESSAGE-ID: header value. This variable is used by the default MESSAGE-ID: generating function, feedmail-default-message-id-generator. If nil, the default, the last-modified timestamp of the queue file is used to create the message MESSAGE-ID: header; if there is no queue file, the current time is used." :group 'feedmail-queue :type 'boolean ) (defcustom feedmail-ask-for-queue-slug nil "*If non-nil, prompt user for part of the queue file name. The file will automatically get the FQM suffix and an embedded sequence number for uniqueness, so don't specify that. But, you are responsible for making sure the resulting filename is legit for the operating system you are using. If this variable is nil or if you just hit return in response to the prompt, feedmail queuing will take care of things properly. At the prompt, completion is available if you want to see what filenames are already in use. You probably don't want to be bothered with this prompting since feedmail by default uses queue file names based on the subjects of the messages." :group 'feedmail-queue :type 'boolean ) (defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker "*If non-nil, a function which creates part of the queued file name. The returned string should be just the non-directory filename part, without FQM suffix or uniquifying sequence numbers. The current buffer holds the raw message. The default function creates the slug based on the message subject." :group 'feedmail-queue :type '(choice (const nil) function) ) (defcustom feedmail-queue-fqm-suffix ".fqm" "*The FQM suffix used to distinguish feedmail queued message files. You probably want this to be a period followed by some letters and/or digits. The distinction is to be able to tell them from other random files that happen to be in the feedmail-queue-directory or feedmail-queue-draft-directory. By the way, FQM stands for feedmail queued message." :group 'feedmail-queue :type 'string ) (defcustom feedmail-nuke-buffer-after-queue nil "*If non-nil, silently kill the buffer after a message is queued. You might like that since a side-effect of queueing the message is that its buffer name gets changed to the filename. That means that the buffer won't be reused for the next message you compose. If you are using VM for creating messages, you probably want to leave this nil, since VM has its own options for managing the recycling of message buffers." :group 'feedmail-queue :type 'boolean ) ;; defvars to make byte-compiler happy(er) (defvar feedmail-error-buffer nil "not a user option variable") (defvar feedmail-prepped-text-buffer nil "not a user option variable") (defvar feedmail-raw-text-buffer nil "not a user option variable") (defvar feedmail-address-list nil "not a user option variable") (defun feedmail-confirm-addresses-hook-example () "An example of a feedmail-last-chance-hook. It shows the simple addresses and gets a confirmation. Use as: (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)." (save-window-excursion (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E"))) (erase-buffer) (insert (mapconcat 'identity feedmail-address-list " ")) (if (not (y-or-n-p "How do you like them apples? ")) (error "Sending...gave up in last chance hook") ))) (defcustom feedmail-last-chance-hook nil "*User's last opportunity to modify the message on its way out. It has already had all the header prepping from the standard package. The next step after running the hook will be to push the buffer into a subprocess that mails the mail. The hook might be interested in these: (1) feedmail-prepped-text-buffer contains the header and body of the message, ready to go; (2) feedmail-address-list contains a list of simplified recipients of addresses which are to be given to the subprocess (the hook may change the list); (3) feedmail-error-buffer is an empty buffer intended to soak up errors for display to the user. If the hook allows interactive activity, the user should not send more mail while in the hook since some of the internal buffers will be reused and things will get confused." :group 'feedmail-misc :type 'hook ) (defcustom feedmail-queue-runner-mode-setter '(lambda (&optional arg) (mail-mode)) "*A function to set the proper mode of a message file. Called when the message is read back out of the queue directory with a single argument, the optional argument used in the call to feedmail-run-the-queue or feedmail-run-the-queue-no-prompts. Most people want mail-mode, so the default value is an anonymous function which is just a wrapper to ignore the supplied argument when calling it, but here's your chance to have something different. Called with funcall, not call-interactively." :group 'feedmail-queue :type 'function ) (defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit "*Function to initiate sending a message file. Called for each message read back out of the queue directory with a single argument, the optional argument used in the call to feedmail-run-the-queue or feedmail-run-the-queue-no-prompts. Interactively, that argument will be the prefix argument. Most people want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's your chance to have something different. Called with funcall, not call-interactively." :group 'feedmail-queue :type 'function ) (defcustom feedmail-queue-runner-cleaner-upper '(lambda (fqm-file &optional arg) (delete-file fqm-file) (if (and arg feedmail-queue-chatty) (message "Nuked %s" fqm-file))) "*Function that will be called after a message has been sent. It's not called in the case of errors. This function is called with two arguments, the name of the message queue file for the message just sent, and the optional argument used in the call to feedmail-run-the-queue or feedmail-run-the-queue-no-prompts. Interactively, that argument will be the prefix argument. In any case, the affiliated buffer is killed elsewhere, so don't do that inside this function. Return value is ignored. The default action is an anonymous function which gets rid of the file from the queue directory. With a non-nil second argument, a brief message is give for each file deleted. You could replace this function, for example, to archive all of your sent messages someplace (though there are better ways to get that particular result)." :group 'feedmail-queue :type 'function ) (defvar feedmail-queue-runner-is-active nil "*Non-nil means we're inside the logic of the queue-running loop. That is, iterating over all messages in the queue to send them. In that case, the value is the name of the queued message file currently being processed. This can be used for differentiating customized code for different scenarios. Users shouldn't set or change this variable.") (defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail "*Function used to send the prepped buffer to a subprocess. The function's three (mandatory) arguments are: (1) the buffer containing the prepped message; (2) a buffer where errors should be directed; and (3) a list containing the addresses individually as strings. Three popular choices for this are feedmail-buffer-to-binmail, feedmail-buffer-to-smtpmail, and feedmail-buffer-to-sendmail. If you use the sendmail form, you probably want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc to nil. If you use the binmail form, check the value of feedmail-binmail-template." :group 'feedmail-misc :type 'function ) (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") "*Command template for the subprocess which will get rid of the mail. It can result in any command understandable by /bin/sh. Might not work at all in non-UNIX environments. The single '%s', if present, gets replaced by the space-separated, simplified list of addressees. Used in feedmail-buffer-to-binmail to form the shell command which will receive the contents of the prepped buffer as stdin. If you'd like your errors to come back as mail instead of immediately in a buffer, try /bin/rmail instead of /bin/mail (this can be accomplished by keeping the default nil setting of mail-interactive). You might also like to consult local mail experts for any other interesting command line possibilities." :group 'feedmail-misc :type 'string ) ;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and ;; feedmail-buffer-to-smptmail are the only things provided for values ;; for the variable feedmail-buffer-eating-function. It's pretty easy ;; to write your own, though. (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid) "Function which actually calls /bin/mail as a subprocess. Feeds the buffer to it." (set-buffer prepped) (apply 'call-process-region (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c" (format feedmail-binmail-template (mapconcat 'identity addr-listoid " ")))))) (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid) "Function which actually calls sendmail as a subprocess. Feeds the buffer to it. Probably has some flaws for RESENT-* and other complicated cases." (set-buffer prepped) (apply 'call-process-region (append (list (point-min) (point-max) (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail") nil errors-to nil "-oi" "-t") ;; Don't say "from root" if running under su. (and (equal (user-real-login-name) "root") (list "-f" (user-login-name))) ;; These mean "report errors by mail" and "deliver in background". (if (null mail-interactive) '("-oem" "-odb"))))) ;; provided by jam@austin.asc.slb.com (James A. McLaughlin); ;; simplified by WJC after more feedmail development; ;; idea (but not implementation) of copying smtpmail trace buffer to ;; feedmail error buffer from: ;; Mon 14-Oct-1996; Douglas Gray Stephens ;; modified to insert error for displaying (defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid) "Function which actually calls smtpmail-via-smtp to send buffer as e-mail." ;; I'm not sure smtpmail.el is careful about the following ;; return value, but it also uses it internally, so I will fear ;; no evil. (require 'smtpmail) (if (not (smtpmail-via-smtp addr-listoid prepped)) (progn (set-buffer errors-to) (insert "Send via smtpmail failed. Probable SMTP protocol error.\n") (insert "Look for details below or in the *Messages* buffer.\n\n") (let ((case-fold-search t) ;; don't be overconfident about the name of the trace buffer (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server)))) (mapcar '(lambda (buffy) (if (string-match tracer (buffer-name buffy)) (progn (insert "SMTP Trace from " (buffer-name buffy) "\n---------------") (insert-buffer buffy) (insert "\n\n")))) (buffer-list)))))) (defun feedmail-send-it () "A function which is a suitable value for send-mail-function. To use it, you probably want something like this in your .emacs or similar place: (setq send-mail-function 'feedmail-send-it) (autoload 'feedmail-send-it \"feedmail\")" ;; avoid matching trouble over slash vs backslash by getting canonical (if feedmail-queue-directory (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) (if feedmail-queue-draft-directory (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory))) (if (not feedmail-enable-queue) (feedmail-send-it-immediately) ;; else, queuing is enabled, should we ask about it or just do it? (if feedmail-ask-before-queue (let ((desire (feedmail-queue-send-edit-prompt))) (cond ((eq desire 'send) ;; hooks can make this take a while so clear the prompt (message "Immediate send...") (feedmail-send-it-immediately)) ((eq desire 'edit) (error "Message not queued; returning to edit")) ((eq desire 'draft) (feedmail-dump-message-to-queue feedmail-queue-draft-directory)) ((eq desire 'queue) (feedmail-dump-message-to-queue feedmail-queue-directory)) (t (error "feedmail-send-it lost its marbles")))) (feedmail-dump-message-to-queue feedmail-queue-directory)))) ;;;###autoload (defun feedmail-run-the-queue-no-prompts (&optional arg) "Like feedmail-run-the-queue, but suppress confirmation prompts." (interactive "p") (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg))) ;;;###autoload (defun feedmail-run-the-queue (&optional arg) "Visit each message in the feedmail queue directory and send it out. Return value is a list of three things: number of messages sent, number of messages skipped, and number of non-message things in the queue (commonly backup file names and the like)." (interactive "p") ;; avoid matching trouble over slash vs backslash by getting canonical (if feedmail-queue-directory (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory))) (if feedmail-queue-draft-directory (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory))) (let* ((maybe-file) (qlist (feedmail-look-at-queue-directory feedmail-queue-directory)) (message-count (nth 0 qlist)) (other-count (nth 1 qlist)) (messages-sent 0) (messages-skipped 0) (blobby-buffer) (already-buffer) (list-of-possible-fqms)) (save-window-excursion (setq list-of-possible-fqms (directory-files feedmail-queue-directory)) (if feedmail-queue-run-orderer (setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms))) (mapcar '(lambda (blobby) (setq maybe-file (expand-file-name blobby feedmail-queue-directory)) (cond ((file-directory-p maybe-file) nil) ; don't care about subdirs ((feedmail-fqm-p blobby) (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby))) (setq already-buffer (if (fboundp 'find-buffer-visiting) ; missing from XEmacs (find-buffer-visiting maybe-file) (get-file-buffer maybe-file))) (if (and already-buffer (buffer-modified-p already-buffer)) (save-window-excursion (display-buffer (set-buffer already-buffer)) (if (fboundp 'y-or-n-p-with-timeout) ;; make a guess that the user just forgot to save (if (y-or-n-p-with-timeout (format "Visiting %s; save before send? " blobby) 10 t) (save-buffer)) (if (y-or-n-p (format "Visiting %s; save before send? " blobby)) (save-buffer)) ))) (set-buffer blobby-buffer) (setq buffer-offer-save nil) (buffer-disable-undo) (insert-file-contents-literally maybe-file) (funcall feedmail-queue-runner-mode-setter arg) (condition-case nil ; don't give up the loop if user skips some (let ((feedmail-enable-queue nil) (feedmail-queue-runner-is-active maybe-file)) (funcall feedmail-queue-runner-message-sender arg) (set-buffer blobby-buffer) (if (buffer-modified-p) ; still modified, means wasn't sent (setq messages-skipped (1+ messages-skipped)) (setq messages-sent (1+ messages-sent)) (funcall feedmail-queue-runner-cleaner-upper maybe-file arg))) (error (setq messages-skipped (1+ messages-skipped)))) (kill-buffer blobby-buffer) (if feedmail-queue-chatty (progn (message "Messages: %d to go, %d sent, %d skipped (%d other files ignored)" (- message-count messages-sent messages-skipped) messages-sent messages-skipped other-count) (sit-for feedmail-queue-chatty-sit-for)))))) list-of-possible-fqms)) (if feedmail-queue-chatty (message "Messages: %d sent, %d skipped (%d other files ignored)" messages-sent messages-skipped other-count)) (list messages-sent messages-skipped other-count))) (defun feedmail-queue-send-edit-prompt () "Ask whether to queue, send immediately, or return to editing a message." ;; Some implementation ideas here came from the userlock.el code (discard-input) (save-window-excursion (let ((answer) (d-char) (d-string)) (if (stringp feedmail-ask-before-queue-default) (progn (setq d-char (string-to-char feedmail-ask-before-queue-default)) (setq d-string feedmail-ask-before-queue-default)) (setq d-string (char-to-string feedmail-ask-before-queue-default)) (setq d-char feedmail-ask-before-queue-default) ) (while (null answer) (message "Message action (q, i, d, e, ?)? [%s]: " d-string) (let ((user-sez (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0)) (downcase (read-char-exclusive))))) (if (= user-sez help-char) (feedmail-queue-send-edit-prompt-help d-string) (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) (setq user-sez d-char)) (setq answer (assoc user-sez '((?q . queue) (?d . draft) (?r . draft) (?e . edit) (?\C-g . edit) (?n . edit) (?i . send) (?s . send) (?? . help)))) (cond ((null answer) (beep) (message "Please type q, i, d, or e; or ? for help [%s]:" d-string) (sit-for 3)) ((eq (cdr answer) 'help) (feedmail-queue-send-edit-prompt-help d-string) (setq answer nil)) )))) (cdr answer) ))) (defun feedmail-queue-send-edit-prompt-help (d-string) (with-output-to-temp-buffer "*Help*" (princ "You're dispatching a message and feedmail queuing is enabled. Choices: q QUEUE for later sending (via feedmail-run-the-queue) i IMMEDIATELY send this (but not the other queued messages) d DRAFT queue in the draft directory e EDIT return to the message edit buffer (don't send or queue) Synonyms: s SEND immediately (same as \"i\") r ROUGH draft (same as \"d\") n NOPE didn't mean it (same as \"e\") y YUP do the default behavior (same as \"C-m\") The default (if you just hit return) is user-configurable and is currently \"") (princ d-string) (princ "\".") (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode))))) (defun feedmail-look-at-queue-directory (queue-directory) "Find out some things about a queue directory. Result is a list containing a count of queued messages in the directory, a count of other files in the directory, and a high water mark for prefix sequence numbers. Subdirectories are not included in the counts." (let ((message-count 0) (other-count 0) (high-water 0)) ;; iterate, counting things we find along the way in the directory (if (file-directory-p queue-directory) (mapcar '(lambda (blobby) (cond ((file-directory-p blobby) nil) ; don't care about subdirs ((feedmail-fqm-p blobby) (if (string-match "^[0-9][0-9][0-9]-" blobby) (let ((water-mark)) (setq water-mark (string-to-int (substring blobby 0 3))) (if (> water-mark high-water) (setq high-water water-mark)))) (setq message-count (1+ message-count))) (t (setq other-count (1+ other-count))) )) (directory-files queue-directory))) (list message-count other-count high-water))) (defun feedmail-queue-subject-slug-maker () "Create a name for storing the message in the queue. The name is based on the SUBJECT: header (if there is one). Special characters are mapped to mostly alphanumerics for safety." (let ((eoh-marker) (case-fold-search t) (subject "") (s-point)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (setq eoh-marker (point-marker)) (goto-char (point-min)) ;; get raw subject value (if (re-search-forward "^SUBJECT:" eoh-marker t) (progn (setq s-point (point)) (end-of-line) (setq subject (buffer-substring s-point (point))))) ;; replace all non-alphanumerics with hyphen for safety (while (string-match "[^a-z0-9-]+" subject) (setq subject (replace-match "-" nil nil subject))) ;; collapse multiple hyphens to one (while (string-match "--+" subject) (setq subject (replace-match "-" nil nil subject))) ;; for tidyness, peel off leading hyphens (if (string-match "^-*" subject) (setq subject (replace-match "" nil nil subject))) ;; for tidyness, peel off trailing hyphens (if (string-match "-*$" subject) (setq subject (replace-match "" nil nil subject))) (if (zerop (length subject)) (setq subject "no-subject")) subject )) (defun feedmail-create-queue-filename (queue-directory) (let ((slug "wjc")) (if feedmail-queue-slug-maker (save-excursion (setq slug (funcall feedmail-queue-slug-maker)))) (if feedmail-ask-for-queue-slug (setq slug (read-file-name (concat "Message filename slug [" slug "]? ") queue-directory slug nil))) (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug)) (concat (expand-file-name slug queue-directory) feedmail-queue-fqm-suffix) )) (defun feedmail-dump-message-to-queue (queue-directory) (or (file-accessible-directory-p queue-directory) ;; progn to get nil result no matter what (progn (make-directory queue-directory t) nil) (file-accessible-directory-p queue-directory) (error (concat "Message not queued; trouble with directory " queue-directory))) (let ((filename) (is-fqm) (is-in-this-dir) (previous-buffer-file-name buffer-file-name) (directory-stats)) (if buffer-file-name (progn (setq is-fqm (feedmail-fqm-p buffer-file-name)) (setq is-in-this-dir (string-equal (directory-file-name queue-directory) (directory-file-name (expand-file-name (file-name-directory buffer-file-name))))))) ;; if visiting a queued message, just save (if (and is-fqm is-in-this-dir) (setq filename buffer-file-name) (setq filename (feedmail-create-queue-filename queue-directory))) ;; make binary file on DOS/Win95/WinNT, etc (let ((buffer-file-type feedmail-force-binary-write)) (write-file filename)) ;; convenient for moving from draft to q, for example (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir)) (y-or-n-p (format "Was previously %s; delete that? " previous-buffer-file-name))) (delete-file previous-buffer-file-name)) (if feedmail-nuke-buffer-after-queue (let ((a-s-file-name buffer-auto-save-file-name)) ;; be aggressive in nuking auto-save files (and (kill-buffer (current-buffer)) delete-auto-save-files (file-exists-p a-s-file-name) (delete-file a-s-file-name)))) (if feedmail-queue-chatty (progn (message (concat "Queued in " filename)) (sit-for feedmail-queue-chatty-sit-for))) (setq directory-stats (feedmail-look-at-queue-directory queue-directory)) (if feedmail-queue-chatty (progn (message "%s messages, %s other files in %s" (nth 0 directory-stats) (nth 1 directory-stats) queue-directory) (sit-for feedmail-queue-chatty-sit-for) )))) ;; from a similar function in mail-utils.el (defun feedmail-rfc822-time-zone (time) (let* ((sec (or (car (current-time-zone time)) 0)) (absmin (/ (abs sec) 60))) (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) (defun feedmail-rfc822-date (arg-time) (let ((time (if arg-time arg-time (current-time)))) (concat (format-time-string "%a, %e %b %Y %T " time) (feedmail-rfc822-time-zone time) ))) (defun feedmail-default-date-generator (message-file-name) "Create contents for an RFC-822 compliant message DATE: header." (let ((date-time)) (if (and (not feedmail-queue-use-send-time-for-date) message-file-name) (setq date-time (nth 5 (file-attributes message-file-name)))) (feedmail-rfc822-date date-time))) (defun feedmail-default-message-id-generator (message-file-name) "*Create contents for a message MESSAGE-ID: header. Based on a date and a sort of random number for tie breaking. Also uses user-mail-address, so be sure it's set." (let ((date-time)) (if (and (not feedmail-queue-use-send-time-for-message-id) message-file-name) (setq date-time (nth 5 (file-attributes message-file-name)))) (format "<%d-%s%s-%s>" (mod (random) 10000) (format-time-string "%a%d%b%Y%H%M%S" date-time) (feedmail-rfc822-time-zone date-time) user-mail-address) )) (defun feedmail-send-it-immediately () "Handle immediate sending, including during a queue run." (let* ((feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*")) (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*")) (feedmail-raw-text-buffer (current-buffer)) (eoh-marker) (is-a-resend) (address-list)) (unwind-protect (save-excursion (set-buffer feedmail-prepped-text-buffer) (erase-buffer) ;; jam contents of user-supplied mail buffer into our scratch buffer (insert-buffer-substring feedmail-raw-text-buffer) ;; require one newline at the end. (goto-char (point-max)) (or (= (preceding-char) ?\n) (insert ?\n)) (let ((case-fold-search nil)) ;; Change header-delimiter to be what mailers expect (empty line). (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (setq eoh-marker (point-marker))) ;; mail-aliases nil = mail-abbrevs.el (if (or feedmail-force-expand-mail-aliases (and (fboundp 'expand-mail-aliases) mail-aliases)) (expand-mail-aliases (point-min) eoh-marker)) ;; make it pretty (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker)) ;; ignore any blank lines in the header (goto-char (point-min)) (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker)) (replace-match "\n")) (let ((case-fold-search t)) (goto-char (point-min)) ;; there are some RFC-822 combinations/cases missed here, ;; but probably good enough and what users expect ;; ;; use resent-* stuff only if there is at least one non-empty one (setq is-a-resend (re-search-forward ;; header name, followed by optional whitespace, followed by ;; non-whitespace, followed by anything, followed by newline; ;; the idea is empty RESENT-* headers are ignored "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)\\s-*\\S-+.*$" eoh-marker t)) (setq address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker is-a-resend)) (if (not address-list) (error "Sending...abandoned, no addressees")) ;; Find and handle any BCC fields. (if feedmail-nuke-bcc (feedmail-accume-n-nuke-header eoh-marker "^BCC:")) (if feedmail-nuke-resent-bcc (feedmail-accume-n-nuke-header eoh-marker "^RESENT-BCC:")) (goto-char (point-min)) (if (re-search-forward (if is-a-resend "^RESENT-FROM:" "^FROM:") eoh-marker t) ;; If there is a FROM: and no SENDER:, put in a SENDER: ;; if requested by user (if (and feedmail-sender-line (not (save-excursion (goto-char (point-min)) (re-search-forward (if is-a-resend "^RESENT-SENDER:" "^SENDER:") eoh-marker t)))) (progn (forward-line 1) (insert (if is-a-resend "Resent-Sender: " "Sender: ") feedmail-sender-line "\n"))) ;; no FROM: ... force one? (if feedmail-from-line (progn (goto-char (point-min)) (insert (if is-a-resend "Resent-From: " "From: ") feedmail-from-line "\n"))) ) ;; X-Mailer: emacs xx.yy.zz (via feedmail N X) user appendage (if (and feedmail-x-mailer-line (not (save-excursion (goto-char (point-min)) (re-search-forward ;; X-Resent-Mailer invented by WJC (if is-a-resend "^X-RESENT-MAILER:" "^X-MAILER:") eoh-marker t)))) (progn (goto-char (point-min)) (insert (if is-a-resend "X-Resent-Mailer: " "X-Mailer: ") (cond ((eq feedmail-x-mailer-line t) (concat (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs ")) emacs-version " (via feedmail " feedmail-patch-level (if feedmail-queue-runner-is-active " Q" " I") ") " feedmail-x-mailer-line-user-appendage) ) (t feedmail-x-mailer-line)) "\n"))) ;; don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:[ \t]*\n" eoh-marker t) (replace-match "")) ;; don't send out a blank headers of various sorts (goto-char (point-min)) (and feedmail-nuke-empty-headers ; hey, who's an empty-header? (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t) (replace-match "")))) ;; message ID generation (if feedmail-message-id-generator (let ((case-fold-search t) (msgid-part)) (goto-char (point-min)) (if (re-search-forward (if is-a-resend "^RESENT-MESSAGE-ID:.*\n" "^MESSAGE-ID:.*\n") eoh-marker t) (replace-match "")) (setq msgid-part (funcall feedmail-message-id-generator (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))) (goto-char (point-min)) (and msgid-part (string-match "[^ \t]" msgid-part) (insert (if is-a-resend "Resent-Message-ID: " "Message-ID: ") msgid-part "\n")))) ;; create DATE: header (if feedmail-date-generator (let ((case-fold-search t) (date-part)) (goto-char (point-min)) (if (re-search-forward (if is-a-resend "^RESENT-DATE:.*\n" "^DATE:.*\n") eoh-marker t) (replace-match "")) (setq date-part (funcall feedmail-date-generator (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))) (goto-char (point-min)) (and date-part (string-match "[^ \t]" date-part) (insert (if is-a-resend "Resent-Date: " "Date: ") date-part "\n")))) (save-excursion (set-buffer feedmail-error-buffer) (erase-buffer)) (run-hooks 'feedmail-last-chance-hook) (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^FCC:")) (also-file) (confirm (cond ((eq feedmail-confirm-outgoing 'immediate) (not feedmail-queue-runner-is-active)) ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active) (t feedmail-confirm-outgoing)))) (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer)) (progn (save-excursion (funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer address-list)) (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer))) (progn ; if a file but not running the queue, offer to delete it (setq also-file (expand-file-name also-file)) (if (y-or-n-p (format "Delete message file %s? " also-file)) (delete-file also-file)))) (goto-char (point-min)) ;; re-insert and handle any FCC fields. (if fcc (let ((default-buffer-file-type feedmail-force-binary-write)) (insert fcc) (mail-do-fcc eoh-marker)))) (error "Sending...abandoned") ; user bailed out of one-last-look ))) ; unwind-protect body (save-excursion) ;; unwind-protect cleanup forms (kill-buffer feedmail-prepped-text-buffer) (set-buffer feedmail-error-buffer) (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer) (progn (display-buffer feedmail-error-buffer) ;; read fast ... the meter is running (if (and feedmail-queue-runner-is-active feedmail-queue-chatty) (progn (message "Sending...failed") (ding t) (sit-for 3))) (error "Sending...failed"))) (set-buffer feedmail-raw-text-buffer)) ) ; let (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active)) (let ((q-cnt) (d-cnt)) (setq q-cnt (nth 0 (feedmail-look-at-queue-directory feedmail-queue-directory))) (setq d-cnt (nth 0 (feedmail-look-at-queue-directory feedmail-queue-draft-directory))) (if (or (> q-cnt 0) (> d-cnt 0)) (progn (message "feedmail [D: %d, Q: %d]" d-cnt q-cnt) (sit-for feedmail-queue-chatty-sit-for))))) ) (defun feedmail-accume-n-nuke-header (header-end header-regexp) "Delete headers matching a regexp and their continuation lines. There may be multiple such lines, and each may have arbitrarily many continuation lines. Return an accumulation of the deleted headers, including the intervening newlines." (let ((case-fold-search t) (dropout)) (save-excursion (goto-char (point-min)) ;; iterate over all matching lines (while (re-search-forward header-regexp header-end t) (forward-line 1) (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point)))) (delete-region (match-beginning 0) (point)) ;; get rid of any continuation lines (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (setq dropout (concat dropout (buffer-substring (match-beginning 0) (point)))) (replace-match ""))) (identity dropout)))) (defun feedmail-fill-to-cc-function (header-end) "Smart filling of address headers (don't be fooled by the name). The filling tries to avoid splitting lines except at commas. This avoids, in particular, splitting within parenthesized comments in addresses. Headers filled include FROM:, REPLY-TO:, TO:, CC:, BCC:, RESENT-TO:, RESENT-CC:, and RESENT-BCC:." (let ((case-fold-search t) (fill-prefix "\t") (fill-column feedmail-fill-to-cc-fill-column) this-line this-line-end) (save-excursion (goto-char (point-min)) ;; iterate over all TO:/CC:, etc, lines (while (re-search-forward "^\\(FROM:\\|REPLY-TO:\\|TO:\\|CC:\\|BCC:\\|RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)" header-end t) (setq this-line (match-beginning 0)) ;; replace 0 or more leading spaces with a single space (and (looking-at "[ \t]*") (replace-match " ")) (forward-line 1) ;; get any continuation lines (while (and (looking-at "[ \t]+") (< (point) header-end)) (forward-line 1)) (setq this-line-end (point-marker)) ;; The general idea is to break only on commas. Collapse ;; multiple whitespace to a single blank; change ;; all the blanks to something unprintable; change the ;; commas to blanks; fill the region; change it back. (save-excursion (goto-char this-line) (while (re-search-forward "\\s-+" (1- this-line-end) t) (replace-match " "))) (subst-char-in-region this-line this-line-end ? 2 t) ; blank->C-b (subst-char-in-region this-line this-line-end ?, ? t) ; comma->blank (fill-region-as-paragraph this-line this-line-end) (subst-char-in-region this-line this-line-end ? ?, t) ; comma<-blank (subst-char-in-region this-line this-line-end 2 ? t) ; blank<-C-b ;; look out for missing commas before continuation lines (save-excursion (goto-char this-line) (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t) (replace-match "\\1,\n\t"))) )))) (require 'mail-utils) ; pick up mail-strip-quoted-names (defun feedmail-deduce-address-list (message-buffer header-start header-end &optional is-a-resend) "Get address list with all comments and other excitement trimmed. Returns a list of strings. Duplicate addresses will have been weeded out." (let ((simple-address) (address-blob) (this-line) (addr-regexp) ; implementation modified from smtpmail.el (this-line-end)) (setq feedmail-address-list nil) (unwind-protect (save-excursion (set-buffer (get-buffer-create " *feedmail scratch*")) (erase-buffer) (insert-buffer-substring message-buffer header-start header-end) (if is-a-resend (setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)") (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)")) (goto-char (point-min)) (let ((case-fold-search t)) (while (re-search-forward addr-regexp (point-max) t) (replace-match "") (setq this-line (match-beginning 0)) (forward-line 1) ;; get any continuation lines (while (and (looking-at "^[ \t]+") (< (point) (point-max))) (forward-line 1)) (setq this-line-end (point-marker)) ;; only keep if we don't have it already (setq address-blob (mail-strip-quoted-names (buffer-substring this-line this-line-end))) (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob) (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) (setq address-blob (replace-match "" t t address-blob)) (if (not (member simple-address feedmail-address-list)) (add-to-list 'feedmail-address-list simple-address))) )) (kill-buffer nil) ;; not needed, but meets user expectations (setq feedmail-address-list (nreverse feedmail-address-list)))) (identity feedmail-address-list))) (defun feedmail-one-last-look (feedmail-prepped-text-buffer) "Offer the user one last chance to give it up." (save-excursion (save-window-excursion (switch-to-buffer feedmail-prepped-text-buffer) (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout)) (y-or-n-p-with-timeout "Send this email? " (abs feedmail-confirm-outgoing-timeout) (> feedmail-confirm-outgoing-timeout 0)) (y-or-n-p "Send this email? ")) ))) (defun feedmail-fqm-p (might-be) "Internal; does filename end with FQM suffix?" (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be)) (provide 'feedmail) ;;; feedmail.el ends here