Subject: RE: feedmail.el with queues

From: [email-masked]
Date: Thu, 3 Oct 1996 17:42:34 -0400

;;; This is feedmail.el, a replacement for parts of
;;; GNUemacs' sendmail.el (specifically, it's what handles your outgoing
;;; mail after you type C-c C-c in mail mode).
;;;
;;; feedmail.el
;;; LCD record:
;;; feedmail|Bill [email-masked]|Outbound mail handling|96-10-03|3|feedmail.el
;;;
;;; Written by Bill Carpenter <[email-masked]>
;;; 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 Oct  1996
;;; 
;;; 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.
;;;
;;; This stuff 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: headers after getting address info
;;;
;;;    --- does smart filling of TO: and CC: headers
;;;
;;;    --- processes FCC: lines and removes them
;;;
;;;    --- empty headers are removed
;;;
;;;    --- can force FROM: or SENDER: line
;;;
;;;    --- can generate a Message-ID line
;;;
;;;    --- 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)
;;;
;;;    --- you can generate an X-MAILER: message header
;;;
;;; After a few options below, you will find the function
;;; feedmail-send-it.  Everything after that function is just local
;;; stuff for this file.  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 don't recommend 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")
;;;        (autoload 'feedmail-run-the-queue "feedmail")
;;;

(defconst feedmail-patch-level "3")

(defvar feedmail-confirm-outgoing nil
  "*If non-nil, gives a y-or-n confirmation prompt after prepping,
before sending mail.")

(defvar feedmail-nuke-bcc t
  "*Non-nil means get rid of the BCC: lines from the message header
text before sending the mail.  In any case, the BCC: lines do
participate in the composed address list.  You probably want to keep
them if you're using sendmail (see feedmail-buffer-eating-function).")

(defvar feedmail-fill-to-cc t
  "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header
lines.  If nil, the lines are left as-is.  The filling is done after
mail address alias expansion.")

(defvar feedmail-fill-to-cc-fill-column default-fill-column
  "*Fill column used when wrapping mail TO: and CC: lines.")

(defvar feedmail-nuke-empty-headers t
  "*If non-nil, headers with no contents are removed from the outgoing
email.  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.")

;;; 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.

(defvar feedmail-sender-line nil
  "*If nil, no SENDER: header is forced.  If non-nil and the email
already has a FROM: header, a SENDER: header is forced with this 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, [email-masked].  Don't include a trailing
newline or the keyword SENDER:.  They're automatically provided.")

;; user-full-name suggested by [email-masked] (=Kimball Collins)
(defvar feedmail-from-line
  (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")")
  "*If non-nil and the email has no FROM: header, one will be forced
with this as its contents. A good value would be a fully-qualified
domain name form of your address.  For example, [email-masked].
(The default value of this variable is probably not very good, since
it doesn't have a domain part.)  Don't include a trailing newline or
the keyword FROM:.  They're automatically provided.")

(defvar feedmail-x-mailer-line-user-appendage nil
  "*See feedmail-x-mailer-line.")

(defvar feedmail-x-mailer-line t
  "*Controls 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.")

;;; Here's how I use the GNUS Message-ID generator for mail but not
;;; for news postings:
;;;
;;;   (setq feedmail-message-id-generator 'wjc:gnusish-message-id)
;;;   (setq gnus-your-domain "att.com")
;;;   
;;;   (defun wjc:gnusish-message-id ()
;;;     (require 'gnuspost)
;;;     (if (fboundp 'wjc:gnus-inews-message-id)
;;;   	  (wjc:gnus-inews-message-id)
;;;   	(gnus-inews-message-id)))
;;;   
;;;   (setq news-inews-hook
;;;   	  '(lambda () 
;;;   		 (defun gnus-inews-date () nil)
;;;   		 (fset 'wjc:gnus-inews-message-id (symbol-function 'gnus-inews-message-id))
;;;   		 (defun gnus-inews-message-id () nil)
;;;   		 ))
;;;   
(defvar feedmail-message-id-generator nil
  "*If non-nil, should be a function (called with no arguments) which
will generate a unique message ID which will be inserted on a
Message-ID: header.  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.  For an example of a message ID generating
function, you could look at the GNUS function gnus-inews-message-id.
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.")

(defvar feedmail-enable-queue nil
  "*If non-nil, provides for stashing outgoing messages in a
disk-based queue for later transmission.  The messages are queued in
their raw state as they appear in the mail-mode buffer and can be
arbitrarily edited 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.

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 (you might
change your mind about contents of a reply based on a message you see
a bit later).

To transmit all the messages in the queue, invoke command
feedmail-run-the-queue.")

(defvar feedmail-ask-before-queue t
  "*If non-nil and if queueing is enabled, feedmail will ask if you
want the message to be queued, sent immediately, or if you want to be
returned to the buffer to continue editing.")

(defvar 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.")

(defvar feedmail-queue-chatty-sit-for 1
  "*After some messages are divulged, it is prudent to pause before
something else obliterates them.  This value controls the duration of
the pause.")

(defvar feedmail-ask-for-queue-slug nil
  "*If non-nil, you get to specify part of the name of the file into
which the message will be stored.  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 where 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.")

(defvar feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
  "*If non-nil, a function to call to generate the file slug
for storing the message in.  The returned slug should be just the filename
part, without FQM suffix or uniquifying sequence numbers.  The
current buffer holds the raw message.  The default stuff creates the
slug based on the message subject.")

;; just some bookkeeping due to differences between Unix and MS
;; operating environments
(defvar feedmail-sep-thing (if (boundp 'directory-sep-char) (char-to-string directory-sep-char) "/"))

(defvar feedmail-queue-directory
  (concat (getenv "HOME") feedmail-sep-thing "mail" feedmail-sep-thing "q")
  "*Name of an directory where messages will be queued.  Directory will
be created if necessary.  Should be a string that doesn't end with
a slash.  Default is \"$HOME/mail/q\".")

(defvar feedmail-queue-fqm-suffix ".fqm"
  "*The FQM suffix used to distinguish queued message files from other
random files that happen to be in the feedmail-queue-directory. 
FQM stands for \"feedmail queued message\".")

(defvar feedmail-nuke-buffer-after-queue nil
  "*If non-nil, silently kill the buffer after a message has been
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.")

(defun feedmail-confirm-addresses-hook-example ()
  "An example of a last chance hook that 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 feedmail-address-buffer)
	(if (not (y-or-n-p "How do you like them apples? "))
		(error "Sending...gave up in last chance hook"))))

(defvar 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
buffers:  (1) feedmail-prepped-text-buffer contains the header and body
of the message, ready to go;  (2) feedmail-address-buffer contains the
space-separated, simplified list of addresses which is to be given to
the subprocess (the hook may change them).  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.")

(defvar feedmail-queue-runner-mode-setter 'mail-mode
  "*A function to be called to set the proper mode of a message file
read back out of the queue directory.  Most people want mail-mode, but
here's your chance to have something different.")

(defvar feedmail-queue-runner-message-sender 'mail-send-and-exit
  "*Function to call to initiate sending a message file read back out
of the queue directory.  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 call-interactively.")

(defvar feedmail-queue-runner-cleaner-upper
  '(lambda ()
	 (delete-file (buffer-file-name))
	 )
  "*Function that will be called after a message has been successfully
sent (it's not called in the case of errors).  The default action is
to get rid of the file from the queue directory.  You could replace
this, for example, to archive all of your sent messages someplace
(though there are better ways to get that particular result).  This
function is called with the message buffer as the current buffer and
the message queue file as the associated file.  In any case, the
current buffer is killed elsewhere, so don't do that inside this
function.")

(defvar feedmail-queue-runner-is-active nil
  "*Indicates whether or not we're inside the logic of the loop
iterating over all messages in the queue to send them.  This can be
used for differentiating customized code for different scenarios.
Users shouldn't set or change this variable.")

(defvar 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 string containing the space-separated list of simplified
addresses.  Two popular choices for this are 'feedmail-buffer-to-binmail
and 'feedmail-buffer-to-sendmail.  If you use the sendmail form, you
probably want to set feedmail-nuke-bcc to nil.  If you use the binmail
form, check the value of feedmail-binmail-template.")

(defvar 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.  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.")

;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail 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-mail-buffer mail-error-buffer simple-address-list)
  "Function which actually calls /bin/mail as a subprocess and feeds the buffer to it."
  (save-excursion
	(set-buffer prepped-mail-buffer)
	(apply 'call-process-region
		   (append (list (point-min) (point-max)
						 "/bin/sh" nil mail-error-buffer nil "-c"
						 (format feedmail-binmail-template simple-address-list ))))
	) ;; save-excursion
  )

(defun feedmail-buffer-to-sendmail (prepped-mail-buffer feedmail-error-buffer simple-address-list)
  "Function which actually calls sendmail as a subprocess and feeds the buffer to it."
  (save-excursion
	(set-buffer prepped-mail-buffer)
	(apply 'call-process-region
		   (append (list (point-min) (point-max)
					   (if (boundp 'sendmail-program)
						   sendmail-program
						 "/usr/lib/sendmail")
					   nil feedmail-error-buffer 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 [email-masked] (James A. McLaughlin)
(defun feedmail-buffer-to-smtpmail (prepped-mail-buffer mail-error-buffer simple-address-list)
  "Function which actually calls smtpmail-via-smtp to send buffer as e-mail."
  (let ((recipient-address-list nil))
    (save-excursion
      (set-buffer feedmail-address-buffer)
      ;; adapted from smtpmail-deduce-address-list in smtpmail.el to put the
      ;; buffer of addresses into a list for smtpmail-via-smtp
      (goto-char (point-min))
      (while (re-search-forward "\\([^ ]+\\)" (point-max) t)
        (setq recipient-address-list
              (cons (buffer-substring (match-beginning 1) (match-end 1))
                    recipient-address-list)))
      (set-buffer mail-error-buffer)
      (if (not (smtpmail-via-smtp recipient-address-list
                                  prepped-mail-buffer))
          (insert "Send failed. SMTP Protocol Error.")))))

;; feedmail-send-it is the only "public" function is this file.
;; All of the others are just little helpers.
(defun feedmail-send-it ()
  (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) (feedmail-send-it-immediately))
		   ((eq desire 'edit) (error "Message not queued; returning to edit."))
		   (t (feedmail-dump-message-to-queue))))
	  (feedmail-dump-message-to-queue))
	))

(defun feedmail-run-the-queue (arg)
  "Visit each message in the feedmail queue directory and send it out."
  (interactive "P")
  (let* ((maybe-file)
		 (qlist (feedmail-look-at-queue-directory "fake"))
		 (message-count (nth 1 qlist))
		 (other-count (nth 2 qlist))
		 (messages-sent 0)
		 (messages-skipped 0)
		 )
	(save-excursion
	  (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
		  ((string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") blobby)
		   (if feedmail-queue-chatty
			   (find-file maybe-file)
			 (find-file-noselect maybe-file))
		   (set-buffer (if (fboundp 'find-buffer-visiting)
						   (find-buffer-visiting maybe-file)
						 (get-file-buffer maybe-file)))
		   (funcall feedmail-queue-runner-mode-setter)
		   (condition-case nil  ;; don't give up the loop if user skips some
			   (let ((feedmail-enable-queue nil)
					 (feedmail-queue-runner-is-active t))
				 (funcall feedmail-queue-runner-message-sender arg)
				 (setq messages-sent (1+ messages-sent))
				 (set-buffer (if (fboundp 'find-buffer-visiting)
								 (find-buffer-visiting maybe-file)
							   (get-file-buffer maybe-file)))
				 (funcall feedmail-queue-runner-cleaner-upper)
				 )
			 (error (setq messages-skipped (1+ messages-skipped)))
			 )
		   (kill-buffer nil)
		   (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)
				 ) ;progn
			 ) ;if
		   )
		  ) ;cond
		 ) ;lambda
	   (directory-files feedmail-queue-directory)
	   ))
	(if feedmail-queue-chatty
		(message "Messages: %d sent, %d skipped (%d other files ignored)"
				 messages-sent messages-skipped other-count))
	) ;let
  )

(defun feedmail-queue-send-edit-prompt ()
  "Ask whether to queue, send immediately, or return to editing a message.
Some ideas here came from the userlock.el code."
  (discard-input)
  (save-window-excursion
	(let (answer)
      (while (null answer)
		(message "Message action (q, i, e, ?)? [q] ")
		(let ((user-sez (let
					   ((inhibit-quit t)
						(cursor-in-echo-area t)
						(echo-keystrokes 0))
					 (downcase
					  (if (fboundp 'read-char-exclusive)
						  (read-char-exclusive)
						(read-char))
					  ))))
		  (if (= user-sez help-char)
			  (feedmail-queue-send-edit-prompt-help)
			(setq answer
				  (assoc user-sez
						 '((?q . queue) (?\C-m . queue) (?\C-j . queue)
						   (?e . edit)  (?\C-g . edit)
						   (?i . send)  (?s . send)     (?? . help))))
			(cond
			 ((null answer) (beep)
			  (message "Please type q, i, or e; or ? for help")
			  (sit-for 3))
			 ((eq (cdr answer) 'help)
			  (feedmail-queue-send-edit-prompt-help) (setq answer nil))
			 ))))
	  (cdr answer)
	  )))

(defun feedmail-queue-send-edit-prompt-help ()
  (with-output-to-temp-buffer "*Help*"
    (princ "You're dispatching a message and feedmail queuing is enabled.

Choices:

   q  QUEUE the message for later sending (via feedmail-run-the-queue)
   i  IMMEDIATELY  send the message (but not the other queued messages)
   s  SEND  the message immediately (same as \"i\")
   e  EDIT, returning to the message edit buffer (don't send, don't queue)

The default is to QUEUE.")
    (save-excursion
      (set-buffer standard-output)
      (if (fboundp 'help-mode (help-mode)))
	  )))

(defun feedmail-look-at-queue-directory (in-slug)
  "Find out some things about the queue directory.
Result is a list containing the sequenced-slug, a count of queued messages
in the directory, and a count of other files in the directory.
Subdirectories are not included in the counts.

The sequenced-slug is an available queued message filename (not
including the FQM suffix).  It comes from just bumping a sequence
number in a pre-determined filename pattern based on in-slug.  It's
not guaranteed to be the highest numbered such filename."

  (and (string-match
		(concat (regexp-quote feedmail-queue-fqm-suffix) "$")
		in-slug) ;;nuke existing suffix
	   (setq in-slug  ;; replace-match for strings doesn't work in v18
			 (concat
			  (substring in-slug 0 (match-beginning 0))
			  (substring in-slug (match-end 0)))))
  (and (string-match "-+$" in-slug) ;;nuke trailing dashes (why not?)
	   (setq in-slug  ;; replace-match for strings doesn't work in v18
			 (concat
			  (substring in-slug 0 (match-beginning 0))
			  (substring in-slug (match-end 0)))))
  (while (string-match "--+" in-slug) ;;collapse multi dashes (why not?)
	(setq in-slug  ;; replace-match for strings doesn't work in v18
		  (concat
		   (substring in-slug 0 (match-beginning 0))
		   "-"
		   (substring in-slug (match-end 0)))))
  (let ((ticker 1)
		(slug-sequence nil)
		(message-count 0)
		(other-count 0)
		(maybe-file nil))
	;; iterate, counting things we find along the way in the directory
	(mapcar
	 '(lambda (blobby)
	   (setq maybe-file
			(concat
			 (directory-file-name feedmail-queue-directory)
			 feedmail-sep-thing
			 blobby))
	   (cond
		((file-directory-p maybe-file) nil) ;; don't care about subdirs
		((string-match
		  (concat (regexp-quote feedmail-queue-fqm-suffix) "$") maybe-file)
		 (setq message-count (1+ message-count)))
		(t (setq other-count (1+ other-count)))
		))
	 (directory-files feedmail-queue-directory))
	(setq maybe-file nil)
	(while (or (null maybe-file) (file-exists-p maybe-file))
	  (setq slug-sequence (format "%s-%03d" in-slug ticker))
	  (setq maybe-file
			(expand-file-name
			 (concat slug-sequence feedmail-queue-fqm-suffix)
			 feedmail-queue-directory))
	  (setq ticker (1+ ticker))
	  ) ;while
	(list slug-sequence message-count other-count)
	)
  )

(defun feedmail-queue-subject-slug-maker ()
  "*Creates a name 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 (
		(end-of-headers-marker)
		(case-fold-search t)
		(subject "")
		(cooked-subject "")
		(s-point)
		(dex 0)
		(leng)
		(this-dat)
		)
	(goto-char (point-min))
	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
	(setq end-of-headers-marker (point-marker))
	(goto-char (point-min))
	(if (re-search-forward "^subject:" end-of-headers-marker t)
		(progn
		  (setq s-point (point-marker))
		  (end-of-line)
		  (setq subject (buffer-substring s-point (point-marker)))
		  ) ;progn
	  )
	(if (string-match " *" subject)  ;; for tidyness, peel off leading spaces
		(setq subject (substring subject (match-end 0))))
	(setq leng (length subject))
	(if (or (eq leng 0) (null subject)) (progn (setq subject "no-subject") (setq leng 3)))
	;; pretty inelegant elisp, but does the job
	;; replace all non-alphanumerics with hyphen for safety
	(while (< dex leng)
	  (setq this-dat (substring subject dex (1+ dex)))
	  (if (string-match "[a-z0-9]" this-dat)
		  (setq cooked-subject (concat cooked-subject this-dat))
		(setq cooked-subject (concat cooked-subject "-")))
	  (setq dex (1+ dex)))
	cooked-subject
	))

(defun feedmail-create-queue-filename ()
  (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 "]? ")
			   (concat (directory-file-name feedmail-queue-directory) feedmail-sep-thing)
			   slug ; default-file-name
			   nil) ;read-file-name
			  ))
	(concat
	 (expand-file-name (car (feedmail-look-at-queue-directory slug))
					   feedmail-queue-directory)
	 feedmail-queue-fqm-suffix)
  ))

(defun feedmail-dump-message-to-queue ()
  (or (if (fboundp 'file-accessible-directory-p)
		  (file-accessible-directory-p feedmail-queue-directory)
		(file-directory-p feedmail-queue-directory))
	  (progn ;; to get nil result no matter what
		(if (fboundp 'make-directory)
			(make-directory feedmail-queue-directory t))
		nil) ;progn
	  (if (fboundp 'file-accessible-directory-p)
          (file-accessible-directory-p feedmail-queue-directory)
        (file-directory-p feedmail-queue-directory))
	  (error (concat "Message not queued; trouble with directory " feedmail-queue-directory)))
  (let ((filename)
		(directory-stats))
	(if (and buffer-file-name  ;; if visiting a queued message, just save
			 (string-match
			  (concat (regexp-quote feedmail-queue-fqm-suffix) "$")
			  buffer-file-name)
			 (string-equal
			  (downcase (directory-file-name feedmail-queue-directory))
			  (downcase (directory-file-name (file-name-directory buffer-file-name))))
			 )
		(setq filename buffer-file-name)
	  (setq filename (feedmail-create-queue-filename))
	)
	(write-file filename)
	(if feedmail-nuke-buffer-after-queue (kill-buffer nil))
	(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 "fake"))
	(if feedmail-queue-chatty
		(progn
		  (message "%s messages, %s other files in %s"
				   (nth 1 directory-stats)
				   (nth 2 directory-stats)
				   feedmail-queue-directory)
		  (sit-for feedmail-queue-chatty-sit-for)
		  )
	  )
	))

(defun feedmail-send-it-immediately ()
  (let* ((default-case-fold-search t)
		 (feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*"))
		 (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*"))
		 (feedmail-address-buffer (get-buffer-create " *Outgoing Email Address List*"))
		 (feedmail-raw-text-buffer (current-buffer))
		 (case-fold-search nil)
		 end-of-headers-marker)

    (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))

		;; 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")
		;; why was this backward-char here?
		;;(backward-char 1)
		(setq end-of-headers-marker (point-marker))

		(if (and (fboundp 'expand-mail-aliases) ; nil = mail-abbrevs.el
			 mail-aliases)
		    (expand-mail-aliases (point-min) end-of-headers-marker))

		;; make it pretty
		(if feedmail-fill-to-cc (feedmail-fill-to-cc-function end-of-headers-marker))
		;; ignore any blank lines in the header
		(goto-char (point-min))
		(while (and (re-search-forward "\n\n\n*" end-of-headers-marker t) (< (point) end-of-headers-marker))
		  (replace-match "\n"))
	  
		(let ((case-fold-search t))
		  (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) end-of-headers-marker)
		  (save-excursion (set-buffer feedmail-address-buffer)
						  (goto-char (point-min))
						  (if (not (re-search-forward "\\S-" (point-max) t))
							  (error "Sending...abandoned, no addressees!")))

		  ;; Find and handle any BCC fields.
		  (if feedmail-nuke-bcc (feedmail-do-bcc end-of-headers-marker))

		  ;; Find and handle any FCC fields.
		  (goto-char (point-min))
		  (if (re-search-forward "^FCC:" end-of-headers-marker t)
			  (mail-do-fcc end-of-headers-marker))

		  (goto-char (point-min))
		  (if (re-search-forward "^FROM:" end-of-headers-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 "^SENDER:" end-of-headers-marker t))))
				  (progn (forward-line 1) (insert "Sender: " feedmail-sender-line "\n")))

			;; no FROM: ... force one?
			(if feedmail-from-line
				(progn (goto-char (point-min)) (insert "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-MAILER:" end-of-headers-marker t))))
			  (progn
				(goto-char (point-min))
				(insert
				 "X-Mailer: "
				 (cond
				  ((eq feedmail-x-mailer-line t)
				   (concat
					(let ((case-fold-search t))
					  (if (string-match "emacs" emacs-version) "" "emacs ")) ;let
					emacs-version
					" (via feedmail "
					feedmail-patch-level
					(if feedmail-queue-runner-is-active " Q" " I")
					") "
					feedmail-x-mailer-line-user-appendage) ;concat
				   )
				  (t feedmail-x-mailer-line))
				 "\n") ;insert
				) ;progn
			) ;if

		  ;; don't send out a blank subject line
		  (goto-char (point-min))
		  (if (re-search-forward "^Subject:[ \t]*\n" end-of-headers-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" end-of-headers-marker t)
				 (replace-match ""))))

		;; message ID generation
		(if feedmail-message-id-generator
			(progn
			  (goto-char (point-min))
			  (if (re-search-forward "^MESSAGE-ID:[ \t]*\n" end-of-headers-marker t)
				  (replace-match ""))
			  (setq feedmail-msgid-part (funcall feedmail-message-id-generator))
			  (goto-char (point-min))
			  (and feedmail-msgid-part (string-match "[^ \t]" feedmail-msgid-part)
				  (insert "Message-ID: " feedmail-msgid-part "\n"))))

		(save-excursion (set-buffer feedmail-error-buffer) (erase-buffer))

		(run-hooks 'feedmail-last-chance-hook)

		(if (or (not feedmail-confirm-outgoing) (feedmail-one-last-look feedmail-prepped-text-buffer))
			(funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer
					 (save-excursion (set-buffer feedmail-address-buffer) (buffer-string)))
		  (error "Sending...abandoned")
		  )
		)  ;; unwind-protect body (save-excursion)

	  ;; unwind-protect cleanup forms
	  (kill-buffer feedmail-prepped-text-buffer)
	  (kill-buffer feedmail-address-buffer)
	  (set-buffer feedmail-error-buffer)
	  (if (zerop (buffer-size))
		  (kill-buffer feedmail-error-buffer)
		(progn (display-buffer feedmail-error-buffer)
			   (error "Sending...failed")))
	  (set-buffer feedmail-raw-text-buffer))
	) ;; let
  )

(defun feedmail-do-bcc (header-end)
  "Delete BCC: and their continuation lines from the header area.
There may be multiple BCC: lines, and each may have arbitrarily
many continuation lines."
  (let ((case-fold-search t))
	(save-excursion (goto-char (point-min))
	  ;; iterate over all BCC: lines
	  (while (re-search-forward "^BCC:" header-end t)
		(delete-region (match-beginning 0) (progn (forward-line 1) (point)))
		;; get rid of any continuation lines
		(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
		  (replace-match ""))
		)
	  ) ;; save-excursion
	) ;; let
  )

(defun feedmail-fill-to-cc-function (header-end)
  "Smart filling of TO: and CC: headers.  The filling tries to avoid
splitting lines except at commas.  This avoids, in particular,
splitting within parenthesized comments in addresses."
  (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: lines
	  (while (re-search-forward "^\\(TO:\\|CC:\\)" header-end t)
		(setq this-line (match-beginning 0))
		;; replace 0 or more 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))
		  (replace-match " ")
		  (forward-line 1))
		(setq this-line-end (point-marker))

		;; The general idea is to break only on commas.  Change
		;; all the blanks to something unprintable; change the
		;; commas to blanks; fill the region; change it back.
		(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")))
		)
	  ) ;; while
	) ;; save-excursion
  )

(defun feedmail-deduce-address-list (feedmail-text-buffer header-start header-end)
  "Get address list suitable for command line use on simple /bin/mail."
  (require 'mail-utils)  ;; pick up mail-strip-quoted-names
  (let
	  ((case-fold-search t)
	   (simple-address-list "")
	   this-line
	   this-line-end)
	(unwind-protect
		(save-excursion
		  (set-buffer feedmail-address-buffer) (erase-buffer)
		  (insert-buffer-substring feedmail-text-buffer header-start header-end)
		  (goto-char (point-min))
		  (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
			(replace-match "")
			(setq this-line (match-beginning 0))
			(forward-line 1)
			;; get any continuation lines
			(while (and (looking-at "^[ \t]+") (< (point) header-end))
			  (forward-line 1))
			(setq this-line-end (point-marker))
			(setq simple-address-list
				  (concat simple-address-list " "
						  (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
			)
		  (erase-buffer)
		  (insert-string simple-address-list)
		  (subst-char-in-region (point-min) (point-max) 10 ?  t)  ;; newline --> blank
		  (subst-char-in-region (point-min) (point-max) ?, ?  t)  ;; comma   --> blank
		  (subst-char-in-region (point-min) (point-max)  9 ?  t)  ;; tab     --> blank

		  (goto-char (point-min))
		  ;; tidyness in case hook is not robust when it looks at this
		  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))

		  )
	  )
	)
  )

(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)
	(y-or-n-p "Send this email? "))))

(provide 'feedmail)