|
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
|
|
110
|
289 ;; Courtesy of Per Abrahamsen <abraham@dina.kvl.dk> in an attempt to make
|
|
|
290 ;; Emacs and XEmacs less stupid about default mail addresses.
|
|
|
291
|
|
|
292 ;; We trust the administrator if he has set `mail-host-address'.
|
|
120
|
293 ;; We trust the user if he has already customized `user-mail-address'.
|
|
|
294 (defcustom query-user-mail-address (and (not mail-host-address)
|
|
|
295 (not user-mail-address))
|
|
110
|
296 "If non-nil, prompt the user for his mail address."
|
|
|
297 :group 'message
|
|
|
298 :type 'boolean)
|
|
|
299
|
|
114
|
300 ;;;###autoload
|
|
110
|
301 (defun user-mail-address ()
|
|
|
302 "Query the user for his mail address, unless it is already known."
|
|
|
303 (interactive)
|
|
114
|
304 (when (and (not noninteractive) query-user-mail-address)
|
|
|
305 (let ((addr (or user-mail-address
|
|
|
306 (concat (user-login-name) "@"
|
|
|
307 (or mail-host-address
|
|
|
308 (system-name))))))
|
|
|
309 (setq user-mail-address
|
|
|
310 (read-string "Your mail address? " (cons addr 0)))
|
|
|
311 (setq query-user-mail-address nil)
|
|
|
312 ;; TODO: Run sanity check from Gnus here.
|
|
|
313 (when (y-or-n-p "Save address for future sessions? ")
|
|
|
314 (put 'user-mail-address 'saved-value
|
|
|
315 (list user-mail-address))
|
|
|
316 (put 'query-user-mail-address 'saved-value '(nil))
|
|
116
|
317 (require 'cus-edit)
|
|
|
318 (custom-save-all))))
|
|
|
319 (if user-mail-address
|
|
|
320 user-mail-address
|
|
|
321 (setq user-mail-address (concat (user-login-name) "@"
|
|
|
322 (or mail-host-address
|
|
|
323 (system-name))))))
|
|
110
|
324
|
|
0
|
325 (defun mail-setup (to subject in-reply-to cc replybuffer actions)
|
|
|
326 (or mail-default-reply-to
|
|
|
327 (setq mail-default-reply-to (getenv "REPLYTO")))
|
|
|
328 ;Removed. See `mail-abbrevs.el'.
|
|
|
329 ; (sendmail-synch-aliases)
|
|
|
330 ; (if (eq mail-aliases t)
|
|
|
331 ; (progn
|
|
|
332 ; (setq mail-aliases nil)
|
|
|
333 ; (if (file-exists-p mail-personal-alias-file)
|
|
|
334 ; (build-mail-aliases))))
|
|
|
335 (setq mail-send-actions actions)
|
|
|
336 (mail-aliases-setup)
|
|
|
337 (setq mail-reply-buffer replybuffer)
|
|
|
338 (goto-char (point-min))
|
|
|
339 (insert "To: ")
|
|
|
340 (save-excursion
|
|
|
341 (if to
|
|
|
342 ;; Here removed code to extract names from within <...>
|
|
|
343 ;; on the assumption that mail-strip-quoted-names
|
|
|
344 ;; has been called and has done so.
|
|
|
345 (let ((fill-prefix "\t")
|
|
|
346 (address-start (point)))
|
|
|
347 (insert to "\n")
|
|
|
348 (fill-region-as-paragraph address-start (point-max)))
|
|
|
349 (newline))
|
|
|
350 (if cc
|
|
|
351 (let ((fill-prefix "\t")
|
|
|
352 (address-start (progn (insert "CC: ") (point))))
|
|
|
353 (insert cc "\n")
|
|
|
354 (fill-region-as-paragraph address-start (point-max))))
|
|
|
355 (if in-reply-to
|
|
|
356 (let ((fill-prefix "\t")
|
|
|
357 (fill-column 78)
|
|
|
358 (address-start (point)))
|
|
|
359 (insert "In-reply-to: " in-reply-to "\n")
|
|
|
360 (fill-region-as-paragraph address-start (point-max))))
|
|
|
361 (insert "Subject: " (or subject "") "\n")
|
|
|
362 (if mail-default-headers
|
|
|
363 (insert mail-default-headers))
|
|
|
364 (if mail-default-reply-to
|
|
|
365 (insert "Reply-to: " mail-default-reply-to "\n"))
|
|
|
366 (if mail-self-blind
|
|
|
367 (insert "BCC: " (user-login-name) "\n"))
|
|
|
368 (if mail-archive-file-name
|
|
|
369 (insert "FCC: " mail-archive-file-name "\n"))
|
|
|
370 (insert mail-header-separator "\n")
|
|
|
371
|
|
|
372 ;; Insert the signature. But remember the beginning of the message.
|
|
|
373 (if to (setq to (point)))
|
|
|
374 (cond ((eq mail-signature t)
|
|
|
375 (if (file-exists-p mail-signature-file)
|
|
|
376 (progn
|
|
|
377 (insert "\n\n-- \n")
|
|
|
378 (insert-file-contents mail-signature-file))))
|
|
|
379 (mail-signature
|
|
|
380 (insert mail-signature)))
|
|
|
381 (goto-char (point-max))
|
|
|
382 (or (bolp) (newline)))
|
|
|
383 (if to (goto-char to))
|
|
|
384 (or to subject in-reply-to
|
|
|
385 (set-buffer-modified-p nil))
|
|
|
386 (run-hooks 'mail-setup-hook))
|
|
|
387
|
|
|
388 ;;;###autoload
|
|
|
389 (defun mail-mode ()
|
|
|
390 "Major mode for editing mail to be sent.
|
|
|
391 Like Text Mode but with these additional commands:
|
|
|
392 C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit
|
|
|
393 C-c C-f move to a header field (and create it if there isn't):
|
|
|
394 C-c C-f C-t move to To: C-c C-f C-s move to Subj:
|
|
|
395 C-c C-f C-b move to BCC: C-c C-f C-c move to CC:
|
|
|
396 C-c C-f C-f move to FCC: C-c C-f C-r move to Reply-To:
|
|
|
397 C-c C-t mail-text (move to beginning of message text).
|
|
|
398 C-c C-w mail-signature (insert `mail-signature-file' file).
|
|
|
399 C-c C-y mail-yank-original (insert current message, in Rmail).
|
|
|
400 C-c C-q mail-fill-yanked-message (fill what was yanked).
|
|
|
401 C-c C-v mail-sent-via (add a sent-via field for each To or CC)."
|
|
|
402 (interactive)
|
|
|
403 (kill-all-local-variables)
|
|
|
404 (make-local-variable 'mail-reply-buffer)
|
|
|
405 (setq mail-reply-buffer nil)
|
|
|
406 (make-local-variable 'mail-send-actions)
|
|
|
407 (set-syntax-table mail-mode-syntax-table)
|
|
|
408 (use-local-map mail-mode-map)
|
|
|
409 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
410 (setq major-mode 'mail-mode)
|
|
|
411 (setq mode-name "Mail")
|
|
|
412 (setq buffer-offer-save t)
|
|
|
413 (turn-on-auto-fill) ; XEmacs - maybe filladapt should be default, too.
|
|
|
414 (make-local-variable 'paragraph-separate)
|
|
|
415 (make-local-variable 'paragraph-start)
|
|
|
416 (setq paragraph-start (concat (regexp-quote mail-header-separator)
|
|
|
417 "$\\|[ \t]*[-_][-_][-_]+$\\|"
|
|
|
418 paragraph-start))
|
|
|
419 (setq paragraph-separate (concat (regexp-quote mail-header-separator)
|
|
|
420 "$\\|[ \t]*[-_][-_][-_]+$\\|"
|
|
|
421 paragraph-separate))
|
|
|
422 ;; Set menu
|
|
|
423 (setq mode-popup-menu mail-popup-menu)
|
|
|
424 (if (featurep 'menubar)
|
|
|
425 (progn
|
|
|
426 ;; make a local copy of the menubar, so our modes don't
|
|
|
427 ;; change the global menubar
|
|
|
428 (set-buffer-menubar current-menubar)
|
|
|
429 (add-submenu nil mail-menubar-menu)))
|
|
|
430
|
|
|
431 (run-hooks 'text-mode-hook 'mail-mode-hook))
|
|
|
432
|
|
|
433
|
|
|
434 ;;; Set up keymap.
|
|
|
435
|
|
|
436 (if mail-mode-map
|
|
|
437 nil
|
|
|
438 (setq mail-mode-map (make-sparse-keymap))
|
|
|
439 (set-keymap-parents mail-mode-map (list text-mode-map))
|
|
|
440 (set-keymap-name mail-mode-map 'mail-mode-map)
|
|
|
441 (define-key mail-mode-map "\C-c?" 'describe-mode)
|
|
|
442 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
|
|
|
443 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
|
|
|
444 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
|
|
|
445 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
|
|
|
446 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
|
|
|
447 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
|
|
|
448 (define-key mail-mode-map "\C-c\C-t" 'mail-text)
|
|
|
449 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
|
|
|
450 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
|
|
|
451 (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
|
|
|
452 ;;CRAP!!(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)CRAP!
|
|
|
453 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
|
|
|
454 (define-key mail-mode-map "\C-c\C-s" 'mail-send))
|
|
|
455
|
|
|
456 ;;; mail-mode popup menu
|
|
|
457
|
|
|
458 (defvar mail-menubar-menu
|
|
|
459 (purecopy
|
|
|
460 '("Mail"
|
|
|
461 "Sending Mail:"
|
|
|
462 "----"
|
|
|
463 ["Send and Exit" mail-send-and-exit t]
|
|
|
464 ["Send Mail" mail-send t]
|
|
|
465 "----"
|
|
|
466 "Go to Field:"
|
|
|
467 "----"
|
|
|
468 ["To:" mail-to t]
|
|
|
469 ["Subject:" mail-subject t]
|
|
|
470 ["CC:" mail-cc t]
|
|
|
471 ["BCC:" mail-bcc t]
|
|
|
472 ["Reply-To:" mail-reply-to t]
|
|
|
473 ;; ["Sent Via:" mail-sent-via t]
|
|
|
474 ["Text" mail-text t]
|
|
|
475 "----"
|
|
|
476 "Miscellaneous Commands:"
|
|
|
477 "----"
|
|
|
478 ["Yank Original" mail-yank-original
|
|
|
479 (not (null mail-reply-buffer))]
|
|
|
480 ["Fill Yanked Message" mail-fill-yanked-message
|
|
|
481 (save-excursion
|
|
|
482 (goto-char (point-min))
|
|
|
483 (and (search-forward (concat "\n" mail-header-separator
|
|
|
484 "\n") nil t)
|
|
|
485 (not (looking-at "[ \t\n]*\\'"))))]
|
|
|
486 ["Insert Signature" mail-signature
|
|
|
487 (and (stringp mail-signature-file)
|
|
|
488 (file-exists-p mail-signature-file))]
|
|
|
489 ["Insert File..." insert-file t]
|
|
|
490 ["Insert Buffer..." insert-buffer t]
|
|
|
491 "----"
|
|
|
492 ["Cancel" mail-dont-send t]
|
|
|
493 ))
|
|
|
494 "Menubar menu for `mail-mode'.")
|
|
|
495
|
|
|
496 (defvar mail-popup-menu
|
|
|
497 (purecopy
|
|
|
498 (cons "Sendmail Commands"
|
|
|
499 (cdr mail-menubar-menu)))
|
|
|
500 "Menubar menu for `mail-mode'.")
|
|
|
501
|
|
|
502
|
|
|
503 (defun mail-send-and-exit (arg)
|
|
|
504 "Send message like `mail-send', then, if no errors, exit from mail buffer.
|
|
|
505 Prefix arg means don't delete this window."
|
|
|
506 (interactive "P")
|
|
|
507 (mail-send)
|
|
|
508 (mail-bury arg))
|
|
|
509
|
|
|
510 (defun mail-dont-send (arg)
|
|
|
511 "Don't send the message you have been editing.
|
|
|
512 Prefix arg means don't delete this window."
|
|
|
513 (interactive "P")
|
|
|
514 (mail-bury arg))
|
|
|
515
|
|
|
516 (defun mail-bury (arg)
|
|
|
517 "Bury this mail buffer."
|
|
|
518 (let ((newbuf (other-buffer (current-buffer))))
|
|
|
519 (bury-buffer (current-buffer))
|
|
|
520 (if (and (fboundp 'frame-parameters)
|
|
|
521 (cdr (assq 'dedicated (frame-parameters)))
|
|
|
522 (not (null (delq (selected-frame) (visible-frame-list)))))
|
|
|
523 (delete-frame (selected-frame))
|
|
|
524 (let (rmail-flag summary-buffer)
|
|
|
525 (and (not arg)
|
|
|
526 (not (one-window-p))
|
|
|
527 (save-excursion
|
|
|
528 (set-buffer (window-buffer (next-window (selected-window) 'not)))
|
|
|
529 (setq rmail-flag (eq major-mode 'rmail-mode))
|
|
|
530 (setq summary-buffer
|
|
|
531 (and mail-bury-selects-summary
|
|
|
532 (boundp 'rmail-summary-buffer)
|
|
|
533 rmail-summary-buffer
|
|
|
534 (buffer-name rmail-summary-buffer)
|
|
|
535 (not (get-buffer-window rmail-summary-buffer))
|
|
|
536 rmail-summary-buffer))))
|
|
|
537 (if rmail-flag
|
|
|
538 ;; If the Rmail buffer has a summary, show that.
|
|
|
539 (if summary-buffer (switch-to-buffer summary-buffer)
|
|
|
540 (delete-window))
|
|
|
541 (switch-to-buffer newbuf))))))
|
|
|
542
|
|
|
543 (defun mail-send ()
|
|
|
544 "Send the message in the current buffer.
|
|
|
545 If `mail-interactive' is non-nil, wait for success indication or error
|
|
|
546 messages, and inform user. Otherwise any failure is reported in a message
|
|
|
547 back to the user from the mailer."
|
|
|
548 (interactive)
|
|
|
549 (if (if buffer-file-name
|
|
|
550 (y-or-n-p "Send buffer contents as mail message? ")
|
|
|
551 (or (buffer-modified-p)
|
|
|
552 (y-or-n-p "Message already sent; resend? ")))
|
|
|
553 (progn
|
|
|
554 (expand-abbrev) ; for mail-abbrevs
|
|
|
555 (run-hooks 'mail-send-hook)
|
|
|
556 (message "Sending...")
|
|
|
557 (funcall send-mail-function)
|
|
|
558 ;; Now perform actions on successful sending.
|
|
|
559 (while mail-send-actions
|
|
|
560 (condition-case nil
|
|
|
561 (apply (car (car mail-send-actions))
|
|
|
562 (cdr (car mail-send-actions)))
|
|
|
563 (error))
|
|
|
564 (setq mail-send-actions (cdr mail-send-actions)))
|
|
|
565 (message "Sending...done")
|
|
|
566
|
|
|
567 ;; If buffer has no file, mark it as unmodified and delete autosave.
|
|
|
568 (cond ((or (not buffer-file-name)
|
|
|
569 (not (buffer-modified-p)))
|
|
|
570 (set-buffer-modified-p nil)
|
|
|
571 (delete-auto-save-file-if-necessary t))
|
|
|
572 ((or noninteractive
|
|
|
573 (y-or-n-p (format "Save file %s? " buffer-file-name)))
|
|
|
574 (save-buffer))))))
|
|
|
575
|
|
|
576 (defun sendmail-send-it ()
|
|
|
577 (require 'mail-utils)
|
|
|
578 (let ((errbuf (if mail-interactive
|
|
|
579 (generate-new-buffer " sendmail errors")
|
|
|
580 0))
|
|
|
581 (tembuf (generate-new-buffer " sendmail temp"))
|
|
|
582 (case-fold-search nil)
|
|
|
583 resend-to-addresses
|
|
|
584 delimline
|
|
|
585 (mailbuf (current-buffer)))
|
|
|
586 (unwind-protect
|
|
|
587 (save-excursion
|
|
|
588 (set-buffer tembuf)
|
|
|
589 (erase-buffer)
|
|
|
590 (insert-buffer-substring mailbuf)
|
|
|
591 (goto-char (point-max))
|
|
|
592 ;; require one newline at the end.
|
|
|
593 (or (= (preceding-char) ?\n)
|
|
|
594 (insert ?\n))
|
|
|
595 ;; Change header-delimiter to be what sendmail expects.
|
|
|
596 (goto-char (point-min))
|
|
|
597 (re-search-forward
|
|
|
598 (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
599 (replace-match "\n")
|
|
|
600 (backward-char 1)
|
|
|
601 (setq delimline (point-marker))
|
|
|
602 ;Removed. See `mail-abbrevs.el'.
|
|
|
603 ; (sendmail-synch-aliases)
|
|
|
604 ; (if mail-aliases
|
|
|
605 ; (expand-mail-aliases (point-min) delimline))
|
|
|
606 ; (goto-char (point-min))
|
|
|
607 ;; ignore any blank lines in the header
|
|
|
608 (while (and (re-search-forward "\n\n\n*" delimline t)
|
|
|
609 (< (point) delimline))
|
|
|
610 (replace-match "\n"))
|
|
|
611 (let ((case-fold-search t))
|
|
|
612 (goto-char (point-min))
|
|
|
613 (while (re-search-forward "^Resent-to:" delimline t)
|
|
|
614 (setq resend-to-addresses
|
|
|
615 (save-restriction
|
|
|
616 (narrow-to-region (point)
|
|
|
617 (save-excursion
|
|
|
618 (end-of-line)
|
|
|
619 (point)))
|
|
|
620 (append (mail-parse-comma-list)
|
|
|
621 resend-to-addresses))))
|
|
|
622 ;;; Apparently this causes a duplicate Sender.
|
|
|
623 ;;; ;; If the From is different than current user, insert Sender.
|
|
|
624 ;;; (goto-char (point-min))
|
|
|
625 ;;; (and (re-search-forward "^From:" delimline t)
|
|
|
626 ;;; (progn
|
|
|
627 ;;; (require 'mail-utils)
|
|
|
628 ;;; (not (string-equal
|
|
|
629 ;;; (mail-strip-quoted-names
|
|
|
630 ;;; (save-restriction
|
|
|
631 ;;; (narrow-to-region (point-min) delimline)
|
|
|
632 ;;; (mail-fetch-field "From")))
|
|
|
633 ;;; (user-login-name))))
|
|
|
634 ;;; (progn
|
|
|
635 ;;; (forward-line 1)
|
|
|
636 ;;; (insert "Sender: " (user-login-name) "\n")))
|
|
|
637 ;; Don't send out a blank subject line
|
|
|
638 (goto-char (point-min))
|
|
|
639 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
|
|
|
640 (replace-match ""))
|
|
|
641 ;; Put the "From:" field in unless for some odd reason
|
|
|
642 ;; they put one in themselves.
|
|
|
643 (goto-char (point-min))
|
|
|
644 (if (not (re-search-forward "^From:" delimline t))
|
|
114
|
645 (let* ((login (user-mail-address))
|
|
0
|
646 (fullname (user-full-name)))
|
|
|
647 (cond ((eq mail-from-style 'angles)
|
|
|
648 (insert "From: " fullname)
|
|
|
649 (let ((fullname-start (+ (point-min) 6))
|
|
|
650 (fullname-end (point-marker)))
|
|
|
651 (goto-char fullname-start)
|
|
|
652 ;; Look for a character that cannot appear unquoted
|
|
|
653 ;; according to RFC 822.
|
|
|
654 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
|
|
|
655 fullname-end 1)
|
|
|
656 (progn
|
|
|
657 ;; Quote fullname, escaping specials.
|
|
|
658 (goto-char fullname-start)
|
|
|
659 (insert "\"")
|
|
|
660 (while (re-search-forward "[\"\\]"
|
|
|
661 fullname-end 1)
|
|
|
662 (replace-match "\\\\\\&" t))
|
|
|
663 (insert "\""))))
|
|
|
664 (insert " <" login ">\n"))
|
|
|
665 ((eq mail-from-style 'parens)
|
|
|
666 (insert "From: " login " (")
|
|
|
667 (let ((fullname-start (point)))
|
|
|
668 (insert fullname)
|
|
|
669 (let ((fullname-end (point-marker)))
|
|
|
670 (goto-char fullname-start)
|
|
|
671 ;; RFC 822 says \ and nonmatching parentheses
|
|
|
672 ;; must be escaped in comments.
|
|
|
673 ;; Escape every instance of ()\ ...
|
|
|
674 (while (re-search-forward "[()\\]" fullname-end 1)
|
|
|
675 (replace-match "\\\\\\&" t))
|
|
|
676 ;; ... then undo escaping of matching parentheses,
|
|
|
677 ;; including matching nested parentheses.
|
|
|
678 (goto-char fullname-start)
|
|
|
679 (while (re-search-forward
|
|
|
680 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
|
|
|
681 fullname-end 1)
|
|
|
682 (replace-match "\\1(\\3)" t)
|
|
|
683 (goto-char fullname-start))))
|
|
|
684 (insert ")\n"))
|
|
|
685 ((null mail-from-style)
|
|
|
686 (insert "From: " login "\n")))))
|
|
|
687 ;; Insert an extra newline if we need it to work around
|
|
|
688 ;; Sun's bug that swallows newlines.
|
|
|
689 (goto-char (1+ delimline))
|
|
|
690 (if (eval mail-mailer-swallows-blank-line)
|
|
|
691 (newline))
|
|
|
692 ;; Find and handle any FCC fields.
|
|
|
693 (goto-char (point-min))
|
|
|
694 (if (re-search-forward "^FCC:" delimline t)
|
|
|
695 (mail-do-fcc delimline))
|
|
|
696 (if mail-interactive
|
|
|
697 (save-excursion
|
|
|
698 (set-buffer errbuf)
|
|
|
699 (erase-buffer))))
|
|
|
700 (let ((default-directory "/"))
|
|
|
701 (apply 'call-process-region
|
|
|
702 (append (list (point-min) (point-max)
|
|
|
703 (if (boundp 'sendmail-program)
|
|
|
704 sendmail-program
|
|
|
705 "/usr/lib/sendmail")
|
|
|
706 nil errbuf nil "-oi")
|
|
|
707 ;; Always specify who from,
|
|
|
708 ;; since some systems have broken sendmails.
|
|
|
709 (list "-f" (user-login-name))
|
|
|
710 ;;; ;; Don't say "from root" if running under su.
|
|
|
711 ;;; (and (equal (user-real-login-name) "root")
|
|
|
712 ;;; (list "-f" (user-login-name)))
|
|
|
713 (and mail-alias-file
|
|
|
714 (list (concat "-oA" mail-alias-file)))
|
|
|
715 ;; These mean "report errors by mail"
|
|
|
716 ;; and "deliver in background".
|
|
|
717 (if (null mail-interactive) '("-oem" "-odb"))
|
|
|
718 ;; Get the addresses from the message
|
|
|
719 ;; unless this is a resend.
|
|
|
720 ;; We must not do that for a resend
|
|
|
721 ;; because we would find the original addresses.
|
|
|
722 ;; For a resend, include the specific addresses.
|
|
|
723 (or resend-to-addresses
|
|
|
724 '("-t")))))
|
|
|
725 (if mail-interactive
|
|
|
726 (save-excursion
|
|
|
727 (set-buffer errbuf)
|
|
|
728 (goto-char (point-min))
|
|
|
729 (while (re-search-forward "\n\n* *" nil t)
|
|
|
730 (replace-match "; "))
|
|
|
731 (if (not (zerop (buffer-size)))
|
|
|
732 (error "Sending...failed to %s"
|
|
|
733 (buffer-substring (point-min) (point-max)))))))
|
|
|
734 (kill-buffer tembuf)
|
|
|
735 (if (bufferp errbuf)
|
|
|
736 (kill-buffer errbuf)))))
|
|
|
737
|
|
|
738 ;;; FCC hackery, by jwz. This version works on BABYL and VM buffers.
|
|
|
739 ;;; To accomplish the latter, VM is loaded when this file is compiled.
|
|
|
740 ;;; Don't worry, it's only loaded at compile-time.
|
|
|
741
|
|
|
742 (defun mail-do-fcc (header-end)
|
|
|
743 (let (fcc-list
|
|
|
744 (send-mail-buffer (current-buffer))
|
|
|
745 (tembuf (generate-new-buffer " rmail output"))
|
|
|
746 (case-fold-search t)
|
|
|
747 beg end)
|
|
|
748 (or (markerp header-end) (error "header-end must be a marker"))
|
|
|
749 (save-excursion
|
|
|
750 (goto-char (point-min))
|
|
|
751 (while (re-search-forward "^FCC:[ \t]*" header-end t)
|
|
|
752 (setq fcc-list (cons (buffer-substring (point)
|
|
|
753 (progn
|
|
|
754 (end-of-line)
|
|
|
755 (skip-chars-backward " \t")
|
|
|
756 (point)))
|
|
|
757 fcc-list))
|
|
|
758 (delete-region (match-beginning 0)
|
|
|
759 (progn (forward-line 1) (point))))
|
|
|
760 (set-buffer tembuf)
|
|
|
761 (erase-buffer)
|
|
|
762 ;; insert just the headers to avoid moving the gap more than
|
|
|
763 ;; necessary (the message body could be arbitrarily huge.)
|
|
|
764 (insert-buffer-substring send-mail-buffer 1 header-end)
|
|
|
765
|
|
|
766 ;; if there's no From: or Date: field, cons some.
|
|
|
767 (goto-char (point-min))
|
|
|
768 (or (re-search-forward "^From[ \t]*:" header-end t)
|
|
|
769 (insert "From: " (user-login-name) " (" (user-full-name) ")\n"))
|
|
|
770 (goto-char (point-min))
|
|
|
771 (or (re-search-forward "^Date[ \t]*:" header-end t)
|
|
|
772 (mail-do-fcc-insert-date-header))
|
|
|
773
|
|
|
774 ;; insert a magic From_ line.
|
|
|
775 (goto-char (point-min))
|
|
|
776 (insert "\nFrom " (user-login-name) " " (current-time-string) "\n")
|
|
|
777 (goto-char (point-max))
|
|
|
778 (insert-buffer-substring send-mail-buffer header-end)
|
|
|
779 (goto-char (point-max))
|
|
|
780 (insert ?\n)
|
|
|
781 (goto-char (1- header-end))
|
|
|
782
|
|
|
783 ;; ``Quote'' "^From " as ">From "
|
|
|
784 ;; (note that this isn't really quoting, as there is no requirement
|
|
|
785 ;; that "^[>]+From " be quoted in the same transparent way.)
|
|
|
786 (let ((case-fold-search nil))
|
|
|
787 (while (search-forward "\nFrom " nil t)
|
|
|
788 (forward-char -5)
|
|
|
789 (insert ?>)))
|
|
|
790
|
|
|
791 (setq beg (point-min)
|
|
|
792 end (point-max))
|
|
|
793 (while fcc-list
|
|
|
794 (let ((target-buffer (get-file-buffer (car fcc-list))))
|
|
|
795 (if target-buffer
|
|
|
796 ;; File is present in a buffer => append to that buffer.
|
|
|
797 (save-excursion
|
|
|
798 (set-buffer target-buffer)
|
|
|
799 (cond ((eq major-mode 'rmail-mode)
|
|
|
800 (mail-do-fcc-rmail-internal tembuf))
|
|
|
801 ((eq major-mode 'vm-mode)
|
|
|
802 (mail-do-fcc-vm-internal tembuf))
|
|
|
803 (t
|
|
|
804 ;; Append to an ordinary buffer as a Unix mail message.
|
|
|
805 (goto-char (point-max))
|
|
|
806 (insert-buffer-substring tembuf beg end))))
|
|
|
807 ;; Else append to the file directly.
|
|
|
808 ;; (It's OK if it is an RMAIL or VM file -- the message will be
|
|
|
809 ;; parsed when the file is read in.)
|
|
|
810 (write-region
|
|
|
811 (1+ (point-min)) (point-max) (car fcc-list) t)))
|
|
|
812 (setq fcc-list (cdr fcc-list))))
|
|
|
813 (kill-buffer tembuf)))
|
|
|
814
|
|
|
815 (defvar mail-do-fcc-cached-timezone nil)
|
|
|
816
|
|
|
817 (defun mail-do-fcc-insert-date-header ()
|
|
|
818 ;; Convert the ctime() format that `current-time-string' returns into
|
|
|
819 ;; an RFC-822-legal date.
|
|
|
820 (let ((s (current-time-string)))
|
|
|
821 (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]\\)"
|
|
|
822 s)
|
|
|
823 (insert "Date: "
|
|
|
824 (substring s (match-beginning 1) (match-end 1)) ", "
|
|
|
825 (substring s (match-beginning 3) (match-end 3)) " "
|
|
|
826 (substring s (match-beginning 2) (match-end 2)) " "
|
|
|
827 (substring s (match-beginning 5) (match-end 5)) " "
|
|
|
828 (substring s (match-beginning 4) (match-end 4)) " ")
|
|
|
829
|
|
|
830 (if mail-do-fcc-cached-timezone
|
|
|
831 (insert mail-do-fcc-cached-timezone "\n")
|
|
|
832 ;;
|
|
|
833 ;; First, try to use the current-time-zone function, which may not be
|
|
|
834 ;; defined, and even if it is defined, may error or return nil.
|
|
|
835 ;;
|
|
|
836 (or (condition-case ()
|
|
|
837 (let ((zoneinfo (current-time-zone)))
|
|
|
838 (setq mail-do-fcc-cached-timezone
|
|
|
839 (if (stringp (nth 1 zoneinfo))
|
|
|
840 (nth 1 zoneinfo)
|
|
|
841 (or (if (nth 1 zoneinfo) (nth 3 zoneinfo))
|
|
|
842 (nth 2 zoneinfo))))
|
|
|
843 (if mail-do-fcc-cached-timezone
|
|
|
844 (insert mail-do-fcc-cached-timezone "\n"))
|
|
|
845 mail-do-fcc-cached-timezone)
|
|
|
846 (error nil))
|
|
|
847 ;;
|
|
|
848 ;; Otherwise, run date(1) and parse its output. Yuck!
|
|
|
849 ;;
|
|
|
850 (save-restriction
|
|
|
851 (narrow-to-region (point) (point))
|
|
|
852 (call-process "date" nil t nil)
|
|
|
853 (end-of-line)
|
|
|
854 (insert "\n")
|
|
|
855 (forward-word -1) ; skip back over year
|
|
|
856 (delete-region (1- (point)) (1- (point-max))) ; nuke year to end
|
|
|
857 (forward-word -1) ; skip back over zone
|
|
|
858 (delete-region (point-min) (point)) ; nuke beginning to zone
|
|
|
859 (setq mail-do-fcc-cached-timezone
|
|
|
860 (buffer-substring (point-min) (1- (point-max)))))))))
|
|
|
861
|
|
110
|
862 (eval-when-compile
|
|
|
863 (require 'vm-misc))
|
|
|
864
|
|
0
|
865 (defun mail-do-fcc-rmail-internal (buffer)
|
|
|
866 (or (eq major-mode 'rmail-mode) (error "this only works in rmail-mode"))
|
|
|
867 (let ((b (point-min))
|
|
|
868 (e (point-max))
|
|
|
869 (buffer-read-only nil))
|
|
|
870 (unwind-protect
|
|
|
871 (progn
|
|
|
872 (widen)
|
|
|
873 (goto-char (point-max))
|
|
|
874 ;; This forces RMAIL's message counters to be recomputed when the
|
|
|
875 ;; next RMAIL operation is done on the buffer.
|
|
|
876 ;; See rmail-maybe-set-message-counters.
|
|
|
877 (setq rmail-total-messages nil)
|
|
|
878 (insert "\^L\n0, unseen,,\n*** EOOH ***")
|
|
|
879 (insert-buffer-substring buffer)
|
|
|
880 (insert "\n\C-_"))
|
|
|
881 (narrow-to-region b e)
|
|
|
882 (rmail-maybe-set-message-counters))))
|
|
|
883
|
|
|
884 (defun mail-do-fcc-vm-internal (buffer)
|
|
|
885 (or (eq major-mode 'vm-mode) (error "this only works in vm-mode"))
|
|
|
886 (let ((buffer-read-only nil)
|
|
|
887 (foreign-folder-p (not (eq vm-folder-type 'From_))))
|
|
|
888
|
|
|
889 (if foreign-folder-p
|
|
|
890 ;; `buffer' has already been prepared with a "From " line which
|
|
|
891 ;; has a sensible user-id and date in it, but if we're FCCing to
|
|
|
892 ;; a VM folder that isn't in From_ format, we must discard that
|
|
|
893 ;; and let VM do whatever voodoo it needs to do. (Actually we
|
|
|
894 ;; could do this all the time, but then all FCCed messages would
|
|
|
895 ;; have "From VM ..." envelopes, which is less attractive.)
|
|
|
896 (save-excursion
|
|
|
897 (set-buffer buffer)
|
|
|
898 (goto-char (point-min))
|
|
|
899 (skip-chars-forward "\n")
|
|
|
900 (forward-line)
|
|
|
901 (delete-region (point-min) (point))))
|
|
|
902
|
|
|
903 ;; Largely copied from #'vm-save-message in vm-save.el
|
|
|
904 (vm-save-restriction
|
|
|
905 (widen)
|
|
|
906 (goto-char (point-max))
|
|
|
907 (if foreign-folder-p
|
|
|
908 (vm-write-string (current-buffer)
|
|
|
909 (vm-leading-message-separator vm-folder-type)))
|
|
|
910 (insert-buffer-substring buffer)
|
|
|
911 (if foreign-folder-p
|
|
|
912 (vm-write-string (current-buffer)
|
|
|
913 (vm-trailing-message-separator vm-folder-type)))
|
|
|
914
|
|
|
915 (vm-increment vm-messages-not-on-disk)
|
|
|
916 (vm-set-buffer-modified-p t)
|
|
|
917 (vm-clear-modification-flag-undos)
|
|
|
918 (vm-check-for-killed-summary)
|
|
|
919 (vm-assimilate-new-messages)
|
|
|
920 (vm-update-summary-and-mode-line))))
|
|
|
921
|
|
|
922 ;;(defun mail-sent-via ()
|
|
|
923 ;; "Make a Sent-via header line from each To or CC header line."
|
|
|
924 ;; (interactive)
|
|
|
925 ;; (save-excursion
|
|
|
926 ;; (goto-char (point-min))
|
|
|
927 ;; ;; find the header-separator
|
|
|
928 ;; (search-forward (concat "\n" mail-header-separator "\n"))
|
|
|
929 ;; (forward-line -1)
|
|
|
930 ;; ;; put a marker at the end of the header
|
|
|
931 ;; (let ((end (point-marker))
|
|
|
932 ;; (case-fold-search t)
|
|
|
933 ;; to-line)
|
|
|
934 ;; (goto-char (point-min))
|
|
|
935 ;; ;; search for the To: lines and make Sent-via: lines from them
|
|
|
936 ;; ;; search for the next To: line
|
|
|
937 ;; (while (re-search-forward "^\\(to\\|cc\\):" end t)
|
|
|
938 ;; ;; Grab this line plus all its continuations, sans the `to:'.
|
|
|
939 ;; (let ((to-line
|
|
|
940 ;; (buffer-substring (point)
|
|
|
941 ;; (progn
|
|
|
942 ;; (if (re-search-forward "^[^ \t\n]" end t)
|
|
|
943 ;; (backward-char 1)
|
|
|
944 ;; (goto-char end))
|
|
|
945 ;; (point)))))
|
|
|
946 ;; ;; Insert a copy, with altered header field name.
|
|
|
947 ;; (insert-before-markers "Sent-via:" to-line))))))
|
|
|
948
|
|
|
949 (defun mail-to ()
|
|
|
950 "Move point to end of To-field."
|
|
|
951 (interactive)
|
|
|
952 (expand-abbrev)
|
|
|
953 (mail-position-on-field "To"))
|
|
|
954
|
|
|
955 (defun mail-subject ()
|
|
|
956 "Move point to end of Subject-field."
|
|
|
957 (interactive)
|
|
|
958 (expand-abbrev)
|
|
|
959 (mail-position-on-field "Subject"))
|
|
|
960
|
|
|
961 (defun mail-cc ()
|
|
|
962 "Move point to end of CC-field. Create a CC field if none."
|
|
|
963 (interactive)
|
|
|
964 (expand-abbrev)
|
|
|
965 (or (mail-position-on-field "cc" t)
|
|
|
966 (progn (mail-position-on-field "to")
|
|
|
967 (insert "\nCC: "))))
|
|
|
968
|
|
|
969 (defun mail-bcc ()
|
|
|
970 "Move point to end of BCC-field. Create a BCC field if none."
|
|
|
971 (interactive)
|
|
|
972 (expand-abbrev)
|
|
|
973 (or (mail-position-on-field "bcc" t)
|
|
|
974 (progn (mail-position-on-field "to")
|
|
|
975 (insert "\nBCC: "))))
|
|
|
976
|
|
|
977 (defun mail-fcc (folder)
|
|
|
978 "Add a new FCC field, with file name completion."
|
|
|
979 (interactive "FFolder carbon copy: ")
|
|
|
980 (expand-abbrev)
|
|
|
981 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
|
|
|
982 (mail-position-on-field "to"))
|
|
|
983 (insert "\nFCC: " folder))
|
|
|
984
|
|
|
985 (defun mail-reply-to ()
|
|
|
986 "Move point to end of Reply-To-field. Create a Reply-To field if none."
|
|
|
987 (interactive)
|
|
|
988 (expand-abbrev)
|
|
|
989 (or (mail-position-on-field "reply-to" t)
|
|
|
990 (progn (mail-position-on-field "to")
|
|
|
991 (insert "\nReply-To: "))))
|
|
|
992
|
|
|
993 (defun mail-position-on-field (field &optional soft)
|
|
|
994 (let (end
|
|
|
995 (case-fold-search t))
|
|
|
996 (goto-char (point-min))
|
|
|
997 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
|
|
|
998 (setq end (match-beginning 0))
|
|
|
999 (goto-char (point-min))
|
|
|
1000 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
|
|
|
1001 (progn
|
|
|
1002 (re-search-forward "^[^ \t]" nil 'move)
|
|
|
1003 (beginning-of-line)
|
|
|
1004 (skip-chars-backward "\n")
|
|
|
1005 t)
|
|
|
1006 (or soft
|
|
|
1007 (progn (goto-char end)
|
|
70
|
1008 ;; #### FSF has the next two clauses reversed.
|
|
|
1009 ;; which is correct?
|
|
|
1010 (skip-chars-backward "\n")
|
|
|
1011 (insert "\n" field ": ")))
|
|
0
|
1012 nil)))
|
|
|
1013
|
|
|
1014 (defun mail-text ()
|
|
|
1015 "Move point to beginning of message text."
|
|
|
1016 (interactive)
|
|
|
1017 (expand-abbrev)
|
|
|
1018 (goto-char (point-min))
|
|
|
1019 (search-forward (concat "\n" mail-header-separator "\n")))
|
|
|
1020
|
|
|
1021 (defun mail-signature (&optional atpoint)
|
|
|
1022 "Sign letter with contents of the file `mail-signature-file'.
|
|
|
1023 Prefix arg means put contents at point."
|
|
|
1024 (interactive "P")
|
|
|
1025 (save-excursion
|
|
|
1026 (or atpoint
|
|
|
1027 (goto-char (point-max)))
|
|
|
1028 (skip-chars-backward " \t\n")
|
|
|
1029 (end-of-line)
|
|
|
1030 (or atpoint
|
|
|
1031 (delete-region (point) (point-max)))
|
|
|
1032 (insert "\n\n-- \n")
|
|
|
1033 (insert-file-contents (expand-file-name mail-signature-file))))
|
|
|
1034
|
|
|
1035 (defun mail-fill-yanked-message (&optional justifyp)
|
|
|
1036 "Fill the paragraphs of a message yanked into this one.
|
|
|
1037 Numeric argument means justify as well."
|
|
|
1038 (interactive "P")
|
|
|
1039 (save-excursion
|
|
|
1040 (goto-char (point-min))
|
|
|
1041 (search-forward (concat "\n" mail-header-separator "\n") nil t)
|
|
|
1042 (fill-individual-paragraphs (point)
|
|
|
1043 (point-max)
|
|
|
1044 justifyp
|
|
|
1045 t)))
|
|
|
1046
|
|
|
1047 (defun mail-indent-citation ()
|
|
|
1048 "Modify text just inserted from a message to be cited.
|
|
|
1049 The inserted text should be the region.
|
|
|
1050 When this function returns, the region is again around the modified text.
|
|
|
1051
|
|
|
1052 Normally, indent each nonblank line `mail-indentation-spaces' spaces.
|
|
|
1053 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
|
|
|
1054 (let ((start (point)))
|
|
|
1055 (mail-yank-clear-headers start (mark t))
|
|
|
1056 (if (null mail-yank-prefix)
|
|
|
1057 (indent-rigidly start (mark t) mail-indentation-spaces)
|
|
|
1058 (save-excursion
|
|
|
1059 (goto-char start)
|
|
|
1060 (while (< (point) (mark t))
|
|
|
1061 (insert mail-yank-prefix)
|
|
|
1062 (forward-line 1))))))
|
|
|
1063
|
|
|
1064 (defun mail-yank-original (arg)
|
|
|
1065 "Insert the message being replied to, if any (in rmail).
|
|
|
1066 Puts point before the text and mark after.
|
|
|
1067 Normally, indents each nonblank line ARG spaces (default 3).
|
|
|
1068 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
|
|
|
1069
|
|
|
1070 Just \\[universal-argument] as argument means don't indent, insert no prefix,
|
|
|
1071 and don't delete any header fields."
|
|
|
1072 (interactive "P")
|
|
|
1073 (if mail-reply-buffer
|
|
|
1074 (let ((start (point))
|
|
|
1075 (reader-buf mail-reply-buffer)
|
|
|
1076 (reader-window (get-buffer-window mail-reply-buffer
|
|
|
1077 (selected-frame))))
|
|
|
1078 ;; If the original message is in another window in the same frame,
|
|
|
1079 ;; delete that window to save screen space.
|
|
|
1080 ;; t means don't alter other frames.
|
|
|
1081 (if reader-window
|
|
|
1082 (delete-windows-on reader-buf t))
|
|
|
1083 (insert-buffer reader-buf)
|
|
|
1084 (if (consp arg)
|
|
|
1085 nil
|
|
|
1086 (goto-char start)
|
|
|
1087 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
|
|
|
1088 mail-indentation-spaces)))
|
|
|
1089 (cond (mail-citation-hook
|
|
|
1090 (run-hooks 'mail-citation-hook))
|
|
|
1091 (mail-yank-hooks
|
|
|
1092 (run-hooks 'mail-yank-hooks))
|
|
|
1093 (t
|
|
|
1094 (mail-indent-citation)))))
|
|
|
1095 (exchange-point-and-mark t)
|
|
|
1096 (if (not (eolp)) (insert ?\n)))))
|
|
|
1097
|
|
|
1098 (defun mail-yank-clear-headers (start end)
|
|
|
1099 (if mail-yank-ignored-headers
|
|
|
1100 (save-excursion
|
|
|
1101 (goto-char start)
|
|
|
1102 (if (search-forward "\n\n" end t)
|
|
|
1103 (save-restriction
|
|
|
1104 (narrow-to-region start (point))
|
|
|
1105 (goto-char start)
|
|
|
1106 (while (let ((case-fold-search t))
|
|
|
1107 (re-search-forward mail-yank-ignored-headers nil t))
|
|
|
1108 (beginning-of-line)
|
|
|
1109 (delete-region (point)
|
|
|
1110 (progn (re-search-forward "\n[^ \t]")
|
|
|
1111 (forward-char -1)
|
|
|
1112 (point)))))))))
|
|
|
1113
|
|
|
1114 ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file.
|
|
|
1115
|
|
|
1116 ;;;###autoload
|
|
|
1117 (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
|
|
|
1118 "Edit a message to be sent. Prefix arg means resume editing (don't erase).
|
|
|
1119 When this function returns, the buffer `*mail*' is selected.
|
|
|
1120 The value is t if the message was newly initialized; otherwise, nil.
|
|
|
1121
|
|
|
1122 Optionally, the signature file `mail-signature-file' can be inserted at the
|
|
|
1123 end; see the variable `mail-signature'.
|
|
|
1124
|
|
|
1125 \\<mail-mode-map>
|
|
|
1126 While editing message, type \\[mail-send-and-exit] to send the message and exit.
|
|
|
1127
|
|
|
1128 Various special commands starting with C-c are available in sendmail mode
|
|
|
1129 to move to message header fields:
|
|
|
1130 \\{mail-mode-map}
|
|
|
1131
|
|
|
1132 The variable `mail-signature' controls whether the signature file
|
|
|
1133 `mail-signature-file' is inserted immediately.
|
|
|
1134
|
|
|
1135 If `mail-signature' is nil, use \\[mail-signature] to insert the
|
|
|
1136 signature in `mail-signature-file'.
|
|
|
1137
|
|
|
1138 If `mail-self-blind' is non-nil, a BCC to yourself is inserted
|
|
|
1139 when the message is initialized.
|
|
|
1140
|
|
|
1141 If `mail-default-reply-to' is non-nil, it should be an address (a string);
|
|
|
1142 a Reply-to: field with that address is inserted.
|
|
|
1143
|
|
|
1144 If `mail-archive-file-name' is non-nil, an FCC field with that file name
|
|
|
1145 is inserted.
|
|
|
1146
|
|
|
1147 The normal hook `mail-setup-hook' is run after the message is
|
|
|
1148 initialized. It can add more default fields to the message.
|
|
|
1149
|
|
|
1150 When calling from a program, the first argument if non-nil says
|
|
|
1151 not to erase the existing contents of the `*mail*' buffer.
|
|
|
1152
|
|
|
1153 The second through fifth arguments,
|
|
|
1154 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
|
|
|
1155 the initial contents of those header fields.
|
|
|
1156 These arguments should not have final newlines.
|
|
|
1157 The sixth argument REPLYBUFFER is a buffer whose contents
|
|
|
1158 should be yanked if the user types C-c C-y.
|
|
|
1159 The seventh argument ACTIONS is a list of actions to take
|
|
|
1160 if/when the message is sent. Each action looks like (FUNCTION . ARGS);
|
|
|
1161 when the message is sent, we apply FUNCTION to ARGS.
|
|
|
1162 This is how Rmail arranges to mark messages `answered'."
|
|
|
1163 (interactive "P")
|
|
|
1164 (if mail-use-multiple-buffers-p
|
|
|
1165
|
|
|
1166 ;; RMS doesn't like this behavior but it seems more logical to me. --ben
|
|
|
1167 (let ((index 1)
|
|
|
1168 buffer)
|
|
|
1169 ;; If requested, look for a mail buffer that is modified and go to it.
|
|
|
1170 (if noerase
|
|
|
1171 (progn
|
|
|
1172 (while (and (setq buffer
|
|
|
1173 (get-buffer (if (= 1 index) "*mail*"
|
|
|
1174 (format "*mail*<%d>" index))))
|
|
|
1175 (not (buffer-modified-p buffer)))
|
|
|
1176 (setq index (1+ index)))
|
|
|
1177 (if buffer (switch-to-buffer buffer)
|
|
|
1178 ;; If none exists, start a new message.
|
|
|
1179 ;; This will never re-use an existing unmodified mail buffer
|
|
|
1180 ;; (since index is not 1 anymore). Perhaps it should.
|
|
|
1181 (setq noerase nil))))
|
|
|
1182 ;; Unless we found a modified message and are happy, start a
|
|
|
1183 ;; new message.
|
|
|
1184 (if (not noerase)
|
|
|
1185 (progn
|
|
|
1186 ;; Look for existing unmodified mail buffer.
|
|
|
1187 (while (and (setq buffer
|
|
|
1188 (get-buffer (if (= 1 index) "*mail*"
|
|
|
1189 (format "*mail*<%d>" index))))
|
|
|
1190 (buffer-modified-p buffer))
|
|
|
1191 (setq index (1+ index)))
|
|
|
1192 ;; If none, make a new one.
|
|
|
1193 (or buffer
|
|
|
1194 (setq buffer (generate-new-buffer "*mail*")))
|
|
|
1195 ;; Go there and initialize it.
|
|
|
1196 (switch-to-buffer buffer)
|
|
|
1197 (erase-buffer)
|
|
|
1198 ;; put mail auto-save files in home dir instead of
|
|
|
1199 ;; scattering them around the file system.
|
|
|
1200 (setq default-directory (or mail-dir (expand-file-name "~/")))
|
|
|
1201 (auto-save-mode auto-save-default)
|
|
|
1202 (mail-mode)
|
|
|
1203 (mail-setup to subject in-reply-to cc replybuffer actions)
|
|
|
1204 (if (and buffer-auto-save-file-name
|
|
|
1205 (file-exists-p buffer-auto-save-file-name))
|
|
|
1206 (message "Auto save file for draft message exists; consider M-x mail-recover"))
|
|
|
1207 t)))
|
|
|
1208
|
|
|
1209 ;; Alternate behavior that RMS likes.
|
|
|
1210 (pop-to-buffer "*mail*")
|
|
|
1211 (auto-save-mode auto-save-default)
|
|
|
1212 (mail-mode)
|
|
|
1213 ;; Disconnect the buffer from its visited file
|
|
|
1214 ;; (in case the user has actually visited a file *mail*).
|
|
|
1215 ; (set-visited-file-name nil)
|
|
|
1216 (let (initialized)
|
|
|
1217 (and (not noerase)
|
|
|
1218 (or (not (buffer-modified-p))
|
|
|
1219 (y-or-n-p "Unsent message being composed; erase it? "))
|
|
|
1220 (progn (erase-buffer)
|
|
|
1221 (mail-setup to subject in-reply-to cc replybuffer actions)
|
|
|
1222 (setq initialized t)))
|
|
|
1223 (if (and buffer-auto-save-file-name
|
|
|
1224 (file-exists-p buffer-auto-save-file-name))
|
|
|
1225 (message "Auto save file for draft message exists; consider M-x mail-recover"))
|
|
|
1226 initialized)))
|
|
|
1227
|
|
|
1228 (defun mail-recover ()
|
|
|
1229 "Reread contents of current buffer from its last auto-save file."
|
|
|
1230 (interactive)
|
|
|
1231 (let ((file-name (let ((default-directory (expand-file-name "~/")))
|
|
|
1232 ;; put mail auto-save files in home dir instead of
|
|
|
1233 ;; scattering them around the file system.
|
|
|
1234 (make-auto-save-file-name))))
|
|
|
1235 (cond ((save-window-excursion
|
|
|
1236 (if (not (eq system-type 'vax-vms))
|
|
|
1237 (with-output-to-temp-buffer "*Directory*"
|
|
|
1238 (buffer-disable-undo standard-output)
|
|
|
1239 (let ((default-directory "/"))
|
|
|
1240 (call-process
|
|
|
1241 "ls" nil standard-output nil "-l" file-name))))
|
|
|
1242 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
|
|
|
1243 (let ((buffer-read-only nil))
|
|
|
1244 (erase-buffer)
|
|
|
1245 (insert-file-contents file-name nil)))
|
|
|
1246 (t (error "mail-recover cancelled")))))
|
|
|
1247
|
|
|
1248 ;;;###autoload
|
|
|
1249 (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
|
|
|
1250 "Like `mail' command, but display mail buffer in another window."
|
|
|
1251 (interactive "P")
|
|
|
1252 (let ((pop-up-windows t)
|
|
|
1253 (special-display-buffer-names nil)
|
|
|
1254 (special-display-regexps nil)
|
|
|
1255 (same-window-buffer-names nil)
|
|
|
1256 (same-window-regexps nil))
|
|
|
1257 (pop-to-buffer "*mail*"))
|
|
|
1258 (mail noerase to subject in-reply-to cc replybuffer sendactions))
|
|
|
1259
|
|
|
1260 ;;;###autoload
|
|
|
1261 (defun mail-other-frame (&optional noerase to subject in-reply-to cc
|
|
|
1262 replybuffer sendactions)
|
|
|
1263 "Like `mail' command, but display mail buffer in another frame."
|
|
|
1264 (interactive "P")
|
|
|
1265 (let ((pop-up-frames t)
|
|
|
1266 (special-display-buffer-names nil)
|
|
|
1267 (special-display-regexps nil)
|
|
|
1268 (same-window-buffer-names nil)
|
|
|
1269 (same-window-regexps nil))
|
|
|
1270 (pop-to-buffer "*mail*"))
|
|
|
1271 (mail noerase to subject in-reply-to cc replybuffer sendactions))
|
|
|
1272
|
|
|
1273 ;;; Do not execute these when sendmail.el is loaded,
|
|
|
1274 ;;; only in loaddefs.el.
|
|
|
1275 ;;;###autoload (define-key ctl-x-map "m" 'mail)
|
|
|
1276 ;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window)
|
|
|
1277 ;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame)
|
|
|
1278
|
|
|
1279 ;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
|
|
|
1280
|
|
|
1281 ;;; Do not add anything but external entries on this page.
|
|
|
1282
|
|
|
1283 (provide 'sendmail)
|
|
|
1284
|
|
|
1285 ;;; sendmail.el ends here
|
