X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/25ca2e61403f97b5a023164f2924d5f8aca2492a..186f4720cca79dc4261d538abe2d30429246122b:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 4fa513089b..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 @@ -30,7 +29,7 @@ ;;; Code: (require 'mail-utils) -(autoload 'rfc2047-encode-string "rfc2047") +(require 'rfc2047) (defgroup sendmail nil "Mail sending commands for Emacs." @@ -44,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) @@ -137,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, @@ -159,15 +152,14 @@ 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(custom-initialize-delay 'send-mail-function nil) - ;;;###autoload (defcustom mail-header-separator (purecopy "--text follows this line--") "Line used to separate headers from text in messages being composed." @@ -294,7 +286,7 @@ The default value matches citations like `foo-bar>' plus whitespace." (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) @@ -310,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) @@ -320,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)) @@ -350,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)) @@ -469,7 +460,8 @@ 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") + "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. @@ -513,6 +505,51 @@ by Emacs.)") "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)))) @@ -532,11 +569,7 @@ by Emacs.)") send-actions return-action &rest ignored) (if switch-function - (let ((special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (funcall switch-function "*mail*"))) + (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)))) @@ -648,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. @@ -666,12 +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)) @@ -694,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, @@ -803,10 +842,18 @@ 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 (null arg) mail-return-action) - (apply (car mail-return-action) (cdr mail-return-action)) + ;; 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 @@ -823,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. @@ -862,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 ", ")) @@ -895,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) @@ -943,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. @@ -1008,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. @@ -1037,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 @@ -1051,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) @@ -1156,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 @@ -1165,7 +1233,7 @@ 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)) @@ -1347,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." @@ -1629,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 @@ -1648,13 +1719,25 @@ 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 (add-hook 'same-window-buffer-names (purecopy "*unsent mail*")) - ;;;###autoload (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions return-action) @@ -1706,11 +1789,11 @@ The seventh argument ACTIONS is a list of actions to take This is how Rmail arranges to mark messages `answered'." (interactive "P") (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 @@ -1778,7 +1861,7 @@ The seventh argument ACTIONS is a list of actions to take ;; 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)) @@ -1858,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) @@ -1883,24 +1966,14 @@ 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.