Commit | Line | Data |
---|---|---|
537ab246 BG |
1 | ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file |
2 | ||
acaf905b | 3 | ;; Copyright (C) 1985, 1987, 1993-1994, 2001-2012 |
95df8112 | 4 | ;; Free Software Foundation, Inc. |
537ab246 BG |
5 | |
6 | ;; Maintainer: FSF | |
7 | ;; Keywords: mail | |
bd78fa1d | 8 | ;; Package: rmail |
537ab246 BG |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | (require 'rmail) | |
30 | (provide 'rmailout) | |
31 | ||
537ab246 | 32 | (defcustom rmail-output-decode-coding nil |
c10782e6 | 33 | "If non-nil, do coding system decoding when outputting message as Babyl." |
aab4c09b GM |
34 | :type 'boolean |
35 | :group 'rmail-output) | |
537ab246 | 36 | |
537ab246 | 37 | (defcustom rmail-output-file-alist nil |
c10782e6 | 38 | "Alist matching regexps to suggested output Rmail files. |
537ab246 BG |
39 | This is a list of elements of the form (REGEXP . NAME-EXP). |
40 | The suggestion is taken if REGEXP matches anywhere in the message buffer. | |
41 | NAME-EXP may be a string constant giving the file name to use, | |
42 | or more generally it may be any kind of expression that returns | |
43 | a file name as a string." | |
44 | :type '(repeat (cons regexp | |
45 | (choice :value "" | |
46 | (string :tag "File Name") | |
47 | sexp))) | |
48 | :group 'rmail-output) | |
ee218151 | 49 | ;; This is risky because NAME-EXP gets evalled. |
6dc3311d | 50 | ;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t) |
537ab246 | 51 | |
aab4c09b | 52 | (defcustom rmail-fields-not-to-output nil |
5b148883 GM |
53 | "Regexp describing fields to exclude when outputting a message to a file. |
54 | The function `rmail-delete-unwanted-fields' uses this, ignoring case." | |
aab4c09b GM |
55 | :type '(choice (const :tag "None" nil) |
56 | regexp) | |
57 | :group 'rmail-output) | |
58 | ||
537ab246 BG |
59 | (defun rmail-output-read-file-name () |
60 | "Read the file name to use for `rmail-output'. | |
ee218151 GM |
61 | Set `rmail-default-file' to this name as well as returning it. |
62 | This uses `rmail-output-file-alist'." | |
63 | (let* ((default-file | |
64 | (when rmail-output-file-alist | |
65 | (or rmail-buffer (error "There is no Rmail buffer")) | |
66 | (save-current-buffer | |
67 | (set-buffer rmail-buffer) | |
68 | (let ((beg (rmail-msgbeg rmail-current-message)) | |
69 | (end (rmail-msgend rmail-current-message))) | |
70 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | |
71 | (save-excursion | |
72 | (save-restriction | |
73 | (widen) | |
74 | (narrow-to-region beg end) | |
75 | (let ((tail rmail-output-file-alist) | |
76 | answer) | |
77 | ;; Suggest a file based on a pattern match. | |
78 | (while (and tail (not answer)) | |
79 | (goto-char (point-min)) | |
80 | (if (re-search-forward (caar tail) nil t) | |
81 | (setq answer (eval (cdar tail)))) | |
82 | (setq tail (cdr tail))) | |
83 | ;; If no suggestion, use same file as last time. | |
84 | (or answer rmail-default-file)))))))) | |
85 | (read-file | |
86 | (expand-file-name | |
87 | (read-file-name | |
88 | (concat "Output message to mail file (default " | |
89 | (file-name-nondirectory default-file) | |
90 | "): ") | |
91 | (file-name-directory default-file) | |
92 | (abbreviate-file-name default-file)) | |
93 | (file-name-directory default-file)))) | |
94 | (setq rmail-default-file | |
95 | (if (file-directory-p read-file) | |
96 | (expand-file-name (file-name-nondirectory default-file) | |
97 | read-file) | |
98 | (expand-file-name | |
99 | (or read-file (file-name-nondirectory default-file)) | |
100 | (file-name-directory default-file)))))) | |
537ab246 | 101 | |
537ab246 | 102 | (defun rmail-delete-unwanted-fields (preserve) |
d4653d3c | 103 | "Delete all headers matching `rmail-fields-not-to-output'. |
5b148883 GM |
104 | Retains headers matching the regexp PRESERVE. Ignores case. |
105 | The buffer should be narrowed to just the header." | |
537ab246 BG |
106 | (if rmail-fields-not-to-output |
107 | (save-excursion | |
108 | (goto-char (point-min)) | |
5b148883 GM |
109 | (let ((case-fold-search t)) |
110 | (while (re-search-forward rmail-fields-not-to-output nil t) | |
111 | (beginning-of-line) | |
112 | (unless (looking-at preserve) | |
113 | (delete-region (point) (line-beginning-position 2)))))))) | |
537ab246 BG |
114 | \f |
115 | (defun rmail-output-as-babyl (file-name nomsg) | |
116 | "Convert the current buffer's text to Babyl and output to FILE-NAME. | |
d4653d3c GM |
117 | Alters the current buffer's text, so it should be a temporary buffer. |
118 | If a buffer is visiting FILE-NAME, adds the text to that buffer | |
119 | rather than saving the file directly. If the buffer is an Rmail buffer, | |
120 | updates it accordingly. If no buffer is visiting FILE-NAME, appends | |
121 | the text directly to FILE-NAME, and displays a \"Wrote file\" message | |
122 | unless NOMSG is a symbol (neither nil nor t)." | |
123 | (let ((coding-system-for-write 'emacs-mule-unix)) | |
537ab246 BG |
124 | (save-restriction |
125 | (goto-char (point-min)) | |
126 | (search-forward "\n\n" nil 'move) | |
127 | (narrow-to-region (point-min) (point)) | |
128 | (if rmail-fields-not-to-output | |
129 | (rmail-delete-unwanted-fields nil))) | |
130 | ||
131 | ;; Convert to Babyl format. | |
132 | (rmail-convert-to-babyl-format) | |
133 | ;; Write it into the file, or its buffer. | |
134 | (let ((buf (find-buffer-visiting file-name)) | |
135 | (tembuf (current-buffer))) | |
136 | (if (null buf) | |
137 | (write-region (point-min) (point-max) file-name t nomsg) | |
138 | (if (eq buf (current-buffer)) | |
139 | (error "Can't output message to same file it's already in")) | |
140 | ;; File has been visited, in buffer BUF. | |
141 | (set-buffer buf) | |
142 | (let ((inhibit-read-only t) | |
aab4c09b | 143 | (msg (bound-and-true-p rmail-current-message))) |
537ab246 BG |
144 | ;; If MSG is non-nil, buffer is in RMAIL mode. |
145 | (if msg | |
c10782e6 | 146 | (rmail-output-to-babyl-buffer tembuf msg) |
537ab246 BG |
147 | ;; Output file not in rmail mode => just insert at the end. |
148 | (narrow-to-region (point-min) (1+ (buffer-size))) | |
149 | (goto-char (point-max)) | |
150 | (insert-buffer-substring tembuf))))))) | |
151 | ||
dfeab394 GM |
152 | ;; Called only if rmail-summary-exists, which means rmailsum is loaded. |
153 | (declare-function rmail-update-summary "rmailsum" (&rest ignore)) | |
154 | ||
c10782e6 | 155 | (defun rmail-output-to-babyl-buffer (tembuf msg) |
d4653d3c GM |
156 | "Copy message in TEMBUF into the current Babyl Rmail buffer. |
157 | Do what is necessary to make Rmail know about the new message, then | |
158 | display message number MSG." | |
159 | ;; Turn on Auto Save mode, if it's off in this buffer but enabled by default. | |
aab4c09b GM |
160 | (and (not buffer-auto-save-file-name) |
161 | auto-save-default | |
162 | (auto-save-mode t)) | |
163 | (rmail-maybe-set-message-counters) | |
164 | (widen) | |
165 | (narrow-to-region (point-max) (point-max)) | |
166 | (insert-buffer-substring tembuf) | |
167 | (goto-char (point-min)) | |
168 | (widen) | |
169 | (search-backward "\n\^_") | |
170 | (narrow-to-region (point) (point-max)) | |
171 | (rmail-count-new-messages t) | |
172 | (if (rmail-summary-exists) | |
d4653d3c | 173 | (rmail-select-summary (rmail-update-summary))) |
aab4c09b | 174 | (rmail-show-message-1 msg)) |
537ab246 BG |
175 | \f |
176 | (defun rmail-convert-to-babyl-format () | |
d4653d3c | 177 | "Convert the mbox message in the current buffer to Babyl format." |
537ab246 BG |
178 | (let ((count 0) (start (point-min)) |
179 | (case-fold-search nil) | |
180 | (buffer-undo-list t)) | |
181 | (goto-char (point-min)) | |
182 | (save-restriction | |
183 | (unless (looking-at "^From ") | |
184 | (error "Invalid mbox message")) | |
f824857f | 185 | (insert "\^L\n0,,\n*** EOOH ***\n") |
537ab246 BG |
186 | (rmail-nuke-pinhead-header) |
187 | ;; Decode base64 or quoted printable contents, Rmail style. | |
188 | (let* ((header-end (save-excursion | |
189 | (and (re-search-forward "\n\n" nil t) | |
190 | (1- (point))))) | |
191 | (case-fold-search t) | |
192 | (quoted-printable-header-field-end | |
193 | (save-excursion | |
194 | (re-search-forward | |
195 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | |
196 | header-end t))) | |
197 | (base64-header-field-end | |
198 | (and | |
199 | ;; Don't decode non-text data. | |
200 | (save-excursion | |
201 | (re-search-forward | |
202 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | |
203 | header-end t)) | |
204 | (save-excursion | |
205 | (re-search-forward | |
206 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | |
207 | header-end t))))) | |
208 | ||
209 | (goto-char (point-max)) | |
210 | (if quoted-printable-header-field-end | |
211 | (save-excursion | |
212 | (unless (mail-unquote-printable-region | |
213 | header-end (point) nil t t) | |
214 | (message "Malformed MIME quoted-printable message")) | |
215 | ;; Change "quoted-printable" to "8bit", | |
216 | ;; to reflect the decoding we just did. | |
217 | (goto-char quoted-printable-header-field-end) | |
218 | (delete-region (point) (search-backward ":")) | |
219 | (insert ": 8bit"))) | |
220 | (if base64-header-field-end | |
221 | (save-excursion | |
222 | (when (condition-case nil | |
223 | (progn | |
224 | (base64-decode-region | |
225 | (1+ header-end) | |
226 | (save-excursion | |
227 | ;; Prevent base64-decode-region | |
228 | ;; from removing newline characters. | |
229 | (skip-chars-backward "\n\t ") | |
230 | (point))) | |
231 | t) | |
232 | (error nil)) | |
233 | ;; Change "base64" to "8bit", to reflect the | |
234 | ;; decoding we just did. | |
235 | (goto-char base64-header-field-end) | |
236 | (delete-region (point) (search-backward ":")) | |
237 | (insert ": 8bit"))))) | |
238 | ;; Transform anything within the message text | |
239 | ;; that might appear to be the end of a Babyl-format message. | |
240 | (save-excursion | |
241 | (save-restriction | |
242 | (narrow-to-region start (point)) | |
243 | (goto-char (point-min)) | |
244 | (while (search-forward "\n\^_" nil t) ; single char | |
245 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" | |
246 | ;; This is for malformed messages that don't end in newline. | |
247 | ;; There shouldn't be any, but some users say occasionally | |
248 | ;; there are some. | |
249 | (or (bolp) (newline)) | |
250 | (insert ?\^_) | |
251 | (setq last-coding-system-used nil) | |
252 | ;; Decode coding system, following specs in the message header, | |
253 | ;; and record what coding system was decoded. | |
254 | (if rmail-output-decode-coding | |
255 | (let ((mime-charset | |
256 | (if (save-excursion | |
257 | (goto-char start) | |
258 | (search-forward "\n\n" nil t) | |
259 | (let ((case-fold-search t)) | |
260 | (re-search-backward | |
261 | rmail-mime-charset-pattern | |
262 | start t))) | |
263 | (intern (downcase (match-string 1)))))) | |
264 | (rmail-decode-region start (point) mime-charset))) | |
265 | (save-excursion | |
266 | (goto-char start) | |
267 | (forward-line 3) | |
268 | (insert "X-Coding-System: " | |
269 | (symbol-name last-coding-system-used) | |
270 | "\n"))))) | |
271 | ||
537ab246 | 272 | (defun rmail-nuke-pinhead-header () |
d4653d3c GM |
273 | "Delete the \"From \" line in the current mbox message. |
274 | The variable `rmail-unix-mail-delimiter' specifies the From line format. | |
275 | Replaces the From line with a \"Mail-from\" header. Adds \"Date\" and | |
276 | \"From\" headers if they are not already present." | |
537ab246 BG |
277 | (save-excursion |
278 | (save-restriction | |
279 | (let ((start (point)) | |
280 | (end (progn | |
281 | (condition-case () | |
282 | (search-forward "\n\n") | |
283 | (error | |
284 | (goto-char (point-max)) | |
285 | (insert "\n\n"))) | |
286 | (point))) | |
287 | has-from has-date) | |
288 | (narrow-to-region start end) | |
289 | (let ((case-fold-search t)) | |
290 | (goto-char start) | |
291 | (setq has-from (search-forward "\nFrom:" nil t)) | |
292 | (goto-char start) | |
293 | (setq has-date (and (search-forward "\nDate:" nil t) (point))) | |
294 | (goto-char start)) | |
295 | (let ((case-fold-search nil)) | |
296 | (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) | |
297 | (replace-match | |
298 | (concat | |
299 | "Mail-from: \\&" | |
300 | ;; Keep and reformat the date if we don't | |
301 | ;; have a Date: field. | |
302 | (if has-date | |
303 | "" | |
304 | (concat | |
305 | "Date: \\2, \\4 \\3 \\9 \\5 " | |
306 | ||
307 | ;; The timezone could be matched by group 7 or group 10. | |
308 | ;; If neither of them matched, assume EST, since only | |
309 | ;; Easterners would be so sloppy. | |
310 | ;; It's a shame the substitution can't use "\\10". | |
311 | (cond | |
312 | ((/= (match-beginning 7) (match-end 7)) "\\7") | |
313 | ((/= (match-beginning 10) (match-end 10)) | |
314 | (buffer-substring (match-beginning 10) | |
315 | (match-end 10))) | |
316 | (t "EST")) | |
317 | "\n")) | |
318 | ;; Keep and reformat the sender if we don't | |
319 | ;; have a From: field. | |
320 | (if has-from | |
321 | "" | |
322 | "From: \\1\n")) | |
323 | t))))))) | |
324 | \f | |
6aa7fc5b | 325 | (autoload 'mail-mbox-from "mail-utils") |
1640a85f | 326 | |
537ab246 | 327 | (defun rmail-output-as-mbox (file-name nomsg &optional as-seen) |
aab4c09b | 328 | "Convert the current buffer's text to mbox and output to FILE-NAME. |
d4653d3c GM |
329 | Alters the current buffer's text, so it should be a temporary buffer. |
330 | If a buffer is visiting FILE-NAME, adds the text to that buffer | |
331 | rather than saving the file directly. If the buffer is an Rmail buffer, | |
332 | updates it accordingly. If no buffer is visiting FILE-NAME, appends | |
333 | the text directly to FILE-NAME, and displays a \"Wrote file\" message | |
334 | unless NOMSG is a symbol (neither nil nor t). | |
537ab246 BG |
335 | AS-SEEN is non-nil if we are copying the message \"as seen\"." |
336 | (let ((case-fold-search t) | |
050f62bf GM |
337 | from date) |
338 | (goto-char (point-min)) | |
537ab246 BG |
339 | ;; Preserve the Mail-From and MIME-Version fields |
340 | ;; even if they have been pruned. | |
341 | (search-forward "\n\n" nil 'move) | |
342 | (narrow-to-region (point-min) (point)) | |
537ab246 BG |
343 | (rmail-delete-unwanted-fields |
344 | (if rmail-enable-mime "Mail-From" | |
345 | "Mail-From\\|MIME-Version\\|Content-type")) | |
050f62bf | 346 | (goto-char (point-min)) |
1640a85f | 347 | (or (looking-at "From ") |
6aa7fc5b | 348 | (insert (mail-mbox-from))) |
537ab246 | 349 | (widen) |
537ab246 BG |
350 | ;; Make sure message ends with blank line. |
351 | (goto-char (point-max)) | |
7184dd77 | 352 | (rmail-ensure-blank-line) |
537ab246 | 353 | (goto-char (point-min)) |
537ab246 BG |
354 | (let ((buf (find-buffer-visiting file-name)) |
355 | (tembuf (current-buffer))) | |
356 | (if (null buf) | |
357 | (let ((coding-system-for-write 'raw-text-unix)) | |
7184dd77 | 358 | ;; FIXME should ensure existing file ends with a blank line. |
537ab246 BG |
359 | (write-region (point-min) (point-max) file-name t nomsg)) |
360 | (if (eq buf (current-buffer)) | |
361 | (error "Can't output message to same file it's already in")) | |
362 | ;; File has been visited, in buffer BUF. | |
363 | (set-buffer buf) | |
364 | (let ((inhibit-read-only t) | |
365 | (msg (and (boundp 'rmail-current-message) | |
366 | rmail-current-message))) | |
367 | (and msg as-seen | |
368 | (error "Can't output \"as seen\" to a visited Rmail file")) | |
369 | (if msg | |
370 | (rmail-output-to-rmail-buffer tembuf msg) | |
371 | ;; Output file not in Rmail mode => just insert at the end. | |
372 | (narrow-to-region (point-min) (1+ (buffer-size))) | |
373 | (goto-char (point-max)) | |
374 | (insert-buffer-substring tembuf))))))) | |
375 | ||
537ab246 | 376 | (defun rmail-output-to-rmail-buffer (tembuf msg) |
d4653d3c GM |
377 | "Copy message in TEMBUF into the current Rmail buffer. |
378 | Do what is necessary to make Rmail know about the new message. then | |
379 | display message number MSG." | |
537ab246 BG |
380 | (save-excursion |
381 | (rmail-swap-buffers-maybe) | |
9aadce25 | 382 | (rmail-modify-format) |
7184dd77 GM |
383 | ;; Turn on Auto Save mode, if it's off in this buffer but enabled |
384 | ;; by default. | |
537ab246 BG |
385 | (and (not buffer-auto-save-file-name) |
386 | auto-save-default | |
387 | (auto-save-mode t)) | |
388 | (rmail-maybe-set-message-counters) | |
7184dd77 GM |
389 | ;; Insert the new message after the last old message. |
390 | (widen) | |
447f30f6 GM |
391 | (unless (zerop (buffer-size)) |
392 | ;; Make sure the last old message ends with a blank line. | |
393 | (goto-char (point-max)) | |
394 | (rmail-ensure-blank-line) | |
395 | ;; Insert the new message at the end. | |
396 | (narrow-to-region (point-max) (point-max))) | |
537ab246 BG |
397 | (insert-buffer-substring tembuf) |
398 | (rmail-count-new-messages t) | |
7184dd77 | 399 | ;; FIXME should re-use existing windows. |
537ab246 | 400 | (if (rmail-summary-exists) |
d4653d3c | 401 | (rmail-select-summary (rmail-update-summary))) |
a1a29341 | 402 | (rmail-show-message-1 msg))) |
537ab246 BG |
403 | \f |
404 | ;;; There are functions elsewhere in Emacs that use this function; | |
405 | ;;; look at them before you change the calling method. | |
406 | ;;;###autoload | |
5b148883 | 407 | (defun rmail-output (file-name &optional count noattribute not-rmail) |
537ab246 | 408 | "Append this message to mail file FILE-NAME. |
554fda1a GM |
409 | Writes mbox format, unless FILE-NAME exists and is Babyl format, in which |
410 | case it writes Babyl. | |
d4653d3c GM |
411 | |
412 | Interactively, the default file name comes from `rmail-default-file', | |
413 | which is updated to the name you use in this command. In all uses, if | |
414 | FILE-NAME is not absolute, it is expanded with the directory part of | |
415 | `rmail-default-file'. | |
537ab246 | 416 | |
554fda1a GM |
417 | If a buffer is visiting FILE-NAME, adds the text to that buffer |
418 | rather than saving the file directly. If the buffer is an Rmail | |
419 | buffer, updates it accordingly. | |
420 | ||
421 | This command always outputs the complete message header, even if | |
422 | the header display is currently pruned. | |
537ab246 | 423 | |
554fda1a GM |
424 | Optional prefix argument COUNT (default 1) says to output that |
425 | many consecutive messages, starting with the current one (ignoring | |
426 | deleted messages). If `rmail-delete-after-output' is non-nil, deletes | |
427 | messages after output. | |
537ab246 | 428 | |
554fda1a GM |
429 | The optional third argument NOATTRIBUTE, if non-nil, says not to |
430 | set the `filed' attribute, and not to display a \"Wrote file\" | |
431 | message (if writing a file directly). | |
537ab246 | 432 | |
5b148883 GM |
433 | Set the optional fourth argument NOT-RMAIL non-nil if you call this |
434 | from a non-Rmail buffer. In this case, COUNT is ignored." | |
537ab246 BG |
435 | (interactive |
436 | (list (rmail-output-read-file-name) | |
437 | (prefix-numeric-value current-prefix-arg))) | |
438 | (or count (setq count 1)) | |
439 | (setq file-name | |
440 | (expand-file-name file-name | |
441 | (and rmail-default-file | |
442 | (file-name-directory rmail-default-file)))) | |
537ab246 BG |
443 | ;; Warn about creating new file. |
444 | (or (find-buffer-visiting file-name) | |
445 | (file-exists-p file-name) | |
5b148883 | 446 | (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) |
537ab246 | 447 | (error "Output file does not exist")) |
5b148883 GM |
448 | (if noattribute (setq noattribute 'nomsg)) |
449 | (let ((babyl-format (and (file-readable-p file-name) | |
450 | (mail-file-babyl-p file-name))) | |
de62d9e9 RS |
451 | (cur (current-buffer)) |
452 | (buf (find-buffer-visiting file-name))) | |
453 | ||
454 | ;; If a babyl file is visited in a buffer, is it visited as babyl | |
455 | ;; or as mbox? | |
456 | (and babyl-format buf | |
457 | (with-current-buffer buf | |
458 | (save-restriction | |
459 | (widen) | |
460 | (save-excursion | |
461 | (goto-char (point-min)) | |
462 | (setq babyl-format | |
463 | (looking-at "BABYL OPTIONS:")))))) | |
464 | ||
5b148883 GM |
465 | (if not-rmail ; eg via message-fcc-handler-function |
466 | (with-temp-buffer | |
5b148883 GM |
467 | (insert-buffer-substring cur) |
468 | ;; Output in the appropriate format. | |
469 | (if babyl-format | |
1640a85f GM |
470 | (progn |
471 | (goto-char (point-min)) | |
472 | ;; rmail-convert-to-babyl-format errors if no From line, | |
473 | ;; whereas rmail-output-as-mbox inserts one. | |
474 | (or (looking-at "From ") | |
6aa7fc5b | 475 | (insert (mail-mbox-from))) |
1640a85f | 476 | (rmail-output-as-babyl file-name noattribute)) |
5b148883 GM |
477 | (rmail-output-as-mbox file-name noattribute))) |
478 | ;; Called from an Rmail buffer. | |
479 | (if rmail-buffer | |
480 | (set-buffer rmail-buffer) | |
481 | (error "There is no Rmail buffer")) | |
8038d2d2 GM |
482 | (if (zerop rmail-total-messages) |
483 | (error "No messages to output")) | |
5b148883 GM |
484 | (let ((orig-count count) |
485 | beg end) | |
537ab246 | 486 | (while (> count 0) |
5b148883 GM |
487 | (setq beg (rmail-msgbeg rmail-current-message) |
488 | end (rmail-msgend rmail-current-message)) | |
489 | ;; All access to the buffer's local variables is now finished... | |
490 | (save-excursion | |
491 | ;; ... so it is ok to go to a different buffer. | |
492 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | |
493 | (setq cur (current-buffer)) | |
494 | (save-restriction | |
495 | (widen) | |
496 | (with-temp-buffer | |
497 | (insert-buffer-substring cur beg end) | |
498 | (if babyl-format | |
499 | (rmail-output-as-babyl file-name noattribute) | |
500 | (rmail-output-as-mbox file-name noattribute))))) | |
501 | (or noattribute ; mark message as "filed" | |
502 | (rmail-set-attribute rmail-filed-attr-index t)) | |
537ab246 | 503 | (setq count (1- count)) |
5b148883 GM |
504 | (let ((next-message-p |
505 | (if rmail-delete-after-output | |
506 | (rmail-delete-forward) | |
507 | (if (> count 0) | |
508 | (rmail-next-undeleted-message 1)))) | |
509 | (num-appended (- orig-count count))) | |
510 | (if (and (> count 0) (not next-message-p)) | |
511 | (error "Only %d message%s appended" num-appended | |
512 | (if (= num-appended 1) "" "s"))))))))) | |
513 | ||
514 | ;; FIXME nothing outside uses this, so NOT-RMAIL could be dropped. | |
515 | ;; FIXME this duplicates code from rmail-output. | |
33417df2 | 516 | ;;;###autoload |
5b148883 | 517 | (defun rmail-output-as-seen (file-name &optional count noattribute not-rmail) |
aab4c09b | 518 | "Append this message to mbox file named FILE-NAME. |
5b148883 GM |
519 | The details are as for `rmail-output', except that: |
520 | i) the header is output as currently seen | |
521 | ii) this function cannot write to Babyl files | |
522 | iii) an Rmail buffer cannot be visiting FILE-NAME | |
523 | ||
524 | Note that if NOT-RMAIL is non-nil, there is no difference between this | |
525 | function and `rmail-output'. This argument may be removed in future, | |
526 | so you should call `rmail-output' directly in that case." | |
537ab246 BG |
527 | (interactive |
528 | (list (rmail-output-read-file-name) | |
529 | (prefix-numeric-value current-prefix-arg))) | |
5b148883 GM |
530 | (if not-rmail |
531 | (rmail-output file-name count noattribute not-rmail) | |
532 | (or count (setq count 1)) | |
533 | (setq file-name | |
534 | (expand-file-name file-name | |
535 | (and rmail-default-file | |
536 | (file-name-directory rmail-default-file)))) | |
537 | ;; Warn about creating new file. | |
538 | (or (find-buffer-visiting file-name) | |
539 | (file-exists-p file-name) | |
540 | (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) | |
541 | (error "Output file does not exist")) | |
542 | ;; FIXME why not? | |
537ab246 BG |
543 | (if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) |
544 | (error "Cannot output `as seen' to a Babyl file")) | |
5b148883 GM |
545 | (if noattribute (setq noattribute 'nomsg)) |
546 | (if rmail-buffer | |
547 | (set-buffer rmail-buffer) | |
548 | (error "There is no Rmail buffer")) | |
8038d2d2 GM |
549 | (if (zerop rmail-total-messages) |
550 | (error "No messages to output")) | |
5b148883 GM |
551 | (let ((orig-count count) |
552 | (cur (current-buffer))) | |
553 | (while (> count 0) | |
554 | (let (beg end) | |
555 | ;; If operating from whole-mbox buffer, get message bounds. | |
556 | (or (rmail-buffers-swapped-p) | |
557 | (setq beg (rmail-msgbeg rmail-current-message) | |
558 | end (rmail-msgend rmail-current-message))) | |
559 | (save-restriction | |
560 | (widen) | |
561 | ;; If operating from the view buffer, get the bounds. | |
562 | (or beg | |
563 | (setq beg (point-min) | |
564 | end (point-max))) | |
565 | (with-temp-buffer | |
566 | (insert-buffer-substring cur beg end) | |
567 | (rmail-output-as-mbox file-name noattribute t)))) | |
568 | (or noattribute ; mark message as "filed" | |
537ab246 | 569 | (rmail-set-attribute rmail-filed-attr-index t)) |
5b148883 GM |
570 | (setq count (1- count)) |
571 | (let ((next-message-p | |
572 | (if rmail-delete-after-output | |
573 | (rmail-delete-forward) | |
574 | (if (> count 0) | |
575 | (rmail-next-undeleted-message 1)))) | |
576 | (num-appended (- orig-count count))) | |
577 | (if (and (> count 0) (not next-message-p)) | |
578 | (error "Only %d message%s appended" num-appended | |
579 | (if (= num-appended 1) "" "s")))))))) | |
537ab246 BG |
580 | |
581 | \f | |
582 | ;;;###autoload | |
583 | (defun rmail-output-body-to-file (file-name) | |
584 | "Write this message body to the file FILE-NAME. | |
d4653d3c GM |
585 | Interactively, the default file name comes from either the message |
586 | \"Subject\" header, or from `rmail-default-body-file'. Updates the value | |
587 | of `rmail-default-body-file' accordingly. In all uses, if FILE-NAME | |
588 | is not absolute, it is expanded with the directory part of | |
589 | `rmail-default-body-file'. | |
590 | ||
591 | Note that this overwrites FILE-NAME (after confirmation), rather | |
592 | than appending to it. Deletes the message after writing if | |
593 | `rmail-delete-after-output' is non-nil." | |
537ab246 BG |
594 | (interactive |
595 | (let ((default-file | |
596 | (or (mail-fetch-field "Subject") | |
597 | rmail-default-body-file))) | |
fe6dd7e2 RS |
598 | (setq default-file |
599 | (replace-regexp-in-string ":" "-" default-file)) | |
600 | (setq default-file | |
601 | (replace-regexp-in-string " " "-" default-file)) | |
537ab246 BG |
602 | (list (setq rmail-default-body-file |
603 | (read-file-name | |
604 | "Output message body to file: " | |
605 | (and default-file (file-name-directory default-file)) | |
606 | default-file | |
607 | nil default-file))))) | |
608 | (setq file-name | |
609 | (expand-file-name file-name | |
610 | (and rmail-default-body-file | |
611 | (file-name-directory rmail-default-body-file)))) | |
8038d2d2 GM |
612 | (if (zerop rmail-current-message) |
613 | (error "No message to output")) | |
537ab246 BG |
614 | (save-excursion |
615 | (goto-char (point-min)) | |
616 | (search-forward "\n\n") | |
617 | (and (file-exists-p file-name) | |
618 | (not (y-or-n-p (format "File %s exists; overwrite? " file-name))) | |
619 | (error "Operation aborted")) | |
620 | (write-region (point) (point-max) file-name)) | |
621 | (if rmail-delete-after-output | |
622 | (rmail-delete-forward))) | |
623 | ||
537ab246 | 624 | ;;; rmailout.el ends here |