X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b7235808116742ec0a7aacbe53fb80db13ce5ef7..186f4720cca79dc4261d538abe2d30429246122b:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index da8fe85da8..d685b8b3e7 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,7 +1,6 @@ ;;; 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, 2007, 2008, 2009, 2010 +;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2011 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -28,13 +27,9 @@ ;; documented in the Emacs user's manual. ;;; Code: -(eval-when-compile - ;; Necessary to avoid recursive `require's. - (provide 'sendmail) - (require 'rmail) - (require 'mailalias)) +(require 'mail-utils) -(autoload 'rfc2047-encode-string "rfc2047") +(require 'rfc2047) (defgroup sendmail nil "Mail sending commands for Emacs." @@ -48,12 +43,14 @@ :version "22.1") (defcustom sendmail-program - (cond - ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") - ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") - ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") - (t "fakemail")) ;In ../etc, to interface to /bin/mail. + (or (executable-find "sendmail") + (cond + ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") + ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") + ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") + (t "sendmail"))) "Program used to send messages." + :version "24.1" ; add executable-find, remove fakemail :group 'mail :type 'file) @@ -141,21 +138,13 @@ Otherwise, let mailer send back a message to report errors." :group 'sendmail :version "23.1") -;; 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) + ;; Assume smtpmail is the preferred choice if it's already configured. + (if (and (boundp 'smtpmail-smtp-server) + smtpmail-smtp-server) + 'smtpmail-send-it 'sendmail-query-once) "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, @@ -163,11 +152,12 @@ 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 sendmail-query-once :tag "Query the user") (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) - :initialize 'custom-initialize-delay + :version "24.1" :group 'sendmail) ;;;###autoload @@ -201,13 +191,14 @@ 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'. + "If non-nil, the name of a file to use instead of the sendmail default. 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) +This variable has no effect unless your system uses sendmail as its mailer. +The default file is defined in sendmail's configuration file, e.g. +`/etc/aliases'." + :type '(choice (const :tag "Sendmail default" nil) file) :group 'sendmail) ;;;###autoload @@ -283,19 +274,19 @@ regardless of what part of it (if any) is included in the cited text.") ;;;###autoload (defcustom mail-citation-prefix-regexp - (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[]>|}]\\)+") + (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \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") + :version "24.1") (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\M-\t" 'mail-complete) + (define-key map "\M-\t" 'completion-at-point) (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) @@ -311,7 +302,6 @@ The default value matches citations like `foo-bar>' plus whitespace." (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) @@ -321,6 +311,9 @@ The default value matches citations like `foo-bar>' plus whitespace." (define-key map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) + (define-key map [menu-bar mail attachment] + '("Attach File" . mail-add-attachment)) + (define-key map [menu-bar mail fill] '("Fill Citation" . mail-fill-yanked-message)) @@ -351,9 +344,6 @@ The default value matches citations like `foo-bar>' plus whitespace." (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)) @@ -381,15 +371,8 @@ The default value matches citations like `foo-bar>' plus whitespace." 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) + "Read mail aliases from personal aliases file and set `mail-aliases'. +By default, this is the file specified by `mail-personal-alias-file'." t) ;;;###autoload (defcustom mail-signature t @@ -415,9 +398,11 @@ and should insert whatever you want to insert." ;;;###autoload (defcustom mail-default-directory (purecopy "~/") - "Directory for mail buffers. -Value of `default-directory' for mail buffers. -This directory is used for auto-save files of mail buffers." + "Value of `default-directory' for Mail mode buffers. +This directory is used for auto-save files of Mail mode buffers. + +Note that Message mode does not use this variable; it auto-saves +in `message-auto-save-directory'." :type '(directory :tag "Directory") :group 'sendmail :version "22.1") @@ -425,8 +410,7 @@ This directory is used for auto-save files of mail buffers." (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) +(defvar mail-return-action nil) ;;;###autoload (defcustom mail-default-headers nil @@ -436,8 +420,6 @@ before you edit the message, so you can edit or delete the lines." :type '(choice (const nil) string) :group 'sendmail) -;; FIXME no need for autoload -;;;###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 @@ -446,8 +428,6 @@ is non-nil." :type 'boolean :group 'sendmail) -;; FIXME no need for autoload -;;;###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. @@ -471,23 +451,17 @@ support Delivery Status Notification." ;; 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{|}~]+:")) +(defvar mail-mailer-swallows-blank-line nil "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.") +The actual value should be an expression to evaluate that returns +non-nil if the problem will actually occur. +\(As far as we know, this is not an issue on any system still supported +by Emacs.)") + +(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled +(make-obsolete-variable 'mail-mailer-swallows-blank-line + "no need to set this on any modern system." + "24.1" 'set) (defvar mail-mode-syntax-table ;; define-derived-mode will make it inherit from text-mode-syntax-table. @@ -531,6 +505,51 @@ actually occur.") "Additional expressions to highlight in Mail mode.") +;;;###autoload +(defun sendmail-query-once () + "Query for `send-mail-function' and send mail with it. +This also saves the value of `send-mail-function' via Customize." + ;; If send-mail-function is already setup, we're incorrectly called + ;; a second time, probably because someone's using an old value + ;; of send-mail-function. + (when (eq send-mail-function 'sendmail-query-once) + (let* ((options `(("Mail client" . mailclient-send-it) + ,@(when (and sendmail-program + (executable-find sendmail-program)) + '(("Mail transport agent" . sendmail-send-it))) + ("SMTP server" . smtpmail-send-it))) + (choice + ;; Query the user. + (with-temp-buffer + (rename-buffer "*Emacs Mail Setup Help*" t) + (insert "\ + Emacs is about to send an email message. However, it was not configured + for sending email. You can instruct Emacs to send email in one of the + following ways: + + - Start your default mail client and pass to it the message text. + Type \"Mail client\" at the prompt below to select this option.\n\n") + (if (and sendmail-program + (executable-find sendmail-program)) + (insert "\ + - Invoke the system's mail transport agent (\"sendmail\"). + Type \"Mail transport agent\" at the prompt below to select this option.\n\n")) + (insert "\ + - Send mail directly by communicating with your mail server + (this requires setting up SMTP parameters). + Type \"SMTP server\" at the prompt below to select this option. + + Emacs will record your selection and will use it thereafter. To change + your selection later, customize the option `send-mail-function'.\n") + (goto-char (point-min)) + (display-buffer (current-buffer)) + (let ((completion-ignore-case t)) + (completing-read "Send mail via: " + options nil 'require-match))))) + (customize-save-variable 'send-mail-function + (cdr (assoc-string choice options t))))) + (funcall send-mail-function)) + (defun sendmail-sync-aliases () (when mail-personal-alias-file (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) @@ -538,16 +557,50 @@ actually occur.") (setq mail-alias-modtime modtime mail-aliases t))))) -(defun mail-setup (to subject in-reply-to cc replybuffer actions) + +;;;###autoload +(define-mail-user-agent 'sendmail-user-agent + 'sendmail-user-agent-compose + 'mail-send-and-exit) + +;;;###autoload +(defun sendmail-user-agent-compose (&optional to subject other-headers + continue switch-function yank-action + send-actions return-action + &rest ignored) + (if switch-function + (funcall switch-function "*mail*")) + (let ((cc (cdr (assoc-string "cc" other-headers t))) + (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t))) + (body (cdr (assoc-string "body" other-headers t)))) + (or (mail continue to subject in-reply-to cc yank-action + send-actions return-action) + continue + (error "Message aborted")) + (save-excursion + (rfc822-goto-eoh) + (while other-headers + (unless (member-ignore-case (car (car other-headers)) + '("in-reply-to" "cc" "body")) + (insert (car (car other-headers)) ": " + (cdr (car other-headers)) + (if use-hard-newlines hard-newline "\n"))) + (setq other-headers (cdr other-headers))) + (when body + (forward-line 1) + (insert body)) + t))) + +(defun mail-setup (to subject in-reply-to cc replybuffer + actions return-action) (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))))) + (when (eq mail-aliases t) + (setq mail-aliases nil) + (and mail-personal-alias-file + (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. @@ -555,8 +608,12 @@ actually occur.") (set-buffer-multibyte (default-value 'enable-multibyte-characters)) (if current-input-method (inactivate-input-method)) + + ;; Local variables for Mail mode. (setq mail-send-actions actions) (setq mail-reply-action replybuffer) + (setq mail-return-action return-action) + (goto-char (point-min)) (if mail-setup-with-from (mail-insert-from-field)) @@ -624,6 +681,7 @@ switching to, the `*mail*' buffer. See also `mail-setup-hook'." :options '(footnote-mode)) (defvar mail-mode-abbrev-table text-mode-abbrev-table) +(defvar mail-encode-mml) ;;;###autoload (define-derived-mode mail-mode text-mode "Mail" "Major mode for editing mail to be sent. @@ -642,11 +700,15 @@ Here are commands that move to a header field (and create it if there isn't): \\[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). +\\[mail-insert-file] insert a text file into the message. +\\[mail-add-attachment] attach to the message a file as binary attachment. 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) + (make-local-variable 'mail-return-action) + (make-local-variable 'mail-encode-mml) + (setq mail-encode-mml nil) (setq buffer-offer-save t) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mail-font-lock-keywords t t)) @@ -669,6 +731,8 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and (setq adaptive-fill-first-line-regexp (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (add-hook 'completion-at-point-functions #'mail-completion-at-point-function + nil 'local) ;; `-- ' precedes the signature. `-----' appears at the start of the ;; lines that delimit forwarded messages. ;; Lines containing just >= 3 dashes, perhaps after whitespace, @@ -714,7 +778,7 @@ Leave point at the start of the delimiter line." "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)))) + (let ((old-line-start (line-beginning-position))) (if (do-auto-fill) (save-excursion (beginning-of-line) @@ -778,41 +842,19 @@ Prefix arg means don't delete this window." (defun mail-bury (&optional arg) "Bury this mail buffer." - (let ((newbuf (other-buffer (current-buffer)))) + (let ((newbuf (other-buffer (current-buffer))) + (return-action mail-return-action) + some-rmail) (bury-buffer (current-buffer)) - (if (and (or nil - ;; In this case, we need to go to a different frame. - (window-dedicated-p (frame-selected-window)) - ;; In this mode of operation, the frame was probably - ;; made for this buffer, so the user probably wants - ;; to delete it now. - (and pop-up-frames (one-window-p)) - (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)))))) + ;; If there is an Rmail buffer, return to it nicely + ;; even if this message was not started by an Rmail command. + (unless return-action + (dolist (buffer (buffer-list)) + (if (eq (buffer-local-value 'major-mode buffer) 'rmail-mode) + (setq return-action `(rmail-mail-return ,newbuf))))) + (if (and (null arg) return-action) + (apply (car return-action) (cdr return-action)) + (switch-to-buffer newbuf)))) (defcustom mail-send-hook nil "Hook run just before sending a message." @@ -828,6 +870,7 @@ header when sending a message to a mailing list." :type '(repeat string) :group 'sendmail) +(declare-function mml-to-mime "mml" ()) (defun mail-send () "Send the message in the current buffer. @@ -867,9 +910,9 @@ the user from the mailer." (let ((l)) (mapc ;; remove duplicates - '(lambda (e) - (unless (member e l) - (push e l))) + (lambda (e) + (unless (member e l) + (push e l))) (split-string new-header-values ",[[:space:]]+" t)) (mapconcat 'identity l ", ")) @@ -900,6 +943,9 @@ the user from the mailer." (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) (forward-line 1))) (goto-char opoint) + (when mail-encode-mml + (mml-to-mime) + (setq mail-encode-mml nil)) (run-hooks 'mail-send-hook) (message "Sending...") (funcall send-mail-function) @@ -948,12 +994,14 @@ of outgoing mails regardless of the current language environment. See also the function `select-message-coding-system'.") (defun mail-insert-from-field () + "Insert the \"From:\" field of a mail header. +The style of the field is determined by the variable `mail-from-style'. +This function does not perform RFC2047 encoding." (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)) + (setq quote-fullname t)) (cond ((null mail-from-style) (insert "From: " login "\n")) ;; This is deprecated. @@ -1013,6 +1061,21 @@ See also the function `select-message-coding-system'.") (goto-char fullname-start)))) (insert ")\n"))))) +(defun mail-encode-header (beg end) + "Encode the mail header between BEG and END according to RFC2047. +Return non-nil if and only if some part of the header is encoded." + (save-restriction + (narrow-to-region beg end) + (let* ((selected (select-message-coding-system)) + (mm-coding-system-priorities + (if (and selected (coding-system-get selected :mime-charset)) + (cons selected mm-coding-system-priorities) + mm-coding-system-priorities)) + (tick (buffer-chars-modified-tick)) + (rfc2047-encode-encoded-words nil)) + (rfc2047-encode-message-header) + (= tick (buffer-chars-modified-tick))))) + ;; Normally you will not need to modify these options unless you are ;; using some non-genuine substitute for sendmail which does not ;; implement each and every option that the original supports. @@ -1042,9 +1105,6 @@ external program defined by `sendmail-program'." 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 @@ -1056,6 +1116,7 @@ external program defined by `sendmail-program'." (unless multibyte (set-buffer-multibyte nil)) (insert-buffer-substring mailbuf) + (set-buffer-file-coding-system selected-coding) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) @@ -1092,23 +1153,23 @@ external program defined by `sendmail-program'." ;; 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"))) + (delete-region (line-beginning-position) + (line-beginning-position 2)))) + ;; 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) @@ -1145,8 +1206,7 @@ external program defined by `sendmail-program'." ;; should override any specified in the message itself. (when where-content-type (goto-char where-content-type) - (beginning-of-line) - (delete-region (point) + (delete-region (point-at-bol) (progn (forward-line 1) (point))))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. @@ -1162,6 +1222,8 @@ external program defined by `sendmail-program'." (if mail-interactive (with-current-buffer errbuf (erase-buffer)))) + ;; Encode the header according to RFC2047. + (mail-encode-header (point-min) delimline) (goto-char (point-min)) (if (let ((case-fold-search t)) (or resend-to-addresses @@ -1171,13 +1233,13 @@ external program defined by `sendmail-program'." (coding-system-for-write selected-coding) (args (append (list (point-min) (point-max) - program + sendmail-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))) + ;; ;; 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 @@ -1353,6 +1415,9 @@ just append to the file, in Babyl format if necessary." (point))))) ;; Insert a copy, with altered header field name. (insert-before-markers "Sent-via:" to-line)))))) + +(make-obsolete 'mail-sent-via "nobody can remember what it is for." "24.1") + (defun mail-to () "Move point to end of To field, creating it if necessary." @@ -1635,7 +1700,7 @@ If the current line has `mail-yank-prefix', insert it on the new line." (split-line mail-yank-prefix)) -(defun mail-attach-file (&optional file) +(defun mail-insert-file (&optional file) "Insert a file at the end of the buffer, with separator lines around it." (interactive "fAttach file: ") (save-excursion @@ -1654,14 +1719,28 @@ If the current line has `mail-yank-prefix', insert it on the new line." (insert-file-contents file) (or (bolp) (newline)) (goto-char start)))) + +(define-obsolete-function-alias 'mail-attach-file 'mail-insert-file "24.1") + +(declare-function mml-attach-file "mml" + (file &optional type description disposition)) +(declare-function mm-default-file-encoding "mm-encode" (file)) + +(defun mail-add-attachment (file) + "Add FILE as a MIME attachment to the end of the mail message being composed." + (interactive "fAttach file: ") + (mml-attach-file file + (or (mm-default-file-encoding file) + "application/octet-stream") nil) + (setq mail-encode-mml t)) + ;; Put these commands last, to reduce chance of lossage from quitting ;; in middle of loading the file. -;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*mail*")) - ;;;###autoload -(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) +(defun mail (&optional noerase to subject in-reply-to cc replybuffer + actions return-action) "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. @@ -1709,55 +1788,12 @@ The seventh argument ACTIONS is a list of actions to take 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*")) + (pop-to-buffer-same-window (generate-new-buffer "*mail*")) (and noerase (not (get-buffer "*mail*")) (setq noerase nil)) - (pop-to-buffer "*mail*")) + (pop-to-buffer-same-window "*mail*")) ;; Avoid danger that the auto-save file can't be written. (let ((dir (expand-file-name @@ -1771,7 +1807,7 @@ The seventh argument ACTIONS is a list of actions to take (mail-mode) ;; Disconnect the buffer from its visited file ;; (in case the user has actually visited a file *mail*). -;;; (set-visited-file-name nil) + ;; (set-visited-file-name nil) (let (initialized) (and (not (and noerase (not (eq noerase 'new)))) @@ -1790,7 +1826,8 @@ The seventh argument ACTIONS is a list of actions to take t)) (let ((inhibit-read-only t)) (erase-buffer) - (mail-setup to subject in-reply-to cc replybuffer actions) + (mail-setup to subject in-reply-to cc replybuffer actions + return-action) (setq initialized t))) (if (and buffer-auto-save-file-name (file-exists-p buffer-auto-save-file-name)) @@ -1820,8 +1857,11 @@ The seventh argument ACTIONS is a list of actions to take ;; names are normally ``trivial'', so Dired will set point after ;; all the files, at buffer bottom. We want it on the first ;; file instead. + ;; Require dired so that dired-trivial-filenames does not get + ;; unbound on exit from the let. + (require 'dired) (let ((dired-trivial-filenames t)) - (dired-other-window wildcard (concat dired-listing-switches "t"))) + (dired-other-window wildcard (concat dired-listing-switches " -t"))) (rename-buffer "*Auto-saved Drafts*" t) (save-excursion (goto-char (point-min)) @@ -1901,9 +1941,9 @@ you can move to one of them and type C-c C-c to recover that one." ;; `ls' is not a standard program (it will use ;; ls-lisp instead). (dired-noselect file-name - (concat dired-listing-switches "t")))) + (concat dired-listing-switches " -t")))) (save-selected-window - (select-window (display-buffer dispbuf t)) + (switch-to-buffer-other-window dispbuf) (goto-char (point-min)) (forward-line 2) (dired-move-to-filename) @@ -1926,29 +1966,18 @@ you can move to one of them and type C-c C-c to recover that one." (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*")) + (switch-to-buffer-other-window "*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*")) + (switch-to-buffer-other-frame "*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