]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/sendmail.el
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-25
[gnu-emacs] / lisp / mail / sendmail.el
index c56b4193da8b91e217d169a4700691c2cea7e923..b456f8543b1f29565a9a151d2aa3d4c8c9275478 100644 (file)
@@ -1,6 +1,6 @@
 ;;; sendmail.el --- mail sending commands for Emacs.  -*- byte-compile-dynamic: t -*-
 
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 03, 2004
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -68,20 +68,26 @@ controlled by a separate variable, `mail-specify-envelope-from'."
 (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
-`mail-envelope-from', with `user-mail-address' as fallback.
+the variable `mail-envelope-from', with `user-mail-address' as fallback.
 
-On most systems, specifying the envelope-from address
-is a privileged operation."
+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.
-If this is nil while `mail-specify-envelope-from' is non-nil, the
-content of `user-mail-address' is used."
+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)
 
@@ -179,8 +185,8 @@ The function `mail-setup' runs this hook."
 (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 your MAILRC environment
-variable can override that name.)
+\(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")
 
@@ -257,7 +263,7 @@ If a string, that string is inserted.
   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 "None" nil)
+  :type '(choice (const :tag "None" nil)
                 (const :tag "Use `.signature' file" t)
                 (string :tag "String to insert")
                 (sexp :tag "Expression to evaluate"))
@@ -269,6 +275,15 @@ and should insert whatever you want to insert."
   :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.")
@@ -301,6 +316,16 @@ 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
@@ -356,16 +381,17 @@ actually occur.")
               (beginning-of-line) (end-of-line)
               (2 font-lock-constant-face nil t)
               (4 font-lock-comment-face nil t)))
-           '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
+           '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
              . font-lock-string-face))))
   "Additional expressions to highlight in Mail mode.")
 
 \f
 (defun sendmail-sync-aliases ()
-  (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
-    (or (equal mail-alias-modtime modtime)
-       (setq mail-alias-modtime modtime
-             mail-aliases t))))
+  (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
@@ -374,8 +400,9 @@ actually occur.")
   (if (eq mail-aliases t)
       (progn
        (setq mail-aliases nil)
-       (if (file-exists-p mail-personal-alias-file)
-           (build-mail-aliases))))
+       (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.
@@ -455,6 +482,7 @@ actually occur.")
   :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.
@@ -477,7 +505,6 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(mail-font-lock-keywords t t))
   (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
   (make-local-variable 'normal-auto-fill-function)
   (setq normal-auto-fill-function 'mail-mode-auto-fill)
   (make-local-variable 'fill-paragraph-function)
@@ -485,6 +512,9 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
   ;; 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]*\\|"
@@ -497,12 +527,11 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
   ;; lines that delimit forwarded messages.
   ;; 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)
+  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
                                "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
                                "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
-                               "-- $\\|---+$\\|"
-                               page-delimiter))
-  (setq paragraph-separate paragraph-start))
+                               "--\\( \\|-+\\)$\\|"
+                               page-delimiter)))
 
 
 (defun mail-header-end ()
@@ -554,7 +583,7 @@ If within the headers, this makes the new lines into continuation lines."
 (defun mail-mode-fill-paragraph (arg)
   ;; Do something special only if within the headers.
   (if (< (point) (mail-header-end))
-      (let (beg end fieldname) 
+      (let (beg end fieldname)
        (when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
                (setq beg (point)))
        (setq fieldname
@@ -601,6 +630,7 @@ If within the headers, this makes the new lines into continuation lines."
   (define-key mail-mode-map "\C-c\C-t" 'mail-text)
   (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
   (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
+  (define-key mail-mode-map [remap split-line] 'mail-split-line)
   (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
   (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
   (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
@@ -664,27 +694,32 @@ If within the headers, this makes the new lines into continuation lines."
 \f
 ;; User-level commands for sending.
 
-(defun mail-send-and-exit (arg)
+(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 (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 (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)))))
-       (delete-frame (selected-frame))
+       (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))
@@ -755,6 +790,14 @@ the user from the mailer."
            (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))
 \f
 ;; This does the real work of sending a message via sendmail.
 ;; It is called via the variable send-mail-function.
@@ -787,10 +830,9 @@ external program defined by `sendmail-program'."
                    (generate-new-buffer " sendmail errors")
                  0))
        (tembuf (generate-new-buffer " sendmail temp"))
+       (multibyte enable-multibyte-characters)
        (case-fold-search nil)
-       (coding (and (local-variable-p 'buffer-file-coding-system)
-                    buffer-file-coding-system))
-       selected-coding
+       (selected-coding (select-message-coding-system))
 ;;;    resend-to-addresses
        delimline
        fcc-was-found
@@ -802,13 +844,14 @@ external program defined by `sendmail-program'."
        ;; local binding in the mail buffer will take effect.
        (envelope-from
         (and mail-specify-envelope-from
-             (or mail-envelope-from user-mail-address))))
+             (or (mail-envelope-from) user-mail-address))))
     (unwind-protect
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
+         (unless multibyte
+           (set-buffer-multibyte nil))
          (insert-buffer-substring mailbuf)
-         (set-buffer-file-coding-system coding)
          (goto-char (point-max))
          ;; require one newline at the end.
          (or (= (preceding-char) ?\n)
@@ -914,7 +957,7 @@ external program defined by `sendmail-program'."
                             ;; ... then undo escaping of matching parentheses,
                             ;; including matching nested parentheses.
                             (goto-char fullname-start)
-                            (while (re-search-forward 
+                            (while (re-search-forward
                                     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
                                     fullname-end 1)
                               (replace-match "\\1(\\3)" t)
@@ -932,7 +975,7 @@ external program defined by `sendmail-program'."
                   (not (re-search-forward "^MIME-version:" delimline t))
                   (progn (skip-chars-forward "\0-\177")
                          (/= (point) (point-max)))
-                  (setq selected-coding (select-message-coding-system))
+                  selected-coding
                   (setq charset
                         (coding-system-get selected-coding :mime-charset))
                   (goto-char delimline)
@@ -961,10 +1004,8 @@ external program defined by `sendmail-program'."
 \\|^resent-cc:\\|^resent-bcc:"
                                   delimline t))
              (let* ((default-directory "/")
-                    (coding-system-for-write
-                     (or selected-coding
-                         (select-message-coding-system)))
-                    (args 
+                    (coding-system-for-write selected-coding)
+                    (args
                      (append (list (point-min) (point-max)
                                    program
                                    nil errbuf nil "-oi")
@@ -990,10 +1031,13 @@ external program defined by `sendmail-program'."
 ;;;                          (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) (zerop exit-value)
+               (or (null exit-value) (eq 0 exit-value)
                    (error "Sending...failed with exit value %d" exit-value)))
            (or fcc-was-found
                (error "No recipients")))
@@ -1199,7 +1243,7 @@ external program defined by `sendmail-program'."
       (mail-position-on-field "to"))
   (insert "\nFCC: " folder))
 
-(defun mail-reply-to ()      
+(defun mail-reply-to ()
   "Move point to end of Reply-To-field.  Create a Reply-To field if none."
   (interactive)
   (expand-abbrev)
@@ -1229,7 +1273,7 @@ external program defined by `sendmail-program'."
   (goto-char (mail-text-start)))
 \f
 (defun mail-signature (&optional atpoint)
-  "Sign letter with contents of the file `mail-signature-file'.
+  "Sign letter with signature based on `mail-signature-file'.
 Prefix arg means put contents at point."
   (interactive "P")
   (save-excursion
@@ -1239,8 +1283,10 @@ Prefix arg means put contents at point."
     (end-of-line)
     (or atpoint
        (delete-region (point) (point-max)))
-    (insert "\n\n-- \n")
-    (insert-file-contents (expand-file-name mail-signature-file))))
+    (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.
@@ -1386,6 +1432,13 @@ and don't delete any header fields."
               (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))
+
 \f
 (defun mail-attach-file (&optional file)
   "Insert a file at the end of the buffer, with separator lines around it."
@@ -1499,10 +1552,11 @@ The seventh argument ACTIONS is a list of actions to take
 ;;;          (message "Auto save file for draft message exists; consider M-x mail-recover"))
 ;;;          t))
   (pop-to-buffer "*mail*")
-  ;; Put the auto-save file in the home dir
-  ;; to avoid any danger that it can't be written.
-  (if (file-exists-p (expand-file-name "~/"))
-      (setq default-directory (expand-file-name "~/")))
+  ;; 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))
@@ -1582,7 +1636,7 @@ The seventh argument ACTIONS is a list of actions to take
       (define-key (current-local-map) "v"
        (lambda ()
          (interactive)
-         (let ((coding-system-for-read 'emacs-mule-unix))
+         (let ((coding-system-for-read 'utf-8-emacs-unix))
            (dired-view-file))))
       (define-key (current-local-map) "\C-c\C-c"
        (lambda ()
@@ -1590,13 +1644,13 @@ The seventh argument ACTIONS is a list of actions to take
          (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))
+               (coding-system-for-read 'utf-8-emacs-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
+             ;; to utf-8-emacs, 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
@@ -1618,8 +1672,10 @@ you can move to one of them and type C-c C-c to recover that one."
   (switch-to-buffer "*mail*")
   ;; If *mail* didn't exist, set its directory, so that auto-saved
   ;; drafts will be found.
-  (if (file-exists-p (expand-file-name "~/"))
-      (setq default-directory "~/"))
+  (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))
@@ -1631,15 +1687,12 @@ you can move to one of them and type C-c C-c to recover that one."
                  ;; ls-lisp instead).
                  (dired-noselect file-name
                                  (concat dired-listing-switches "t"))))
-            (save-excursion
-              (set-buffer dispbuf)
-              (let ((buffer-read-only nil))
-                (goto-char (point-min))
-                (forward-line)
-                (kill-line 2)
-                (dired-move-to-filename)
-                (setq dispbuf (rename-buffer "*Directory*" t))))
-            (display-buffer dispbuf 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)))
@@ -1648,7 +1701,7 @@ you can move to one of them and type C-c C-c to recover that one."
                     (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))
+                    (coding-system-for-read 'utf-8-emacs-unix))
                 (erase-buffer)
                 (insert-file-contents file-name nil)
                 (setq buffer-file-coding-system buffer-coding)))))
@@ -1682,4 +1735,5 @@ you can move to one of them and type C-c C-c to recover that one."
 
 (provide 'sendmail)
 
+;;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
 ;;; sendmail.el ends here