;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
-;; Save this file as feedmail.el somewhere on your elisp
-;; loadpath; byte-compile it. Put the following lines somewhere in
-;; your ~/.emacs stuff:
+;; Save this file as feedmail.el somewhere on your elisp loadpath;
+;; byte-compile it. Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
;; (autoload 'feedmail-send-it "feedmail")
(require 'mail-utils) ; pick up mail-strip-quoted-names
-(eval-when-compile
- (require 'smtpmail)
- (require 'cl))
-
(autoload 'mail-do-fcc "sendmail")
(defgroup feedmail nil
cases. You can give a timeout for the prompt; see variable
`feedmail-confirm-outgoing-timeout'."
:group 'feedmail-misc
- :type 'boolean
- )
+ :type '(choice (const nil)
+ (const queued)
+ (const immediate)
+ (other t)))
(defcustom feedmail-display-full-frame 'queued
shuttled robotically onward."
:version "24.1"
:group 'feedmail-misc
- :type 'boolean
- )
+ :type '(choice (const nil)
+ (const queued)
+ (const immediate)
+ (other t)))
(defcustom feedmail-confirm-outgoing-timeout nil
is an option for either 'first or 'last because you might have a
delivery agent that processes the addresses backwards."
:group 'feedmail-headers
- :type 'boolean
- )
+ :type '(choice (const nil)
+ (const first)
+ (const last)))
(defcustom feedmail-fill-to-cc t
(defcustom feedmail-force-binary-write t
"If non-nil, force writing file as binary (this applies to queues and Fcc:).
On systems where there is a difference between binary and text files,
-feedmail will temporarily manipulate the value of `buffer-file-type'
+feedmail will temporarily manipulate the value of `coding-system-for-write'
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."
(feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
- (run-hooks 'feedmail-mail-send-hook))
- )
-
-
-(defvar feedmail-mail-send-hook nil
- "See documentation for `feedmail-mail-send-hook-splitter'.")
+ (run-hooks 'feedmail-mail-send-hook)))
+(defcustom feedmail-mail-send-hook nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for immediate mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
-(defvar feedmail-mail-send-hook-queued nil
- "See documentation for `feedmail-mail-send-hook-splitter'.")
-
+(defcustom feedmail-mail-send-hook-queued nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for queued mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
(defun feedmail-confirm-addresses-hook-example ()
"An example of a `feedmail-last-chance-hook'.
(erase-buffer)
(insert (mapconcat 'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
- (error "FQM: Sending...gave up in last chance hook")
- )))
-
+ (error "FQM: 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.
;; These mean "report errors by mail" and "deliver in background".
(if (null mail-interactive) '("-oem" "-odb")))))
+(declare-function smtpmail-via-smtp "smtpmail"
+ (recipient smtpmail-text-buffer &optional ask-for-password))
+(defvar smtpmail-smtp-server)
+
;; 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-say-debug ">in-> feedmail-run-the-queue-global-prompts")
(let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
-;; letf fools the byte-compiler.
-(defvar file-name-buffer-file-type-alist)
-
;;;###autoload
(defun feedmail-run-the-queue (&optional arg)
"Visit each message in the feedmail queue directory and send it out.
(setq buffer-offer-save nil)
(buffer-disable-undo blobby-buffer)
(insert-file-contents-literally maybe-file)
- (setq buffer-file-type t) ; binary
(goto-char (point-min))
;; if at least two line-endings with CRLF, translate the file
(if (looking-at ".*\r\n.*\r\n")
(while (search-forward "\r\n" nil t)
(replace-match "\n" nil t)))
-;; ;; work around text-vs-binary weirdness
-;; ;; if we don't find the normal M-H-S, try reading the file a different way
-;; (if (not (feedmail-find-eoh t))
-;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
-;; (erase-buffer)
-;; (insert-file-contents maybe-file)))
(funcall feedmail-queue-runner-mode-setter arg)
(condition-case signal-stuff ; don't give up the loop if user skips some
(let ((feedmail-enable-queue nil)
(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))
+ ;; make binary file on DOS/Windows 95/Windows NT, etc
+ (let ((coding-system-for-write
+ (if feedmail-force-binary-write
+ 'no-conversion
+ coding-system-for-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))
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
(feedmail-say-debug ">in-> feedmail-send-it-immediately")
- (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
- (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
+ (let ((feedmail-error-buffer
+ (get-buffer-create " *FQM Outgoing Email Errors*"))
+ (feedmail-prepped-text-buffer
+ (get-buffer-create " *FQM Outgoing Email Text*"))
(feedmail-raw-text-buffer (current-buffer))
(feedmail-address-list)
(eoh-marker)
(a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
(a-re-dtc "^\\(To\\|Cc\\):")
(a-re-db "^Bcc:")
- ;; to get a temporary changeable copy
+ ;; To get a temporary changeable copy.
(mail-header-separator mail-header-separator)
)
(unwind-protect
(set-buffer feedmail-error-buffer) (erase-buffer)
(set-buffer feedmail-prepped-text-buffer) (erase-buffer)
- ;; jam contents of user-supplied mail buffer into our scratch 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.
+ ;; Require one newline at the end.
(goto-char (point-max))
(or (= (preceding-char) ?\n) (insert ?\n))
(and (fboundp 'expand-mail-aliases) mail-aliases))
(expand-mail-aliases (point-min) eoh-marker))
- ;; make it pretty
+ ;; Make it pretty.
(if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
- ;; ignore any blank lines in the header
+ ;; 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))
+ (while (and (re-search-forward "\n\n\n*" eoh-marker t)
+ (< (point) eoh-marker))
(replace-match "\n"))
(let ((case-fold-search t) (addr-regexp))
(goto-char (point-min))
- ;; there are some RFC-822 combinations/cases missed here,
- ;; but probably good enough and what users expect
+ ;; 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
+ ;; Use resent-* stuff only if there is at least one non-empty one.
(setq feedmail-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
+ ;; 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))
- ;; if we say so, gather the Bcc stuff before the main course
- (if (eq feedmail-deduce-bcc-where 'first)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; the main course
- (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
- ;; handled by first or last cases, so don't get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
- ;; not handled by first or last cases, so also get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; if we say so, gather the Bcc stuff after the main course
- (if (eq feedmail-deduce-bcc-where 'last)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
- ;; not needed, but meets user expectations
+ ;; If we say so, gather the Bcc stuff before the main course.
+ (when (eq feedmail-deduce-bcc-where 'first)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ ;; The main course.
+ (setq addr-regexp
+ (if (memq feedmail-deduce-bcc-where '(first last))
+ ;; Handled by first or last cases, so don't get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtc a-re-dtc)
+ ;; Not handled by first or last cases, so also get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtcb a-re-dtcb)))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list))
+ ;; If we say so, gather the Bcc stuff after the main course.
+ (when (eq feedmail-deduce-bcc-where 'last)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ (if (not feedmail-address-list)
+ (error "FQM: Sending...abandoned, no addressees"))
+ ;; Not needed, but meets user expectations.
(setq feedmail-address-list (nreverse feedmail-address-list))
;; Find and handle any Bcc fields.
- (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
- (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
- (if (and bcc-holder (not feedmail-nuke-bcc))
- (progn (goto-char (point-min))
- (insert bcc-holder)))
- (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
- (progn (goto-char (point-min))
- (insert resent-bcc-holder)))
+ (setq bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
+ (setq resent-bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
+ (when (and bcc-holder (not feedmail-nuke-bcc))
+ (goto-char (point-min))
+ (insert bcc-holder))
+ (when (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
+ (goto-char (point-min))
+ (insert resent-bcc-holder))
(goto-char (point-min))
;; fiddle about, fiddle about, fiddle about....
(feedmail-fiddle-sender)
(feedmail-fiddle-x-mailer)
(feedmail-fiddle-message-id
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
(feedmail-fiddle-date
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
- (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
+ (feedmail-fiddle-list-of-fiddle-plexes
+ feedmail-fiddle-plex-user-list)
;; don't send out a blank headers of various sorts
;; (this loses on continued line with a blank first line)
(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)
+ (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n"
+ eoh-marker t)
(replace-match ""))))
(feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
(confirm (cond
((eq feedmail-confirm-outgoing 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-confirm-outgoing 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-confirm-outgoing)))
(fullframe (cond
((eq feedmail-display-full-frame 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-display-full-frame 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-display-full-frame))))
(if fullframe
(progn
(switch-to-buffer feedmail-prepped-text-buffer t)
(delete-other-windows)))
- (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
- (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
+ (if (or (not confirm)
+ (feedmail-one-last-look feedmail-prepped-text-buffer))
+ (let ((user-mail-address
+ (feedmail-envelope-deducer eoh-marker)))
(feedmail-say-debug "give it to buffer-eater")
(feedmail-give-it-to-buffer-eater)
(feedmail-say-debug "gave it to buffer-eater")
- (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
+ (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))
(when (or feedmail-queue-auto-file-nuke
(y-or-n-p
(format "FQM: Delete message file %s? "
also-file)))
- ;; if we delete the affiliated file, get rid
+ ;; If we delete the affiliated file, get rid
;; of the file name association and make sure we
- ;; don't annoy people with a prompt on exit
+ ;; don't annoy people with a prompt on exit.
(delete-file also-file)
(with-current-buffer feedmail-raw-text-buffer
(setq buffer-offer-save nil)
(setq buffer-file-name nil)))))
(goto-char (point-min))
- ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
- (if fcc (letf (((default-value 'buffer-file-type)
- feedmail-force-binary-write))
- (insert fcc)
- (if (not feedmail-nuke-bcc-in-fcc)
- (progn (if bcc-holder (insert bcc-holder))
- (if resent-bcc-holder (insert resent-bcc-holder))))
-
- (run-hooks 'feedmail-before-fcc-hook)
-
- (if feedmail-nuke-body-in-fcc
- (progn (goto-char eoh-marker)
- (if (natnump feedmail-nuke-body-in-fcc)
- (forward-line feedmail-nuke-body-in-fcc))
- (delete-region (point) (point-max))
- ))
- (mail-do-fcc eoh-marker)
- )))
- ;; user bailed out of one-last-look
+ ;; Re-insert and handle any Fcc fields (and, optionally,
+ ;; any Bcc).
+ (when fcc
+ (let ((coding-system-for-write
+ (if (and (memq system-type '(ms-dos windows-nt))
+ feedmail-force-binary-write)
+ 'no-conversion
+ coding-system-for-write)))
+ (unwind-protect
+ (progn
+ (insert fcc)
+ (unless feedmail-nuke-bcc-in-fcc
+ (if bcc-holder (insert bcc-holder))
+ (if resent-bcc-holder
+ (insert resent-bcc-holder)))
+
+ (run-hooks 'feedmail-before-fcc-hook)
+
+ (when feedmail-nuke-body-in-fcc
+ (goto-char eoh-marker)
+ (if (natnump feedmail-nuke-body-in-fcc)
+ (forward-line feedmail-nuke-body-in-fcc))
+ (delete-region (point) (point-max)))
+ (mail-do-fcc eoh-marker))))))
+ ;; User bailed out of one-last-look.
(if feedmail-queue-runner-is-active
(throw 'skip-me-q 'skip-me-q)
(throw 'skip-me-i 'skip-me-i))
)))) ; unwind-protect body (save-excursion)
- ;; unwind-protect cleanup forms
+ ;; 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 feedmail-queue-runner-is-active
- (progn
- (ding t)
- (feedmail-say-chatter "Sending...failed")))
- (error "FQM: Sending...failed")))
+ (display-buffer feedmail-error-buffer)
+ ;; Read fast ... the meter is running.
+ (if feedmail-queue-runner-is-active
+ (progn
+ (ding t)
+ (feedmail-say-chatter "Sending...failed")))
+ (error "FQM: Sending...failed"))
(set-buffer feedmail-raw-text-buffer))
) ; let
- (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
- (progn
- (feedmail-queue-reminder 'after-immediate)
- (sit-for feedmail-queue-chatty-sit-for)))
- )
+ (when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
+ (feedmail-queue-reminder 'after-immediate)
+ (sit-for feedmail-queue-chatty-sit-for)))
(defun feedmail-fiddle-header (name value &optional action folding)