]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/sendmail.el
Fix year ranges in copyright notice.
[gnu-emacs] / lisp / mail / sendmail.el
index 31b0a06cd3e6c1c85c84a8065226bea7e2f2c1f7..bc2a50f38e6babd6379b3f81d427418dcd0b3b33 100644 (file)
@@ -1,6 +1,7 @@
 ;;; sendmail.el --- mail sending commands for Emacs.
 
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
 ;; documented in the Emacs user's manual.
 
 ;;; Code:
+(eval-when-compile
+  ;; Necessary to avoid recursive `require's.
+  (provide 'sendmail)
+  (require 'rmail)
+  (require 'mailalias))
+
 (defgroup sendmail nil
   "Mail sending commands for Emacs."
   :prefix "mail-"
@@ -43,12 +50,29 @@ If `parens', they look like:
        king@grassland.com (Elvis Parsley)
 If `angles', they look like:
        Elvis Parsley <king@grassland.com>
-If `system-default', Rmail allows the system to insert its default From field."
+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 t
+  "*If non-nil, specify the envelope-from address when sending mail.
+The value used to specify it is whatever is found in `user-mail-address'.
+
+On most systems, specifying the envelope-from address
+is a privileged operation."
+  :version "21.1"
+  :type 'boolean
+  :group 'sendmail)
+
 ;;;###autoload
 (defcustom mail-self-blind nil "\
 *Non-nil means insert BCC to self in messages to be sent.
@@ -129,6 +153,7 @@ This file need not actually exist."
   "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)
   :group 'sendmail)
 
 (defvar mail-aliases t
@@ -407,6 +432,12 @@ actually occur.")
       (set-buffer-modified-p nil))
   (run-hooks 'mail-setup-hook))
 \f
+(defcustom mail-mode-hook nil
+  "Hook run by Mail mode."
+  :group 'sendmail
+  :type 'hook
+  :options '(footnote-mode))
+
 ;;;###autoload
 (defun mail-mode ()
   "Major mode for editing mail to be sent.
@@ -453,7 +484,7 @@ Here are commands that move to a header field (and create it if there isn't):
   ;; Lines containing just >= 3 dashes, perhaps after whitespace,
   ;; are also sometimes used and should be separators.
   (setq paragraph-start (concat (regexp-quote mail-header-separator)
-                               "$\\|[ \t]*\\([-|#;>*]+ *\\|(?[0-9]+[.)] *\\)*$"
+                               "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
                                "\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
                                "-- $\\|---+$\\|"
                                page-delimiter))
@@ -660,6 +691,12 @@ Prefix arg means don't delete this window."
              (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)
+
 (defun mail-send ()
   "Send the message in the current buffer.
 If `mail-interactive' is non-nil, wait for success indication
@@ -701,7 +738,7 @@ the user from the mailer."
            (error))
          (setq mail-send-actions (cdr mail-send-actions)))
        (message "Sending...done")
-       ;; If buffer has no file, mark it as unmodified and delete autosave.
+       ;; If buffer has no file, mark it as unmodified and delete auto-save.
        (if (not buffer-file-name)
            (progn
              (set-buffer-modified-p nil)
@@ -712,7 +749,22 @@ the user from the mailer."
 
 ;;;###autoload
 (defvar sendmail-coding-system nil
-  "Coding system to encode the outgoing mail.")
+  "*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 sendmail-send-it ()
   (require 'mail-utils)
@@ -724,17 +776,7 @@ the user from the mailer."
        resend-to-addresses
        delimline
        fcc-was-found
-       (mailbuf (current-buffer))
-       (sendmail-coding-system
-        (if (local-variable-p 'buffer-file-coding-system)
-            buffer-file-coding-system
-          (or sendmail-coding-system
-              default-buffer-file-coding-system
-              'iso-latin-1))))
-    (if (fboundp select-safe-coding-system-function)
-       (setq sendmail-coding-system
-             (funcall select-safe-coding-system-function
-                      (point-min) (point-max) sendmail-coding-system)))
+       (mailbuf (current-buffer)))
     (unwind-protect
        (save-excursion
          (set-buffer tembuf)
@@ -855,7 +897,7 @@ the user from the mailer."
                         (insert "From: " login "\n"))
                        ((eq mail-from-style 'system-default)
                         nil)
-                       (t (error "Invalid value for `system-default'")))))
+                       (t (error "Invalid value for `mail-from-style'")))))
            ;; Insert an extra newline if we need it to work around
            ;; Sun's bug that swallows newlines.
            (goto-char (1+ delimline))
@@ -876,38 +918,38 @@ the user from the mailer."
                (re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\
 \\|^resent-cc:\\|^resent-bcc:"
                                   delimline t))
-             (let ((default-directory "/")
-                   (coding-system-for-write sendmail-coding-system))
-               (apply 'call-process-region
-                      (append (list (point-min) (point-max)
-                                    (if (boundp 'sendmail-program)
-                                        sendmail-program
-                                      "/usr/lib/sendmail")
-                                    nil errbuf nil "-oi")
-                              ;; Always specify who from,
-                              ;; since some systems have broken sendmails.
-                              ;; unless user has said no.
-                              (if (memq mail-from-style '(angles parens nil))
+             (let* ((default-directory "/")
+                    (coding-system-for-write (select-message-coding-system))
+                    (args 
+                     (append (list (point-min) (point-max)
+                                   (if (boundp 'sendmail-program)
+                                       sendmail-program
+                                     "/usr/lib/sendmail")
+                                   nil errbuf nil "-oi")
+                             (and mail-specify-envelope-from 
                                   (list "-f" user-mail-address))
-;;;                           ;; 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")))))
+;;;                          ;; 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"))))
+                    (exit-value (apply 'call-process-region args)))
+               (or (null exit-value) (zerop exit-value)
+                   (error "Sending...failed with exit value %d" exit-value)))
            (or fcc-was-found
                (error "No recipients")))
          (if mail-interactive
@@ -1050,7 +1092,7 @@ the user from the mailer."
   (interactive)
   (save-excursion
     ;; put a marker at the end of the header
-    (let ((end (make-marker (mail-header-end)))
+    (let ((end (copy-marker (mail-header-end)))
          (case-fold-search t)
          to-line)
       (goto-char (point-min))
@@ -1196,7 +1238,8 @@ and don't delete any header fields."
          ;; delete that window to save screen space.
          ;; t means don't alter other frames.
          (delete-windows-on original t)
-         (insert-buffer original))
+         (insert-buffer original)
+         (set-text-properties (point) (mark t) nil))
        (if (consp arg)
            nil
          (goto-char start)
@@ -1257,6 +1300,9 @@ 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