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