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