;;; sendmail.el --- mail sending commands for Emacs.
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Commentary:
+
+;; This mode provides mail-sending facilities from within Emacs. It is
+;; documented in the Emacs user's manual.
+
;;; Code:
;;;###autoload
-(defconst mail-self-blind nil "\
+(defvar mail-self-blind nil "\
Non-nil means insert BCC to self in messages to be sent.
This is done when the message is initialized,
so you can remove or alter the BCC field to override the default.")
;;;###autoload
-(defconst mail-interactive nil "\
+(defvar mail-interactive nil "\
Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
;;;###autoload
-(defconst mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
+(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
Delete these headers from old message when it's inserted in a reply.")
;; Useful to set in site-init.el
;;;###autoload
-(defconst send-mail-function 'sendmail-send-it "\
+(defvar send-mail-function 'sendmail-send-it "\
Function to call to send the current buffer as mail.
The headers are be delimited by a line which is `mail-header-separator'.")
*Name of file to write all outgoing messages in, or nil for none.
Do not use an rmail file here! Instead, use its inbox file.")
+;;;###autoload
(defvar mail-default-reply-to nil
"*Address to insert as default Reply-to field of outgoing messages.")
+;;;###autoload
(defvar mail-alias-file nil
"*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
This file defines aliases to be expanded by the mailer; this is a different
(defvar mail-yank-prefix nil
"*Prefix insert on lines of yanked message being replied to.
nil means use indentation.")
+(defvar mail-indentation-spaces 3
+ "*Number of spaces to insert at the beginning of each cited line.
+Used by `mail-yank-original' via `mail-yank-cite'.")
+(defvar mail-yank-hooks nil
+ "Obsolete 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.
+
+This is a normal hook, misnamed for historical reasons.
+It is semi-obsolete and mail agents should no longer use it.")
+
+(defvar 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.
+
+If this hook is entirely empty (nil), a default action is taken
+instead of no action.")
(defvar mail-abbrevs-loaded nil)
(defvar mail-mode-map nil)
It is inserted before you edit the message,
so you can edit or delete these lines.")
+;; 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")
+ (let ((buffer (get-buffer-create " *temp*")))
+ (unwind-protect
+ (save-excursion
+ (set-buffer buffer)
+ (insert-file-contents "/etc/sendmail.cf")
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (re-search-forward "^OR\\>" nil t)))
+ (kill-buffer buffer))))
+ '(looking-at "[ \t]\\|[-a-zA-Z]+:"))
+ "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.")
+
(defvar mail-mode-syntax-table nil
"Syntax table used while in mail mode.")
(setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
(modify-syntax-entry ?% ". " mail-mode-syntax-table)))
+(defvar mail-send-hook nil
+ "Normal hook run before sending mail, in Mail mode.")
+
(defun mail-setup (to subject in-reply-to cc replybuffer actions)
(if (eq mail-aliases t)
(progn
(insert "To: ")
(save-excursion
(if to
- (progn
+ ;; Here removed code to extract names from within <...>
+ ;; on the assumption that mail-strip-quoted-names
+ ;; has been called and has done so.
+ (let ((fill-prefix "\t")
+ (address-start (point)))
(insert to "\n")
- ;;; Here removed code to extract names from within <...>
- ;;; on the assumption that mail-strip-quoted-names
- ;;; has been called and has done so.
- (let ((fill-prefix "\t"))
- (fill-region (point-min) (point-max))))
+ (fill-region-as-paragraph address-start (point-max)))
(newline))
(if cc
- (let ((opos (point))
- (fill-prefix "\t"))
- (insert "CC: " cc "\n")
- (fill-region-as-paragraph opos (point-max))))
+ (let ((fill-prefix "\t")
+ (address-start (progn (insert "CC: ") (point))))
+ (insert cc "\n")
+ (fill-region-as-paragraph address-start (point-max))))
(if in-reply-to
(insert "In-reply-to: " in-reply-to "\n"))
(insert "Subject: " (or subject "") "\n")
(if mail-archive-file-name
(insert "FCC: " mail-archive-file-name "\n"))
(insert mail-header-separator "\n")
- ;; Insert the signature.
+ ;; Insert the signature. But remember the beginning of the message.
+ (if to (setq to (point)))
(cond ((eq mail-signature t)
(if (file-exists-p "~/.signature")
(progn
- (insert "--\n")
+ (insert "\n\n-- \n")
(insert-file-contents "~/.signature"))))
(mail-signature
(insert mail-signature)))
(goto-char (point-max))
(or (bolp) (newline)))
- (if to (goto-char (point-max)))
+ (if to (goto-char to))
(or to subject in-reply-to
(set-buffer-modified-p nil))
(run-hooks 'mail-setup-hook))
C-c C-f move to a header field (and create it if there isn't):
C-c C-f C-t move to To: C-c C-f C-s move to Subj:
C-c C-f C-b move to BCC: C-c C-f C-c move to CC:
+ C-c C-f C-f move to FCC:
C-c C-t move to message text.
C-c C-y mail-yank-original (insert current message, in Rmail).
C-c C-q mail-fill-yanked-message (fill what was yanked).
"$\\|^[ \t]*[-_][-_][-_]+$\\|"
paragraph-separate))
(run-hooks 'text-mode-hook 'mail-mode-hook))
+\f
+;;; Set up keymap.
(if mail-mode-map
nil
(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
(define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
(define-key mail-mode-map "\C-c\C-s" 'mail-send))
+
+(define-key mail-mode-map [menu-bar mail]
+ (cons "Mail" (make-sparse-keymap "Mail")))
+
+(define-key mail-mode-map [menu-bar mail fill]
+ '("Fill Citation" . mail-fill-yanked-message))
+
+(define-key mail-mode-map [menu-bar mail yank]
+ '("Cite Original" . mail-yank-original))
+
+(define-key mail-mode-map [menu-bar mail signature]
+ '("Insert Signature" . mail-signature))
+
+(define-key mail-mode-map [menu-bar mail cancel]
+ '("Cancel" . mail-dont-send))
+
+(define-key mail-mode-map [menu-bar mail send-stay]
+ '("Send, Keep Editing" . mail-send))
+
+(define-key mail-mode-map [menu-bar mail send]
+ '("Send Message" . mail-send-and-exit))
+
+(define-key mail-mode-map [menu-bar headers]
+ (cons "Headers" (make-sparse-keymap "Headers")))
+
+(define-key mail-mode-map [menu-bar headers sent-via]
+ '("Sent Via" . mail-sent-via))
+
+(define-key mail-mode-map [menu-bar headers text]
+ '("Text" . mail-text))
+
+(define-key mail-mode-map [menu-bar headers bcc]
+ '("Bcc" . mail-bcc))
+
+(define-key mail-mode-map [menu-bar headers fcc]
+ '("Fcc" . mail-fcc))
+
+(define-key mail-mode-map [menu-bar headers cc]
+ '("Cc" . mail-cc))
+
+(define-key mail-mode-map [menu-bar headers subject]
+ '("Subject" . mail-subject))
+
+(define-key mail-mode-map [menu-bar headers to]
+ '("To" . mail-to))
\f
(defun mail-send-and-exit (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)
+ "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)
+ "Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer))))
(bury-buffer (current-buffer))
- (if (and (not arg)
+ (if (and (fboundp 'frame-parameters)
+ (cdr (assq 'dedicated (frame-parameters)))
+ (not (null (delq (selected-frame) (visible-frame-list)))))
+ (delete-frame (selected-frame))
+ (let (rmail-flag summary-buffer)
+ (and (not arg)
(not (one-window-p))
(save-excursion
(set-buffer (window-buffer (next-window (selected-window) 'not)))
- (eq major-mode 'rmail-mode)))
- (delete-window)
- (switch-to-buffer newbuf))))
+ (setq rmail-flag (eq major-mode 'rmail-mode))
+ (setq summary-buffer
+ (and (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))))))
(defun mail-send ()
"Send the message in the current buffer.
Otherwise any failure is reported in a message back to
the user from the mailer."
(interactive)
- (if (or (buffer-modified-p)
- (y-or-n-p "Message already sent; resend? "))
+ (if (if buffer-file-name
+ (y-or-n-p "Send buffer contents as mail message? ")
+ (or (buffer-modified-p)
+ (y-or-n-p "Message already sent; resend? ")))
(progn
- (message "Sending...")
(run-hooks 'mail-send-hook)
+ (message "Sending...")
(funcall send-mail-function)
;; Now perform actions on successful sending.
(while mail-send-actions
(condition-case nil
- (apply (car (car mail-send-actions)) (cdr (car mail-send-actions)))
+ (apply (car (car mail-send-actions))
+ (cdr (car mail-send-actions)))
(error))
(setq mail-send-actions (cdr mail-send-actions)))
- (set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t)
- (message "Sending...done"))))
+ (message "Sending...done")
+ ;; If buffer has no file, mark it as unmodified and delete autosave.
+ (if (not buffer-file-name)
+ (progn
+ (set-buffer-modified-p nil)
+ (delete-auto-save-file-if-necessary t))))))
(defun sendmail-send-it ()
(let ((errbuf (if mail-interactive
0))
(tembuf (generate-new-buffer " sendmail temp"))
(case-fold-search nil)
+ resend-to-addresses
delimline
(mailbuf (current-buffer)))
(unwind-protect
(replace-match "\n"))
(let ((case-fold-search t))
(goto-char (point-min))
- (if (re-search-forward "^Sender:" delimline t)
- (error "Sender may not be specified."))
;; Find and handle any FCC fields.
(goto-char (point-min))
(if (re-search-forward "^FCC:" delimline t)
(mail-do-fcc delimline))
- ;; 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")))
+ (require 'mail-utils)
+ (while (re-search-forward "^Resent-to:" delimline t)
+ (setq resend-to-addresses
+ (save-restriction
+ (narrow-to-region (point)
+ (save-excursion
+ (end-of-line)
+ (point)))
+ (append (mail-parse-comma-list)
+ resend-to-addresses))))
+;;; 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")))
;; "S:" is an abbreviation for "Subject:".
(goto-char (point-min))
(if (re-search-forward "^S:" delimline t)
(goto-char (point-min))
(if (re-search-forward "^Subject:[ \t]*\n" delimline t)
(replace-match ""))
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (if (eval mail-mailer-swallows-blank-line)
+ (newline))
(if mail-interactive
(save-excursion
(set-buffer errbuf)
(if (boundp 'sendmail-program)
sendmail-program
"/usr/lib/sendmail")
- nil errbuf nil
- "-oi" "-t")
+ nil errbuf nil "-oi")
;; Always specify who from,
;; since some systems have broken sendmails.
(list "-f" (user-login-name))
(list (concat "-oA" mail-alias-file)))
;; These mean "report errors by mail"
;; and "deliver in background".
- (if (null mail-interactive) '("-oem" "-odb"))))
+ (if (null mail-interactive) '("-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"))))
(if mail-interactive
(save-excursion
(set-buffer errbuf)
(defun mail-do-fcc (header-end)
(let (fcc-list
(rmailbuf (current-buffer))
- timezone
+ (time (current-time))
(tembuf (generate-new-buffer " rmail output"))
(case-fold-search t))
(save-excursion
(progn (forward-line 1) (point))))
(set-buffer tembuf)
(erase-buffer)
- (call-process "date" nil t nil)
- (goto-char (point-min))
- (re-search-forward
- "[0-9] \\([A-Za-z][A-Za-z ]*[A-Za-z]\\)[0-9 ]*$")
- (setq timezone (buffer-substring (match-beginning 1) (match-end 1)))
- (erase-buffer)
+ ;; This initial newline is written out if the fcc file already exists.
(insert "\nFrom " (user-login-name) " "
- (current-time-string) "\n")
+ (current-time-string time) "\n")
;; Insert the time zone before the year.
(forward-char -1)
(forward-word -1)
- (insert timezone " ")
+ (require 'mail-utils)
+ (insert (mail-rfc822-time-zone time) " ")
(goto-char (point-max))
(insert-buffer-substring rmailbuf)
;; Make sure messages are separated.
(if buffer
;; File is present in a buffer => append to that buffer.
(let ((curbuf (current-buffer))
- (beg (point-min)) (end (point-max)))
+ (beg (point-min)) (end (point-max))
+ (beg2 (save-excursion (goto-char (point-min))
+ (forward-line 2) (point))))
(save-excursion
(set-buffer buffer)
;; Keep the end of the accessible portion at the same place
(let ((max (if (/= (1+ (buffer-size)) (point-max))
(point-max))))
(unwind-protect
- (progn
- (narrow-to-region (point-min) (1+ (buffer-size)))
- (goto-char (point-max))
- (if (eq major-mode 'rmail-mode)
- ;; Append as a message to an RMAIL file
- (let ((buffer-read-only nil))
- ;; This forces RMAIL's message counters to be
- ;; recomputed when the next RMAIL operation is
- ;; done on the buffer.
- ;; See rmail-maybe-set-message-counters.
- (setq rmail-total-messages nil)
+ ;; Code below lifted from rmailout.el
+ ;; function rmail-output-to-rmail-file:
+ (let ((buffer-read-only nil)
+ (msg (and (boundp 'rmail-current-message)
+ rmail-current-message)))
+ ;; If MSG is non-nil, buffer is in RMAIL mode.
+ (if msg
+ (progn
+ (rmail-maybe-set-message-counters)
+ (widen)
+ (narrow-to-region (point-max) (point-max))
(insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
"From: " (user-login-name) "\n"
- "Date: " (current-time-string) "\n")
- (insert-buffer-substring curbuf beg end)
+ "Date: " (mail-rfc822-date) "\n")
+ (insert-buffer-substring curbuf beg2 end)
(insert "\n\C-_")
- (rmail-set-message-counters))
+ (goto-char (point-min))
+ (widen)
+ (search-backward "\n\^_")
+ (narrow-to-region (point) (point-max))
+ (rmail-count-new-messages t)
+ (rmail-show-message msg)
+ (setq max nil))
+ ;; Output file not in rmail mode
+ ;; => just insert at the end.
+ (narrow-to-region (point-min) (1+ (buffer-size)))
+ (goto-char (point-max))
(insert-buffer-substring curbuf beg end)))
(if max (narrow-to-region (point-min) max))))))
;; Else append to the file directly.
(write-region
- ;; Include a blank line before if file already exists.
- (if (file-exists-p (car fcc-list)) (point-min) (1+ (point-min)))
- (point-max) (car fcc-list) t)))
+ (1+ (point-min)) (point-max) (car fcc-list) t)))
(setq fcc-list (cdr fcc-list))))
(kill-buffer tembuf)))
(progn (mail-position-on-field "to")
(insert "\nBCC: "))))
-(defun mail-fcc ()
+(defun mail-fcc (folder)
"Add a new FCC field, with file name completion."
- (interactive)
+ (interactive "FFolder carbon copy: ")
(expand-abbrev)
(or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
(mail-position-on-field "to"))
- (insert "\nFCC: " (read-file-name "Folder carbon copy: ")))
+ (insert "\nFCC: " folder))
(defun mail-position-on-field (field &optional soft)
(let (end
t)
(or soft
(progn (goto-char end)
- (skip-chars-backward "\n")
(insert field ": \n")
(skip-chars-backward "\n")))
nil)))
(search-forward (concat "\n" mail-header-separator "\n")))
\f
(defun mail-signature (atpoint)
- "Sign letter with contents of `mail-signature-file'."
+ "Sign letter with contents of the file `~/.signature'.
+Prefix arg means put contents at point."
(interactive "P")
(save-excursion
(or atpoint
(end-of-line)
(or atpoint
(delete-region (point) (point-max)))
- (insert "\n\n--\n")
+ (insert "\n\n-- \n")
(insert-file-contents (expand-file-name "~/.signature"))))
(defun mail-fill-yanked-message (&optional justifyp)
justifyp
t)))
+(defun mail-indent-citation ()
+ "Modify text just inserted from a message to be cited.
+The inserted text should be the region.
+When this function returns, the region is again around the modified text.
+
+Normally, indent each nonblank line `mail-indentation-spaces' spaces.
+However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
+ (let ((start (point)))
+ (mail-yank-clear-headers start (mark t))
+ (if (null mail-yank-prefix)
+ (indent-rigidly start (mark t) mail-indentation-spaces)
+ (save-excursion
+ (goto-char start)
+ (while (< (point) (mark t))
+ (insert mail-yank-prefix)
+ (forward-line 1))))))
+
(defun mail-yank-original (arg)
"Insert the message being replied to, if any (in rmail).
Puts point before the text and mark after.
(interactive "P")
(if mail-reply-buffer
(let ((start (point)))
- (delete-windows-on mail-reply-buffer)
+ ;; If the original message is in another window in the same frame,
+ ;; delete that window to save screen space.
+ ;; t means don't alter other frames.
+ (delete-windows-on mail-reply-buffer t)
(insert-buffer mail-reply-buffer)
(if (consp arg)
nil
- (mail-yank-clear-headers start (mark))
- (if (null mail-yank-prefix)
- (indent-rigidly start (mark)
- (if arg (prefix-numeric-value arg) 3))
- (save-excursion
- (goto-char start)
- (while (< (point) (mark))
- (insert mail-yank-prefix)
- (forward-line 1)))))
- (exchange-point-and-mark)
+ (goto-char start)
+ (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
+ mail-indentation-spaces)))
+ (if mail-citation-hook
+ (run-hooks 'mail-citation-hook)
+ (if mail-yank-hooks
+ (run-hooks 'mail-yank-hooks)
+ (mail-indent-citation)))))
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer))))
(if (not (eolp)) (insert ?\n)))))
(defun mail-yank-clear-headers (start end)
;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
;;; t))
(switch-to-buffer "*mail*")
- (setq default-directory (expand-file-name "~/"))
+ (if (file-exists-p (expand-file-name "~/"))
+ (setq default-directory (expand-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*).
+; (set-visited-file-name nil)
(let (initialized)
(and (not noerase)
(or (not (buffer-modified-p))
(let ((buffer-read-only nil))
(erase-buffer)
(insert-file-contents file-name nil)))
- (t (error "mail-recover cancelled.")))))
+ (t (error "mail-recover cancelled")))))
;;;###autoload
(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
(pop-to-buffer "*mail*"))
(mail noerase to subject in-reply-to cc replybuffer sendactions))
-
-;;;###autoload
-(define-key ctl-x-map "m" 'mail)
-
-;;;###autoload
-(define-key ctl-x-4-map "m" 'mail-other-window)
-
-;;;###autoload
-(define-key ctl-x-5-map "m" 'mail-other-frame)
-
+;;; Do not execute these when sendmail.el is loaded,
+;;; only in loaddefs.el.
+;;;###autoload (define-key ctl-x-map "m" 'mail)
+;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window)
+;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame)
;;; Do not add anything but external entries on this page.