From 980876fe0ce6fbf90d4148c314bdd79c62599566 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 12 Feb 2006 00:03:56 +0000 Subject: [PATCH] Synch to No Gnus 200602112225. --- contrib/ChangeLog | 4 + contrib/README | 13 +- contrib/sendmail.el | 1866 +++++++++++++++++++++++++++++++++++++++++++++++++++ contrib/smtpmail.el | 981 +++++++++++++++++++++++++++ 4 files changed, 2862 insertions(+), 2 deletions(-) create mode 100644 contrib/sendmail.el create mode 100644 contrib/smtpmail.el diff --git a/contrib/ChangeLog b/contrib/ChangeLog index 39be43c..74ed0be 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2006-02-11 Miles Bader + + * sendmail.el, smtpmail.el: New files, from Emacs tree. + 2005-12-22 TSUCHIYA Masatoshi * gnus-namazu.el (gnus-namazu-remote-groups): Accept `t' as an diff --git a/contrib/README b/contrib/README index 2c8a343..7e8a31d 100644 --- a/contrib/README +++ b/contrib/README @@ -43,6 +43,14 @@ nnir.el one-line-cookie.diff +sendmail.el +smtpmail.el + + Copies of the corresponding files from the Emacs lisp/mail/ + directory, to provide features (occasionally) needed by Gnus which + may not be provided by the versions of these files in older Emacs + distributions. + ssl.el Obsolete interface to OpenSSL. Completely replaced by @@ -72,5 +80,6 @@ vcard.el xml.el - This is used for parsing RSS feeds. Part of Emacs 21.3 and - later. + This is used for parsing RSS feeds. Part of Emacs 21.3 and later. + Note that the version of this file in the Gnus contrib/ directory is + out of date with respect to the version in the Emacs tree. diff --git a/contrib/sendmail.el b/contrib/sendmail.el new file mode 100644 index 0000000..ee512b3 --- /dev/null +++ b/contrib/sendmail.el @@ -0,0 +1,1866 @@ +;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*- + +;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000, +;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This mode provides mail-sending facilities from within Emacs. It is +;; documented in the Emacs user's manual. + +;;; Code: +(eval-when-compile + ;; Necessary to avoid recursive `require's. + (provide 'sendmail) + (require 'rmail) + (require 'mailalias)) + +(autoload 'rfc2047-encode-string "rfc2047") + +(defgroup sendmail nil + "Mail sending commands for Emacs." + :prefix "mail-" + :group 'mail) + +(defcustom mail-setup-with-from t + "Non-nil means insert `From:' field when setting up the message." + :type 'boolean + :group 'sendmail + :version "22.1") + +;;;###autoload +(defcustom mail-from-style 'angles + "Specifies how \"From:\" fields look. + +If `nil', they contain just the return address like: + king@grassland.com +If `parens', they look like: + king@grassland.com (Elvis Parsley) +If `angles', they look like: + Elvis Parsley +If `system-default', allows the mailer to insert its default From field +derived from the envelope-from address. + +In old versions of Emacs, the `system-default' setting also caused +Emacs to pass the proper email address from `user-mail-address' +to the mailer to specify the envelope-from address. But that is now +controlled by a separate variable, `mail-specify-envelope-from'." + :type '(choice (const nil) (const parens) (const angles) + (const system-default)) + :version "20.3" + :group 'sendmail) + +;;;###autoload +(defcustom mail-specify-envelope-from nil + "If non-nil, specify the envelope-from address when sending mail. +The value used to specify it is whatever is found in +the variable `mail-envelope-from', with `user-mail-address' as fallback. + +On most systems, specifying the envelope-from address is a +privileged operation. This variable affects sendmail and +smtpmail -- if you use feedmail to send mail, see instead the +variable `feedmail-deduce-envelope-from'." + :version "21.1" + :type 'boolean + :group 'sendmail) + +(defcustom mail-envelope-from nil + "If non-nil, designate the envelope-from address when sending mail. +This only has an effect if `mail-specify-envelope-from' is non-nil. +The value should be either a string, or the symbol `header' (in +which case the contents of the \"From\" header of the message +being sent is used), or nil (in which case the value of +`user-mail-address' is used)." + :version "21.1" + :type '(choice (string :tag "From-name") + (const :tag "Use From: header from message" header) + (const :tag "Use `user-mail-address'" nil)) + :group 'sendmail) + +;;;###autoload +(defcustom mail-self-blind nil + "Non-nil means insert BCC to self in messages to be sent. +This is done when the message is initialized, +so you can remove or alter the BCC field to override the default." + :type 'boolean + :group 'sendmail) + +;;;###autoload +(defcustom mail-interactive nil + "Non-nil means when sending a message wait for and display errors. +nil means let mailer mail back a message to report errors." + :type 'boolean + :group 'sendmail) + +(defcustom mail-yank-ignored-headers + (concat "^" + (regexp-opt '("via" "mail-from" "origin" "status" "remailed" + "received" "message-id" "summary-line" "to" "subject" + "in-reply-to" "return-path" "mail-reply-to" + "mail-followup-to") "\\(?:") + ":") + "Delete these headers from old message when it's inserted in a reply." + :type 'regexp + :group 'sendmail) + +;; Prevent problems with `window-system' not having the correct value +;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the +;; standard value. +;;;###autoload +(put 'send-mail-function 'standard-value + '((if (and window-system (memq system-type '(darwin windows-nt))) + 'mailclient-send-it + 'sendmail-send-it))) + +;; Useful to set in site-init.el +;;;###autoload +(defcustom send-mail-function + (if (and window-system (memq system-type '(darwin windows-nt))) + 'mailclient-send-it + 'sendmail-send-it) + "Function to call to send the current buffer as mail. +The headers should be delimited by a line which is +not a valid RFC822 header or continuation line, +that matches the variable `mail-header-separator'. +This is used by the default mail-sending commands. See also +`message-send-mail-function' for use with the Message package." + :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") + (function-item smtpmail-send-it :tag "Use SMTPmail package") + (function-item feedmail-send-it :tag "Use Feedmail package") + (function-item mailclient-send-it :tag "Use Mailclient package") + function) + :group 'sendmail) + +;;;###autoload +(defcustom mail-header-separator "--text follows this line--" + "Line used to separate headers from text in messages being composed." + :type 'string + :group 'sendmail) + +;; Set up mail-header-separator for use as a category text property. +(put 'mail-header-separator 'rear-nonsticky '(category)) +;; This was a nice idea, for preventing accidental modification of +;; the separator. But I found it also prevented or obstructed +;; certain deliberate operations, such as copying the separator line +;; up to the top to send myself a copy of an already sent outgoing message +;; and other things. So I turned it off. --rms. +;;(put 'mail-header-separator 'read-only t) + +;;;###autoload +(defcustom mail-archive-file-name nil + "Name of file to write all outgoing messages in, or nil for none. +This can be an inbox file or an Rmail file." + :type '(choice file (const nil)) + :group 'sendmail) + +;;;###autoload +(defcustom mail-default-reply-to nil + "Address to insert as default Reply-to field of outgoing messages. +If nil, it will be initialized from the REPLYTO environment variable +when you first send mail." + :type '(choice (const nil) string) + :group 'sendmail) + +;;;###autoload +(defcustom mail-alias-file nil + "If non-nil, the name of a file to use instead of `/usr/lib/aliases'. +This file defines aliases to be expanded by the mailer; this is a different +feature from that of defining aliases in `.mailrc' to be expanded in Emacs. +This variable has no effect unless your system uses sendmail as its mailer." + :type '(choice (const nil) file) + :group 'sendmail) + +;;;###autoload +(defcustom mail-personal-alias-file "~/.mailrc" + "If non-nil, the name of the user's personal mail alias file. +This file typically should be in same format as the `.mailrc' file used by +the `Mail' or `mailx' program. +This file need not actually exist." + :type '(choice (const nil) file) + :group 'sendmail) + +;;;###autoload +(defcustom mail-setup-hook nil + "Normal hook, run each time a new outgoing mail message is initialized. +The function `mail-setup' runs this hook." + :type 'hook + :options '(fortune-to-signature spook mail-abbrevs-setup) + :group 'sendmail) + +;;;###autoload +(defvar mail-aliases t + "Alist of mail address aliases, +or t meaning should be initialized from your mail aliases file. +\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file' +can specify a different file name.) +The alias definitions in the file have this form: + alias ALIAS MEANING") + +(defvar mail-alias-modtime nil + "The modification time of your mail alias file when it was last examined.") + +;;;###autoload +(defcustom mail-yank-prefix nil + "Prefix insert on lines of yanked message being replied to. +nil means use indentation." + :type '(choice (const nil) string) + :group 'sendmail) + +;;;###autoload +(defcustom mail-indentation-spaces 3 + "Number of spaces to insert at the beginning of each cited line. +Used by `mail-yank-original' via `mail-indent-citation'." + :type 'integer + :group 'sendmail) + +(defvar mail-yank-hooks nil + "Obsolete hook for modifying a citation just inserted in the mail buffer. +Each hook function can find the citation between (point) and (mark t). +And each hook function should leave point and mark around the citation +text as modified. + +This is a normal hook, misnamed for historical reasons. +It is semi-obsolete and mail agents should no longer use it.") + +;;;###autoload +(defcustom mail-citation-hook nil + "Hook for modifying a citation just inserted in the mail buffer. +Each hook function can find the citation between (point) and (mark t), +and should leave point and mark around the citation text as modified. +The hook functions can find the header of the cited message +in the variable `mail-citation-header', whether or not this is included +in the cited portion of the message. + +If this hook is entirely empty (nil), a default action is taken +instead of no action." + :type 'hook + :group 'sendmail) + +(defvar mail-citation-header nil + "While running `mail-citation-hook', this variable holds the message header. +This enables the hook functions to see the whole message header +regardless of what part of it (if any) is included in the cited text.") + +;;;###autoload +(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" + "Regular expression to match a citation prefix plus whitespace. +It should match whatever sort of citation prefixes you want to handle, +with whitespace before and after; it should also match just whitespace. +The default value matches citations like `foo-bar>' plus whitespace." + :type 'regexp + :group 'sendmail + :version "20.3") + +(defvar mail-abbrevs-loaded nil) +(defvar mail-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-\t" 'mail-complete) + (define-key map "\C-c?" 'describe-mode) + (define-key map "\C-c\C-f\C-t" 'mail-to) + (define-key map "\C-c\C-f\C-b" 'mail-bcc) + (define-key map "\C-c\C-f\C-f" 'mail-fcc) + (define-key map "\C-c\C-f\C-c" 'mail-cc) + (define-key map "\C-c\C-f\C-s" 'mail-subject) + (define-key map "\C-c\C-f\C-r" 'mail-reply-to) + (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author + (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list + (define-key map "\C-c\C-t" 'mail-text) + (define-key map "\C-c\C-y" 'mail-yank-original) + (define-key map "\C-c\C-r" 'mail-yank-region) + (define-key map [remap split-line] 'mail-split-line) + (define-key map "\C-c\C-q" 'mail-fill-yanked-message) + (define-key map "\C-c\C-w" 'mail-signature) + (define-key map "\C-c\C-v" 'mail-sent-via) + (define-key map "\C-c\C-c" 'mail-send-and-exit) + (define-key map "\C-c\C-s" 'mail-send) + (define-key map "\C-c\C-i" 'mail-attach-file) + + (define-key map [menu-bar mail] + (cons "Mail" (make-sparse-keymap "Mail"))) + + (define-key map [menu-bar mail fill] + '("Fill Citation" . mail-fill-yanked-message)) + + (define-key map [menu-bar mail yank] + '("Cite Original" . mail-yank-original)) + + (define-key map [menu-bar mail signature] + '("Insert Signature" . mail-signature)) + + (define-key map [menu-bar mail mail-sep] + '("--")) + + (define-key map [menu-bar mail cancel] + '("Cancel" . mail-dont-send)) + + (define-key map [menu-bar mail send-stay] + '("Send, Keep Editing" . mail-send)) + + (define-key map [menu-bar mail send] + '("Send Message" . mail-send-and-exit)) + + (define-key map [menu-bar headers] + (cons "Headers" (make-sparse-keymap "Move to Header"))) + + (define-key map [menu-bar headers text] + '("Text" . mail-text)) + + (define-key map [menu-bar headers expand-aliases] + '("Expand Aliases" . expand-mail-aliases)) + + (define-key map [menu-bar headers sent-via] + '("Sent Via" . mail-sent-via)) + + (define-key map [menu-bar headers mail-reply-to] + '("Mail Reply To" . mail-mail-reply-to)) + + (define-key map [menu-bar headers mail-followup-to] + '("Mail Followup To" . mail-mail-followup-to)) + + (define-key map [menu-bar headers reply-to] + '("Reply-To" . mail-reply-to)) + + (define-key map [menu-bar headers bcc] + '("Bcc" . mail-bcc)) + + (define-key map [menu-bar headers fcc] + '("Fcc" . mail-fcc)) + + (define-key map [menu-bar headers cc] + '("Cc" . mail-cc)) + + (define-key map [menu-bar headers subject] + '("Subject" . mail-subject)) + + (define-key map [menu-bar headers to] + '("To" . mail-to)) + + map)) + +(autoload 'build-mail-aliases "mailalias" + "Read mail aliases from user's personal aliases file and set `mail-aliases'." + nil) + +(autoload 'expand-mail-aliases "mailalias" + "Expand all mail aliases in suitable header fields found between BEG and END. +Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. +Optional second arg EXCLUDE may be a regular expression defining text to be +removed from alias expansions." + nil) + +;;;###autoload +(defcustom mail-signature nil + "Text inserted at end of mail buffer when a message is initialized. +If t, it means to insert the contents of the file `mail-signature-file'. +If a string, that string is inserted. + (To make a proper signature, the string should begin with \\n\\n-- \\n, + which is the standard way to delimit a signature in a message.) +Otherwise, it should be an expression; it is evaluated +and should insert whatever you want to insert." + :type '(choice (const :tag "None" nil) + (const :tag "Use `.signature' file" t) + (string :tag "String to insert") + (sexp :tag "Expression to evaluate")) + :group 'sendmail) +(put 'mail-signature 'risky-local-variable t) + +;;;###autoload +(defcustom mail-signature-file "~/.signature" + "File containing the text inserted at end of mail buffer." + :type 'file + :group 'sendmail) + +;;;###autoload +(defcustom mail-default-directory "~/" + "Directory for mail buffers. +Value of `default-directory' for mail buffers. +This directory is used for auto-save files of mail buffers." + :type '(directory :tag "Directory") + :group 'sendmail + :version "22.1") + +(defvar mail-reply-action nil) +(defvar mail-send-actions nil + "A list of actions to be performed upon successful sending of a message.") +(put 'mail-reply-action 'permanent-local t) +(put 'mail-send-actions 'permanent-local t) + +;;;###autoload +(defcustom mail-default-headers nil + "A string containing header lines, to be inserted in outgoing messages. +It is inserted before you edit the message, +so you can edit or delete these lines." + :type '(choice (const nil) string) + :group 'sendmail) + +;;;###autoload +(defcustom mail-bury-selects-summary t + "If non-nil, try to show RMAIL summary buffer after returning from mail. +The functions \\[mail-send-on-exit] or \\[mail-dont-send] select +the RMAIL summary buffer before returning, if it exists and this variable +is non-nil." + :type 'boolean + :group 'sendmail) + +;;;###autoload +(defcustom mail-send-nonascii 'mime + "Specify whether to allow sending non-ASCII characters in mail. +If t, that means do allow it. nil means don't allow it. +`query' means ask the user each time. +`mime' means add an appropriate MIME header if none already present. +The default is `mime'. +Including non-ASCII characters in a mail message can be problematical +for the recipient, who may not know how to decode them properly." + :type '(choice (const t) (const nil) (const query) (const mime)) + :group 'sendmail) + +(defcustom mail-use-dsn nil + "Ask MTA for notification of failed, delayed or successful delivery. +Note that only some MTAs (currently only recent versions of Sendmail) +support Delivery Status Notification." + :group 'sendmail + :type '(repeat (radio (const :tag "Failure" failure) + (const :tag "Delay" delay) + (const :tag "Success" success))) + :version "22.1") + +;; Note: could use /usr/ucb/mail instead of sendmail; +;; options -t, and -v if not interactive. +(defvar mail-mailer-swallows-blank-line + (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) + (file-readable-p "/etc/sendmail.cf") + (with-temp-buffer + (insert-file-contents "/etc/sendmail.cf") + (goto-char (point-min)) + (let ((case-fold-search nil)) + (re-search-forward "^OR\\>" nil t)))) + ;; According to RFC822, "The field-name must be composed of printable + ;; ASCII characters (i.e. characters that have decimal values between + ;; 33 and 126, except colon)", i.e. any chars except ctl chars, + ;; space, or colon. + '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) + "Set this non-nil if the system's mailer runs the header and body together. +\(This problem exists on Sunos 4 when sendmail is run in remote mode.) +The value should be an expression to test whether the problem will +actually occur.") + +(defvar mail-mode-syntax-table + (let ((st (make-syntax-table))) + ;; define-derived-mode will make it inherit from text-mode-syntax-table. + (modify-syntax-entry ?% ". " st) + st) + "Syntax table used while in `mail-mode'.") + +(defvar mail-font-lock-keywords + (eval-when-compile + (let* ((cite-chars "[>|}]") + (cite-prefix "[:alpha:]") + (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) + (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) + '("^\\(B?CC\\|Reply-to\\|Mail-\\(reply\\|followup\\)-to\\):" . font-lock-keyword-face) + '("^\\(Subject:\\)[ \t]*\\(.+\\)?" + (1 font-lock-comment-face) +;; (2 font-lock-type-face nil t) + ) + ;; Use EVAL to delay in case `mail-header-separator' gets changed. + '(eval . + (let ((separator (if (zerop (length mail-header-separator)) + " \\`\\' " + (regexp-quote mail-header-separator)))) + (cons (concat "^" separator "$") 'font-lock-warning-face))) + ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. + `(,cite-chars + (,(concat "\\=[ \t]*" + "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "\\(" cite-chars "[ \t]*\\)\\)+\\)" + "\\(.*\\)") + (beginning-of-line) (end-of-line) + (1 font-lock-comment-delimiter-face nil t) + (5 font-lock-comment-face nil t))) + '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$" + . font-lock-string-face)))) + "Additional expressions to highlight in Mail mode.") + + +(defun sendmail-sync-aliases () + (when mail-personal-alias-file + (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) + (or (equal mail-alias-modtime modtime) + (setq mail-alias-modtime modtime + mail-aliases t))))) + +(defun mail-setup (to subject in-reply-to cc replybuffer actions) + (or mail-default-reply-to + (setq mail-default-reply-to (getenv "REPLYTO"))) + (sendmail-sync-aliases) + (if (eq mail-aliases t) + (progn + (setq mail-aliases nil) + (when mail-personal-alias-file + (if (file-exists-p mail-personal-alias-file) + (build-mail-aliases))))) + ;; Don't leave this around from a previous message. + (kill-local-variable 'buffer-file-coding-system) + ;; This doesn't work for enable-multibyte-characters. + ;; (kill-local-variable 'enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) + (if current-input-method + (inactivate-input-method)) + (setq mail-send-actions actions) + (setq mail-reply-action replybuffer) + (goto-char (point-min)) + (if mail-setup-with-from + (mail-insert-from-field)) + (insert "To: ") + (save-excursion + (if to + ;; Here removed code to extract names from within <...> + ;; on the assumption that mail-strip-quoted-names + ;; has been called and has done so. + (let ((fill-prefix "\t") + (address-start (point))) + (insert to "\n") + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline))) + (newline)) + (if cc + (let ((fill-prefix "\t") + (address-start (progn (insert "CC: ") (point)))) + (insert cc "\n") + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline)))) + (if in-reply-to + (let ((fill-prefix "\t") + (fill-column 78) + (address-start (point))) + (insert "In-reply-to: " in-reply-to "\n") + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline)))) + (insert "Subject: " (or subject "") "\n") + (if mail-default-headers + (insert mail-default-headers)) + (if mail-default-reply-to + (insert "Reply-to: " mail-default-reply-to "\n")) + (if mail-self-blind + (insert "BCC: " user-mail-address "\n")) + (if mail-archive-file-name + (insert "FCC: " mail-archive-file-name "\n")) + (put-text-property (point) + (progn + (insert mail-header-separator "\n") + (1- (point))) + 'category 'mail-header-separator) + ;; Insert the signature. But remember the beginning of the message. + (if to (setq to (point))) + (cond ((eq mail-signature t) + (if (file-exists-p mail-signature-file) + (progn + (insert "\n\n-- \n") + (insert-file-contents mail-signature-file)))) + ((stringp mail-signature) + (insert mail-signature)) + (t + (eval mail-signature))) + (goto-char (point-max)) + (or (bolp) (newline))) + (if to (goto-char to)) + (or to subject in-reply-to + (set-buffer-modified-p nil)) + (run-hooks 'mail-setup-hook)) + +(defcustom mail-mode-hook nil + "Hook run by Mail mode." + :group 'sendmail + :type 'hook + :options '(footnote-mode)) + +(defvar mail-mode-abbrev-table text-mode-abbrev-table) +;;;###autoload +(define-derived-mode mail-mode text-mode "Mail" + "Major mode for editing mail to be sent. +Like Text Mode but with these additional commands: + +\\[mail-send] mail-send (send the message) +\\[mail-send-and-exit] mail-send-and-exit (send the message and exit) + +Here are commands that move to a header field (and create it if there isn't): + \\[mail-to] move to To: \\[mail-subject] move to Subject: + \\[mail-cc] move to CC: \\[mail-bcc] move to BCC: + \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To: + \\[mail-mail-reply-to] move to Mail-Reply-To: + \\[mail-mail-followup-to] move to Mail-Followup-To: +\\[mail-text] mail-text (move to beginning of message text). +\\[mail-signature] mail-signature (insert `mail-signature-file' file). +\\[mail-yank-original] mail-yank-original (insert current message, in Rmail). +\\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked). +\\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC). +Turning on Mail mode runs the normal hooks `text-mode-hook' and +`mail-mode-hook' (in that order)." + (make-local-variable 'mail-reply-action) + (make-local-variable 'mail-send-actions) + (setq buffer-offer-save t) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(mail-font-lock-keywords t t)) + (make-local-variable 'paragraph-separate) + (make-local-variable 'normal-auto-fill-function) + (setq normal-auto-fill-function 'mail-mode-auto-fill) + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'mail-mode-fill-paragraph) + ;; Allow using comment commands to add/remove quoting (this only does + ;; anything if mail-yank-prefix is set to a non-nil value). + (set (make-local-variable 'comment-start) mail-yank-prefix) + (if mail-yank-prefix + (set (make-local-variable 'comment-start-skip) + (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*"))) + (make-local-variable 'adaptive-fill-regexp) + (setq adaptive-fill-regexp + (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" + adaptive-fill-regexp)) + (make-local-variable 'adaptive-fill-first-line-regexp) + (setq adaptive-fill-first-line-regexp + (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|" + adaptive-fill-first-line-regexp)) + ;; `-- ' precedes the signature. `-----' appears at the start of the + ;; lines that delimit forwarded messages. + ;; Lines containing just >= 3 dashes, perhaps after whitespace, + ;; are also sometimes used and should be separators. + (setq paragraph-separate (concat (regexp-quote mail-header-separator) + "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" + "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" + "--\\( \\|-+\\)$\\|" + page-delimiter))) + + +(defun mail-header-end () + "Return the buffer location of the end of headers, as a number." + (save-restriction + (widen) + (save-excursion + (rfc822-goto-eoh) + (point)))) + +(defun mail-text-start () + "Return the buffer location of the start of text, as a number." + (save-restriction + (widen) + (save-excursion + (rfc822-goto-eoh) + (forward-line 1) + (point)))) + +(defun mail-sendmail-delimit-header () + "Set up whatever header delimiter convention sendmail will use. +Concretely: replace the first blank line in the header with the separator." + (rfc822-goto-eoh) + (insert mail-header-separator) + (point)) + +(defun mail-sendmail-undelimit-header () + "Remove header separator to put the message in correct form for sendmail. +Leave point at the start of the delimiter line." + (rfc822-goto-eoh) + (delete-region (point) (progn (end-of-line) (point)))) + +(defun mail-mode-auto-fill () + "Carry out Auto Fill for Mail mode. +If within the headers, this makes the new lines into continuation lines." + (if (< (point) (mail-header-end)) + (let ((old-line-start (save-excursion (beginning-of-line) (point)))) + (if (do-auto-fill) + (save-excursion + (beginning-of-line) + (while (not (eq (point) old-line-start)) + ;; Use insert-before-markers in case we're inserting + ;; before the saved value of point (which is common). + (insert-before-markers " ") + (forward-line -1)) + t))) + (do-auto-fill))) + +(defun mail-mode-fill-paragraph (arg) + ;; Do something special only if within the headers. + (if (< (point) (mail-header-end)) + (let (beg end fieldname) + (when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes) + (setq beg (point))) + (setq fieldname + (downcase (buffer-substring beg (1- (match-end 0)))))) + (forward-line 1) + ;; Find continuation lines and get rid of their continuation markers. + (while (looking-at "[ \t]") + (delete-horizontal-space) + (forward-line 1)) + (setq end (point-marker)) + (goto-char beg) + ;; If this field contains addresses, + ;; make sure we can fill after each address. + (if (member fieldname + '("to" "cc" "bcc" "from" "reply-to" + "mail-reply-to" "mail-followup-to" + "resent-to" "resent-cc" "resent-bcc" + "resent-from" "resent-reply-to")) + (while (search-forward "," end t) + (or (looking-at "[ \t]") + (insert " ")))) + (fill-region-as-paragraph beg end arg) + ;; Mark all lines except the first as continuations. + (goto-char beg) + (forward-line 1) + (while (< (point) end) + (insert " ") + (forward-line 1)) + (move-marker end nil) + t))) + +;; User-level commands for sending. + +(defun mail-send-and-exit (&optional arg) + "Send message like `mail-send', then, if no errors, exit from mail buffer. +Prefix arg means don't delete this window." + (interactive "P") + (mail-send) + (mail-bury arg)) + +(defun mail-dont-send (&optional arg) + "Don't send the message you have been editing. +Prefix arg means don't delete this window." + (interactive "P") + (mail-bury arg)) + +(defun mail-bury (&optional arg) + "Bury this mail buffer." + (let ((newbuf (other-buffer (current-buffer)))) + (bury-buffer (current-buffer)) + (if (and (or (window-dedicated-p (frame-selected-window)) + (cdr (assq 'mail-dedicated-frame (frame-parameters)))) + (not (null (delq (selected-frame) (visible-frame-list))))) + (progn + (if (display-multi-frame-p) + (delete-frame (selected-frame)) + ;; The previous frame is where normally they have the + ;; RMAIL buffer displayed. + (other-frame -1))) + (let (rmail-flag summary-buffer) + (and (not arg) + (not (one-window-p)) + (with-current-buffer + (window-buffer (next-window (selected-window) 'not)) + (setq rmail-flag (eq major-mode 'rmail-mode)) + (setq summary-buffer + (and mail-bury-selects-summary + (boundp 'rmail-summary-buffer) + rmail-summary-buffer + (buffer-name rmail-summary-buffer) + (not (get-buffer-window rmail-summary-buffer)) + rmail-summary-buffer)))) + (if rmail-flag + ;; If the Rmail buffer has a summary, show that. + (if summary-buffer (switch-to-buffer summary-buffer) + (delete-window)) + (switch-to-buffer newbuf)))))) + +(defcustom mail-send-hook nil + "Hook run just before sending mail with `mail-send'." + :type 'hook + :options '(flyspell-mode-off) + :group 'sendmail) + +;;;###autoload +(defcustom mail-mailing-lists nil "\ +*List of mailing list addresses the user is subscribed to. + +The variable is used to trigger insertion of the \"Mail-Followup-To\" +header when sending a message to a mailing list." + :type '(repeat string) + :group 'sendmail) + + +(defun mail-send () + "Send the message in the current buffer. +If `mail-interactive' is non-nil, wait for success indication +or error messages, and inform user. +Otherwise any failure is reported in a message back to +the user from the mailer." + (interactive) + (if (if buffer-file-name + (y-or-n-p "Send buffer contents as mail message? ") + (or (buffer-modified-p) + (y-or-n-p "Message already sent; resend? "))) + (let ((inhibit-read-only t) + (opoint (point)) + (ml (when mail-mailing-lists + ;; The surrounding regexp assumes the use of + ;; `mail-strip-quoted-names' on addresses before matching + ;; Cannot deal with full RFC 822 freedom, but that is + ;; unlikely to be problematic. + (concat "\\(?:[[:space:];,]\\|\\`\\)" + (regexp-opt mail-mailing-lists t) + "\\(?:[[:space:];,]\\|\\'\\)")))) + ;; If there are mailing lists defined + (when ml + (save-excursion + (let* ((to (mail-fetch-field "to" nil t)) + (cc (mail-fetch-field "cc" nil t)) + (new-header-values ; To: and Cc: + (mail-strip-quoted-names + (concat to (when cc (concat ", " cc)))))) + ;; If message goes to known mailing list ... + (when (string-match ml new-header-values) + ;; Add Mail-Followup-To if none yet + (unless (mail-fetch-field "mail-followup-to") + (goto-char (mail-header-end)) + (insert "Mail-Followup-To: " + (let ((l)) + (mapc + ;; remove duplicates + '(lambda (e) + (unless (member e l) + (push e l))) + (split-string new-header-values + ",[[:space:]]+" t)) + (mapconcat 'identity l ", ")) + "\n")) + ;; Add Mail-Reply-To if none yet + (unless (mail-fetch-field "mail-reply-to") + (goto-char (mail-header-end)) + (insert "Mail-Reply-To: " + (or (mail-fetch-field "reply-to") + user-mail-address) + "\n")))))) + (unless (memq mail-send-nonascii '(t mime)) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (or (= (point) (point-max)) + (if (eq mail-send-nonascii 'query) + (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ") + (error "Aborted")) + (error "Message contains non-ASCII characters")))) + ;; Complain about any invalid line. + (goto-char (point-min)) + (while (< (point) (mail-header-end)) + (unless (looking-at "[ \t]\\|.*:\\|$") + (push-mark opoint) + (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) + (forward-line 1)) + (goto-char opoint) + (run-hooks 'mail-send-hook) + (message "Sending...") + (funcall send-mail-function) + ;; Now perform actions on successful sending. + (while mail-send-actions + (condition-case nil + (apply (car (car mail-send-actions)) + (cdr (car mail-send-actions))) + (error)) + (setq mail-send-actions (cdr mail-send-actions))) + (message "Sending...done") + ;; If buffer has no file, mark it as unmodified and delete auto-save. + (if (not buffer-file-name) + (progn + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t)))))) + +(defun mail-envelope-from () + "Return the envelope mail address to use when sending mail. +This function uses `mail-envelope-from'." + (if (eq mail-envelope-from 'header) + (nth 1 (mail-extract-address-components + (mail-fetch-field "From"))) + mail-envelope-from)) + +;; This does the real work of sending a message via sendmail. +;; It is called via the variable send-mail-function. + +;;;###autoload +(defvar sendmail-coding-system nil + "*Coding system for encoding the outgoing mail. +This has higher priority than `default-buffer-file-coding-system' +and `default-sendmail-coding-system', +but lower priority than the local value of `buffer-file-coding-system'. +See also the function `select-message-coding-system'.") + +;;;###autoload +(defvar default-sendmail-coding-system 'iso-latin-1 + "Default coding system for encoding the outgoing mail. +This variable is used only when `sendmail-coding-system' is nil. + +This variable is set/changed by the command `set-language-environment'. +User should not set this variable manually, +instead use `sendmail-coding-system' to get a constant encoding +of outgoing mails regardless of the current language environment. +See also the function `select-message-coding-system'.") + +(defun mail-insert-from-field () + (let* ((login user-mail-address) + (fullname (user-full-name)) + (quote-fullname nil)) + (if (string-match "[^\0-\177]" fullname) + (setq fullname (rfc2047-encode-string fullname) + quote-fullname t)) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + quote-fullname) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (if quote-fullname + (insert "\"")) + (insert fullname) + (if quote-fullname + (insert "\"")) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n")) + ((eq mail-from-style 'system-default) + nil) + (t (error "Invalid value for `mail-from-style'"))))) + +(defun sendmail-send-it () + "Send the current mail buffer using the Sendmail package. +This is a suitable value for `send-mail-function'. It sends using the +external program defined by `sendmail-program'." + (require 'mail-utils) + (let ((errbuf (if mail-interactive + (generate-new-buffer " sendmail errors") + 0)) + (tembuf (generate-new-buffer " sendmail temp")) + (multibyte enable-multibyte-characters) + (case-fold-search nil) + (selected-coding (select-message-coding-system)) + resend-to-addresses + delimline + fcc-was-found + (mailbuf (current-buffer)) + (program (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail")) + ;; Examine these variables now, so that + ;; local binding in the mail buffer will take effect. + (envelope-from + (and mail-specify-envelope-from + (or (mail-envelope-from) user-mail-address)))) + (unwind-protect + (with-current-buffer tembuf + (erase-buffer) + (unless multibyte + (set-buffer-multibyte nil)) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (mail-header-end)) + (delete-region (point) (progn (end-of-line) (point))) + (setq delimline (point-marker)) + (sendmail-sync-aliases) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; Ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (goto-char (point-min)) + ;; Look for Resent- headers. They require sending + ;; the message specially. + (let ((case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t) + ;; Put a list of such addresses in resend-to-addresses. + (setq resend-to-addresses + (save-restriction + (narrow-to-region (point) + (save-excursion + (forward-line 1) + (while (looking-at "^[ \t]") + (forward-line 1)) + (point))) + (append (mail-parse-comma-list) + resend-to-addresses))) + ;; Delete Resent-BCC ourselves + (if (save-excursion (beginning-of-line) + (looking-at "resent-bcc")) + (delete-region (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (1+ (point)))))) +;;; Apparently this causes a duplicate Sender. +;;; ;; If the From is different than current user, insert Sender. +;;; (goto-char (point-min)) +;;; (and (re-search-forward "^From:" delimline t) +;;; (progn +;;; (require 'mail-utils) +;;; (not (string-equal +;;; (mail-strip-quoted-names +;;; (save-restriction +;;; (narrow-to-region (point-min) delimline) +;;; (mail-fetch-field "From"))) +;;; (user-login-name)))) +;;; (progn +;;; (forward-line 1) +;;; (insert "Sender: " (user-login-name) "\n"))) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) + (replace-match "") + ;; This one matches a Subject just before the header delimiter. + (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t) + (= (match-end 0) delimline)) + (replace-match ""))) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (mail-insert-from-field)) + ;; Possibly add a MIME header for the current coding system + (let (charset) + (goto-char (point-min)) + (and (eq mail-send-nonascii 'mime) + (not (re-search-forward "^MIME-version:" delimline t)) + (progn (skip-chars-forward "\0-\177") + (/= (point) (point-max))) + selected-coding + (setq charset + (coding-system-get selected-coding 'mime-charset)) + (goto-char delimline) + (insert "MIME-version: 1.0\n" + "Content-type: text/plain; charset=" + (symbol-name charset) + "\nContent-Transfer-Encoding: 8bit\n"))) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (progn + (setq fcc-was-found t) + (mail-do-fcc delimline))) + (if mail-interactive + (with-current-buffer errbuf + (erase-buffer)))) + (goto-char (point-min)) + (if (let ((case-fold-search t)) + (or resend-to-addresses + (re-search-forward "^To:\\|^cc:\\|^bcc:" + delimline t))) + (let* ((default-directory "/") + (coding-system-for-write selected-coding) + (args + (append (list (point-min) (point-max) + program + nil errbuf nil "-oi") + (and envelope-from + (list "-f" envelope-from)) +;;; ;; Don't say "from root" if running under su. +;;; (and (equal (user-real-login-name) "root") +;;; (list "-f" (user-login-name))) + (and mail-alias-file + (list (concat "-oA" mail-alias-file))) + (if mail-interactive + ;; These mean "report errors to terminal" + ;; and "deliver interactively" + '("-oep" "-odi") + ;; These mean "report errors by mail" + ;; and "deliver in background". + '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (or resend-to-addresses + '("-t") + ) + (if mail-use-dsn + (list "-N" (mapconcat 'symbol-name + mail-use-dsn ","))) + ) + ) + (exit-value (apply 'call-process-region args))) + (or (null exit-value) (eq 0 exit-value) + (error "Sending...failed with exit value %d" exit-value))) + (or fcc-was-found + (error "No recipients"))) + (if mail-interactive + (with-current-buffer errbuf + (goto-char (point-min)) + (while (re-search-forward "\n\n* *" nil t) + (replace-match "; ")) + (if (not (zerop (buffer-size))) + (error "Sending...failed to %s" + (buffer-substring (point-min) (point-max))))))) + (kill-buffer tembuf) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + +(defun mail-do-fcc (header-end) + (unless (markerp header-end) + (error "Value of `header-end' must be a marker")) + (let (fcc-list + (rmailbuf (current-buffer)) + (time (current-time)) + (tembuf (generate-new-buffer " rmail output")) + (case-fold-search t)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^FCC:[ \t]*" header-end t) + (push (buffer-substring (point) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point))) + fcc-list) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + (set-buffer tembuf) + (erase-buffer) + ;; This initial newline is written out if the fcc file already exists. + (insert "\nFrom " (user-login-name) " " + (current-time-string time) "\n") + ;; Insert the time zone before the year. + (forward-char -1) + (forward-word -1) + (require 'mail-utils) + (insert (mail-rfc822-time-zone time) " ") + (goto-char (point-max)) + (insert-buffer-substring rmailbuf) + ;; Make sure messages are separated. + (goto-char (point-max)) + (insert ?\n) + (goto-char 2) + ;; ``Quote'' "^From " as ">From " + ;; (note that this isn't really quoting, as there is no requirement + ;; that "^[>]+From " be quoted in the same transparent way.) + (let ((case-fold-search nil)) + (while (search-forward "\nFrom " nil t) + (forward-char -5) + (insert ?>))) + (dolist (fcc fcc-list) + (let* ((buffer (find-buffer-visiting fcc)) + (curbuf (current-buffer)) + dont-write-the-file + buffer-matches-file + (beg (point-min)) (end (point-max)) + (beg2 (save-excursion (goto-char (point-min)) + (forward-line 2) (point)))) + (if buffer + ;; File is present in a buffer => append to that buffer. + (with-current-buffer buffer + (setq buffer-matches-file + (and (not (buffer-modified-p)) + (verify-visited-file-modtime buffer))) + ;; Keep the end of the accessible portion at the same place + ;; unless it is the end of the buffer. + (let ((max (if (/= (1+ (buffer-size)) (point-max)) + (point-max)))) + (unwind-protect + ;; Code below lifted from rmailout.el + ;; function rmail-output-to-rmail-file: + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + rmail-current-message))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + (if msg + (progn + ;; Append to an ordinary buffer as a + ;; Unix mail message. + (rmail-maybe-set-message-counters) + (widen) + (narrow-to-region (point-max) (point-max)) + (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" + "Date: " (mail-rfc822-date) "\n") + (insert-buffer-substring curbuf beg2 end) + (insert "\n\C-_") + (goto-char (point-min)) + (widen) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max)) + (rmail-count-new-messages t) + (rmail-show-message msg) + (setq max nil)) + ;; Output file not in rmail mode + ;; => just insert at the end. + (narrow-to-region (point-min) (1+ (buffer-size))) + (goto-char (point-max)) + (insert-buffer-substring curbuf beg end)) + (or buffer-matches-file + (progn + (if (y-or-n-p (format "Save file %s? " + fcc)) + (save-buffer)) + (setq dont-write-the-file t)))) + (if max (narrow-to-region (point-min) max)))))) + ;; Append to the file directly, + ;; unless we've already taken care of it. + (unless dont-write-the-file + (if (and (file-exists-p fcc) + ;; Check that the file isn't empty. We don't + ;; want to insert a newline at the start of an + ;; empty file. + (not (zerop (nth 7 (file-attributes fcc)))) + (mail-file-babyl-p fcc)) + ;; If the file is a Babyl file, + ;; convert the message to Babyl format. + (let ((coding-system-for-write + (or rmail-file-coding-system + 'emacs-mule))) + (with-current-buffer (get-buffer-create " mail-temp") + (setq buffer-read-only nil) + (erase-buffer) + (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " + (mail-rfc822-date) "\n") + (insert-buffer-substring curbuf beg2 end) + (insert "\n\C-_") + (write-region (point-min) (point-max) fcc t) + (erase-buffer))) + (write-region + (1+ (point-min)) (point-max) fcc t))) + (and buffer (not dont-write-the-file) + (with-current-buffer buffer + (set-visited-file-modtime)))))) + (kill-buffer tembuf))) + +(defun mail-sent-via () + "Make a Sent-via header line from each To or CC header line." + (interactive) + (save-excursion + ;; put a marker at the end of the header + (let ((end (copy-marker (mail-header-end))) + (case-fold-search t)) + (goto-char (point-min)) + ;; search for the To: lines and make Sent-via: lines from them + ;; search for the next To: line + (while (re-search-forward "^\\(to\\|cc\\):" end t) + ;; Grab this line plus all its continuations, sans the `to:'. + (let ((to-line + (buffer-substring (point) + (progn + (if (re-search-forward "^[^ \t\n]" end t) + (backward-char 1) + (goto-char end)) + (point))))) + ;; Insert a copy, with altered header field name. + (insert-before-markers "Sent-via:" to-line)))))) + +(defun mail-to () + "Move point to end of To-field." + (interactive) + (expand-abbrev) + (mail-position-on-field "To")) + +(defun mail-subject () + "Move point to end of Subject-field." + (interactive) + (expand-abbrev) + (mail-position-on-field "Subject")) + +(defun mail-cc () + "Move point to end of CC-field. Create a CC field if none." + (interactive) + (expand-abbrev) + (or (mail-position-on-field "cc" t) + (progn (mail-position-on-field "to") + (insert "\nCC: ")))) + +(defun mail-bcc () + "Move point to end of BCC-field. Create a BCC field if none." + (interactive) + (expand-abbrev) + (or (mail-position-on-field "bcc" t) + (progn (mail-position-on-field "to") + (insert "\nBCC: ")))) + +(defun mail-fcc (folder) + "Add a new FCC field, with file name completion." + (interactive "FFolder carbon copy: ") + (expand-abbrev) + (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. + (mail-position-on-field "to")) + (insert "\nFCC: " folder)) + +(defun mail-reply-to () + "Move point to end of Reply-To-field. Create a Reply-To field if none." + (interactive) + (expand-abbrev) + (mail-position-on-field "Reply-To")) + +(defun mail-mail-reply-to () + "Move point to end of Mail-Reply-To field. +Create a Mail-Reply-To field if none." + (interactive) + (expand-abbrev) + (or (mail-position-on-field "mail-reply-to" t) + (progn (mail-position-on-field "to") + (insert "\nMail-Reply-To: ")))) + +(defun mail-mail-followup-to () + "Move point to end of Mail-Followup-To field. +Create a Mail-Followup-To field if none." + (interactive) + (expand-abbrev) + (or (mail-position-on-field "mail-followup-to" t) + (progn (mail-position-on-field "to") + (insert "\nMail-Followup-To: ")))) + +(defun mail-position-on-field (field &optional soft) + (let (end + (case-fold-search t)) + (setq end (mail-header-end)) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) + (progn + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line) + (skip-chars-backward "\n") + t) + (or soft + (progn (goto-char end) + (insert field ": \n") + (skip-chars-backward "\n"))) + nil))) + +(defun mail-text () + "Move point to beginning of message text." + (interactive) + (expand-abbrev) + (goto-char (mail-text-start))) + +(defun mail-signature (&optional atpoint) + "Sign letter with signature based on `mail-signature-file'. +Prefix arg means put contents at point." + (interactive "P") + (save-excursion + (or atpoint + (goto-char (point-max))) + (skip-chars-backward " \t\n") + (end-of-line) + (or atpoint + (delete-region (point) (point-max))) + (if (stringp mail-signature) + (insert mail-signature) + (insert "\n\n-- \n") + (insert-file-contents (expand-file-name mail-signature-file))))) + +(defun mail-fill-yanked-message (&optional justifyp) + "Fill the paragraphs of a message yanked into this one. +Numeric argument means justify as well." + (interactive "P") + (save-excursion + (goto-char (mail-text-start)) + (fill-individual-paragraphs (point) + (point-max) + justifyp + mail-citation-prefix-regexp))) + +(defun mail-indent-citation () + "Modify text just inserted from a message to be cited. +The inserted text should be the region. +When this function returns, the region is again around the modified text. + +Normally, indent each nonblank line `mail-indentation-spaces' spaces. +However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." + (mail-yank-clear-headers (region-beginning) (region-end)) + (if (null mail-yank-prefix) + (indent-rigidly (region-beginning) (region-end) + mail-indentation-spaces) + (save-excursion + (let ((end (set-marker (make-marker) (region-end)))) + (goto-char (region-beginning)) + (while (< (point) end) + (insert mail-yank-prefix) + (forward-line 1)))))) + +(defun mail-yank-original (arg) + "Insert the message being replied to, if any (in rmail). +Puts point after the text and mark before. +Normally, indents each nonblank line ARG spaces (default 3). +However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. + +Just \\[universal-argument] as argument means don't indent, insert no prefix, +and don't delete any header fields." + (interactive "P") + (if mail-reply-action + (let ((start (point)) + (original mail-reply-action)) + (and (consp original) (eq (car original) 'insert-buffer) + (setq original (nth 1 original))) + (if (consp original) + (apply (car original) (cdr original)) + ;; If the original message is in another window in the same frame, + ;; delete that window to save screen space. + ;; t means don't alter other frames. + (delete-windows-on original t) + (with-no-warnings + ;; We really want this to set mark. + (insert-buffer original)) + (set-text-properties (point) (mark t) nil)) + (if (consp arg) + nil + (goto-char start) + (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) + mail-indentation-spaces)) + ;; Avoid error in Transient Mark mode + ;; on account of mark's being inactive. + (mark-even-if-inactive t)) + (cond (mail-citation-hook + ;; Bind mail-citation-header to the inserted + ;; message's header. + (let ((mail-citation-header + (buffer-substring-no-properties + start + (save-excursion + (save-restriction + (narrow-to-region start (point-max)) + (goto-char start) + (rfc822-goto-eoh) + (point)))))) + (run-hooks 'mail-citation-hook))) + (mail-yank-hooks + (run-hooks 'mail-yank-hooks)) + (t + (mail-indent-citation))))) + ;; This is like exchange-point-and-mark, but doesn't activate the mark. + ;; It is cleaner to avoid activation, even though the command + ;; loop would deactivate the mark because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))) + (if (not (eolp)) (insert ?\n))))) + +(defun mail-yank-clear-headers (start end) + (if (< end start) + (let (temp) + (setq temp start start end end temp))) + (if mail-yank-ignored-headers + (save-excursion + (goto-char start) + (if (search-forward "\n\n" end t) + (save-restriction + (narrow-to-region start (point)) + (goto-char start) + (while (let ((case-fold-search t)) + (re-search-forward mail-yank-ignored-headers nil t)) + (beginning-of-line) + (delete-region (point) + (progn (re-search-forward "\n[^ \t]") + (forward-char -1) + (point))))))))) + +(defun mail-yank-region (arg) + "Insert the selected region from the message being replied to. +Puts point after the text and mark before. +Normally, indents each nonblank line ARG spaces (default 3). +However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. + +Just \\[universal-argument] as argument means don't indent, insert no prefix, +and don't delete any header fields." + (interactive "P") + (and (consp mail-reply-action) + (eq (car mail-reply-action) 'insert-buffer) + (with-current-buffer (nth 1 mail-reply-action) + (or (mark t) + (error "No mark set: %S" (current-buffer)))) + (let ((buffer (nth 1 mail-reply-action)) + (start (point)) + ;; Avoid error in Transient Mark mode + ;; on account of mark's being inactive. + (mark-even-if-inactive t)) + ;; Insert the citation text. + (insert (with-current-buffer buffer + (buffer-substring-no-properties (point) (mark)))) + (push-mark start) + ;; Indent or otherwise annotate the citation text. + (if (consp arg) + nil + (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) + mail-indentation-spaces))) + (if mail-citation-hook + ;; Bind mail-citation-hook to the original message's header. + (let ((mail-citation-header + (with-current-buffer buffer + (buffer-substring-no-properties + (point-min) + (save-excursion + (goto-char (point-min)) + (rfc822-goto-eoh) + (point)))))) + (run-hooks 'mail-citation-hook)) + (if mail-yank-hooks + (run-hooks 'mail-yank-hooks) + (mail-indent-citation)))))))) + +(defun mail-split-line () + "Split current line, moving portion beyond point vertically down. +If the current line has `mail-yank-prefix', insert it on the new line." + (interactive "*") + (split-line mail-yank-prefix)) + + +(defun mail-attach-file (&optional file) + "Insert a file at the end of the buffer, with separator lines around it." + (interactive "fAttach file: ") + (save-excursion + (goto-char (point-max)) + (or (bolp) (newline)) + (newline) + (let ((start (point)) + middle) + (insert (format "===File %s===" file)) + (insert-char ?= (max 0 (- 60 (current-column)))) + (newline) + (setq middle (point)) + (insert "============================================================\n") + (push-mark) + (goto-char middle) + (insert-file-contents file) + (or (bolp) (newline)) + (goto-char start)))) + +;; Put these commands last, to reduce chance of lossage from quitting +;; in middle of loading the file. + +;;;###autoload (add-hook 'same-window-buffer-names "*mail*") + +;;;###autoload +(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) + "Edit a message to be sent. Prefix arg means resume editing (don't erase). +When this function returns, the buffer `*mail*' is selected. +The value is t if the message was newly initialized; otherwise, nil. + +Optionally, the signature file `mail-signature-file' can be inserted at the +end; see the variable `mail-signature'. + +\\ +While editing message, type \\[mail-send-and-exit] to send the message and exit. + +Various special commands starting with C-c are available in sendmail mode +to move to message header fields: +\\{mail-mode-map} + +If `mail-self-blind' is non-nil, a BCC to yourself is inserted +when the message is initialized. + +If `mail-default-reply-to' is non-nil, it should be an address (a string); +a Reply-to: field with that address is inserted. + +If `mail-archive-file-name' is non-nil, an FCC field with that file name +is inserted. + +The normal hook `mail-setup-hook' is run after the message is +initialized. It can add more default fields to the message. + +The first argument, NOERASE, determines what to do when there is +an existing modified `*mail*' buffer. If NOERASE is nil, the +existing mail buffer is used, and the user is prompted whether to +keep the old contents or to erase them. If NOERASE has the value +`new', a new mail buffer will be created instead of using the old +one. Any other non-nil value means to always select the old +buffer without erasing the contents. + +The second through fifth arguments, + TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil + the initial contents of those header fields. + These arguments should not have final newlines. +The sixth argument REPLYBUFFER is a buffer which contains an + original message being replied to, or else an action + of the form (FUNCTION . ARGS) which says how to insert the original. + Or it can be nil, if not replying to anything. +The seventh argument ACTIONS is a list of actions to take + if/when the message is sent. Each action looks like (FUNCTION . ARGS); + when the message is sent, we apply FUNCTION to ARGS. + This is how Rmail arranges to mark messages `answered'." + (interactive "P") +;;; This is commented out because I found it was confusing in practice. +;;; It is easy enough to rename *mail* by hand with rename-buffer +;;; if you want to have multiple mail buffers. +;;; And then you can control which messages to save. --rms. +;;; (let ((index 1) +;;; buffer) +;;; ;; If requested, look for a mail buffer that is modified and go to it. +;;; (if noerase +;;; (progn +;;; (while (and (setq buffer +;;; (get-buffer (if (= 1 index) "*mail*" +;;; (format "*mail*<%d>" index)))) +;;; (not (buffer-modified-p buffer))) +;;; (setq index (1+ index))) +;;; (if buffer (switch-to-buffer buffer) +;;; ;; If none exists, start a new message. +;;; ;; This will never re-use an existing unmodified mail buffer +;;; ;; (since index is not 1 anymore). Perhaps it should. +;;; (setq noerase nil)))) +;;; ;; Unless we found a modified message and are happy, start a new message. +;;; (if (not noerase) +;;; (progn +;;; ;; Look for existing unmodified mail buffer. +;;; (while (and (setq buffer +;;; (get-buffer (if (= 1 index) "*mail*" +;;; (format "*mail*<%d>" index)))) +;;; (buffer-modified-p buffer)) +;;; (setq index (1+ index))) +;;; ;; If none, make a new one. +;;; (or buffer +;;; (setq buffer (generate-new-buffer "*mail*"))) +;;; ;; Go there and initialize it. +;;; (switch-to-buffer buffer) +;;; (erase-buffer) +;;; (setq default-directory (expand-file-name "~/")) +;;; (auto-save-mode auto-save-default) +;;; (mail-mode) +;;; (mail-setup to subject in-reply-to cc replybuffer actions) +;;; (if (and buffer-auto-save-file-name +;;; (file-exists-p buffer-auto-save-file-name)) +;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) +;;; t)) + + (if (eq noerase 'new) + (pop-to-buffer (generate-new-buffer "*mail*")) + (and noerase + (not (get-buffer "*mail*")) + (setq noerase nil)) + (pop-to-buffer "*mail*")) + + ;; Avoid danger that the auto-save file can't be written. + (let ((dir (expand-file-name + (file-name-as-directory mail-default-directory)))) + (if (file-exists-p dir) + (setq default-directory dir))) + ;; Only call auto-save-mode if necessary, to avoid changing auto-save file. + (if (or (and auto-save-default (not buffer-auto-save-file-name)) + (and (not auto-save-default) buffer-auto-save-file-name)) + (auto-save-mode auto-save-default)) + (mail-mode) + ;; Disconnect the buffer from its visited file + ;; (in case the user has actually visited a file *mail*). +;;; (set-visited-file-name nil) + (let (initialized) + (and (not (and noerase + (not (eq noerase 'new)))) + (if buffer-file-name + (if (buffer-modified-p) + (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") + (if (y-or-n-p "Disconnect buffer from visited file? ") + (set-visited-file-name nil)) + t) + (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ") + (set-visited-file-name nil) + t)) + ;; A non-file-visiting buffer. + (if (buffer-modified-p) + (y-or-n-p "Unsent message being composed; erase it? ") + t)) + (let ((inhibit-read-only t)) + (erase-buffer) + (mail-setup to subject in-reply-to cc replybuffer actions) + (setq initialized t))) + (if (and buffer-auto-save-file-name + (file-exists-p buffer-auto-save-file-name)) + (message "Auto save file for draft message exists; consider M-x mail-recover")) + initialized)) + +(defun mail-recover-1 () + "Pop up a list of auto-saved draft messages so you can recover one of them." + (interactive) + (let ((file-name (make-auto-save-file-name)) + (ls-lisp-support-shell-wildcards t) + non-random-len wildcard) + ;; Remove the random part from the auto-save-file-name, and + ;; create a wildcard which matches possible candidates. + ;; Note: this knows that make-auto-save-file-name appends + ;; "##" to the buffer name, where RANDOM-STUFF + ;; is the result of (make-temp-name ""). + (setq non-random-len + (- (length file-name) (length (make-temp-name "")) 1)) + (setq wildcard (concat (substring file-name 0 non-random-len) "*")) + (if (null (file-expand-wildcards wildcard)) + (message "There are no auto-saved drafts to recover") + ;; Bind dired-trivial-filenames to t because all auto-save file + ;; names are normally ``trivial'', so Dired will set point after + ;; all the files, at buffer bottom. We want it on the first + ;; file instead. + (let ((dired-trivial-filenames t)) + (dired-other-window wildcard (concat dired-listing-switches "t"))) + (rename-buffer "*Auto-saved Drafts*" t) + (save-excursion + (goto-char (point-min)) + (or (looking-at " Move to the draft file you want to recover,") + (let ((inhibit-read-only t)) + ;; Each line starts with a space so that Font Lock mode + ;; won't highlight the first character. + (insert "\ + Move to the draft file you want to recover, then type C-c C-c + to recover text of message whose composition was interrupted. + To browse text of a draft, type v on the draft file's line. + + You can also delete some of these files; + type d on a line to mark that file for deletion. + + List of possible auto-save files for recovery: + +")))) + (use-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (current-local-map)) + map)) + (define-key (current-local-map) "v" + (lambda () + (interactive) + (let ((coding-system-for-read 'emacs-mule-unix)) + (dired-view-file)))) + (define-key (current-local-map) "\C-c\C-c" + (lambda () + (interactive) + (let ((fname (dired-get-filename)) + ;; Auto-saved files are written in the internal + ;; representation, so they should be read accordingly. + (coding-system-for-read 'emacs-mule-unix)) + (switch-to-buffer-other-window "*mail*") + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-file-contents fname nil) + ;; insert-file-contents will set buffer-file-coding-system + ;; to emacs-mule, which is probably not what they want to + ;; use for sending the message. But we don't know what + ;; was its value before the buffer was killed or Emacs + ;; crashed. We therefore reset buffer-file-coding-system + ;; to the default value, so that either the default does + ;; TRT, or the user will get prompted for the right + ;; encoding when they send the message. + (setq buffer-file-coding-system + default-buffer-file-coding-system)))))))) + +(defun mail-recover () + "Recover interrupted mail composition from auto-save files. + +If the mail buffer has a current valid auto-save file, +the command recovers that file. Otherwise, it displays a +buffer showing the existing auto-saved draft messages; +you can move to one of them and type C-c C-c to recover that one." + (interactive) + ;; In case they invoke us from some random buffer... + (switch-to-buffer "*mail*") + ;; If *mail* didn't exist, set its directory, so that auto-saved + ;; drafts will be found. + (let ((dir (expand-file-name + (file-name-as-directory mail-default-directory)))) + (if (file-exists-p dir) + (setq default-directory dir))) + (or (eq major-mode 'mail-mode) + (mail-mode)) + (let ((file-name buffer-auto-save-file-name)) + (cond ((and file-name (file-exists-p file-name)) + (let ((dispbuf + ;; This used to invoke `ls' via call-process, but + ;; dired-noselect is more portable to systems where + ;; `ls' is not a standard program (it will use + ;; ls-lisp instead). + (dired-noselect file-name + (concat dired-listing-switches "t")))) + (save-selected-window + (select-window (display-buffer dispbuf t)) + (goto-char (point-min)) + (forward-line 2) + (dired-move-to-filename) + (setq dispbuf (rename-buffer "*Directory*" t))) + (if (not (yes-or-no-p + (format "Recover mail draft from auto save file %s? " + file-name))) + (error "mail-recover cancelled") + (let ((buffer-read-only nil) + (buffer-coding buffer-file-coding-system) + ;; Auto-save files are written in internal + ;; representation of non-ASCII characters. + (coding-system-for-read 'emacs-mule-unix)) + (erase-buffer) + (insert-file-contents file-name nil) + (setq buffer-file-coding-system buffer-coding))))) + (t (mail-recover-1))))) + +;;;###autoload +(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions) + "Like `mail' command, but display mail buffer in another window." + (interactive "P") + (let ((pop-up-windows t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (pop-to-buffer "*mail*")) + (mail noerase to subject in-reply-to cc replybuffer sendactions)) + +;;;###autoload +(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions) + "Like `mail' command, but display mail buffer in another frame." + (interactive "P") + (let ((pop-up-frames t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (pop-to-buffer "*mail*")) + (mail noerase to subject in-reply-to cc replybuffer sendactions)) + +;; Do not add anything but external entries on this page. + +(provide 'sendmail) + +;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626 +;;; sendmail.el ends here diff --git a/contrib/smtpmail.el b/contrib/smtpmail.el new file mode 100644 index 0000000..ff38cd2 --- /dev/null +++ b/contrib/smtpmail.el @@ -0,0 +1,981 @@ +;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail + +;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. + +;; Author: Tomoji Kagatani +;; Maintainer: Simon Josefsson +;; w32 Maintainer: Brian D. Carlstrom +;; ESMTP support: Simon Leinen +;; Hacked by Mike Taylor, 11th October 1999 to add support for +;; automatically appending a domain to RCPT TO: addresses. +;; AUTH=LOGIN support: Stephen Cranefield +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Send Mail to smtp host from smtpmail temp buffer. + +;; Please add these lines in your .emacs(_emacs) or use customize. +;; +;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail' +;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus +;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST") +;;(setq smtpmail-local-domain "YOUR DOMAIN NAME") +;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME") +;;(setq smtpmail-debug-info t) ; only to debug problems +;;(setq smtpmail-auth-credentials ; or use ~/.authinfo +;; '(("YOUR SMTP HOST" 25 "username" "password"))) +;;(setq smtpmail-starttls-credentials +;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert"))) +;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an +;; integer or a string, just as long as they match (eq). + +;; To queue mail, set smtpmail-queue-mail to t and use +;; smtpmail-send-queued-mail to send. + +;; Modified by Stephen Cranefield , +;; 22/6/99, to support SMTP Authentication by the AUTH=LOGIN mechanism. +;; See http://help.netscape.com/products/server/messaging/3x/info/smtpauth.html +;; Rewritten by Simon Josefsson to use same credential variable as AUTH +;; support below. + +;; Modified by Simon Josefsson , 22/2/99, to support SMTP +;; Authentication by the AUTH mechanism. +;; See http://www.ietf.org/rfc/rfc2554.txt + +;; Modified by Simon Josefsson , 2000-10-07, to support +;; STARTTLS. Requires external program +;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz. +;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt + +;;; Code: + +(require 'sendmail) +(autoload 'starttls-open-stream "starttls") +(autoload 'starttls-negotiate "starttls") +(autoload 'mail-strip-quoted-names "mail-utils") +(autoload 'message-make-date "message") +(autoload 'message-make-message-id "message") +(autoload 'rfc2104-hash "rfc2104") +(autoload 'netrc-parse "netrc") +(autoload 'netrc-machine "netrc") +(autoload 'netrc-get "netrc") + +;;; +(defgroup smtpmail nil + "SMTP protocol for sending mail." + :group 'mail) + + +(defcustom smtpmail-default-smtp-server nil + "*Specify default SMTP server. +This only has effect if you specify it before loading the smtpmail library." + :type '(choice (const nil) string) + :group 'smtpmail) + +(defcustom smtpmail-smtp-server + (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) + "*The name of the host running SMTP server." + :type '(choice (const nil) string) + :group 'smtpmail) + +(defcustom smtpmail-smtp-service 25 + "*SMTP service port number. +The default value would be \"smtp\" or 25 ." + :type '(choice (integer :tag "Port") (string :tag "Service")) + :group 'smtpmail) + +(defcustom smtpmail-local-domain nil + "*Local domain name without a host name. +If the function (system-name) returns the full internet address, +don't define this value." + :type '(choice (const nil) string) + :group 'smtpmail) + +(defcustom smtpmail-sendto-domain nil + "*Local domain name without a host name. +This is appended (with an @-sign) to any specified recipients which do +not include an @-sign, so that each RCPT TO address is fully qualified. +\(Some configurations of sendmail require this.) + +Don't bother to set this unless you have get an error like: + Sending failed; SMTP protocol error +when sending mail, and the *trace of SMTP session to * +buffer includes an exchange like: + RCPT TO: + 501 : recipient address must contain a domain +" + :type '(choice (const nil) string) + :group 'smtpmail) + +(defcustom smtpmail-debug-info nil + "Whether to print info in buffer *trace of SMTP session to *. +See also `smtpmail-debug-verb' which determines if the SMTP protocol should +be verbose as well." + :type 'boolean + :group 'smtpmail) + +(defcustom smtpmail-debug-verb nil + "Whether this library sends the SMTP VERB command or not. +The commands enables verbose information from the SMTP server." + :type 'boolean + :group 'smtpmail) + +(defcustom smtpmail-code-conv-from nil ;; *junet* + "*smtpmail code convert from this code to *internal*..for tiny-mime.." + :type 'boolean + :group 'smtpmail) + +(defcustom smtpmail-queue-mail nil + "*Specify if mail is queued (if t) or sent immediately (if nil). +If queued, it is stored in the directory `smtpmail-queue-dir' +and sent with `smtpmail-send-queued-mail'." + :type 'boolean + :group 'smtpmail) + +(defcustom smtpmail-queue-dir "~/Mail/queued-mail/" + "*Directory where `smtpmail.el' stores queued mail." + :type 'directory + :group 'smtpmail) + +(defcustom smtpmail-auth-credentials "~/.authinfo" + "Specify username and password for servers, directly or via .netrc file. +This variable can either be a filename pointing to a file in netrc(5) +format, or list of four-element lists that contain, in order, +`servername' (a string), `port' (an integer), `user' (a string) and +`password' (a string, or nil to query the user when needed). If you +need to enter a `realm' too, add it to the user string, so that it +looks like `user@realm'." + :type '(choice file + (repeat (list (string :tag "Server") + (integer :tag "Port") + (string :tag "Username") + (choice (const :tag "Query when needed" nil) + (string :tag "Password"))))) + :version "22.1" + :group 'smtpmail) + +(defcustom smtpmail-starttls-credentials '(("" 25 "" "")) + "Specify STARTTLS keys and certificates for servers. +This is a list of four-element list with `servername' (a string), +`port' (an integer), `key' (a filename) and `certificate' (a filename)." + :type '(repeat (list (string :tag "Server") + (integer :tag "Port") + (file :tag "Key") + (file :tag "Certificate"))) + :version "21.1" + :group 'smtpmail) + +(defcustom smtpmail-warn-about-unknown-extensions nil + "*If set, print warnings about unknown SMTP extensions. +This is mainly useful for development purposes, to learn about +new SMTP extensions that might be useful to support." + :type 'boolean + :version "21.1" + :group 'smtpmail) + +(defvar smtpmail-queue-index-file "index" + "File name of queued mail index, +This is relative to `smtpmail-queue-dir'.") + +(defvar smtpmail-address-buffer) +(defvar smtpmail-recipient-address-list) + +(defvar smtpmail-queue-counter 0) + +;; Buffer-local variable. +(defvar smtpmail-read-point) + +(defvar smtpmail-queue-index (concat smtpmail-queue-dir + smtpmail-queue-index-file)) + +(defconst smtpmail-auth-supported '(cram-md5 plain login) + "List of supported SMTP AUTH mechanisms.") + +;;; +;;; +;;; + +(defvar smtpmail-mail-address nil + "Value to use for envelope-from address for mail from ambient buffer.") + +;;;###autoload +(defun smtpmail-send-it () + (let ((errbuf (if mail-interactive + (generate-new-buffer " smtpmail errors") + 0)) + (tembuf (generate-new-buffer " smtpmail temp")) + (case-fold-search nil) + delimline + (mailbuf (current-buffer)) + ;; Examine this variable now, so that + ;; local binding in the mail buffer will take effect. + (smtpmail-mail-address + (or (and mail-specify-envelope-from (mail-envelope-from)) + user-mail-address)) + (smtpmail-code-conv-from + (if enable-multibyte-characters + (let ((sendmail-coding-system smtpmail-code-conv-from)) + (select-message-coding-system))))) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (mail-sendmail-undelimit-header) + (setq delimline (point-marker)) +;; (sendmail-synch-aliases) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + ;; We used to process Resent-... headers here, + ;; but it was not done properly, and the job + ;; is done correctly in smtpmail-deduce-address-list. + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) + (replace-match "") + ;; This one matches a Subject just before the header delimiter. + (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t) + (= (match-end 0) delimline)) + (replace-match ""))) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (let* ((login smtpmail-mail-address) + (fullname (user-full-name))) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (insert fullname) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n"))))) + ;; Insert a `Message-Id:' field if there isn't one yet. + (goto-char (point-min)) + (unless (re-search-forward "^Message-Id:" delimline t) + (insert "Message-Id: " (message-make-message-id) "\n")) + ;; Insert a `Date:' field if there isn't one yet. + (goto-char (point-min)) + (unless (re-search-forward "^Date:" delimline t) + (insert "Date: " (message-make-date) "\n")) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (if mail-interactive + (with-current-buffer errbuf + (erase-buffer)))) + ;; + ;; + ;; + (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*")) + (setq smtpmail-recipient-address-list + (smtpmail-deduce-address-list tembuf (point-min) delimline)) + (kill-buffer smtpmail-address-buffer) + + (smtpmail-do-bcc delimline) + ; Send or queue + (if (not smtpmail-queue-mail) + (if (not (null smtpmail-recipient-address-list)) + (if (not (smtpmail-via-smtp + smtpmail-recipient-address-list tembuf)) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + (let* ((file-data + (expand-file-name + (format "%s_%i" + (format-time-string "%Y-%m-%d_%H:%M:%S") + (setq smtpmail-queue-counter + (1+ smtpmail-queue-counter))) + smtpmail-queue-dir)) + (file-data (convert-standard-filename file-data)) + (file-elisp (concat file-data ".el")) + (buffer-data (create-file-buffer file-data)) + (buffer-elisp (create-file-buffer file-elisp)) + (buffer-scratch "*queue-mail*")) + (unless (file-exists-p smtpmail-queue-dir) + (make-directory smtpmail-queue-dir t)) + (with-current-buffer buffer-data + (erase-buffer) + (insert-buffer-substring tembuf) + (write-file file-data) + (set-buffer buffer-elisp) + (erase-buffer) + (insert (concat + "(setq smtpmail-recipient-address-list '" + (prin1-to-string smtpmail-recipient-address-list) + ")\n")) + (write-file file-elisp) + (set-buffer (generate-new-buffer buffer-scratch)) + (insert (concat file-data "\n")) + (append-to-file (point-min) + (point-max) + smtpmail-queue-index) + ) + (kill-buffer buffer-scratch) + (kill-buffer buffer-data) + (kill-buffer buffer-elisp)))) + (kill-buffer tembuf) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + +;;;###autoload +(defun smtpmail-send-queued-mail () + "Send mail that was queued as a result of setting `smtpmail-queue-mail'." + (interactive) + (with-temp-buffer + ;;; Get index, get first mail, send it, update index, get second + ;;; mail, send it, etc... + (let ((file-msg "")) + (insert-file-contents smtpmail-queue-index) + (goto-char (point-min)) + (while (not (eobp)) + (setq file-msg (buffer-substring (point) (line-end-position))) + (load file-msg) + ;; Insert the message literally: it is already encoded as per + ;; the MIME headers, and code conversions might guess the + ;; encoding wrongly. + (with-temp-buffer + (let ((coding-system-for-read 'no-conversion)) + (insert-file-contents file-msg)) + (let ((smtpmail-mail-address + (or (and mail-specify-envelope-from (mail-envelope-from)) + user-mail-address))) + (if (not (null smtpmail-recipient-address-list)) + (if (not (smtpmail-via-smtp smtpmail-recipient-address-list + (current-buffer))) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")))) + (delete-file file-msg) + (delete-file (concat file-msg ".el")) + (delete-region (point-at-bol) (point-at-bol 2))) + (write-region (point-min) (point-max) smtpmail-queue-index)))) + +;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) + +(defun smtpmail-fqdn () + (if smtpmail-local-domain + (concat (system-name) "." smtpmail-local-domain) + (system-name))) + +(defsubst smtpmail-cred-server (cred) + (nth 0 cred)) + +(defsubst smtpmail-cred-port (cred) + (nth 1 cred)) + +(defsubst smtpmail-cred-key (cred) + (nth 2 cred)) + +(defsubst smtpmail-cred-user (cred) + (nth 2 cred)) + +(defsubst smtpmail-cred-cert (cred) + (nth 3 cred)) + +(defsubst smtpmail-cred-passwd (cred) + (nth 3 cred)) + +(defun smtpmail-find-credentials (cred server port) + (catch 'done + (let ((l cred) el) + (while (setq el (pop l)) + (when (and (equal server (smtpmail-cred-server el)) + (equal port (smtpmail-cred-port el))) + (throw 'done el)))))) + +(defun smtpmail-maybe-append-domain (recipient) + (if (or (not smtpmail-sendto-domain) + (string-match "@" recipient)) + recipient + (concat recipient "@" smtpmail-sendto-domain))) + +(defun smtpmail-intersection (list1 list2) + (let ((result nil)) + (dolist (el2 list2) + (when (memq el2 list1) + (push el2 result))) + (nreverse result))) + +(defvar starttls-extra-args) +(defvar starttls-extra-arguments) + +(defun smtpmail-open-stream (process-buffer host port) + (let ((cred (smtpmail-find-credentials + smtpmail-starttls-credentials host port))) + (if (null (and cred (condition-case () + (with-no-warnings + (require 'starttls) + (call-process (if starttls-use-gnutls + starttls-gnutls-program + starttls-program))) + (error nil)))) + ;; The normal case. + (open-network-stream "SMTP" process-buffer host port) + (let* ((cred-key (smtpmail-cred-key cred)) + (cred-cert (smtpmail-cred-cert cred)) + (starttls-extra-args + (append + starttls-extra-args + (when (and (stringp cred-key) (stringp cred-cert) + (file-regular-p + (setq cred-key (expand-file-name cred-key))) + (file-regular-p + (setq cred-cert (expand-file-name cred-cert)))) + (list "--key-file" cred-key "--cert-file" cred-cert)))) + (starttls-extra-arguments + (append + starttls-extra-arguments + (when (and (stringp cred-key) (stringp cred-cert) + (file-regular-p + (setq cred-key (expand-file-name cred-key))) + (file-regular-p + (setq cred-cert (expand-file-name cred-cert)))) + (list "--x509keyfile" cred-key "--x509certfile" cred-cert))))) + (starttls-open-stream "SMTP" process-buffer host port))))) + +(defun smtpmail-try-auth-methods (process supported-extensions host port) + (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) + (mech (car (smtpmail-intersection smtpmail-auth-supported mechs))) + (cred (if (stringp smtpmail-auth-credentials) + (let* ((netrc (netrc-parse smtpmail-auth-credentials)) + (port-name (format "%s" (or port "smtp"))) + (hostentry (netrc-machine netrc host port-name + port-name))) + (when hostentry + (list host port + (netrc-get hostentry "login") + (netrc-get hostentry "password")))) + (smtpmail-find-credentials + smtpmail-auth-credentials host port))) + (passwd (when cred + (or (smtpmail-cred-passwd cred) + (read-passwd + (format "SMTP password for %s:%s: " + (smtpmail-cred-server cred) + (smtpmail-cred-port cred)))))) + ret) + (when (and cred mech) + (cond + ((eq mech 'cram-md5) + (smtpmail-send-command process (upcase (format "AUTH %s" mech))) + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (>= (car ret) 400)) + (throw 'done nil)) + (when (eq (car ret) 334) + (let* ((challenge (substring (cadr ret) 4)) + (decoded (base64-decode-string challenge)) + (hash (rfc2104-hash 'md5 64 16 passwd decoded)) + (response (concat (smtpmail-cred-user cred) " " hash)) + (encoded (base64-encode-string response))) + (smtpmail-send-command process (format "%s" encoded)) + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (>= (car ret) 400)) + (throw 'done nil))))) + ((eq mech 'login) + (smtpmail-send-command process "AUTH LOGIN") + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (>= (car ret) 400)) + (throw 'done nil)) + (smtpmail-send-command + process (base64-encode-string (smtpmail-cred-user cred))) + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (>= (car ret) 400)) + (throw 'done nil)) + (smtpmail-send-command process (base64-encode-string passwd)) + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (>= (car ret) 400)) + (throw 'done nil))) + ((eq mech 'plain) + ;; We used to send an empty initial request, and wait for an + ;; empty response, and then send the password, but this + ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this + ;; is not sent if the server did not advertise AUTH PLAIN in + ;; the EHLO response. See RFC 2554 for more info. + (smtpmail-send-command process + (concat "AUTH PLAIN " + (base64-encode-string + (concat "\0" + (smtpmail-cred-user cred) + "\0" + passwd)))) + (if (or (null (car (setq ret (smtpmail-read-response process)))) + (not (integerp (car ret))) + (not (equal (car ret) 235))) + (throw 'done nil))) + + (t + (error "Mechanism %s not implemented" mech))) + ;; Remember the password. + (when (and (not (stringp smtpmail-auth-credentials)) + (null (smtpmail-cred-passwd cred))) + (setcar (cdr (cdr (cdr cred))) passwd))))) + +(defun smtpmail-via-smtp (recipient smtpmail-text-buffer) + (let ((process nil) + (host (or smtpmail-smtp-server + (error "`smtpmail-smtp-server' not defined"))) + (port smtpmail-smtp-service) + ;; smtpmail-mail-address should be set to the appropriate + ;; buffer-local value by the caller, but in case not: + (envelope-from (or smtpmail-mail-address + (and mail-specify-envelope-from + (mail-envelope-from)) + user-mail-address)) + response-code + greeting + process-buffer + (supported-extensions '())) + (unwind-protect + (catch 'done + ;; get or create the trace buffer + (setq process-buffer + (get-buffer-create (format "*trace of SMTP session to %s*" host))) + + ;; clear the trace buffer of old output + (with-current-buffer process-buffer + (setq buffer-undo-list t) + (erase-buffer)) + + ;; open the connection to the server + (setq process (smtpmail-open-stream process-buffer host port)) + (and (null process) (throw 'done nil)) + + ;; set the send-filter + (set-process-filter process 'smtpmail-process-filter) + + (with-current-buffer process-buffer + (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) + (make-local-variable 'smtpmail-read-point) + (setq smtpmail-read-point (point-min)) + + + (if (or (null (car (setq greeting (smtpmail-read-response process)))) + (not (integerp (car greeting))) + (>= (car greeting) 400)) + (throw 'done nil) + ) + + (let ((do-ehlo t) + (do-starttls t)) + (while do-ehlo + ;; EHLO + (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn))) + + (if (or (null (car (setq response-code + (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (progn + ;; HELO + (smtpmail-send-command + process (format "HELO %s" (smtpmail-fqdn))) + + (if (or (null (car (setq response-code + (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil))) + (dolist (line (cdr (cdr response-code))) + (let ((name (mapcar (lambda (s) (intern (downcase s))) + (split-string (substring line 4) "[ ]")))) + (and (eq (length name) 1) + (setq name (car name))) + (and name + (cond ((memq (if (consp name) (car name) name) + '(verb xvrb 8bitmime onex xone + expn size dsn etrn + enhancedstatuscodes + help xusr + auth=login auth starttls)) + (setq supported-extensions + (cons name supported-extensions))) + (smtpmail-warn-about-unknown-extensions + (message "Unknown extension %s" name))))))) + + (if (and do-starttls + (smtpmail-find-credentials smtpmail-starttls-credentials host port) + (member 'starttls supported-extensions) + (numberp (process-id process))) + (progn + (smtpmail-send-command process (format "STARTTLS")) + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil)) + (starttls-negotiate process) + (setq do-starttls nil)) + (setq do-ehlo nil)))) + + (smtpmail-try-auth-methods process supported-extensions host port) + + (if (or (member 'onex supported-extensions) + (member 'xone supported-extensions)) + (progn + (smtpmail-send-command process (format "ONEX")) + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil)))) + + (if (and smtpmail-debug-verb + (or (member 'verb supported-extensions) + (member 'xvrb supported-extensions))) + (progn + (smtpmail-send-command process (format "VERB")) + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil)))) + + (if (member 'xusr supported-extensions) + (progn + (smtpmail-send-command process (format "XUSR")) + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil)))) + + ;; MAIL FROM: + (let ((size-part + (if (or (member 'size supported-extensions) + (assoc 'size supported-extensions)) + (format " SIZE=%d" + (with-current-buffer smtpmail-text-buffer + ;; size estimate: + (+ (- (point-max) (point-min)) + ;; Add one byte for each change-of-line + ;; because of CR-LF representation: + (count-lines (point-min) (point-max))))) + "")) + (body-part + (if (member '8bitmime supported-extensions) + ;; FIXME: + ;; Code should be added here that transforms + ;; the contents of the message buffer into + ;; something the receiving SMTP can handle. + ;; For a receiver that supports 8BITMIME, this + ;; may mean converting BINARY to BASE64, or + ;; adding Content-Transfer-Encoding and the + ;; other MIME headers. The code should also + ;; return an indication of what encoding the + ;; message buffer is now, i.e. ASCII or + ;; 8BITMIME. + (if nil + " BODY=8BITMIME" + "") + ""))) +; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) + (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s" + envelope-from + size-part + body-part)) + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + )) + + ;; RCPT TO: + (let ((n 0)) + (while (not (null (nth n recipient))) + (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient)))) + (setq n (1+ n)) + + (setq response-code (smtpmail-read-response process)) + (if (or (null (car response-code)) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + )) + + ;; DATA + (smtpmail-send-command process "DATA") + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;; Mail contents + (smtpmail-send-data process smtpmail-text-buffer) + + ;;DATA end "." + (smtpmail-send-command process ".") + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;;QUIT +; (smtpmail-send-command process "QUIT") +; (and (null (car (smtpmail-read-response process))) +; (throw 'done nil)) + t )) + (if process + (with-current-buffer (process-buffer process) + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process) + +; (if (or (null (car (setq response-code (smtpmail-read-response process)))) +; (not (integerp (car response-code))) +; (>= (car response-code) 400)) +; (throw 'done nil) +; ) + (delete-process process) + (unless smtpmail-debug-info + (kill-buffer process-buffer))))))) + + +(defun smtpmail-process-filter (process output) + (with-current-buffer (process-buffer process) + (goto-char (point-max)) + (insert output))) + +(defun smtpmail-read-response (process) + (let ((case-fold-search nil) + (response-strings nil) + (response-continue t) + (return-value '(nil ())) + match-end) + (catch 'done + (while response-continue + (goto-char smtpmail-read-point) + (while (not (search-forward "\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (throw 'done nil)) + (accept-process-output process) + (goto-char smtpmail-read-point)) + + (setq match-end (point)) + (setq response-strings + (cons (buffer-substring smtpmail-read-point (- match-end 2)) + response-strings)) + + (goto-char smtpmail-read-point) + (if (looking-at "[0-9]+ ") + (let ((begin (match-beginning 0)) + (end (match-end 0))) + (if smtpmail-debug-info + (message "%s" (car response-strings))) + + (setq smtpmail-read-point match-end) + + ;; ignore lines that start with "0" + (if (looking-at "0[0-9]+ ") + nil + (setq response-continue nil) + (setq return-value + (cons (string-to-number + (buffer-substring begin end)) + (nreverse response-strings))))) + + (if (looking-at "[0-9]+-") + (progn (if smtpmail-debug-info + (message "%s" (car response-strings))) + (setq smtpmail-read-point match-end) + (setq response-continue t)) + (progn + (setq smtpmail-read-point match-end) + (setq response-continue nil) + (setq return-value + (cons nil (nreverse response-strings))))))) + (setq smtpmail-read-point match-end)) + return-value)) + + +(defun smtpmail-send-command (process command) + (goto-char (point-max)) + (if (= (aref command 0) ?P) + (insert "PASS \r\n") + (insert command "\r\n")) + (setq smtpmail-read-point (point)) + (process-send-string process command) + (process-send-string process "\r\n")) + +(defun smtpmail-send-data-1 (process data) + (goto-char (point-max)) + + (if (and (multibyte-string-p data) + smtpmail-code-conv-from) + (setq data (string-as-multibyte + (encode-coding-string data smtpmail-code-conv-from)))) + + (if smtpmail-debug-info + (insert data "\r\n")) + + (setq smtpmail-read-point (point)) + ;; Escape "." at start of a line + (if (eq (string-to-char data) ?.) + (process-send-string process ".")) + (process-send-string process data) + (process-send-string process "\r\n") + ) + +(defun smtpmail-send-data (process buffer) + (let ((data-continue t) sending-data) + (with-current-buffer buffer + (goto-char (point-min))) + (while data-continue + (with-current-buffer buffer + (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) + (end-of-line 2) + (setq data-continue (not (eobp)))) + (smtpmail-send-data-1 process sending-data)))) + +(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) + "Get address list suitable for smtp RCPT TO:
." + (unwind-protect + (with-current-buffer smtpmail-address-buffer + (erase-buffer) + (let + ((case-fold-search t) + (simple-address-list "") + this-line + this-line-end + addr-regexp) + (insert-buffer-substring smtpmail-text-buffer header-start header-end) + (goto-char (point-min)) + ;; RESENT-* fields should stop processing of regular fields. + (save-excursion + (setq addr-regexp + (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" + header-end t) + "^Resent-\\(to\\|cc\\|bcc\\):" + "^\\(To:\\|Cc:\\|Bcc:\\)"))) + + (while (re-search-forward addr-regexp 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 " " simple-address-list "\n") + (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 " ")) + + (goto-char (point-min)) + (let (recipient-address-list) + (while (re-search-forward " \\([^ ]+\\) " (point-max) t) + (backward-char 1) + (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) + recipient-address-list)) + ) + (setq smtpmail-recipient-address-list recipient-address-list)) + + ) + ) + ) + ) + + +(defun smtpmail-do-bcc (header-end) + "Delete [Resent-]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 "^\\(RESENT-\\)?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 "")))))) + + +(provide 'smtpmail) + +;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466 +;;; smtpmail.el ends here -- 1.7.10.4