|
0
|
1 ;;; sendmail.el --- mail sending commands for Emacs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Maintainer: FSF
|
|
|
6 ;; Keywords: mail
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
16
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
0
|
24
|
|
|
25 ;;; Synched up with: FSF 19.30.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; This mode provides mail-sending facilities from within Emacs. It is
|
|
|
30 ;; documented in the Emacs user's manual.
|
|
|
31
|
|
|
32 ;;; Code:
|
|
|
33
|
|
|
34 ;;;###autoload
|
|
|
35 (defvar mail-from-style 'angles "\
|
|
|
36 *Specifies how \"From:\" fields look.
|
|
|
37
|
|
|
38 If `nil', they contain just the return address like:
|
|
|
39 king@grassland.com
|
|
|
40 If `parens', they look like:
|
|
|
41 king@grassland.com (Elvis Parsley)
|
|
|
42 If `angles', they look like:
|
|
|
43 Elvis Parsley <king@grassland.com>")
|
|
|
44
|
|
|
45 ;;;###autoload
|
|
|
46 (defvar mail-self-blind nil "\
|
|
|
47 Non-nil means insert BCC to self in messages to be sent.
|
|
|
48 This is done when the message is initialized,
|
|
|
49 so you can remove or alter the BCC field to override the default.")
|
|
|
50
|
|
|
51 ;;;###autoload
|
|
|
52 (defvar mail-interactive nil "\
|
|
|
53 Non-nil means when sending a message wait for and display errors.
|
|
|
54 nil means let mailer mail back a message to report errors.")
|
|
|
55
|
|
|
56 ;;;###autoload
|
|
|
57 (defvar mail-dir nil "*Default directory for saving messages.")
|
|
|
58
|
|
|
59 ;;; XEmacs change: moved rmail-ignored-headers here from rmail.el so that
|
|
|
60 ;;; the value of mail-yank-ignored-headers can default from it. Both of
|
|
|
61 ;;; these end up in loaddefs.el, but "sendmail" comes before "rmail", so...
|
|
|
62 ;;;
|
|
|
63 ;;;###autoload
|
|
|
64 (defvar rmail-ignored-headers
|
|
|
65 (purecopy
|
|
|
66 (concat
|
|
|
67 "^\\("
|
|
|
68 (mapconcat
|
|
|
69 'identity
|
|
|
70 '(;; RFC822
|
|
|
71 "Sender:" "References:" "Return-Path:" "Received:"
|
|
|
72 "[^: \t\n]*Message-ID:" "Errors-To:"
|
|
|
73 ;; RFC977 (NNTP)
|
|
|
74 "Path:" "Expires:" "Xref:" "Lines:" "Approved:" "Distribution:"
|
|
|
75 ;; SYSV mail:
|
|
|
76 "Content-Length:"
|
|
|
77 ;; MIME:
|
|
|
78 "Mime-Version:" "Content-Type:" "Content-Transfer-Encoding:"
|
|
|
79 ;; X400
|
|
|
80 "X400-Received:" "X400-Originator:" "X400-Mts-Identifier:"
|
|
|
81 "X400-Content-Type:" "Content-Identifier:"
|
|
|
82 ;; RMAIL and /usr/ucb/mail:
|
|
|
83 "Status:" "Summary-Line:"
|
|
|
84 ;; Supercite:
|
|
|
85 "X-Attribution:"
|
|
|
86 ;; Other random junk occasionally seen:
|
|
|
87 "Via:" "Sent-Via:" "Mail-From:" "Origin:" "Comments:" "Originator:"
|
|
|
88 "NF-ID:" "NF-From:" "Posting-Version:" "Posted:" "Posted-Date:"
|
|
|
89 "Date-Received:" "Relay-Version:" "Article-I\\.D\\.:" "NNTP-Version:"
|
|
|
90 "NNTP-Posting-Host:" "X-Mailer:" "X-Newsreader:" "News-Software:"
|
|
|
91 "X-Received:" "X-References:" "X-Envelope-To:"
|
|
|
92 "X-VMS-" "Remailed-" "X-Plantation:" "X-Windows:" "X-Pgp-"
|
|
|
93 )
|
|
|
94 "\\|")
|
|
|
95 "\\)"))
|
|
|
96 "*Gubbish header fields one would rather not see.")
|
|
|
97
|
|
|
98
|
|
|
99 ;;;###autoload
|
|
|
100 (defvar mail-yank-ignored-headers
|
|
|
101 (purecopy
|
|
|
102 (concat rmail-ignored-headers "\\|"
|
|
|
103 "^\\("
|
|
|
104 (mapconcat 'identity
|
|
|
105 '(;; RFC822
|
|
|
106 "Resent-To:" "Resent-By:" "Resent-CC:"
|
|
|
107 "To:" "Subject:" "In-Reply-To:"
|
|
|
108 )
|
|
|
109 "\\|")
|
|
|
110 "\\)"))
|
|
|
111 "Delete these headers from old message when it's inserted in a reply.")
|
|
|
112 ;; minimalist FSF version
|
|
|
113 ;(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
|
|
|
114 ;Delete these headers from old message when it's inserted in a reply.")
|
|
|
115
|
|
|
116 ;; Useful to set in site-init.el
|
|
|
117 ;;;###autoload
|
|
|
118 (defvar send-mail-function 'sendmail-send-it "\
|
|
|
119 Function to call to send the current buffer as mail.
|
|
|
120 The headers should be delimited by a line whose contents
|
|
|
121 match the variable `mail-header-separator'.")
|
|
|
122
|
|
|
123 ;;;###autoload
|
|
|
124 (defvar mail-header-separator (purecopy "--text follows this line--") "\
|
|
|
125 *Line used to separate headers from text in messages being composed.")
|
|
|
126
|
|
|
127 ;;;###autoload
|
|
|
128 (defvar mail-archive-file-name nil "\
|
|
|
129 *Name of file to write all outgoing messages in, or nil for none.
|
|
|
130 This can be an inbox file or an Rmail file.")
|
|
|
131
|
|
|
132 ;;;###autoload
|
|
|
133 (defvar mail-default-reply-to nil
|
|
|
134 "*Address to insert as default Reply-to field of outgoing messages.
|
|
|
135 If nil, it will be initialized from the REPLYTO environment variable
|
|
|
136 when you first send mail.")
|
|
|
137
|
|
|
138 ;;;###autoload
|
|
|
139 (defvar mail-alias-file nil
|
|
|
140 "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
|
|
|
141 This file defines aliases to be expanded by the mailer; this is a different
|
|
|
142 feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
|
|
|
143 This variable has no effect unless your system uses sendmail as its mailer.")
|
|
|
144
|
|
|
145 ;(defvar mail-personal-alias-file "~/.mailrc"
|
|
|
146 ; "*If non-nil, the name of the user's personal mail alias file.
|
|
|
147 ;This file typically should be in same format as the `.mailrc' file used by
|
|
|
148 ;the `Mail' or `mailx' program.
|
|
|
149 ;This file need not actually exist.")
|
|
|
150 (defvaralias 'mail-personal-alias-file 'mail-abbrev-mailrc-file)
|
|
|
151
|
|
|
152 (defvar mail-setup-hook nil
|
|
|
153 "Normal hook, run each time a new outgoing mail message is initialized.
|
|
|
154 The function `mail-setup' runs this hook.")
|
|
|
155
|
|
|
156 ; These are removed. See `mail-abbrevs.el'.
|
|
|
157
|
|
|
158 ;(defvar mail-aliases t
|
|
|
159 ; "Alist of mail address aliases,
|
|
|
160 ;or t meaning should be initialized from your mail aliases file.
|
|
|
161 ;\(The file's name is normally `~/.mailrc', but your MAILRC environment
|
|
|
162 ;variable can override that name.)
|
|
|
163 ;The alias definitions in the file have this form:
|
|
|
164 ; alias ALIAS MEANING")
|
|
|
165 ;
|
|
|
166 ;(defvar mail-alias-modtime nil
|
|
|
167 ; "The modification time of your mail alias file when it was last examined.")
|
|
|
168
|
|
|
169 ;;;###autoload
|
|
|
170 (defvar mail-yank-prefix "> " ; XEmacs change
|
|
|
171 "*Prefix insert on lines of yanked message being replied to.
|
|
|
172 nil means use indentation.")
|
|
|
173
|
|
|
174 (defvar mail-indentation-spaces 3
|
|
|
175 "*Number of spaces to insert at the beginning of each cited line.
|
|
|
176 Used by `mail-yank-original' via `mail-indent-citation'.")
|
|
|
177
|
|
|
178 (defvar mail-yank-hooks nil
|
|
|
179 "Obsolete hook for modifying a citation just inserted in the mail buffer.
|
|
|
180 Each hook function can find the citation between (point) and (mark t).
|
|
|
181 And each hook function should leave point and mark around the citation
|
|
|
182 text as modified.
|
|
|
183
|
|
|
184 This is a normal hook, misnamed for historical reasons.
|
|
|
185 It is semi-obsolete and mail agents should no longer use it.")
|
|
|
186
|
|
|
187 (defvar mail-citation-hook nil
|
|
|
188 "*Hook for modifying a citation just inserted in the mail buffer.
|
|
|
189 Each hook function can find the citation between (point) and (mark t).
|
|
|
190 And each hook function should leave point and mark around the citation
|
|
|
191 text as modified.
|
|
|
192
|
|
|
193 If this hook is entirely empty (nil), a default action is taken
|
|
|
194 instead of no action.")
|
|
|
195
|
|
|
196 (defvar mail-abbrevs-loaded nil)
|
|
|
197 (defvar mail-mode-map nil)
|
|
|
198
|
|
|
199 ; Removed autoloads of `build-mail-aliases' and `expand-mail-aliases'.
|
|
|
200 ; See `mail-abbrevs.el'.
|
|
|
201
|
|
|
202 (autoload 'mail-aliases-setup "mail-abbrevs")
|
|
|
203
|
|
|
204 ;;;###autoload
|
|
|
205 (defvar mail-signature nil
|
|
|
206 "*Text inserted at end of mail buffer when a message is initialized.
|
|
|
207 If t, it means to insert the contents of the file `mail-signature-file'.")
|
|
|
208
|
|
|
209 (defvar mail-signature-file "~/.signature"
|
|
|
210 "*File containing the text inserted at end of mail buffer.")
|
|
|
211
|
|
|
212 (defvar mail-reply-buffer nil)
|
|
|
213 (defvar mail-send-actions nil
|
|
|
214 "A list of actions to be performed upon successful sending of a message.")
|
|
|
215
|
|
|
216 (defvar mail-default-headers nil
|
|
|
217 "*A string containing header lines, to be inserted in outgoing messages.
|
|
|
218 It is inserted before you edit the message,
|
|
|
219 so you can edit or delete these lines.")
|
|
|
220
|
|
|
221 (defvar mail-bury-selects-summary t
|
|
|
222 "*If non-nil, try to show RMAIL summary buffer after returning from mail.
|
|
|
223 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
|
|
|
224 the RMAIL summary buffer before returning, if it exists and this variable
|
|
|
225 is non-nil.")
|
|
|
226
|
|
|
227 ;; Note: could use /usr/ucb/mail instead of sendmail;
|
|
|
228 ;; options -t, and -v if not interactive.
|
|
|
229 (defvar mail-mailer-swallows-blank-line
|
|
|
230 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
|
|
|
231 (file-readable-p "/etc/sendmail.cf")
|
|
|
232 (let ((buffer (get-buffer-create " *temp*")))
|
|
|
233 (unwind-protect
|
|
|
234 (save-excursion
|
|
|
235 (set-buffer buffer)
|
|
|
236 (insert-file-contents "/etc/sendmail.cf")
|
|
|
237 (goto-char (point-min))
|
|
|
238 (let ((case-fold-search nil))
|
|
|
239 (re-search-forward "^OR\\>" nil t)))
|
|
|
240 (kill-buffer buffer))))
|
|
|
241 ;; According to RFC822, "The field-name must be composed of printable
|
|
|
242 ;; ASCII characters (i.e. characters that have decimal values between
|
|
|
243 ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
|
|
|
244 ;; space, or colon.
|
|
|
245 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
|
|
|
246 "Set this non-nil if the system's mailer runs the header and body together.
|
|
|
247 \(This problem exists on Sunos 4 when sendmail is run in remote mode.)
|
|
|
248 The value should be an expression to test whether the problem will
|
|
|
249 actually occur.")
|
|
|
250
|
|
|
251 (defvar mail-use-multiple-buffers-p t
|
|
|
252 "Non-nil means `mail' will create a new buffer if one already exists.")
|
|
|
253
|
|
|
254 (defvar mail-mode-syntax-table nil
|
|
|
255 "Syntax table used while in mail mode.")
|
|
|
256
|
|
|
257 (if (not mail-mode-syntax-table)
|
|
|
258 (progn
|
|
|
259 (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
|
|
|
260 (modify-syntax-entry ?% ". " mail-mode-syntax-table)))
|
|
|
261
|
|
|
262 (defvar mail-font-lock-keywords
|
|
|
263 (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
|
|
|
264 (list '("^To:" . font-lock-function-name-face)
|
|
|
265 '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face)
|
|
|
266 '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
|
|
|
267 (1 font-lock-comment-face) (2 font-lock-type-face nil t))
|
|
|
268 (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
|
|
|
269 1 'font-lock-comment-face)
|
|
|
270 (cons (concat "^[ \t]*"
|
|
|
271 "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
|
|
|
272 "[>|}].*")
|
|
|
273 'font-lock-reference-face)
|
|
|
274 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
|
|
|
275 . font-lock-string-face)))
|
|
|
276 "Additional expressions to highlight in Mail mode.")
|
|
|
277 (put 'mail-mode 'font-lock-defaults '(mail-font-lock-keywords t))
|
|
|
278
|
|
|
279 (defvar mail-send-hook nil
|
|
|
280 "Normal hook run before sending mail, in Mail mode.")
|
|
|
281
|
|
|
282 ; Removed. See above and `mail-abbrevs.el'.
|
|
|
283 ;(defun sendmail-synch-aliases ()
|
|
|
284 ; (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
|
|
|
285 ; (or (equal mail-alias-modtime modtime)
|
|
|
286 ; (setq mail-alias-modtime modtime
|
|
|
287 ; mail-aliases t))))
|
|
|
288
|
|
|
289 (defun mail-setup (to subject in-reply-to cc replybuffer actions)
|
|
|
290 (or mail-default-reply-to
|
|
|
291 (setq mail-default-reply-to (getenv "REPLYTO")))
|
|
|
292 ;Removed. See `mail-abbrevs.el'.
|
|
|
293 ; (sendmail-synch-aliases)
|
|
|
294 ; (if (eq mail-aliases t)
|
|
|
295 ; (progn
|
|
|
296 ; (setq mail-aliases nil)
|
|
|
297 ; (if (file-exists-p mail-personal-alias-file)
|
|
|
298 ; (build-mail-aliases))))
|
|
|
299 (setq mail-send-actions actions)
|
|
|
300 (mail-aliases-setup)
|
|
|
301 (setq mail-reply-buffer replybuffer)
|
|
|
302 (goto-char (point-min))
|
|
|
303 (insert "To: ")
|
|
|
304 (save-excursion
|
|
|
305 (if to
|
|
|
306 ;; Here removed code to extract names from within <...>
|
|
|
307 ;; on the assumption that mail-strip-quoted-names
|
|
|
308 ;; has been called and has done so.
|
|
|
309 (let ((fill-prefix "\t")
|
|
|
310 (address-start (point)))
|
|
|
311 (insert to "\n")
|
|
|
312 (fill-region-as-paragraph address-start (point-max)))
|
|
|
313 (newline))
|
|
|
314 (if cc
|
|
|
315 (let ((fill-prefix "\t")
|
|
|
316 (address-start (progn (insert "CC: ") (point))))
|
|
|
317 (insert cc "\n")
|
|
|
318 (fill-region-as-paragraph address-start (point-max))))
|
|
|
319 (if in-reply-to
|
|
|
320 (let ((fill-prefix "\t")
|
|
|
321 (fill-column 78)
|
|
|
322 (address-start (point)))
|
|
|
323 (insert "In-reply-to: " in-reply-to "\n")
|
|
|
324 (fill-region-as-paragraph address-start (point-max))))
|
|
|
325 (insert "Subject: " (or subject "") "\n")
|
|
|
326 (if mail-default-headers
|
|
|
327 (insert mail-default-headers))
|
|
|
328 (if mail-default-reply-to
|
|
|
329 (insert "Reply-to: " mail-default-reply-to "\n"))
|
|
|
330 (if mail-self-blind
|
|
|
331 (insert "BCC: " (user-login-name) "\n"))
|
|
|
332 (if mail-archive-file-name
|
|
|
333 (insert "FCC: " mail-archive-file-name "\n"))
|
|
|
334 (insert mail-header-separator "\n")
|
|
|
335
|
|
|
336 ;; Insert the signature. But remember the beginning of the message.
|
|
|
337 (if to (setq to (point)))
|
|
|
338 (cond ((eq mail-signature t)
|
|
|
339 (if (file-exists-p mail-signature-file)
|
|
|
340 (progn
|
|
|
341 (insert "\n\n-- \n")
|
|
|
342 (insert-file-contents mail-signature-file))))
|
|
|
343 (mail-signature
|
|
|
344 (insert mail-signature)))
|
|
|
345 (goto-char (point-max))
|
|
|
346 (or (bolp) (newline)))
|
|
|
347 (if to (goto-char to))
|
|
|
348 (or to subject in-reply-to
|
|
|
349 (set-buffer-modified-p nil))
|
|
|
350 (run-hooks 'mail-setup-hook))
|
|
|
351
|
|
|
352 ;;;###autoload
|
|
|
353 (defun mail-mode ()
|
|
|
354 "Major mode for editing mail to be sent.
|
|
|
355 Like Text Mode but with these additional commands:
|
|
|
356 C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit
|
|
|
357 C-c C-f move to a header field (and create it if there isn't):
|
|
|
358 C-c C-f C-t move to To: C-c C-f C-s move to Subj:
|
|
|
359 C-c C-f C-b move to BCC: C-c C-f C-c move to CC:
|
|
|
360 C-c C-f C-f move to FCC: C-c C-f C-r move to Reply-To:
|
|
|
361 C-c C-t mail-text (move to beginning of message text).
|
|
|
362 C-c C-w mail-signature (insert `mail-signature-file' file).
|
|
|
363 C-c C-y mail-yank-original (insert current message, in Rmail).
|
|
|
364 C-c C-q mail-fill-yanked-message (fill what was yanked).
|
|
|
365 C-c C-v mail-sent-via (add a sent-via field for each To or CC)."
|
|
|
366 (interactive)
|
|
|
367 (kill-all-local-variables)
|
|
|
368 (make-local-variable 'mail-reply-buffer)
|
|
|
369 (setq mail-reply-buffer nil)
|
|
|
370 (make-local-variable 'mail-send-actions)
|
|
|
371 (set-syntax-table mail-mode-syntax-table)
|
|
|
372 (use-local-map mail-mode-map)
|
|
|
373 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
374 (setq major-mode 'mail-mode)
|
|
|
375 (setq mode-name "Mail")
|
|
|
376 (setq buffer-offer-save t)
|
|
|
377 (turn-on-auto-fill) ; XEmacs - maybe filladapt should be default, too.
|
|
|
378 (make-local-variable 'paragraph-separate)
|
|
|
379 (make-local-variable 'paragraph-start)
|
|
|
380 (setq paragraph-start (concat (regexp-quote mail-header-separator)
|
|
|
381 "$\\|[ \t]*[-_][-_][-_]+$\\|"
|
|
|
382 paragraph-start))
|
|
|
383 (setq paragraph-separate (concat (regexp-quote mail-header-separator)
|
|
|
384 "$\\|[ \t]*[-_][-_][-_]+$\\|"
|
|
|
385 paragraph-separate))
|
|
|
386 ;; Set menu
|
|
|
387 (setq mode-popup-menu mail-popup-menu)
|
|
|
388 (if (featurep 'menubar)
|
|
|
389 (progn
|
|
|
390 ;; make a local copy of the menubar, so our modes don't
|
|
|
391 ;; change the global menubar
|
|
|
392 (set-buffer-menubar current-menubar)
|
|
|
393 (add-submenu nil mail-menubar-menu)))
|
|
|
394
|
|
|
395 (run-hooks 'text-mode-hook 'mail-mode-hook))
|
|
|
396
|
|
|
397
|
|
|
398 ;;; Set up keymap.
|
|
|
399
|
|
|
400 (if mail-mode-map
|
|
|
401 nil
|
|
|
402 (setq mail-mode-map (make-sparse-keymap))
|
|
|
403 (set-keymap-parents mail-mode-map (list text-mode-map))
|
|
|
404 (set-keymap-name mail-mode-map 'mail-mode-map)
|
|
|
405 (define-key mail-mode-map "\C-c?" 'describe-mode)
|
|
|
406 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
|
|
|
407 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
|
|
|
408 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
|
|
|
409 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
|
|
|
410 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
|
|
|
411 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
|
|
|
412 (define-key mail-mode-map "\C-c\C-t" 'mail-text)
|
|
|
413 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
|
|
|
414 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
|
|
|
415 (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
|
|
|
416 ;;CRAP!!(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)CRAP!
|
|
|
417 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
|
|
|
418 (define-key mail-mode-map "\C-c\C-s" 'mail-send))
|
|
|
419
|
|
|
420 ;;; mail-mode popup menu
|
|
|
421
|
|
|
422 (defvar mail-menubar-menu
|
|
|
423 (purecopy
|
|
|
424 '("Mail"
|
|
|
425 "Sending Mail:"
|
|
|
426 "----"
|
|
|
427 ["Send and Exit" mail-send-and-exit t]
|
|
|
428 ["Send Mail" mail-send t]
|
|
|
429 "----"
|
|
|
430 "Go to Field:"
|
|
|
431 "----"
|
|
|
432 ["To:" mail-to t]
|
|
|
433 ["Subject:" mail-subject t]
|
|
|
434 ["CC:" mail-cc t]
|
|
|
435 ["BCC:" mail-bcc t]
|
|
|
436 ["Reply-To:" mail-reply-to t]
|
|
|
437 ;; ["Sent Via:" mail-sent-via t]
|
|
|
438 ["Text" mail-text t]
|
|
|
439 "----"
|
|
|
440 "Miscellaneous Commands:"
|
|
|
441 "----"
|
|
|
442 ["Yank Original" mail-yank-original
|
|
|
443 (not (null mail-reply-buffer))]
|
|
|
444 ["Fill Yanked Message" mail-fill-yanked-message
|
|
|
445 (save-excursion
|
|
|
446 (goto-char (point-min))
|
|
|
447 (and (search-forward (concat "\n" mail-header-separator
|
|
|
448 "\n") nil t)
|
|
|
449 (not (looking-at "[ \t\n]*\\'"))))]
|
|
|
450 ["Insert Signature" mail-signature
|
|
|
451 (and (stringp mail-signature-file)
|
|
|
452 (file-exists-p mail-signature-file))]
|
|
|
453 ["Insert File..." insert-file t]
|
|
|
454 ["Insert Buffer..." insert-buffer t]
|
|
|
455 "----"
|
|
|
456 ["Cancel" mail-dont-send t]
|
|
|
457 ))
|
|
|
458 "Menubar menu for `mail-mode'.")
|
|
|
459
|
|
|
460 (defvar mail-popup-menu
|
|
|
461 (purecopy
|
|
|
462 (cons "Sendmail Commands"
|
|
|
463 (cdr mail-menubar-menu)))
|
|
|
464 "Menubar menu for `mail-mode'.")
|
|
|
465
|
|
|
466
|
|
|
467 (defun mail-send-and-exit (arg)
|
|
|
468 "Send message like `mail-send', then, if no errors, exit from mail buffer.
|
|
|
469 Prefix arg means don't delete this window."
|
|
|
470 (interactive "P")
|
|
|
471 (mail-send)
|
|
|
472 (mail-bury arg))
|
|
|
473
|
|
|
474 (defun mail-dont-send (arg)
|
|
|
475 "Don't send the message you have been editing.
|
|
|
476 Prefix arg means don't delete this window."
|
|
|
477 (interactive "P")
|
|
|
478 (mail-bury arg))
|
|
|
479
|
|
|
480 (defun mail-bury (arg)
|
|
|
481 "Bury this mail buffer."
|
|
|
482 (let ((newbuf (other-buffer (current-buffer))))
|
|
|
483 (bury-buffer (current-buffer))
|
|
|
484 (if (and (fboundp 'frame-parameters)
|
|
|
485 (cdr (assq 'dedicated (frame-parameters)))
|
|
|
486 (not (null (delq (selected-frame) (visible-frame-list)))))
|
|
|
487 (delete-frame (selected-frame))
|
|
|
488 (let (rmail-flag summary-buffer)
|
|
|
489 (and (not arg)
|
|
|
490 (not (one-window-p))
|
|
|
491 (save-excursion
|
|
|
492 (set-buffer (window-buffer (next-window (selected-window) 'not)))
|
|
|
493 (setq rmail-flag (eq major-mode 'rmail-mode))
|
|
|
494 (setq summary-buffer
|
|
|
495 (and mail-bury-selects-summary
|
|
|
496 (boundp 'rmail-summary-buffer)
|
|
|
497 rmail-summary-buffer
|
|
|
498 (buffer-name rmail-summary-buffer)
|
|
|
499 (not (get-buffer-window rmail-summary-buffer))
|
|
|
500 rmail-summary-buffer))))
|
|
|
501 (if rmail-flag
|
|
|
502 ;; If the Rmail buffer has a summary, show that.
|
|
|
503 (if summary-buffer (switch-to-buffer summary-buffer)
|
|
|
504 (delete-window))
|
|
|
505 (switch-to-buffer newbuf))))))
|
|
|
506
|
|
|
507 (defun mail-send ()
|
|
|
508 "Send the message in the current buffer.
|
|
|
509 If `mail-interactive' is non-nil, wait for success indication or error
|
|
|
510 messages, and inform user. Otherwise any failure is reported in a message
|
|
|
511 back to the user from the mailer."
|
|
|
512 (interactive)
|
|
|
513 (if (if buffer-file-name
|
|
|
514 (y-or-n-p "Send buffer contents as mail message? ")
|
|
|
515 (or (buffer-modified-p)
|
|
|
516 (y-or-n-p "Message already sent; resend? ")))
|
|
|
517 (progn
|
|
|
518 (expand-abbrev) ; for mail-abbrevs
|
|
|
519 (run-hooks 'mail-send-hook)
|
|
|
520 (message "Sending...")
|
|
|
521 (funcall send-mail-function)
|
|
|
522 ;; Now perform actions on successful sending.
|
|
|
523 (while mail-send-actions
|
|
|
524 (condition-case nil
|
|
|
525 (apply (car (car mail-send-actions))
|
|
|
526 (cdr (car mail-send-actions)))
|
|
|
527 (error))
|
|
|
528 (setq mail-send-actions (cdr mail-send-actions)))
|
|
|
529 (message "Sending...done")
|
|
|
530
|
|
|
531 ;; If buffer has no file, mark it as unmodified and delete autosave.
|
|
|
532 (cond ((or (not buffer-file-name)
|
|
|
533 (not (buffer-modified-p)))
|
|
|
534 (set-buffer-modified-p nil)
|
|
|
535 (delete-auto-save-file-if-necessary t))
|
|
|
536 ((or noninteractive
|
|
|
537 (y-or-n-p (format "Save file %s? " buffer-file-name)))
|
|
|
538 (save-buffer))))))
|
|
|
539
|
|
|
540 (defun sendmail-send-it ()
|
|
|
541 (require 'mail-utils)
|
|
|
542 (let ((errbuf (if mail-interactive
|
|
|
543 (generate-new-buffer " sendmail errors")
|
|
|
544 0))
|
|
|
545 (tembuf (generate-new-buffer " sendmail temp"))
|
|
|
546 (case-fold-search nil)
|
|
|
547 resend-to-addresses
|
|
|
548 delimline
|
|
|
549 (mailbuf (current-buffer)))
|
|
|
550 (unwind-protect
|
|
|
551 (save-excursion
|
|
|
552 (set-buffer tembuf)
|
|
|
553 (erase-buffer)
|
|
|
554 (insert-buffer-substring mailbuf)
|
|
|
555 (goto-char (point-max))
|
|
|
556 ;; require one newline at the end.
|
|
|
557 (or (= (preceding-char) ?\n)
|
|
|
558 (insert ?\n))
|
|
|
559 ;; Change header-delimiter to be what sendmail expects.
|
|
|
560 (goto-char (point-min))
|
|
|
561 (re-search-forward
|
|
|
562 (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
563 (replace-match "\n")
|
|
|
564 (backward-char 1)
|
|
|
565 (setq delimline (point-marker))
|
|
|
566 ;Removed. See `mail-abbrevs.el'.
|
|
|
567 ; (sendmail-synch-aliases)
|
|
|
568 ; (if mail-aliases
|
|
|
569 ; (expand-mail-aliases (point-min) delimline))
|
|
|
570 ; (goto-char (point-min))
|
|
|
571 ;; ignore any blank lines in the header
|
|
|
572 (while (and (re-search-forward "\n\n\n*" delimline t)
|
|
|
573 (< (point) delimline))
|
|
|
574 (replace-match "\n"))
|
|
|
575 (let ((case-fold-search t))
|
|
|
576 (goto-char (point-min))
|
|
|
577 (while (re-search-forward "^Resent-to:" delimline t)
|
|
|
578 (setq resend-to-addresses
|
|
|
579 (save-restriction
|
|
|
580 (narrow-to-region (point)
|
|
|
581 (save-excursion
|
|
|
582 (end-of-line)
|
|
|
583 (point)))
|
|
|
584 (append (mail-parse-comma-list)
|
|
|
585 resend-to-addresses))))
|
|
|
586 ;;; Apparently this causes a duplicate Sender.
|
|
|
587 ;;; ;; If the From is different than current user, insert Sender.
|
|
|
588 ;;; (goto-char (point-min))
|
|
|
589 ;;; (and (re-search-forward "^From:" delimline t)
|
|
|
590 ;;; (progn
|
|
|
591 ;;; (require 'mail-utils)
|
|
|
592 ;;; (not (string-equal
|
|
|
593 ;;; (mail-strip-quoted-names
|
|
|
594 ;;; (save-restriction
|
|
|
595 ;;; (narrow-to-region (point-min) delimline)
|
|
|
596 ;;; (mail-fetch-field "From")))
|
|
|
597 ;;; (user-login-name))))
|
|
|
598 ;;; (progn
|
|
|
599 ;;; (forward-line 1)
|
|
|
600 ;;; (insert "Sender: " (user-login-name) "\n")))
|
|
|
601 ;; Don't send out a blank subject line
|
|
|
602 (goto-char (point-min))
|
|
|
603 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
|
|
|
604 (replace-match ""))
|
|
|
605 ;; Put the "From:" field in unless for some odd reason
|
|
|
606 ;; they put one in themselves.
|
|
|
607 (goto-char (point-min))
|
|
|
608 (if (not (re-search-forward "^From:" delimline t))
|
|
|
609 (let* ((login user-mail-address)
|
|
|
610 (fullname (user-full-name)))
|
|
|
611 (cond ((eq mail-from-style 'angles)
|
|
|
612 (insert "From: " fullname)
|
|
|
613 (let ((fullname-start (+ (point-min) 6))
|
|
|
614 (fullname-end (point-marker)))
|
|
|
615 (goto-char fullname-start)
|
|
|
616 ;; Look for a character that cannot appear unquoted
|
|
|
617 ;; according to RFC 822.
|
|
|
618 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
|
|
|
619 fullname-end 1)
|
|
|
620 (progn
|
|
|
621 ;; Quote fullname, escaping specials.
|
|
|
622 (goto-char fullname-start)
|
|
|
623 (insert "\"")
|
|
|
624 (while (re-search-forward "[\"\\]"
|
|
|
625 fullname-end 1)
|
|
|
626 (replace-match "\\\\\\&" t))
|
|
|
627 (insert "\""))))
|
|
|
628 (insert " <" login ">\n"))
|
|
|
629 ((eq mail-from-style 'parens)
|
|
|
630 (insert "From: " login " (")
|
|
|
631 (let ((fullname-start (point)))
|
|
|
632 (insert fullname)
|
|
|
633 (let ((fullname-end (point-marker)))
|
|
|
634 (goto-char fullname-start)
|
|
|
635 ;; RFC 822 says \ and nonmatching parentheses
|
|
|
636 ;; must be escaped in comments.
|
|
|
637 ;; Escape every instance of ()\ ...
|
|
|
638 (while (re-search-forward "[()\\]" fullname-end 1)
|
|
|
639 (replace-match "\\\\\\&" t))
|
|
|
640 ;; ... then undo escaping of matching parentheses,
|
|
|
641 ;; including matching nested parentheses.
|
|
|
642 (goto-char fullname-start)
|
|
|
643 (while (re-search-forward
|
|
|
644 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
|
|
|
645 fullname-end 1)
|
|
|
646 (replace-match "\\1(\\3)" t)
|
|
|
647 (goto-char fullname-start))))
|
|
|
648 (insert ")\n"))
|
|
|
649 ((null mail-from-style)
|
|
|
650 (insert "From: " login "\n")))))
|
|
|
651 ;; Insert an extra newline if we need it to work around
|
|
|
652 ;; Sun's bug that swallows newlines.
|
|
|
653 (goto-char (1+ delimline))
|
|
|
654 (if (eval mail-mailer-swallows-blank-line)
|
|
|
655 (newline))
|
|
|
656 ;; Find and handle any FCC fields.
|
|
|
657 (goto-char (point-min))
|
|
|
658 (if (re-search-forward "^FCC:" delimline t)
|
|
|
659 (mail-do-fcc delimline))
|
|
|
660 (if mail-interactive
|
|
|
661 (save-excursion
|
|
|
662 (set-buffer errbuf)
|
|
|
663 (erase-buffer))))
|
|
|
664 (let ((default-directory "/"))
|
|
|
665 (apply 'call-process-region
|
|
|
666 (append (list (point-min) (point-max)
|
|
|
667 (if (boundp 'sendmail-program)
|
|
|
668 sendmail-program
|
|
|
669 "/usr/lib/sendmail")
|
|
|
670 nil errbuf nil "-oi")
|
|
|
671 ;; Always specify who from,
|
|
|
672 ;; since some systems have broken sendmails.
|
|
|
673 (list "-f" (user-login-name))
|
|
|
674 ;;; ;; Don't say "from root" if running under su.
|
|
|
675 ;;; (and (equal (user-real-login-name) "root")
|
|
|
676 ;;; (list "-f" (user-login-name)))
|
|
|
677 (and mail-alias-file
|
|
|
678 (list (concat "-oA" mail-alias-file)))
|
|
|
679 ;; These mean "report errors by mail"
|
|
|
680 ;; and "deliver in background".
|
|
|
681 (if (null mail-interactive) '("-oem" "-odb"))
|
|
|
682 ;; Get the addresses from the message
|
|
|
683 ;; unless this is a resend.
|
|
|
684 ;; We must not do that for a resend
|
|
|
685 ;; because we would find the original addresses.
|
|
|
686 ;; For a resend, include the specific addresses.
|
|
|
687 (or resend-to-addresses
|
|
|
688 '("-t")))))
|
|
|
689 (if mail-interactive
|
|
|
690 (save-excursion
|
|
|
691 (set-buffer errbuf)
|
|
|
692 (goto-char (point-min))
|
|
|
693 (while (re-search-forward "\n\n* *" nil t)
|
|
|
694 (replace-match "; "))
|
|
|
695 (if (not (zerop (buffer-size)))
|
|
|
696 (error "Sending...failed to %s"
|
|
|
697 (buffer-substring (point-min) (point-max)))))))
|
|
|
698 (kill-buffer tembuf)
|
|
|
699 (if (bufferp errbuf)
|
|
|
700 (kill-buffer errbuf)))))
|
|
|
701
|
|
|
702 ;;; FCC hackery, by jwz. This version works on BABYL and VM buffers.
|
|
|
703 ;;; To accomplish the latter, VM is loaded when this file is compiled.
|
|
|
704 ;;; Don't worry, it's only loaded at compile-time.
|
|
|
705
|
|
|
706 (defun mail-do-fcc (header-end)
|
|
|
707 (let (fcc-list
|
|
|
708 (send-mail-buffer (current-buffer))
|
|
|
709 (tembuf (generate-new-buffer " rmail output"))
|
|
|
710 (case-fold-search t)
|
|
|
711 beg end)
|
|
|
712 (or (markerp header-end) (error "header-end must be a marker"))
|
|
|
713 (save-excursion
|
|
|
714 (goto-char (point-min))
|
|
|
715 (while (re-search-forward "^FCC:[ \t]*" header-end t)
|
|
|
716 (setq fcc-list (cons (buffer-substring (point)
|
|
|
717 (progn
|
|
|
718 (end-of-line)
|
|
|
719 (skip-chars-backward " \t")
|
|
|
720 (point)))
|
|
|
721 fcc-list))
|
|
|
722 (delete-region (match-beginning 0)
|
|
|
723 (progn (forward-line 1) (point))))
|
|
|
724 (set-buffer tembuf)
|
|
|
725 (erase-buffer)
|
|
|
726 ;; insert just the headers to avoid moving the gap more than
|
|
|
727 ;; necessary (the message body could be arbitrarily huge.)
|
|
|
728 (insert-buffer-substring send-mail-buffer 1 header-end)
|
|
|
729
|
|
|
730 ;; if there's no From: or Date: field, cons some.
|
|
|
731 (goto-char (point-min))
|
|
|
732 (or (re-search-forward "^From[ \t]*:" header-end t)
|
|
|
733 (insert "From: " (user-login-name) " (" (user-full-name) ")\n"))
|
|
|
734 (goto-char (point-min))
|
|
|
735 (or (re-search-forward "^Date[ \t]*:" header-end t)
|
|
|
736 (mail-do-fcc-insert-date-header))
|
|
|
737
|
|
|
738 ;; insert a magic From_ line.
|
|
|
739 (goto-char (point-min))
|
|
|
740 (insert "\nFrom " (user-login-name) " " (current-time-string) "\n")
|
|
|
741 (goto-char (point-max))
|
|
|
742 (insert-buffer-substring send-mail-buffer header-end)
|
|
|
743 (goto-char (point-max))
|
|
|
744 (insert ?\n)
|
|
|
745 (goto-char (1- header-end))
|
|
|
746
|
|
|
747 ;; ``Quote'' "^From " as ">From "
|
|
|
748 ;; (note that this isn't really quoting, as there is no requirement
|
|
|
749 ;; that "^[>]+From " be quoted in the same transparent way.)
|
|
|
750 (let ((case-fold-search nil))
|
|
|
751 (while (search-forward "\nFrom " nil t)
|
|
|
752 (forward-char -5)
|
|
|
753 (insert ?>)))
|
|
|
754
|
|
|
755 (setq beg (point-min)
|
|
|
756 end (point-max))
|
|
|
757 (while fcc-list
|
|
|
758 (let ((target-buffer (get-file-buffer (car fcc-list))))
|
|
|
759 (if target-buffer
|
|
|
760 ;; File is present in a buffer => append to that buffer.
|
|
|
761 (save-excursion
|
|
|
762 (set-buffer target-buffer)
|
|
|
763 (cond ((eq major-mode 'rmail-mode)
|
|
|
764 (mail-do-fcc-rmail-internal tembuf))
|
|
|
765 ((eq major-mode 'vm-mode)
|
|
|
766 (mail-do-fcc-vm-internal tembuf))
|
|
|
767 (t
|
|
|
768 ;; Append to an ordinary buffer as a Unix mail message.
|
|
|
769 (goto-char (point-max))
|
|
|
770 (insert-buffer-substring tembuf beg end))))
|
|
|
771 ;; Else append to the file directly.
|
|
|
772 ;; (It's OK if it is an RMAIL or VM file -- the message will be
|
|
|
773 ;; parsed when the file is read in.)
|
|
|
774 (write-region
|
|
|
775 (1+ (point-min)) (point-max) (car fcc-list) t)))
|
|
|
776 (setq fcc-list (cdr fcc-list))))
|
|
|
777 (kill-buffer tembuf)))
|
|
|
778
|
|
|
779 (defvar mail-do-fcc-cached-timezone nil)
|
|
|
780
|
|
|
781 (defun mail-do-fcc-insert-date-header ()
|
|
|
782 ;; Convert the ctime() format that `current-time-string' returns into
|
|
|
783 ;; an RFC-822-legal date.
|
|
|
784 (let ((s (current-time-string)))
|
|
|
785 (string-match "\\`\\([A-Z][a-z][a-z]\\) +\\([A-Z][a-z][a-z]\\) +\\([0-9][0-9]?\\) *\\([0-9][0-9]?:[0-9][0-9]:[0-9][0-9]\\) *[0-9]?[0-9]?\\([0-9][0-9]\\)"
|
|
|
786 s)
|
|
|
787 (insert "Date: "
|
|
|
788 (substring s (match-beginning 1) (match-end 1)) ", "
|
|
|
789 (substring s (match-beginning 3) (match-end 3)) " "
|
|
|
790 (substring s (match-beginning 2) (match-end 2)) " "
|
|
|
791 (substring s (match-beginning 5) (match-end 5)) " "
|
|
|
792 (substring s (match-beginning 4) (match-end 4)) " ")
|
|
|
793
|
|
|
794 (if mail-do-fcc-cached-timezone
|
|
|
795 (insert mail-do-fcc-cached-timezone "\n")
|
|
|
796 ;;
|
|
|
797 ;; First, try to use the current-time-zone function, which may not be
|
|
|
798 ;; defined, and even if it is defined, may error or return nil.
|
|
|
799 ;;
|
|
|
800 (or (condition-case ()
|
|
|
801 (let ((zoneinfo (current-time-zone)))
|
|
|
802 (setq mail-do-fcc-cached-timezone
|
|
|
803 (if (stringp (nth 1 zoneinfo))
|
|
|
804 (nth 1 zoneinfo)
|
|
|
805 (or (if (nth 1 zoneinfo) (nth 3 zoneinfo))
|
|
|
806 (nth 2 zoneinfo))))
|
|
|
807 (if mail-do-fcc-cached-timezone
|
|
|
808 (insert mail-do-fcc-cached-timezone "\n"))
|
|
|
809 mail-do-fcc-cached-timezone)
|
|
|
810 (error nil))
|
|
|
811 ;;
|
|
|
812 ;; Otherwise, run date(1) and parse its output. Yuck!
|
|
|
813 ;;
|
|
|
814 (save-restriction
|
|
|
815 (narrow-to-region (point) (point))
|
|
|
816 (call-process "date" nil t nil)
|
|
|
817 (end-of-line)
|
|
|
818 (insert "\n")
|
|
|
819 (forward-word -1) ; skip back over year
|
|
|
820 (delete-region (1- (point)) (1- (point-max))) ; nuke year to end
|
|
|
821 (forward-word -1) ; skip back over zone
|
|
|
822 (delete-region (point-min) (point)) ; nuke beginning to zone
|
|
|
823 (setq mail-do-fcc-cached-timezone
|
|
|
824 (buffer-substring (point-min) (1- (point-max)))))))))
|
|
|
825
|
|
|
826 (defun mail-do-fcc-rmail-internal (buffer)
|
|
|
827 (or (eq major-mode 'rmail-mode) (error "this only works in rmail-mode"))
|
|
|
828 (let ((b (point-min))
|
|
|
829 (e (point-max))
|
|
|
830 (buffer-read-only nil))
|
|
|
831 (unwind-protect
|
|
|
832 (progn
|
|
|
833 (widen)
|
|
|
834 (goto-char (point-max))
|
|
|
835 ;; This forces RMAIL's message counters to be recomputed when the
|
|
|
836 ;; next RMAIL operation is done on the buffer.
|
|
|
837 ;; See rmail-maybe-set-message-counters.
|
|
|
838 (setq rmail-total-messages nil)
|
|
|
839 (insert "\^L\n0, unseen,,\n*** EOOH ***")
|
|
|
840 (insert-buffer-substring buffer)
|
|
|
841 (insert "\n\C-_"))
|
|
|
842 (narrow-to-region b e)
|
|
|
843 (rmail-maybe-set-message-counters))))
|
|
|
844
|
|
|
845 ;;; Load VM into the compilation environment but not the load environment.
|
|
|
846 (eval-when-compile
|
|
|
847 (or (and (boundp 'loading-vm-kludge) loading-vm-kludge)
|
|
|
848 ;; nastiness to avoid circular provide/require dependency nonsense
|
|
|
849 (fboundp 'vm-spool-files)
|
|
|
850 (let ((loading-vm-kludge t))
|
|
|
851 (require 'vm))))
|
|
|
852
|
|
|
853 (defun mail-do-fcc-vm-internal (buffer)
|
|
|
854 (or (eq major-mode 'vm-mode) (error "this only works in vm-mode"))
|
|
|
855 (let ((buffer-read-only nil)
|
|
|
856 (foreign-folder-p (not (eq vm-folder-type 'From_))))
|
|
|
857
|
|
|
858 (if foreign-folder-p
|
|
|
859 ;; `buffer' has already been prepared with a "From " line which
|
|
|
860 ;; has a sensible user-id and date in it, but if we're FCCing to
|
|
|
861 ;; a VM folder that isn't in From_ format, we must discard that
|
|
|
862 ;; and let VM do whatever voodoo it needs to do. (Actually we
|
|
|
863 ;; could do this all the time, but then all FCCed messages would
|
|
|
864 ;; have "From VM ..." envelopes, which is less attractive.)
|
|
|
865 (save-excursion
|
|
|
866 (set-buffer buffer)
|
|
|
867 (goto-char (point-min))
|
|
|
868 (skip-chars-forward "\n")
|
|
|
869 (forward-line)
|
|
|
870 (delete-region (point-min) (point))))
|
|
|
871
|
|
|
872 ;; Largely copied from #'vm-save-message in vm-save.el
|
|
|
873 (vm-save-restriction
|
|
|
874 (widen)
|
|
|
875 (goto-char (point-max))
|
|
|
876 (if foreign-folder-p
|
|
|
877 (vm-write-string (current-buffer)
|
|
|
878 (vm-leading-message-separator vm-folder-type)))
|
|
|
879 (insert-buffer-substring buffer)
|
|
|
880 (if foreign-folder-p
|
|
|
881 (vm-write-string (current-buffer)
|
|
|
882 (vm-trailing-message-separator vm-folder-type)))
|
|
|
883
|
|
|
884 (vm-increment vm-messages-not-on-disk)
|
|
|
885 (vm-set-buffer-modified-p t)
|
|
|
886 (vm-clear-modification-flag-undos)
|
|
|
887 (vm-check-for-killed-summary)
|
|
|
888 (vm-assimilate-new-messages)
|
|
|
889 (vm-update-summary-and-mode-line))))
|
|
|
890
|
|
|
891 ;;(defun mail-sent-via ()
|
|
|
892 ;; "Make a Sent-via header line from each To or CC header line."
|
|
|
893 ;; (interactive)
|
|
|
894 ;; (save-excursion
|
|
|
895 ;; (goto-char (point-min))
|
|
|
896 ;; ;; find the header-separator
|
|
|
897 ;; (search-forward (concat "\n" mail-header-separator "\n"))
|
|
|
898 ;; (forward-line -1)
|
|
|
899 ;; ;; put a marker at the end of the header
|
|
|
900 ;; (let ((end (point-marker))
|
|
|
901 ;; (case-fold-search t)
|
|
|
902 ;; to-line)
|
|
|
903 ;; (goto-char (point-min))
|
|
|
904 ;; ;; search for the To: lines and make Sent-via: lines from them
|
|
|
905 ;; ;; search for the next To: line
|
|
|
906 ;; (while (re-search-forward "^\\(to\\|cc\\):" end t)
|
|
|
907 ;; ;; Grab this line plus all its continuations, sans the `to:'.
|
|
|
908 ;; (let ((to-line
|
|
|
909 ;; (buffer-substring (point)
|
|
|
910 ;; (progn
|
|
|
911 ;; (if (re-search-forward "^[^ \t\n]" end t)
|
|
|
912 ;; (backward-char 1)
|
|
|
913 ;; (goto-char end))
|
|
|
914 ;; (point)))))
|
|
|
915 ;; ;; Insert a copy, with altered header field name.
|
|
|
916 ;; (insert-before-markers "Sent-via:" to-line))))))
|
|
|
917
|
|
|
918 (defun mail-to ()
|
|
|
919 "Move point to end of To-field."
|
|
|
920 (interactive)
|
|
|
921 (expand-abbrev)
|
|
|
922 (mail-position-on-field "To"))
|
|
|
923
|
|
|
924 (defun mail-subject ()
|
|
|
925 "Move point to end of Subject-field."
|
|
|
926 (interactive)
|
|
|
927 (expand-abbrev)
|
|
|
928 (mail-position-on-field "Subject"))
|
|
|
929
|
|
|
930 (defun mail-cc ()
|
|
|
931 "Move point to end of CC-field. Create a CC field if none."
|
|
|
932 (interactive)
|
|
|
933 (expand-abbrev)
|
|
|
934 (or (mail-position-on-field "cc" t)
|
|
|
935 (progn (mail-position-on-field "to")
|
|
|
936 (insert "\nCC: "))))
|
|
|
937
|
|
|
938 (defun mail-bcc ()
|
|
|
939 "Move point to end of BCC-field. Create a BCC field if none."
|
|
|
940 (interactive)
|
|
|
941 (expand-abbrev)
|
|
|
942 (or (mail-position-on-field "bcc" t)
|
|
|
943 (progn (mail-position-on-field "to")
|
|
|
944 (insert "\nBCC: "))))
|
|
|
945
|
|
|
946 (defun mail-fcc (folder)
|
|
|
947 "Add a new FCC field, with file name completion."
|
|
|
948 (interactive "FFolder carbon copy: ")
|
|
|
949 (expand-abbrev)
|
|
|
950 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
|
|
|
951 (mail-position-on-field "to"))
|
|
|
952 (insert "\nFCC: " folder))
|
|
|
953
|
|
|
954 (defun mail-reply-to ()
|
|
|
955 "Move point to end of Reply-To-field. Create a Reply-To field if none."
|
|
|
956 (interactive)
|
|
|
957 (expand-abbrev)
|
|
|
958 (or (mail-position-on-field "reply-to" t)
|
|
|
959 (progn (mail-position-on-field "to")
|
|
|
960 (insert "\nReply-To: "))))
|
|
|
961
|
|
|
962 (defun mail-position-on-field (field &optional soft)
|
|
|
963 (let (end
|
|
|
964 (case-fold-search t))
|
|
|
965 (goto-char (point-min))
|
|
|
966 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
|
|
|
967 (setq end (match-beginning 0))
|
|
|
968 (goto-char (point-min))
|
|
|
969 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
|
|
|
970 (progn
|
|
|
971 (re-search-forward "^[^ \t]" nil 'move)
|
|
|
972 (beginning-of-line)
|
|
|
973 (skip-chars-backward "\n")
|
|
|
974 t)
|
|
|
975 (or soft
|
|
|
976 (progn (goto-char end)
|
|
|
977 ;; #### FSF has the next two clauses reversed.
|
|
|
978 ;; which is correct?
|
|
|
979 (skip-chars-backward "\n")
|
|
|
980 (insert "\n" field ": ")))
|
|
|
981 nil)))
|
|
|
982
|
|
|
983 (defun mail-text ()
|
|
|
984 "Move point to beginning of message text."
|
|
|
985 (interactive)
|
|
|
986 (expand-abbrev)
|
|
|
987 (goto-char (point-min))
|
|
|
988 (search-forward (concat "\n" mail-header-separator "\n")))
|
|
|
989
|
|
|
990 (defun mail-signature (&optional atpoint)
|
|
|
991 "Sign letter with contents of the file `mail-signature-file'.
|
|
|
992 Prefix arg means put contents at point."
|
|
|
993 (interactive "P")
|
|
|
994 (save-excursion
|
|
|
995 (or atpoint
|
|
|
996 (goto-char (point-max)))
|
|
|
997 (skip-chars-backward " \t\n")
|
|
|
998 (end-of-line)
|
|
|
999 (or atpoint
|
|
|
1000 (delete-region (point) (point-max)))
|
|
|
1001 (insert "\n\n-- \n")
|
|
|
1002 (insert-file-contents (expand-file-name mail-signature-file))))
|
|
|
1003
|
|
|
1004 (defun mail-fill-yanked-message (&optional justifyp)
|
|
|
1005 "Fill the paragraphs of a message yanked into this one.
|
|
|
1006 Numeric argument means justify as well."
|
|
|
1007 (interactive "P")
|
|
|
1008 (save-excursion
|
|
|
1009 (goto-char (point-min))
|
|
|
1010 (search-forward (concat "\n" mail-header-separator "\n") nil t)
|
|
|
1011 (fill-individual-paragraphs (point)
|
|
|
1012 (point-max)
|
|
|
1013 justifyp
|
|
|
1014 t)))
|
|
|
1015
|
|
|
1016 (defun mail-indent-citation ()
|
|
|
1017 "Modify text just inserted from a message to be cited.
|
|
|
1018 The inserted text should be the region.
|
|
|
1019 When this function returns, the region is again around the modified text.
|
|
|
1020
|
|
|
1021 Normally, indent each nonblank line `mail-indentation-spaces' spaces.
|
|
|
1022 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
|
|
|
1023 (let ((start (point)))
|
|
|
1024 (mail-yank-clear-headers start (mark t))
|
|
|
1025 (if (null mail-yank-prefix)
|
|
|
1026 (indent-rigidly start (mark t) mail-indentation-spaces)
|
|
|
1027 (save-excursion
|
|
|
1028 (goto-char start)
|
|
|
1029 (while (< (point) (mark t))
|
|
|
1030 (insert mail-yank-prefix)
|
|
|
1031 (forward-line 1))))))
|
|
|
1032
|
|
|
1033 (defun mail-yank-original (arg)
|
|
|
1034 "Insert the message being replied to, if any (in rmail).
|
|
|
1035 Puts point before the text and mark after.
|
|
|
1036 Normally, indents each nonblank line ARG spaces (default 3).
|
|
|
1037 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
|
|
|
1038
|
|
|
1039 Just \\[universal-argument] as argument means don't indent, insert no prefix,
|
|
|
1040 and don't delete any header fields."
|
|
|
1041 (interactive "P")
|
|
|
1042 (if mail-reply-buffer
|
|
|
1043 (let ((start (point))
|
|
|
1044 (reader-buf mail-reply-buffer)
|
|
|
1045 (reader-window (get-buffer-window mail-reply-buffer
|
|
|
1046 (selected-frame))))
|
|
|
1047 ;; If the original message is in another window in the same frame,
|
|
|
1048 ;; delete that window to save screen space.
|
|
|
1049 ;; t means don't alter other frames.
|
|
|
1050 (if reader-window
|
|
|
1051 (delete-windows-on reader-buf t))
|
|
|
1052 (insert-buffer reader-buf)
|
|
|
1053 (if (consp arg)
|
|
|
1054 nil
|
|
|
1055 (goto-char start)
|
|
|
1056 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
|
|
|
1057 mail-indentation-spaces)))
|
|
|
1058 (cond (mail-citation-hook
|
|
|
1059 (run-hooks 'mail-citation-hook))
|
|
|
1060 (mail-yank-hooks
|
|
|
1061 (run-hooks 'mail-yank-hooks))
|
|
|
1062 (t
|
|
|
1063 (mail-indent-citation)))))
|
|
|
1064 (exchange-point-and-mark t)
|
|
|
1065 (if (not (eolp)) (insert ?\n)))))
|
|
|
1066
|
|
|
1067 (defun mail-yank-clear-headers (start end)
|
|
|
1068 (if mail-yank-ignored-headers
|
|
|
1069 (save-excursion
|
|
|
1070 (goto-char start)
|
|
|
1071 (if (search-forward "\n\n" end t)
|
|
|
1072 (save-restriction
|
|
|
1073 (narrow-to-region start (point))
|
|
|
1074 (goto-char start)
|
|
|
1075 (while (let ((case-fold-search t))
|
|
|
1076 (re-search-forward mail-yank-ignored-headers nil t))
|
|
|
1077 (beginning-of-line)
|
|
|
1078 (delete-region (point)
|
|
|
1079 (progn (re-search-forward "\n[^ \t]")
|
|
|
1080 (forward-char -1)
|
|
|
1081 (point)))))))))
|
|
|
1082
|
|
|
1083 ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file.
|
|
|
1084
|
|
|
1085 ;;;###autoload
|
|
|
1086 (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
|
|
|
1087 "Edit a message to be sent. Prefix arg means resume editing (don't erase).
|
|
|
1088 When this function returns, the buffer `*mail*' is selected.
|
|
|
1089 The value is t if the message was newly initialized; otherwise, nil.
|
|
|
1090
|
|
|
1091 Optionally, the signature file `mail-signature-file' can be inserted at the
|
|
|
1092 end; see the variable `mail-signature'.
|
|
|
1093
|
|
|
1094 \\<mail-mode-map>
|
|
|
1095 While editing message, type \\[mail-send-and-exit] to send the message and exit.
|
|
|
1096
|
|
|
1097 Various special commands starting with C-c are available in sendmail mode
|
|
|
1098 to move to message header fields:
|
|
|
1099 \\{mail-mode-map}
|
|
|
1100
|
|
|
1101 The variable `mail-signature' controls whether the signature file
|
|
|
1102 `mail-signature-file' is inserted immediately.
|
|
|
1103
|
|
|
1104 If `mail-signature' is nil, use \\[mail-signature] to insert the
|
|
|
1105 signature in `mail-signature-file'.
|
|
|
1106
|
|
|
1107 If `mail-self-blind' is non-nil, a BCC to yourself is inserted
|
|
|
1108 when the message is initialized.
|
|
|
1109
|
|
|
1110 If `mail-default-reply-to' is non-nil, it should be an address (a string);
|
|
|
1111 a Reply-to: field with that address is inserted.
|
|
|
1112
|
|
|
1113 If `mail-archive-file-name' is non-nil, an FCC field with that file name
|
|
|
1114 is inserted.
|
|
|
1115
|
|
|
1116 The normal hook `mail-setup-hook' is run after the message is
|
|
|
1117 initialized. It can add more default fields to the message.
|
|
|
1118
|
|
|
1119 When calling from a program, the first argument if non-nil says
|
|
|
1120 not to erase the existing contents of the `*mail*' buffer.
|
|
|
1121
|
|
|
1122 The second through fifth arguments,
|
|
|
1123 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
|
|
|
1124 the initial contents of those header fields.
|
|
|
1125 These arguments should not have final newlines.
|
|
|
1126 The sixth argument REPLYBUFFER is a buffer whose contents
|
|
|
1127 should be yanked if the user types C-c C-y.
|
|
|
1128 The seventh argument ACTIONS is a list of actions to take
|
|
|
1129 if/when the message is sent. Each action looks like (FUNCTION . ARGS);
|
|
|
1130 when the message is sent, we apply FUNCTION to ARGS.
|
|
|
1131 This is how Rmail arranges to mark messages `answered'."
|
|
|
1132 (interactive "P")
|
|
|
1133 (if mail-use-multiple-buffers-p
|
|
|
1134
|
|
|
1135 ;; RMS doesn't like this behavior but it seems more logical to me. --ben
|
|
|
1136 (let ((index 1)
|
|
|
1137 buffer)
|
|
|
1138 ;; If requested, look for a mail buffer that is modified and go to it.
|
|
|
1139 (if noerase
|
|
|
1140 (progn
|
|
|
1141 (while (and (setq buffer
|
|
|
1142 (get-buffer (if (= 1 index) "*mail*"
|
|
|
1143 (format "*mail*<%d>" index))))
|
|
|
1144 (not (buffer-modified-p buffer)))
|
|
|
1145 (setq index (1+ index)))
|
|
|
1146 (if buffer (switch-to-buffer buffer)
|
|
|
1147 ;; If none exists, start a new message.
|
|
|
1148 ;; This will never re-use an existing unmodified mail buffer
|
|
|
1149 ;; (since index is not 1 anymore). Perhaps it should.
|
|
|
1150 (setq noerase nil))))
|
|
|
1151 ;; Unless we found a modified message and are happy, start a
|
|
|
1152 ;; new message.
|
|
|
1153 (if (not noerase)
|
|
|
1154 (progn
|
|
|
1155 ;; Look for existing unmodified mail buffer.
|
|
|
1156 (while (and (setq buffer
|
|
|
1157 (get-buffer (if (= 1 index) "*mail*"
|
|
|
1158 (format "*mail*<%d>" index))))
|
|
|
1159 (buffer-modified-p buffer))
|
|
|
1160 (setq index (1+ index)))
|
|
|
1161 ;; If none, make a new one.
|
|
|
1162 (or buffer
|
|
|
1163 (setq buffer (generate-new-buffer "*mail*")))
|
|
|
1164 ;; Go there and initialize it.
|
|
|
1165 (switch-to-buffer buffer)
|
|
|
1166 (erase-buffer)
|
|
|
1167 ;; put mail auto-save files in home dir instead of
|
|
|
1168 ;; scattering them around the file system.
|
|
|
1169 (setq default-directory (or mail-dir (expand-file-name "~/")))
|
|
|
1170 (auto-save-mode auto-save-default)
|
|
|
1171 (mail-mode)
|
|
|
1172 (mail-setup to subject in-reply-to cc replybuffer actions)
|
|
|
1173 (if (and buffer-auto-save-file-name
|
|
|
1174 (file-exists-p buffer-auto-save-file-name))
|
|
|
1175 (message "Auto save file for draft message exists; consider M-x mail-recover"))
|
|
|
1176 t)))
|
|
|
1177
|
|
|
1178 ;; Alternate behavior that RMS likes.
|
|
|
1179 (pop-to-buffer "*mail*")
|
|
|
1180 (auto-save-mode auto-save-default)
|
|
|
1181 (mail-mode)
|
|
|
1182 ;; Disconnect the buffer from its visited file
|
|
|
1183 ;; (in case the user has actually visited a file *mail*).
|
|
|
1184 ; (set-visited-file-name nil)
|
|
|
1185 (let (initialized)
|
|
|
1186 (and (not noerase)
|
|
|
1187 (or (not (buffer-modified-p))
|
|
|
1188 (y-or-n-p "Unsent message being composed; erase it? "))
|
|
|
1189 (progn (erase-buffer)
|
|
|
1190 (mail-setup to subject in-reply-to cc replybuffer actions)
|
|
|
1191 (setq initialized t)))
|
|
|
1192 (if (and buffer-auto-save-file-name
|
|
|
1193 (file-exists-p buffer-auto-save-file-name))
|
|
|
1194 (message "Auto save file for draft message exists; consider M-x mail-recover"))
|
|
|
1195 initialized)))
|
|
|
1196
|
|
|
1197 (defun mail-recover ()
|
|
|
1198 "Reread contents of current buffer from its last auto-save file."
|
|
|
1199 (interactive)
|
|
|
1200 (let ((file-name (let ((default-directory (expand-file-name "~/")))
|
|
|
1201 ;; put mail auto-save files in home dir instead of
|
|
|
1202 ;; scattering them around the file system.
|
|
|
1203 (make-auto-save-file-name))))
|
|
|
1204 (cond ((save-window-excursion
|
|
|
1205 (if (not (eq system-type 'vax-vms))
|
|
|
1206 (with-output-to-temp-buffer "*Directory*"
|
|
|
1207 (buffer-disable-undo standard-output)
|
|
|
1208 (let ((default-directory "/"))
|
|
|
1209 (call-process
|
|
|
1210 "ls" nil standard-output nil "-l" file-name))))
|
|
|
1211 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
|
|
|
1212 (let ((buffer-read-only nil))
|
|
|
1213 (erase-buffer)
|
|
|
1214 (insert-file-contents file-name nil)))
|
|
|
1215 (t (error "mail-recover cancelled")))))
|
|
|
1216
|
|
|
1217 ;;;###autoload
|
|
|
1218 (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
|
|
|
1219 "Like `mail' command, but display mail buffer in another window."
|
|
|
1220 (interactive "P")
|
|
|
1221 (let ((pop-up-windows t)
|
|
|
1222 (special-display-buffer-names nil)
|
|
|
1223 (special-display-regexps nil)
|
|
|
1224 (same-window-buffer-names nil)
|
|
|
1225 (same-window-regexps nil))
|
|
|
1226 (pop-to-buffer "*mail*"))
|
|
|
1227 (mail noerase to subject in-reply-to cc replybuffer sendactions))
|
|
|
1228
|
|
|
1229 ;;;###autoload
|
|
|
1230 (defun mail-other-frame (&optional noerase to subject in-reply-to cc
|
|
|
1231 replybuffer sendactions)
|
|
|
1232 "Like `mail' command, but display mail buffer in another frame."
|
|
|
1233 (interactive "P")
|
|
|
1234 (let ((pop-up-frames t)
|
|
|
1235 (special-display-buffer-names nil)
|
|
|
1236 (special-display-regexps nil)
|
|
|
1237 (same-window-buffer-names nil)
|
|
|
1238 (same-window-regexps nil))
|
|
|
1239 (pop-to-buffer "*mail*"))
|
|
|
1240 (mail noerase to subject in-reply-to cc replybuffer sendactions))
|
|
|
1241
|
|
|
1242 ;;; Do not execute these when sendmail.el is loaded,
|
|
|
1243 ;;; only in loaddefs.el.
|
|
18
|
1244 ;;; Do not autoload, this package is obsolete. -sb
|
|
0
|
1245 ;;;###autoload (define-key ctl-x-map "m" 'mail)
|
|
|
1246 ;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window)
|
|
|
1247 ;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame)
|
|
|
1248
|
|
|
1249 ;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
|
|
|
1250
|
|
|
1251 ;;; Do not add anything but external entries on this page.
|
|
|
1252
|
|
|
1253 (provide 'sendmail)
|
|
|
1254
|
|
|
1255 ;;; sendmail.el ends here
|
