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