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