sendmail.el 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429
  1. ;; Mail sending commands for Emacs.
  2. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  3. ;; This file is part of GNU Emacs.
  4. ;; GNU Emacs is distributed in the hope that it will be useful,
  5. ;; but WITHOUT ANY WARRANTY. No author or distributor
  6. ;; accepts responsibility to anyone for the consequences of using it
  7. ;; or for whether it serves any particular purpose or works at all,
  8. ;; unless he says so in writing. Refer to the GNU Emacs General Public
  9. ;; License for full details.
  10. ;; Everyone is granted permission to copy, modify and redistribute
  11. ;; GNU Emacs, but only under the conditions described in the
  12. ;; GNU Emacs General Public License. A copy of this license is
  13. ;; supposed to have been given to you along with GNU Emacs so you
  14. ;; can know your rights and responsibilities. It should be in a
  15. ;; file named COPYING. Among other things, the copyright notice
  16. ;; and this notice must be preserved on all copies.
  17. (provide 'sendmail)
  18. ;(defconst mail-self-blind nil
  19. ; "Non-nil means insert BCC to self in messages to be sent.
  20. ;This is done when the message is initialized,
  21. ;so you can remove or alter the BCC field to override the default.")
  22. ;(defconst mail-interactive nil
  23. ; "Non-nil means when sending a message wait for and display errors.
  24. ;nil means let mailer mail back a message to report errors.")
  25. ;(defconst mail-yank-ignored-headers
  26. ; "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:"
  27. ; "Delete these headers from old message when it's inserted in a reply.")
  28. ;(defvar send-mail-function 'sendmail-send-it
  29. ; "Function to call to send the current buffer as mail.
  30. ;The headers are be delimited by a line which is mail-header-separator"")
  31. ; really defined in loaddefs for emacs 17.17+
  32. ;(defvar mail-header-separator "--text follows this line--"
  33. ; "*Line used to separate headers from text in messages being composed.")
  34. ; really defined in loaddefs for emacs 17.17+
  35. ;(defvar mail-archive-file-name nil
  36. ; "*Name of file to write all outgoing messages in, or nil for none.")
  37. ; really defined in loaddefs for emacs 17.17+
  38. (defvar mail-aliases t
  39. "Alias of mail address aliases,
  40. or t meaning should be initialized from .mailrc.")
  41. (defvar mail-abbrevs-loaded nil)
  42. (defvar mail-mode-map nil)
  43. (autoload 'build-mail-aliases "mailalias"
  44. "Read mail aliases from ~/.mailrc and set mail-aliases."
  45. nil)
  46. (autoload 'expand-mail-aliases "mailalias"
  47. "Expand all mail aliases in suitable header fields found between BEG and END.
  48. Suitable header fields are To, CC and BCC."
  49. nil)
  50. (defun mail-setup (to subject in-reply-to cc replybuffer)
  51. (if (eq mail-aliases t)
  52. (progn
  53. (setq mail-aliases nil)
  54. (if (file-exists-p "~/.mailrc")
  55. (build-mail-aliases))))
  56. (setq mail-reply-buffer replybuffer)
  57. (goto-char (point-min))
  58. (insert "To: ")
  59. (save-excursion
  60. (if to
  61. (progn
  62. (insert to "\n")
  63. ;;; Here removed code to extract names from within <...>
  64. ;;; on the assumption that mail-strip-quoted-names
  65. ;;; has been called and has done so.
  66. (let ((fill-prefix "\t"))
  67. (fill-region (point-min) (point-max))))
  68. (newline))
  69. (if cc
  70. (let ((opos (point))
  71. (fill-prefix "\t"))
  72. (insert "CC: " cc "\n")
  73. (fill-region-as-paragraph opos (point-max))))
  74. (if in-reply-to
  75. (insert "In-reply-to: " in-reply-to "\n"))
  76. (insert "Subject: " (or subject "") "\n")
  77. (if mail-self-blind
  78. (insert "BCC: " (user-login-name) "\n"))
  79. (if mail-archive-file-name
  80. (insert "FCC: " mail-archive-file-name "\n"))
  81. (insert mail-header-separator "\n"))
  82. (if to (goto-char (point-max)))
  83. (or to subject in-reply-to
  84. (set-buffer-modified-p nil))
  85. (run-hooks 'mail-setup-hook))
  86. (defun mail-mode ()
  87. "Major mode for editing mail to be sent.
  88. Like Text Mode but with these additional commands:
  89. C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit
  90. C-c C-f move to a header field (and create it if there isn't):
  91. C-c C-f C-t move to To: C-c C-f C-s move to Subj:
  92. C-c C-f C-b move to BCC: C-c C-f C-c move to CC:
  93. C-c C-w mail-signature (insert ~/.signature at end).
  94. C-c C-y mail-yank-original (insert current message, in Rmail).
  95. C-c C-q mail-fill-yanked-message (fill what was yanked)."
  96. (interactive)
  97. (kill-all-local-variables)
  98. (make-local-variable 'mail-reply-buffer)
  99. (setq mail-reply-buffer nil)
  100. (set-syntax-table text-mode-syntax-table)
  101. (use-local-map mail-mode-map)
  102. (setq local-abbrev-table text-mode-abbrev-table)
  103. (setq major-mode 'mail-mode)
  104. (setq mode-name "Mail")
  105. (setq buffer-offer-save t)
  106. (make-local-variable 'paragraph-separate)
  107. (make-local-variable 'paragraph-start)
  108. (setq paragraph-start (concat "^" mail-header-separator
  109. "$\\|^[ \t]*[-_][-_][-_]+$\\|"
  110. paragraph-start))
  111. (setq paragraph-separate (concat "^" mail-header-separator
  112. "$\\|^[ \t]*[-_][-_][-_]+$\\|"
  113. paragraph-separate))
  114. (run-hooks 'text-mode-hook 'mail-mode-hook))
  115. (if mail-mode-map
  116. nil
  117. (setq mail-mode-map (make-sparse-keymap))
  118. (define-key mail-mode-map "\C-c?" 'describe-mode)
  119. (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
  120. (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
  121. (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
  122. (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
  123. (define-key mail-mode-map "\C-c\C-w" 'mail-signature) ; who
  124. (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
  125. (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
  126. (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
  127. (define-key mail-mode-map "\C-c\C-s" 'mail-send))
  128. (defun mail-send-and-exit (arg)
  129. "Send message like mail-send, then, if no errors, exit from mail buffer."
  130. (interactive "P")
  131. (mail-send)
  132. (bury-buffer (current-buffer))
  133. (if (or arg (one-window-p t))
  134. (switch-to-buffer (other-buffer (current-buffer)))
  135. (delete-window)))
  136. ;; Avoid error in Emacs versions before 18.37.
  137. (defun one-window-p (&optional nomini)
  138. (eq (selected-window)
  139. (if (and nomini (zerop (minibuffer-depth)))
  140. (next-window) (next-window (next-window)))))
  141. (defun mail-send ()
  142. "Send the message in the current buffer.
  143. If mail-interactive is non-nil, wait for success indication
  144. or error messages, and inform user.
  145. Otherwise any failure is reported in a message back to
  146. the user from the mailer."
  147. (interactive)
  148. (message "Sending...")
  149. (funcall send-mail-function)
  150. (set-buffer-modified-p nil)
  151. (delete-auto-save-file-if-necessary)
  152. (message "Sending...done"))
  153. (defun sendmail-send-it ()
  154. (let ((errbuf (if mail-interactive
  155. (generate-new-buffer " sendmail errors")
  156. 0))
  157. (tembuf (generate-new-buffer " sendmail temp"))
  158. (case-fold-search nil)
  159. delimline
  160. (mailbuf (current-buffer)))
  161. (unwind-protect
  162. (save-excursion
  163. (set-buffer tembuf)
  164. (erase-buffer)
  165. (insert-buffer-substring mailbuf)
  166. (goto-char (point-max))
  167. ;; require one newline at the end.
  168. (or (= (preceding-char) ?\n)
  169. (insert ?\n))
  170. ;; Change header-delimiter to be what sendmail expects.
  171. (goto-char (point-min))
  172. (re-search-forward
  173. (concat "^" (regexp-quote mail-header-separator) "\n"))
  174. (replace-match "\n")
  175. (backward-char 1)
  176. (setq delimline (point-marker))
  177. (if mail-aliases
  178. (expand-mail-aliases (point-min) delimline))
  179. (goto-char (point-min))
  180. ;; ignore any blank lines in the header
  181. (while (and (re-search-forward "\n\n\n*" delimline t)
  182. (< (point) delimline))
  183. (replace-match "\n"))
  184. (let ((case-fold-search t))
  185. ;; Find and handle any FCC fields.
  186. (goto-char (point-min))
  187. (if (re-search-forward "^FCC:" delimline t)
  188. (mail-do-fcc delimline))
  189. ;; If there is a From and no Sender, put it a Sender.
  190. (goto-char (point-min))
  191. (and (re-search-forward "^From:" delimline t)
  192. (not (save-excursion
  193. (goto-char (point-min))
  194. (re-search-forward "^Sender:" delimline t)))
  195. (progn
  196. (forward-line 1)
  197. (insert "Sender: " (user-login-name) "\n")))
  198. ;; don't send out a blank subject line
  199. (goto-char (point-min))
  200. (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
  201. (replace-match ""))
  202. (if mail-interactive
  203. (save-excursion
  204. (set-buffer errbuf)
  205. (erase-buffer))))
  206. (apply 'call-process-region
  207. (append (list (point-min) (point-max)
  208. (if (boundp 'sendmail-program)
  209. sendmail-program
  210. "/usr/lib/sendmail")
  211. nil errbuf nil
  212. "-oi" "-t")
  213. ;; Don't say "from root" if running under su.
  214. (and (equal (user-real-login-name) "root")
  215. (list "-f" (user-login-name)))
  216. ;; These mean "report errors by mail"
  217. ;; and "deliver in background".
  218. (if (null mail-interactive) '("-oem" "-odb"))))
  219. (if mail-interactive
  220. (save-excursion
  221. (set-buffer errbuf)
  222. (goto-char (point-min))
  223. (while (re-search-forward "\n\n* *" nil t)
  224. (replace-match "; "))
  225. (if (not (zerop (buffer-size)))
  226. (error "Sending...failed to %s"
  227. (buffer-substring (point-min) (point-max)))))))
  228. (kill-buffer tembuf)
  229. (if (bufferp errbuf)
  230. (kill-buffer errbuf)))))
  231. (defun mail-do-fcc (header-end)
  232. (let (fcc-list
  233. (rmailbuf (current-buffer))
  234. (tembuf (generate-new-buffer " rmail output"))
  235. (case-fold-search t))
  236. (save-excursion
  237. (goto-char (point-min))
  238. (while (re-search-forward "^FCC:[ \t]*" header-end t)
  239. (setq fcc-list (cons (buffer-substring (point)
  240. (progn
  241. (end-of-line)
  242. (skip-chars-backward " \t")
  243. (point)))
  244. fcc-list))
  245. (delete-region (match-beginning 0)
  246. (progn (forward-line 1) (point))))
  247. (set-buffer tembuf)
  248. (erase-buffer)
  249. (insert "\nFrom " (user-login-name) " "
  250. (current-time-string) "\n")
  251. (insert-buffer-substring rmailbuf)
  252. ;; Make sure messages are separated.
  253. (goto-char (point-max))
  254. (insert ?\n)
  255. (goto-char 2)
  256. ;; ``Quote'' "^From " as ">From "
  257. ;; (note that this isn't really quoting, as there is no requirement
  258. ;; that "^[>]+From " be quoted in the same transparent way.)
  259. (let ((case-fold-search nil))
  260. (while (search-forward "\nFrom " nil t)
  261. (forward-char -5)
  262. (insert ?>)))
  263. (while fcc-list
  264. (write-region (point-min) (point-max) (car fcc-list) t)
  265. (setq fcc-list (cdr fcc-list))))
  266. (kill-buffer tembuf)))
  267. (defun mail-to ()
  268. "Move point to end of To-field."
  269. (interactive)
  270. (expand-abbrev)
  271. (mail-position-on-field "To"))
  272. (defun mail-subject ()
  273. "Move point to end of Subject-field."
  274. (interactive)
  275. (expand-abbrev)
  276. (mail-position-on-field "Subject"))
  277. (defun mail-cc ()
  278. "Move point to end of CC-field. Create a CC field if none."
  279. (interactive)
  280. (expand-abbrev)
  281. (or (mail-position-on-field "cc" t)
  282. (progn (mail-position-on-field "to")
  283. (insert "\nCC: "))))
  284. (defun mail-bcc ()
  285. "Move point to end of BCC-field. Create a BCC field if none."
  286. (interactive)
  287. (expand-abbrev)
  288. (or (mail-position-on-field "bcc" t)
  289. (progn (mail-position-on-field "to")
  290. (insert "\nBCC: "))))
  291. (defun mail-position-on-field (field &optional soft)
  292. (let (end
  293. (case-fold-search t))
  294. (goto-char (point-min))
  295. (search-forward (concat "\n" mail-header-separator "\n"))
  296. (setq end (match-beginning 0))
  297. (goto-char (point-min))
  298. (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
  299. (progn
  300. (re-search-forward "^[^ \t]" nil 'move)
  301. (beginning-of-line)
  302. (skip-chars-backward "\n")
  303. t)
  304. (or soft
  305. (progn (goto-char end)
  306. (skip-chars-backward "\n")
  307. (insert "\n" field ": ")))
  308. nil)))
  309. (defun mail-signature ()
  310. "Sign letter with contents of ~/.signature file."
  311. (interactive)
  312. (save-excursion
  313. (goto-char (point-max))
  314. (insert-file-contents (expand-file-name "~/.signature"))))
  315. (defun mail-fill-yanked-message (&optional justifyp)
  316. "Fill the paragraphs of a message yanked into this one.
  317. Numeric argument means justify as well."
  318. (interactive "P")
  319. (save-excursion
  320. (goto-char (point-min))
  321. (search-forward (concat "\n" mail-header-separator "\n") nil t)
  322. (fill-individual-paragraphs (point)
  323. (point-max)
  324. justifyp
  325. t)))
  326. (defun mail-yank-original (arg)
  327. "Insert the message being replied to, if any (in rmail).
  328. Puts point before the text and mark after.
  329. Indents each nonblank line ARG spaces (default 3).
  330. Just \\[universal-argument] as argument means don't indent
  331. and don't delete any header fields."
  332. (interactive "P")
  333. (if mail-reply-buffer
  334. (let ((start (point)))
  335. (delete-windows-on mail-reply-buffer)
  336. (insert-buffer mail-reply-buffer)
  337. (if (consp arg)
  338. nil
  339. (mail-yank-clear-headers start (mark))
  340. (indent-rigidly start (mark)
  341. (if arg (prefix-numeric-value arg) 3)))
  342. (exchange-point-and-mark)
  343. (if (not (eolp)) (insert ?\n)))))
  344. (defun mail-yank-clear-headers (start end)
  345. (save-excursion
  346. (goto-char start)
  347. (if (search-forward "\n\n" end t)
  348. (save-restriction
  349. (narrow-to-region start (point))
  350. (goto-char start)
  351. (while (let ((case-fold-search t))
  352. (re-search-forward mail-yank-ignored-headers nil t))
  353. (beginning-of-line)
  354. (delete-region (point)
  355. (progn (re-search-forward "\n[^ \t]")
  356. (forward-char -1)
  357. (point))))))))
  358. ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file.
  359. (defun mail (&optional noerase to subject in-reply-to cc replybuffer)
  360. "Edit a message to be sent. Argument means resume editing (don't erase).
  361. Returns with message buffer seleted; value t if message freshly initialized.
  362. While editing message, type C-c C-c to send the message and exit.
  363. Various special commands starting with C-c are available in sendmail mode
  364. to move to message header fields. Type C-c? for a list of them.
  365. If mail-self-blind is non-nil, a BCC to yourself is inserted
  366. when the message is initialized.
  367. If mail-setup-hook is bound, its value is called with no arguments
  368. after the message is initialized. It can add more default fields.
  369. When calling from a program, the second through fifth arguments
  370. TO, SUBJECT, CC and IN-REPLY-TO specify if non-nil
  371. the initial contents of those header fields.
  372. These arguments should not have final newlines.
  373. The sixth argument REPLYBUFFER is a buffer whose contents
  374. should be yanked if the user types C-c y."
  375. (interactive "P")
  376. (switch-to-buffer "*mail*")
  377. (setq default-directory (expand-file-name "~/"))
  378. (auto-save-mode auto-save-default)
  379. (mail-mode)
  380. (and (not noerase)
  381. (or (not (buffer-modified-p))
  382. (y-or-n-p "Unsent message being composed; erase it? "))
  383. (progn (erase-buffer)
  384. (mail-setup to subject in-reply-to cc replybuffer)
  385. t)))
  386. (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer)
  387. "Like \"mail\" command, but display mail buffer in another window."
  388. (interactive "P")
  389. (let ((pop-up-windows t))
  390. (pop-to-buffer "*mail*"))
  391. (mail noerase to subject in-reply-to cc replybuffer))
  392. ;;; Do not add anything but external entries on this page.