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