38412
|
1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
|
658
|
2
|
64754
|
3 ;; Copyright (C) 1985, 1987, 1993, 1994, 2001, 2002, 2003, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
845
|
5
|
788
|
6 ;; Maintainer: FSF
|
814
|
7 ;; Keywords: mail
|
788
|
8
|
63
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
78232
|
13 ;; the Free Software Foundation; either version 3, or (at your option)
|
63
|
14 ;; any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
63
|
25
|
38412
|
26 ;;; Commentary:
|
|
27
|
788
|
28 ;;; Code:
|
63
|
29
|
5859
|
30 (require 'rmail)
|
23986
|
31 (provide 'rmailout)
|
5859
|
32
|
16188
|
33 ;;;###autoload
|
17631
|
34 (defcustom rmail-output-file-alist nil
|
145
|
35 "*Alist matching regexps to suggested output Rmail files.
|
4056
|
36 This is a list of elements of the form (REGEXP . NAME-EXP).
|
4851
|
37 The suggestion is taken if REGEXP matches anywhere in the message buffer.
|
4056
|
38 NAME-EXP may be a string constant giving the file name to use,
|
|
39 or more generally it may be any kind of expression that returns
|
17631
|
40 a file name as a string."
|
|
41 :type '(repeat (cons regexp
|
|
42 (choice :value ""
|
|
43 (string :tag "File Name")
|
|
44 sexp)))
|
|
45 :group 'rmail-output)
|
145
|
46
|
23986
|
47 (defun rmail-output-read-rmail-file-name ()
|
|
48 "Read the file name to use for `rmail-output-to-rmail-file'.
|
|
49 Set `rmail-default-rmail-file' to this name as well as returning it."
|
|
50 (let ((default-file
|
|
51 (let (answer tail)
|
|
52 (setq tail rmail-output-file-alist)
|
|
53 ;; Suggest a file based on a pattern match.
|
|
54 (while (and tail (not answer))
|
|
55 (save-excursion
|
37613
|
56 (set-buffer rmail-buffer)
|
23986
|
57 (goto-char (point-min))
|
|
58 (if (re-search-forward (car (car tail)) nil t)
|
|
59 (setq answer (eval (cdr (car tail)))))
|
|
60 (setq tail (cdr tail))))
|
|
61 ;; If no suggestions, use same file as last time.
|
|
62 (expand-file-name (or answer rmail-default-rmail-file)))))
|
|
63 (let ((read-file
|
|
64 (expand-file-name
|
|
65 (read-file-name
|
65680
|
66 (concat "Output message to Rmail file (default "
|
23986
|
67 (file-name-nondirectory default-file)
|
65680
|
68 "): ")
|
23986
|
69 (file-name-directory default-file)
|
|
70 (abbreviate-file-name default-file))
|
|
71 (file-name-directory default-file))))
|
|
72 ;; If the user enters just a directory,
|
|
73 ;; use the name within that directory chosen by the default.
|
|
74 (setq rmail-default-rmail-file
|
|
75 (if (file-directory-p read-file)
|
|
76 (expand-file-name (file-name-nondirectory default-file)
|
|
77 read-file)
|
|
78 read-file)))))
|
|
79
|
|
80 (defun rmail-output-read-file-name ()
|
|
81 "Read the file name to use for `rmail-output'.
|
|
82 Set `rmail-default-file' to this name as well as returning it."
|
|
83 (let ((default-file
|
|
84 (let (answer tail)
|
|
85 (setq tail rmail-output-file-alist)
|
|
86 ;; Suggest a file based on a pattern match.
|
|
87 (while (and tail (not answer))
|
|
88 (save-excursion
|
|
89 (goto-char (point-min))
|
|
90 (if (re-search-forward (car (car tail)) nil t)
|
|
91 (setq answer (eval (cdr (car tail)))))
|
|
92 (setq tail (cdr tail))))
|
|
93 ;; If no suggestion, use same file as last time.
|
|
94 (or answer rmail-default-file))))
|
|
95 (let ((read-file
|
|
96 (expand-file-name
|
|
97 (read-file-name
|
65680
|
98 (concat "Output message to Unix mail file (default "
|
23986
|
99 (file-name-nondirectory default-file)
|
65680
|
100 "): ")
|
23986
|
101 (file-name-directory default-file)
|
|
102 (abbreviate-file-name default-file))
|
|
103 (file-name-directory default-file))))
|
|
104 (setq rmail-default-file
|
|
105 (if (file-directory-p read-file)
|
|
106 (expand-file-name (file-name-nondirectory default-file)
|
|
107 read-file)
|
|
108 (expand-file-name
|
|
109 (or read-file (file-name-nondirectory default-file))
|
|
110 (file-name-directory default-file)))))))
|
|
111
|
23042
|
112 ;;; There are functions elsewhere in Emacs that use this function;
|
|
113 ;;; look at them before you change the calling method.
|
16343
|
114 ;;;###autoload
|
29160
|
115 (defun rmail-output-to-rmail-file (file-name &optional count stay)
|
63
|
116 "Append the current message to an Rmail file named FILE-NAME.
|
|
117 If the file does not exist, ask if it should be created.
|
|
118 If file is being visited, the message is appended to the Emacs
|
|
119 buffer visiting that file.
|
19961
|
120 If the file exists and is not an Rmail file, the message is
|
|
121 appended in inbox format, the same way `rmail-output' does it.
|
4056
|
122
|
7332
|
123 The default file name comes from `rmail-default-rmail-file',
|
5592
|
124 which is updated to the name you use in this command.
|
|
125
|
66701
|
126 A prefix argument COUNT says to output that many consecutive messages,
|
29160
|
127 starting with the current one. Deleted messages are skipped and don't count.
|
|
128
|
66701
|
129 If the optional argument STAY is non-nil, then leave the last filed
|
|
130 message up instead of moving forward to the next non-deleted message."
|
3657
7503a402c721
(rmail-output-to-rmail-file): Use the smart default in the prompt.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
131 (interactive
|
23986
|
132 (list (rmail-output-read-rmail-file-name)
|
|
133 (prefix-numeric-value current-prefix-arg)))
|
1866
|
134 (or count (setq count 1))
|
202
|
135 (setq file-name
|
|
136 (expand-file-name file-name
|
5590
|
137 (file-name-directory rmail-default-rmail-file)))
|
13054
|
138 (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
|
4056
|
139 (rmail-output file-name count)
|
|
140 (rmail-maybe-set-message-counters)
|
|
141 (setq file-name (abbreviate-file-name file-name))
|
17268
|
142 (or (find-buffer-visiting file-name)
|
4056
|
143 (file-exists-p file-name)
|
|
144 (if (yes-or-no-p
|
|
145 (concat "\"" file-name "\" does not exist, create it? "))
|
|
146 (let ((file-buffer (create-file-buffer file-name)))
|
63
|
147 (save-excursion
|
4056
|
148 (set-buffer file-buffer)
|
|
149 (rmail-insert-rmail-file-header)
|
36717
|
150 (let ((require-final-newline nil)
|
|
151 (coding-system-for-write
|
|
152 (or rmail-file-coding-system
|
|
153 'emacs-mule-unix)))
|
4056
|
154 (write-region (point-min) (point-max) file-name t 1)))
|
|
155 (kill-buffer file-buffer))
|
|
156 (error "Output file does not exist")))
|
|
157 (while (> count 0)
|
|
158 (let (redelete)
|
|
159 (unwind-protect
|
|
160 (progn
|
37613
|
161 (set-buffer rmail-buffer)
|
5278
|
162 ;; Temporarily turn off Deleted attribute.
|
|
163 ;; Do this outside the save-restriction, since it would
|
|
164 ;; shift the place in the buffer where the visible text starts.
|
|
165 (if (rmail-message-deleted-p rmail-current-message)
|
|
166 (progn (setq redelete t)
|
|
167 (rmail-set-attribute "deleted" nil)))
|
4056
|
168 (save-restriction
|
|
169 (widen)
|
|
170 ;; Decide whether to append to a file or to an Emacs buffer.
|
|
171 (save-excursion
|
17268
|
172 (let ((buf (find-buffer-visiting file-name))
|
4056
|
173 (cur (current-buffer))
|
|
174 (beg (1+ (rmail-msgbeg rmail-current-message)))
|
22259
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
175 (end (1+ (rmail-msgend rmail-current-message)))
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
176 (coding-system-for-write
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
177 (or rmail-file-coding-system
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
178 'emacs-mule-unix)))
|
4056
|
179 (if (not buf)
|
9993
|
180 ;; Output to a file.
|
|
181 (if rmail-fields-not-to-output
|
|
182 ;; Delete some fields while we output.
|
|
183 (let ((obuf (current-buffer)))
|
|
184 (set-buffer (get-buffer-create " rmail-out-temp"))
|
|
185 (insert-buffer-substring obuf beg end)
|
|
186 (rmail-delete-unwanted-fields)
|
|
187 (append-to-file (point-min) (point-max) file-name)
|
|
188 (set-buffer obuf)
|
|
189 (kill-buffer (get-buffer " rmail-out-temp")))
|
|
190 (append-to-file beg end file-name))
|
4056
|
191 (if (eq buf (current-buffer))
|
|
192 (error "Can't output message to same file it's already in"))
|
|
193 ;; File has been visited, in buffer BUF.
|
|
194 (set-buffer buf)
|
|
195 (let ((buffer-read-only nil)
|
|
196 (msg (and (boundp 'rmail-current-message)
|
|
197 rmail-current-message)))
|
|
198 ;; If MSG is non-nil, buffer is in RMAIL mode.
|
|
199 (if msg
|
|
200 (progn
|
5331
|
201 ;; Turn on auto save mode, if it's off in this
|
|
202 ;; buffer but enabled by default.
|
|
203 (and (not buffer-auto-save-file-name)
|
|
204 auto-save-default
|
|
205 (auto-save-mode t))
|
4056
|
206 (rmail-maybe-set-message-counters)
|
|
207 (widen)
|
|
208 (narrow-to-region (point-max) (point-max))
|
|
209 (insert-buffer-substring cur beg end)
|
|
210 (goto-char (point-min))
|
|
211 (widen)
|
|
212 (search-backward "\n\^_")
|
|
213 (narrow-to-region (point) (point-max))
|
9993
|
214 (rmail-delete-unwanted-fields)
|
4056
|
215 (rmail-count-new-messages t)
|
5278
|
216 (if (rmail-summary-exists)
|
|
217 (rmail-select-summary
|
|
218 (rmail-update-summary)))
|
4056
|
219 (rmail-show-message msg))
|
22259
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
220 ;; Output file not in rmail mode => just insert at the end.
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
221 (narrow-to-region (point-min) (1+ (buffer-size)))
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
222 (goto-char (point-max))
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
223 (insert-buffer-substring cur beg end)
|
e7a998137db5
(rmail-output-to-rmail-file): Specify the coding system for writing.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
224 (rmail-delete-unwanted-fields)))))))
|
4056
|
225 (rmail-set-attribute "filed" t))
|
|
226 (if redelete (rmail-set-attribute "deleted" t))))
|
|
227 (setq count (1- count))
|
|
228 (if rmail-delete-after-output
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
229 (unless
|
29160
|
230 (if (and (= count 0) stay)
|
|
231 (rmail-delete-message)
|
|
232 (rmail-delete-forward))
|
|
233 (setq count 0))
|
4056
|
234 (if (> count 0)
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
235 (unless
|
29160
|
236 (if (not stay) (rmail-next-undeleted-message 1))
|
|
237 (setq count 0)))))))
|
4056
|
238
|
16343
|
239 ;;;###autoload
|
17631
|
240 (defcustom rmail-fields-not-to-output nil
|
|
241 "*Regexp describing fields to exclude when outputting a message to a file."
|
|
242 :type '(choice (const :tag "None" nil)
|
|
243 regexp)
|
|
244 :group 'rmail-output)
|
9993
|
245
|
|
246 ;; Delete from the buffer header fields we don't want output.
|
|
247 ;; NOT-RMAIL if t means this buffer does not have the full header
|
|
248 ;; and *** EOOH *** that a message in an Rmail file has.
|
|
249 (defun rmail-delete-unwanted-fields (&optional not-rmail)
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
250 (if rmail-fields-not-to-output
|
9993
|
251 (save-excursion
|
|
252 (goto-char (point-min))
|
|
253 ;; Find the end of the header.
|
|
254 (if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
|
|
255 (search-forward "\n\n" nil t))
|
|
256 (let ((end (point-marker)))
|
|
257 (goto-char (point-min))
|
|
258 (while (re-search-forward rmail-fields-not-to-output end t)
|
|
259 (beginning-of-line)
|
|
260 (delete-region (point)
|
|
261 (progn (forward-line 1) (point)))))))))
|
|
262
|
23042
|
263 ;;; There are functions elsewhere in Emacs that use this function;
|
|
264 ;;; look at them before you change the calling method.
|
16343
|
265 ;;;###autoload
|
5011
|
266 (defun rmail-output (file-name &optional count noattribute from-gnus)
|
6651
|
267 "Append this message to system-inbox-format mail file named FILE-NAME.
|
66701
|
268 A prefix argument COUNT says to output that many consecutive messages,
|
1866
|
269 starting with the current one. Deleted messages are skipped and don't count.
|
66701
|
270 When called from lisp code, COUNT may be omitted and defaults to 1.
|
4265
|
271
|
4836
|
272 If the pruned message header is shown on the current message, then
|
|
273 messages will be appended with pruned headers; otherwise, messages
|
|
274 will be appended with their original headers.
|
|
275
|
7561
|
276 The default file name comes from `rmail-default-file',
|
5592
|
277 which is updated to the name you use in this command.
|
|
278
|
4265
|
279 The optional third argument NOATTRIBUTE, if non-nil, says not
|
5011
|
280 to set the `filed' attribute, and not to display a message.
|
|
281
|
|
282 The optional fourth argument FROM-GNUS is set when called from GNUS."
|
63
|
283 (interactive
|
23986
|
284 (list (rmail-output-read-file-name)
|
|
285 (prefix-numeric-value current-prefix-arg)))
|
1866
|
286 (or count (setq count 1))
|
202
|
287 (setq file-name
|
|
288 (expand-file-name file-name
|
5590
|
289 (and rmail-default-file
|
|
290 (file-name-directory rmail-default-file))))
|
13054
|
291 (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
|
4056
|
292 (rmail-output-to-rmail-file file-name count)
|
37613
|
293 (set-buffer rmail-buffer)
|
4836
|
294 (let ((orig-count count)
|
|
295 (rmailbuf (current-buffer))
|
|
296 (case-fold-search t)
|
|
297 (tembuf (get-buffer-create " rmail-output"))
|
|
298 (original-headers-p
|
5011
|
299 (and (not from-gnus)
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
300 (save-excursion
|
5011
|
301 (save-restriction
|
|
302 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
|
|
303 (goto-char (point-min))
|
|
304 (forward-line 1)
|
|
305 (= (following-char) ?0)))))
|
4836
|
306 header-beginning
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
307 mail-from mime-version content-type)
|
4836
|
308 (while (> count 0)
|
23042
|
309 ;; Preserve the Mail-From and MIME-Version fields
|
|
310 ;; even if they have been pruned.
|
5011
|
311 (or from-gnus
|
23042
|
312 (save-excursion
|
|
313 (save-restriction
|
|
314 (widen)
|
|
315 (goto-char (rmail-msgbeg rmail-current-message))
|
|
316 (setq header-beginning (point))
|
|
317 (search-forward "\n*** EOOH ***\n")
|
|
318 (narrow-to-region header-beginning (point))
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
319 (setq mail-from (mail-fetch-field "Mail-From"))
|
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
320 (unless rmail-enable-mime
|
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
321 (setq mime-version (mail-fetch-field "MIME-Version")
|
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
322 content-type (mail-fetch-field "Content-type"))))))
|
4056
|
323 (save-excursion
|
|
324 (set-buffer tembuf)
|
|
325 (erase-buffer)
|
|
326 (insert-buffer-substring rmailbuf)
|
38304
|
327 (when rmail-enable-mime
|
|
328 (if original-headers-p
|
|
329 (delete-region (goto-char (point-min))
|
|
330 (if (search-forward "\n*** EOOH ***\n")
|
|
331 (match-end 0)))
|
|
332 (goto-char (point-min))
|
|
333 (forward-line 2)
|
|
334 (delete-region (point-min)(point))
|
|
335 (search-forward "\n*** EOOH ***\n")
|
|
336 (delete-region (match-beginning 0)
|
|
337 (if (search-forward "\n\n")
|
|
338 (1- (match-end 0)))))
|
|
339 (setq buffer-file-coding-system (or rmail-file-coding-system
|
|
340 'raw-text)))
|
9993
|
341 (rmail-delete-unwanted-fields t)
|
23528
|
342 (or (bolp) (insert "\n"))
|
4056
|
343 (goto-char (point-min))
|
4836
|
344 (if mail-from
|
|
345 (insert mail-from "\n")
|
|
346 (insert "From "
|
|
347 (mail-strip-quoted-names (or (mail-fetch-field "from")
|
|
348 (mail-fetch-field "really-from")
|
|
349 (mail-fetch-field "sender")
|
|
350 "unknown"))
|
|
351 " " (current-time-string) "\n"))
|
68316
|
352 (when mime-version
|
|
353 (insert "MIME-Version: " mime-version)
|
|
354 ;; Some malformed MIME messages set content-type to nil.
|
|
355 (when content-type
|
|
356 (insert "\nContent-type: " content-type "\n")))
|
4056
|
357 ;; ``Quote'' "\nFrom " as "\n>From "
|
|
358 ;; (note that this isn't really quoting, as there is no requirement
|
|
359 ;; that "\n[>]+From " be quoted in the same transparent way.)
|
10101
c0afdaf34c6f
(rmail-output): Don't quote "From " lines unless the capitalization is exact.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
360 (let ((case-fold-search nil))
|
c0afdaf34c6f
(rmail-output): Don't quote "From " lines unless the capitalization is exact.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
361 (while (search-forward "\nFrom " nil t)
|
c0afdaf34c6f
(rmail-output): Don't quote "From " lines unless the capitalization is exact.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
362 (forward-char -5)
|
c0afdaf34c6f
(rmail-output): Don't quote "From " lines unless the capitalization is exact.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
363 (insert ?>)))
|
4265
|
364 (write-region (point-min) (point-max) file-name t
|
|
365 (if noattribute 'nomsg)))
|
4836
|
366 (or noattribute
|
|
367 (if (equal major-mode 'rmail-mode)
|
|
368 (rmail-set-attribute "filed" t)))
|
|
369 (setq count (1- count))
|
5011
|
370 (or from-gnus
|
|
371 (let ((next-message-p
|
|
372 (if rmail-delete-after-output
|
|
373 (rmail-delete-forward)
|
|
374 (if (> count 0)
|
|
375 (rmail-next-undeleted-message 1))))
|
|
376 (num-appended (- orig-count count)))
|
|
377 (if (and next-message-p original-headers-p)
|
|
378 (rmail-toggle-header))
|
|
379 (if (and (> count 0) (not next-message-p))
|
49587
e82b3fe06d4c
(rmail-output): If preserving MIME-version, preserve Content-type too.
Francesco Potortì <pot@gnu.org>
diff
changeset
|
380 (progn
|
5011
|
381 (error
|
|
382 (save-excursion
|
|
383 (set-buffer rmailbuf)
|
|
384 (format "Only %d message%s appended" num-appended
|
|
385 (if (= num-appended 1) "" "s"))))
|
|
386 (setq count 0))))))
|
4836
|
387 (kill-buffer tembuf))))
|
658
|
388
|
17267
|
389 ;;;###autoload
|
17305
|
390 (defun rmail-output-body-to-file (file-name)
|
17267
|
391 "Write this message body to the file FILE-NAME.
|
|
392 FILE-NAME defaults, interactively, from the Subject field of the message."
|
|
393 (interactive
|
|
394 (let ((default-file
|
22202
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
395 (or (mail-fetch-field "Subject")
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
396 rmail-default-body-file)))
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
397 (list (setq rmail-default-body-file
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
398 (read-file-name
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
399 "Output message body to file: "
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
400 (and default-file (file-name-directory default-file))
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
401 default-file
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
402 nil default-file)))))
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
403 (setq file-name
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
404 (expand-file-name file-name
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
405 (and rmail-default-body-file
|
cca4f78e5e2a
(rmail-output-body-to-file): Avoid error if message has no subject.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
406 (file-name-directory rmail-default-body-file))))
|
17267
|
407 (save-excursion
|
|
408 (goto-char (point-min))
|
|
409 (search-forward "\n\n")
|
17305
|
410 (and (file-exists-p file-name)
|
73972
98d8e09fad2d
(rmail-output-body-to-file): Use `format', not `message', in `y-or-n-p' call.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
411 (not (y-or-n-p (format "File %s exists; overwrite? " file-name)))
|
17305
|
412 (error "Operation aborted"))
|
17267
|
413 (write-region (point) (point-max) file-name)
|
|
414 (if (equal major-mode 'rmail-mode)
|
|
415 (rmail-set-attribute "stored" t)))
|
|
416 (if rmail-delete-after-output
|
|
417 (rmail-delete-forward)))
|
|
418
|
52401
|
419 ;;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
|
658
|
420 ;;; rmailout.el ends here
|