X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d3db616e13ccfff600069fde5efe5f2075662611..0ec0d9c10af49b1a96bfb9ff607d890a29911549:/lisp/mail/sendmail.el

diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 78d18ee98e..e4da1dcddb 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,6 +1,6 @@
 ;;; sendmail.el --- mail sending commands for Emacs.
 
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1998 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
@@ -42,8 +42,28 @@ If `nil', they contain just the return address like:
 If `parens', they look like:
 	king@grassland.com (Elvis Parsley)
 If `angles', they look like:
-	Elvis Parsley <king@grassland.com>"
-  :type '(choice (const nil) (const parens) (const angles))
+	Elvis Parsley <king@grassland.com>
+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
@@ -71,8 +91,8 @@ nil means let mailer mail back a message to report errors."
 ;;;###autoload
 (defvar send-mail-function 'sendmail-send-it "\
 Function to call to send the current buffer as mail.
-The headers should be delimited by a line whose contents
-match the variable `mail-header-separator'.")
+The headers should be delimited by a line which is
+not a valid RFC822 header or continuation line.")
 
 ;;;###autoload
 (defcustom mail-header-separator "--text follows this line--" "\
@@ -161,15 +181,31 @@ It is semi-obsolete and mail agents should no longer use it.")
 
 (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 each hook function should leave point and mark around the citation
-text as modified.
+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.")
+
+(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 nil)
 
@@ -187,9 +223,18 @@ removed from alias expansions."
 ;;;###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'."
-  :type '(choice (const nil) (const t) string)
+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 "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)
 
 (defcustom mail-signature-file "~/.signature"
   "*File containing the text inserted at end of mail buffer."
@@ -325,19 +370,28 @@ actually occur.")
 	(let ((fill-prefix "\t")
 	      (address-start (point)))
 	  (insert to "\n")
-	  (fill-region-as-paragraph address-start (point-max)))
+	  (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))))
+	  (fill-region-as-paragraph address-start (point-max))
+	  (goto-char (point-max))
+	  (unless (bolp)
+	    (newline))))
     (if in-reply-to
-        (let ((fill-prefix "\t")
+	(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))))
+	  (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))
@@ -359,8 +413,10 @@ actually occur.")
 	       (progn
 		 (insert "\n\n-- \n")
 		 (insert-file-contents mail-signature-file))))
-	  (mail-signature
-	   (insert mail-signature)))
+	  ((stringp mail-signature)
+	   (insert mail-signature))
+	  (t
+	   (eval mail-signature)))
     (goto-char (point-max))
     (or (bolp) (newline)))
   (if to (goto-char to))
@@ -402,31 +458,60 @@ Here are commands that move to a header field (and create it if there isn't):
   (setq fill-paragraph-function 'mail-mode-fill-paragraph)
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
-	(concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+	(concat "[ \t]*\\([-|#;>*]+ *\\|(?[0-9]+[.)] *\\)+"
+		"\\|[ \t]*[-a-z0-9A-Z]*>+[ \t]*"
+		"\\|[ \t]*"))
   (make-local-variable 'adaptive-fill-first-line-regexp)
   (setq adaptive-fill-first-line-regexp
-	(concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp))
+	(concat adaptive-fill-first-line-regexp
+		"\\|[ \t]*[-a-z0-9A-Z]*>+[ \t]*"))
   ;; `-- ' 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-start (concat (regexp-quote mail-header-separator)
-				"$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
+				"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
+				"\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
+				"-- $\\|---+$\\|"
 				page-delimiter))
   (setq paragraph-separate paragraph-start)
   (run-hooks 'text-mode-hook 'mail-mode-hook))
 
+
+(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)
-	 (save-excursion
-	   (goto-char (point-min))
-	   (if (re-search-forward
-		(concat "^" (regexp-quote mail-header-separator) "$")
-		nil t)
-	       (point)
-	     0)))
+  (if (< (point) (mail-header-end))
       (let ((old-line-start (save-excursion (beginning-of-line) (point))))
 	(if (do-auto-fill)
 	    (save-excursion
@@ -441,14 +526,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)
-	 (save-excursion
-	   (goto-char (point-min))
-	   (if (re-search-forward
-		(concat "^" (regexp-quote mail-header-separator) "$")
-		nil t)
-	       (point)
-	     0)))
+  (if (< (point) (mail-header-end))
       (let (beg end fieldname) 
 	(re-search-backward "^[-a-zA-Z]+:" nil 'yes)
 	(setq beg (point))
@@ -623,7 +701,7 @@ the user from the mailer."
 		(error "Message contains non-ASCII characters"))))
 	;; Complain about any invalid line.
 	(goto-char (point-min))
-	(while (not (looking-at (regexp-quote mail-header-separator)))
+	(while (< (point) (mail-header-end))
 	  (unless (looking-at "[ \t]\\|.*:\\|$")
 	    (push-mark opoint)
 	    (error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
@@ -640,7 +718,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)
@@ -651,7 +729,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)
@@ -663,17 +756,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)
@@ -684,11 +767,8 @@ the user from the mailer."
 	  (or (= (preceding-char) ?\n)
 	      (insert ?\n))
 	  ;; Change header-delimiter to be what sendmail expects.
-	  (goto-char (point-min))
-	  (re-search-forward
-	    (concat "^" (regexp-quote mail-header-separator) "\n"))
-	  (replace-match "\n")
-	  (backward-char 1)
+	  (goto-char (mail-header-end))
+	  (delete-region (point) (progn (end-of-line) (point)))
 	  (setq delimline (point-marker))
 	  (sendmail-sync-aliases)
 	  (if mail-aliases
@@ -794,7 +874,10 @@ the user from the mailer."
 			       (goto-char fullname-start))))
 			 (insert ")\n"))
 			((null mail-from-style)
-			 (insert "From: " login "\n")))))
+			 (insert "From: " login "\n"))
+			((eq mail-from-style 'system-default)
+			 nil)
+			(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))
@@ -815,36 +898,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.
-			       (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
-				   ;; 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")))))
+	      (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"))))
+		     (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
@@ -986,12 +1071,8 @@ the user from the mailer."
   "Make a Sent-via header line from each To or CC header line."
   (interactive)
   (save-excursion
-    (goto-char (point-min))
-    ;; find the header-separator
-    (search-forward (concat "\n" mail-header-separator "\n"))
-    (forward-line -1)
     ;; put a marker at the end of the header
-    (let ((end (point-marker))
+    (let ((end (copy-marker (mail-header-end)))
 	  (case-fold-search t)
 	  to-line)
       (goto-char (point-min))
@@ -1054,9 +1135,7 @@ the user from the mailer."
 (defun mail-position-on-field (field &optional soft)
   (let (end
 	(case-fold-search t))
-    (goto-char (point-min))
-    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-    (setq end (match-beginning 0))
+    (setq end (mail-header-end))
     (goto-char (point-min))
     (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
 	(progn
@@ -1074,8 +1153,7 @@ the user from the mailer."
   "Move point to beginning of message text."
   (interactive)
   (expand-abbrev)
-  (goto-char (point-min))
-  (search-forward (concat "\n" mail-header-separator "\n")))
+  (goto-char (mail-text-start)))
 
 (defun mail-signature (atpoint)
   "Sign letter with contents of the file `mail-signature-file'.
@@ -1096,12 +1174,11 @@ Prefix arg means put contents at point."
 Numeric argument means justify as well."
   (interactive "P")
   (save-excursion
-    (goto-char (point-min))
-    (search-forward (concat "\n" mail-header-separator "\n") nil t)
+    (goto-char (mail-text-start))
     (fill-individual-paragraphs (point)
 				(point-max)
 				justifyp
-				t)))
+				mail-citation-prefix-regexp)))
 
 (defun mail-indent-citation ()
   "Modify text just inserted from a message to be cited.
@@ -1141,15 +1218,28 @@ 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)
 	  (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))
 	    (if mail-citation-hook
-		(run-hooks 'mail-citation-hook)
+		;; Bind mail-citation-hook 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))
 	      (if mail-yank-hooks
 		  (run-hooks 'mail-yank-hooks)
 		(mail-indent-citation)))))
@@ -1190,11 +1280,17 @@ 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)))
+	     (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 (point) (mark))))
+		   (buffer-substring-no-properties (point) (mark))))
 	 (push-mark start)
 	 ;; Indent or otherwise annotate the citation text.
 	 (if (consp arg)
@@ -1202,7 +1298,16 @@ and don't delete any header fields."
 	   (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
 					    mail-indentation-spaces)))
 	     (if mail-citation-hook
-		 (run-hooks '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))))))))
@@ -1323,7 +1428,10 @@ The seventh argument ACTIONS is a list of actions to take
   ;; to avoid any danger that it can't be written.
   (if (file-exists-p (expand-file-name "~/"))
       (setq default-directory (expand-file-name "~/")))
-  (auto-save-mode auto-save-default)
+  ;; 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*).