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