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