Commit | Line | Data |
---|---|---|
13a40633 | 1 | ;;; unrmail.el --- convert Rmail Babyl files to mbox files |
76550a57 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1992, 2001-2014 Free Software Foundation, Inc. |
8548041d | 4 | |
34dc21db | 5 | ;; Maintainer: emacs-devel@gnu.org |
e9571d2a ER |
6 | ;; Keywords: mail |
7 | ||
8548041d RS |
8 | ;; This file is part of GNU Emacs. |
9 | ||
b1fc2b50 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
8548041d | 11 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
8548041d RS |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8548041d | 22 | |
60370d40 PJ |
23 | ;;; Commentary: |
24 | ||
76550a57 ER |
25 | ;;; Code: |
26 | ||
8548041d RS |
27 | ;;;###autoload |
28 | (defun batch-unrmail () | |
13a40633 | 29 | "Convert old-style Rmail Babyl files to mbox format. |
d654dddf | 30 | Specify the input Rmail Babyl file names as command line arguments. |
8548041d RS |
31 | For each Rmail file, the corresponding output file name |
32 | is made by adding `.mail' at the end. | |
33 | For example, invoke `emacs -batch -f batch-unrmail RMAIL'." | |
8548041d RS |
34 | (if (not noninteractive) |
35 | (error "`batch-unrmail' is to be used only with -batch")) | |
36 | (let ((error nil)) | |
37 | (while command-line-args-left | |
38 | (or (unrmail (car command-line-args-left) | |
39 | (concat (car command-line-args-left) ".mail")) | |
40 | (setq error t)) | |
41 | (setq command-line-args-left (cdr command-line-args-left))) | |
42 | (message "Done") | |
43 | (kill-emacs (if error 1 0)))) | |
44 | ||
7b692c10 | 45 | (declare-function mail-mbox-from "mail-utils" ()) |
3a1eda7c | 46 | (defvar rmime-magic-string) ; in rmime.el, if you have it |
2b54af74 | 47 | |
13a40633 GM |
48 | (defcustom unrmail-mbox-format 'mboxrd |
49 | "The mbox format that `unrmail' should produce. | |
50 | These formats separate messages using lines that start with \"From \". | |
51 | Therefore any lines in the message bodies that start with \"From \" | |
52 | must be quoted. The `mboxo' format just prepends a \">\" to such lines. | |
53 | This is not reversible, because given a line starting with \">From \" in | |
54 | an mboxo file, it is not possible to know whether the original had a \">\" | |
06827ec8 | 55 | or not. The `mboxrd' format avoids this by also quoting \">From \" as |
13a40633 GM |
56 | \">>From \", and so on. For this reason, mboxrd is recommended. |
57 | ||
58 | See also `rmail-mbox-format'." | |
8e0762ca | 59 | :type '(choice (const mboxrd) |
06827ec8 | 60 | (const mboxo)) |
13a40633 | 61 | :version "24.4" |
8e0762ca | 62 | :group 'rmail-files) |
13a40633 | 63 | |
8548041d RS |
64 | ;;;###autoload |
65 | (defun unrmail (file to-file) | |
13a40633 GM |
66 | "Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE. |
67 | The variable `unrmail-mbox-format' controls which mbox format to use." | |
d654dddf | 68 | (interactive "fUnrmail (babyl file): \nFUnrmail into (new mailbox file): ") |
6740652e RS |
69 | (with-temp-buffer |
70 | ;; Read in the old Rmail file with no decoding. | |
71 | (let ((coding-system-for-read 'raw-text)) | |
72 | (insert-file-contents file)) | |
73 | ;; But make it multibyte. | |
74 | (set-buffer-multibyte t) | |
de456f3b | 75 | (setq buffer-file-coding-system 'raw-text-unix) |
6740652e RS |
76 | |
77 | (if (not (looking-at "BABYL OPTIONS")) | |
78 | (error "This file is not in Babyl format")) | |
79 | ||
80 | ;; Decode the file contents just as Rmail did. | |
4d6769e1 | 81 | (let ((coding-system rmail-file-coding-system) |
6740652e RS |
82 | from to) |
83 | (goto-char (point-min)) | |
84 | (search-forward "\n\^_" nil t) ; Skip BABYL header. | |
b09a806e | 85 | (setq from (point)) |
6740652e RS |
86 | (goto-char (point-max)) |
87 | (search-backward "\n\^_" from 'mv) | |
b09a806e GM |
88 | (if (= from (setq to (point))) |
89 | (error "The input file contains no messages")) | |
6740652e RS |
90 | (unless (and coding-system |
91 | (coding-system-p coding-system)) | |
92 | (setq coding-system | |
93 | ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but | |
94 | ;; earlier versions did that with the current buffer's encoding. | |
95 | ;; So we want to favor detection of emacs-mule (whose normal | |
96 | ;; priority is quite low), but still allow detection of other | |
9e614a3f GM |
97 | ;; encodings if emacs-mule won't fit. |
98 | (car (with-coding-priority '(emacs-mule) | |
99 | (detect-coding-region from to))))) | |
6740652e RS |
100 | (unless (memq coding-system |
101 | '(undecided undecided-unix)) | |
102 | (set-buffer-modified-p t) ; avoid locking when decoding | |
103 | (let ((buffer-undo-list t)) | |
104 | (decode-coding-region from to coding-system)) | |
105 | (setq coding-system last-coding-system-used)) | |
106 | ||
107 | (setq buffer-file-coding-system nil) | |
108 | ||
109 | ;; We currently don't use this value, but maybe we should. | |
110 | (setq save-buffer-coding-system | |
111 | (or coding-system 'undecided))) | |
112 | ||
a538e583 KH |
113 | ;; Default the directory of TO-FILE based on where FILE is. |
114 | (setq to-file (expand-file-name to-file default-directory)) | |
5eba27ea RS |
115 | (condition-case () |
116 | (delete-file to-file) | |
117 | (file-error nil)) | |
4eb5bf46 | 118 | (message "Writing messages to %s..." to-file) |
6740652e RS |
119 | (goto-char (point-min)) |
120 | ||
121 | (let ((temp-buffer (get-buffer-create " unrmail")) | |
122 | (from-buffer (current-buffer))) | |
123 | ||
124 | ;; Process the messages one by one. | |
4925ab0b | 125 | (while (re-search-forward "^\^_\^l" nil t) |
6740652e RS |
126 | (let ((beg (point)) |
127 | (end (save-excursion | |
4925ab0b GM |
128 | (if (re-search-forward "^\^_\\(\^l\\|\\'\\)" nil t) |
129 | (match-beginning 0) | |
130 | (point-max)))) | |
6740652e | 131 | (coding 'raw-text) |
5eba27ea | 132 | label-line attrs keywords |
6740652e | 133 | mail-from reformatted) |
5eba27ea RS |
134 | (with-current-buffer temp-buffer |
135 | (setq buffer-undo-list t) | |
136 | (erase-buffer) | |
137 | (setq buffer-file-coding-system coding) | |
138 | (insert-buffer-substring from-buffer beg end) | |
139 | (goto-char (point-min)) | |
140 | (forward-line 1) | |
6740652e RS |
141 | ;; Record whether the header is reformatted. |
142 | (setq reformatted (= (following-char) ?1)) | |
143 | ||
144 | ;; Collect the label line, then get the attributes | |
145 | ;; and the keywords from it. | |
5eba27ea RS |
146 | (setq label-line |
147 | (buffer-substring (point) | |
6740652e RS |
148 | (save-excursion (forward-line 1) |
149 | (point)))) | |
56ba4401 | 150 | (re-search-forward ",, ?") |
5eba27ea RS |
151 | (unless (eolp) |
152 | (setq keywords | |
153 | (buffer-substring (point) | |
154 | (progn (end-of-line) | |
155 | (1- (point))))) | |
56ba4401 GM |
156 | ;; Mbox rmail needs the spaces. Bug#2303. |
157 | ;;; (setq keywords | |
158 | ;;; (replace-regexp-in-string ", " "," keywords)) | |
159 | ) | |
5eba27ea RS |
160 | |
161 | (setq attrs | |
162 | (list | |
163 | (if (string-match ", answered," label-line) ?A ?-) | |
164 | (if (string-match ", deleted," label-line) ?D ?-) | |
165 | (if (string-match ", edited," label-line) ?E ?-) | |
166 | (if (string-match ", filed," label-line) ?F ?-) | |
a880e5b9 EZ |
167 | (if (string-match ", retried," label-line) ?R ?-) |
168 | (if (string-match ", forwarded," label-line) ?S ?-) | |
169 | (if (string-match ", unseen," label-line) ?U ?-) | |
170 | (if (string-match ", resent," label-line) ?r ?-))) | |
6740652e RS |
171 | |
172 | ;; Delete the special Babyl lines at the start, | |
173 | ;; and the ***EOOH*** line, and the reformatted header if any. | |
174 | (goto-char (point-min)) | |
175 | (if reformatted | |
176 | (progn | |
177 | (forward-line 2) | |
178 | ;; Delete Summary-Line headers. | |
179 | (let ((case-fold-search t)) | |
180 | (while (looking-at "Summary-Line:") | |
181 | (forward-line 1))) | |
182 | (delete-region (point-min) (point)) | |
183 | ;; Delete the old reformatted header. | |
184 | (re-search-forward "^[*][*][*] EOOH [*][*][*]\n") | |
185 | (forward-line -1) | |
186 | (let ((start (point))) | |
187 | (search-forward "\n\n") | |
188 | (delete-region start (point)))) | |
189 | ;; Not reformatted. Delete the special | |
190 | ;; lines before the real header. | |
191 | (re-search-forward "^[*][*][*] EOOH [*][*][*]\n") | |
192 | (delete-region (point-min) (point))) | |
193 | ||
4925ab0b GM |
194 | ;; Handle rmime formatting. |
195 | (when (require 'rmime nil t) | |
196 | (let ((start (point))) | |
197 | (while (search-forward rmime-magic-string nil t)) | |
198 | (delete-region start (point)))) | |
199 | ||
6740652e | 200 | ;; Some operations on the message header itself. |
5eba27ea | 201 | (goto-char (point-min)) |
6740652e | 202 | (save-restriction |
d654dddf | 203 | (narrow-to-region |
6740652e RS |
204 | (point-min) |
205 | (save-excursion (search-forward "\n\n" nil 'move) (point))) | |
206 | ||
207 | ;; Fetch or construct what we should use in the `From ' line. | |
71d8a140 EZ |
208 | (setq mail-from (or (let ((from (mail-fetch-field "Mail-From"))) |
209 | ;; mail-mbox-from (below) returns a | |
210 | ;; string that ends in a newline, but | |
211 | ;; but mail-fetch-field does not, so | |
212 | ;; we append a newline here. | |
213 | (if from | |
214 | (format "%s\n" from))) | |
7b692c10 | 215 | (mail-mbox-from))) |
6740652e RS |
216 | |
217 | ;; If the message specifies a coding system, use it. | |
218 | (let ((maybe-coding (mail-fetch-field "X-Coding-System"))) | |
219 | (if maybe-coding | |
de456f3b EZ |
220 | (setq coding |
221 | ;; Force Unix EOLs. | |
222 | (coding-system-change-eol-conversion | |
223 | (intern maybe-coding) 0)) | |
224 | ;; If there's no X-Coding-System header, assume the | |
225 | ;; message was never decoded. | |
226 | (setq coding 'raw-text-unix))) | |
6740652e RS |
227 | |
228 | ;; Delete the Mail-From: header field if any. | |
229 | (when (re-search-forward "^Mail-from:" nil t) | |
230 | (beginning-of-line) | |
231 | (delete-region (point) | |
232 | (progn (forward-line 1) (point))))) | |
233 | ||
234 | (goto-char (point-min)) | |
235 | ;; Insert the `From ' line. | |
71d8a140 | 236 | (insert mail-from) |
6740652e | 237 | ;; Record the keywords and attributes in our special way. |
77f33383 | 238 | (insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n") |
5eba27ea | 239 | (when keywords |
77f33383 | 240 | (insert "X-RMAIL-KEYWORDS: " keywords "\n")) |
13a40633 GM |
241 | ;; Convert From to >From, etc. |
242 | (let ((case-fold-search nil) | |
243 | (fromline (if (eq 'mboxrd unrmail-mbox-format) | |
244 | "^>*From " | |
245 | "^From "))) | |
246 | (while (re-search-forward fromline nil t) | |
247 | (beginning-of-line) | |
248 | (insert ?>) | |
249 | (forward-line 1))) | |
88d03607 | 250 | (goto-char (point-max)) |
d2992a38 ML |
251 | ;; Add terminator blank line to message. |
252 | (insert "\n") | |
de456f3b EZ |
253 | ;; Write it to the output file, suitably encoded. |
254 | (let ((coding-system-for-write coding)) | |
255 | (write-region (point-min) (point-max) to-file t | |
256 | 'nomsg))))) | |
6740652e | 257 | (kill-buffer temp-buffer)) |
4eb5bf46 | 258 | (message "Writing messages to %s...done" to-file))) |
76550a57 | 259 | |
896546cd RS |
260 | (provide 'unrmail) |
261 | ||
d654dddf | 262 | ;;; unrmail.el ends here |