1 |
;;; unrmail.el --- convert Rmail files to mailbox files |
;;; unrmail.el --- convert Rmail files to mailbox files |
2 |
|
|
3 |
;;; Copyright (C) 1992, 2002 Free Software Foundation, Inc. |
;;; Copyright (C) 1992, 2002, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Maintainer: FSF |
;; Maintainer: FSF |
6 |
;; Keywords: mail |
;; Keywords: mail |
29 |
(defvar command-line-args-left) ;Avoid 'free variable' warning |
(defvar command-line-args-left) ;Avoid 'free variable' warning |
30 |
|
|
31 |
;;;###autoload |
;;;###autoload |
32 |
(defun batch-unrmail () |
(defun batch-convert-babyl () |
33 |
"Convert Rmail files to system inbox format. |
"Convert Babyl files (old Rmail file) to system inbox format. |
34 |
Specify the input Rmail file names as command line arguments. |
Specify the input Babyl file names as command line arguments. |
35 |
For each Rmail file, the corresponding output file name |
For each Babyl file, the corresponding output file name |
36 |
is made by adding `.mail' at the end. |
is made by adding `.mail' at the end. |
37 |
For example, invoke `emacs -batch -f batch-unrmail RMAIL'." |
For example, invoke `emacs -batch -f batch-unrmail RMAIL'." |
38 |
;; command-line-args-left is what is left of the command line (from startup.el) |
;; command-line-args-left is what is left of the command line (from startup.el) |
48 |
(kill-emacs (if error 1 0)))) |
(kill-emacs (if error 1 0)))) |
49 |
|
|
50 |
;;;###autoload |
;;;###autoload |
51 |
(defun unrmail (file to-file) |
(defalias 'batch-unrmail 'batch-convert-babyl) |
52 |
"Convert Rmail file FILE to system inbox format file TO-FILE." |
|
53 |
|
;;;###autoload |
54 |
|
(defun convert-babyl-file (file to-file) |
55 |
|
"Convert Babyl (old Rmail) file FILE to system inbox format file TO-FILE." |
56 |
(interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ") |
(interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ") |
57 |
(let ((message-count 1) |
(with-temp-buffer |
58 |
;; Prevent rmail from making, or switching to, a summary buffer. |
(decode-babyl-file file) |
59 |
(rmail-display-summary nil) |
;; Write it to the output file. |
60 |
(rmail-delete-after-output nil) |
;; Since the file may contain messages of different encodings |
61 |
(temp-buffer (get-buffer-create " unrmail"))) |
;; at the tail (non-BYBYL part), we can't decode them at once |
62 |
; (rmail file) |
;; on reading. So, at first, we read the file without text |
63 |
;; Default the directory of TO-FILE based on where FILE is. |
;; code conversion, then decode the messages one by one by |
64 |
(setq to-file (expand-file-name to-file default-directory)) |
;; rmail-decode-babyl-format or |
65 |
(condition-case () |
;; rmail-convert-to-babyl-format. |
66 |
(delete-file to-file) |
(let ((coding-system-for-write 'raw-text)) |
67 |
(file-error nil)) |
(write-region (point-min) (point-max) to-file nil |
68 |
(message "Writing messages to %s..." to-file) |
'nomsg)))) |
69 |
(if (save-restriction |
|
70 |
(save-excursion |
;;;###autoload |
71 |
(widen) |
(defalias 'unrmail 'convert-babyl-file) |
72 |
(goto-char (point-min)) |
|
73 |
(not (looking-at "BABYL OPTIONS")))) |
;;;###autoload |
74 |
(write-region (point-min) (point-max) to-file t 'nomsg) |
(defun decode-babyl-file (file) |
75 |
(save-restriction |
"Convert Babyl file FILE to system inbox format in current buffer." |
76 |
(widen) |
(interactive "fUnrmail (rmail file): ") |
77 |
(while (<= message-count rmail-total-messages) |
;; Read in the Babyl file with no decoding. |
78 |
(let ((beg (rmail-msgbeg message-count)) |
(let ((thisbuf (current-buffer))) |
79 |
(end (rmail-msgbeg (1+ message-count))) |
(with-temp-buffer |
80 |
(from-buffer (current-buffer)) |
(let ((coding-system-for-read 'raw-text)) |
81 |
(coding (or rmail-file-coding-system 'raw-text)) |
(insert-file-contents file)) |
82 |
label-line attrs keywords |
;; But make it multibyte. |
83 |
header-beginning mail-from) |
(set-buffer-multibyte t) |
84 |
(save-excursion |
|
85 |
(goto-char (rmail-msgbeg message-count)) |
(if (not (looking-at "BABYL OPTIONS")) |
86 |
(setq header-beginning (point)) |
(error "File %s not in Babyl format")) |
87 |
(search-forward "\n*** EOOH ***\n") |
|
88 |
(forward-line -1) |
(decode-babyl thisbuf)))) |
89 |
(search-forward "\n\n") |
|
90 |
(save-restriction |
;;;###autoload |
91 |
(narrow-to-region header-beginning (point)) |
(defun decode-babyl (outbuf) |
92 |
(setq mail-from |
"Convert Babyl data in current bufer to inbox format and store in OUTBUF." |
93 |
(or (mail-fetch-field "Mail-From") |
;; Decode the file contents just as Rmail did. |
94 |
(concat "From " |
(let ((modifiedp (buffer-modified-p)) |
95 |
(mail-strip-quoted-names (or (mail-fetch-field "from") |
(coding-system rmail-file-coding-system) |
96 |
(mail-fetch-field "really-from") |
from to) |
|
(mail-fetch-field "sender") |
|
|
"unknown")) |
|
|
" " (current-time-string)))))) |
|
|
(with-current-buffer temp-buffer |
|
|
(setq buffer-undo-list t) |
|
|
(erase-buffer) |
|
|
(setq buffer-file-coding-system coding) |
|
|
(insert-buffer-substring from-buffer beg end) |
|
|
(goto-char (point-min)) |
|
|
(forward-line 1) |
|
|
(setq label-line |
|
|
(buffer-substring (point) |
|
|
(progn (forward-line 1) |
|
|
(point)))) |
|
|
(forward-line -1) |
|
|
(search-forward ",,") |
|
|
(unless (eolp) |
|
|
(setq keywords |
|
|
(buffer-substring (point) |
|
|
(progn (end-of-line) |
|
|
(1- (point))))) |
|
|
(setq keywords |
|
|
(replace-regexp-in-string ", " "," keywords))) |
|
|
|
|
|
(setq attrs |
|
|
(list |
|
|
(if (string-match ", answered," label-line) ?A ?-) |
|
|
(if (string-match ", deleted," label-line) ?D ?-) |
|
|
(if (string-match ", edited," label-line) ?E ?-) |
|
|
(if (string-match ", filed," label-line) ?F ?-) |
|
|
(if (string-match ", resent," label-line) ?R ?-) |
|
|
(if (string-match ", unseen," label-line) ?\ ?-) |
|
|
(if (string-match ", stored," label-line) ?S ?-))) |
|
|
(unrmail-unprune) |
|
|
(goto-char (point-min)) |
|
|
(insert mail-from "\n") |
|
|
(insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n") |
|
|
(when keywords |
|
|
(insert "X-BABYL-V6-KEYWORDS: " keywords "\n")) |
|
|
(goto-char (point-min)) |
|
|
;; ``Quote'' "\nFrom " as "\n>From " |
|
|
;; (note that this isn't really quoting, as there is no requirement |
|
|
;; that "\n[>]+From " be quoted in the same transparent way.) |
|
|
(let ((case-fold-search nil)) |
|
|
(while (search-forward "\nFrom " nil t) |
|
|
(forward-char -5) |
|
|
(insert ?>))) |
|
|
(write-region (point-min) (point-max) to-file t |
|
|
'nomsg))) |
|
|
(setq message-count (1+ message-count))))) |
|
|
(message "Writing messages to %s...done" to-file))) |
|
|
|
|
|
(defun unrmail-unprune () |
|
|
(let* ((pruned |
|
|
(save-excursion |
|
|
(goto-char (point-min)) |
|
|
(forward-line 1) |
|
|
(= (following-char) ?1)))) |
|
|
(if pruned |
|
|
(progn |
|
|
(goto-char (point-min)) |
|
|
(forward-line 2) |
|
|
;; Delete Summary-Line headers. |
|
|
(let ((case-fold-search t)) |
|
|
(while (looking-at "Summary-Line:") |
|
|
(forward-line 1))) |
|
|
(delete-region (point-min) (point)) |
|
|
;; Delete the old reformatted header. |
|
|
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n") |
|
|
(forward-line -1) |
|
|
(let ((start (point))) |
|
|
(search-forward "\n\n") |
|
|
(delete-region start (point)))) |
|
|
;; Delete everything up to the real header. |
|
|
(goto-char (point-min)) |
|
|
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n") |
|
|
(delete-region (point-min) (point))) |
|
97 |
(goto-char (point-min)) |
(goto-char (point-min)) |
98 |
(when (re-search-forward "^Mail-from:") |
(search-forward "\n\^_" nil t) ; Skip BABYL header. |
99 |
(beginning-of-line) |
(setq from (point)) |
100 |
(delete-region (point) |
(goto-char (point-max)) |
101 |
(progn (forward-line 1) (point)))))) |
(search-backward "\n\^_" from 'mv) |
102 |
|
(setq to (point)) |
103 |
|
(unless (and coding-system |
104 |
|
(coding-system-p coding-system)) |
105 |
|
(setq coding-system |
106 |
|
;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but |
107 |
|
;; earlier versions did that with the current buffer's encoding. |
108 |
|
;; So we want to favor detection of emacs-mule (whose normal |
109 |
|
;; priority is quite low), but still allow detection of other |
110 |
|
;; encodings if emacs-mule won't fit. The call to |
111 |
|
;; detect-coding-with-priority below achieves that. |
112 |
|
(car (detect-coding-with-priority |
113 |
|
from to |
114 |
|
'((coding-category-emacs-mule . emacs-mule)))))) |
115 |
|
(unless (memq coding-system |
116 |
|
'(undecided undecided-unix)) |
117 |
|
(set-buffer-modified-p t) ; avoid locking when decoding |
118 |
|
(let ((buffer-undo-list t)) |
119 |
|
(decode-coding-region from to coding-system)) |
120 |
|
(setq coding-system last-coding-system-used)) |
121 |
|
|
122 |
|
(setq buffer-file-coding-system nil) |
123 |
|
|
124 |
|
;; We currently don't use this value, but maybe we should. |
125 |
|
(setq save-buffer-coding-system |
126 |
|
(or coding-system 'undecided))) |
127 |
|
|
128 |
|
(goto-char (point-min)) |
129 |
|
|
130 |
|
(let ((temp-buffer (get-buffer-create " unrmail")) |
131 |
|
(from-buffer (current-buffer))) |
132 |
|
|
133 |
|
;; Process the messages one by one. |
134 |
|
(while (search-forward "\^_\^l" nil t) |
135 |
|
(let ((beg (point)) |
136 |
|
(end (save-excursion |
137 |
|
(if (search-forward "\^_" nil t) |
138 |
|
(1- (point)) (point-max)))) |
139 |
|
(coding 'raw-text) |
140 |
|
label-line attrs keywords |
141 |
|
mail-from reformatted) |
142 |
|
(with-current-buffer temp-buffer |
143 |
|
(setq buffer-undo-list t) |
144 |
|
(erase-buffer) |
145 |
|
(setq buffer-file-coding-system coding) |
146 |
|
(insert-buffer-substring from-buffer beg end) |
147 |
|
(goto-char (point-min)) |
148 |
|
(forward-line 1) |
149 |
|
;; Record whether the header is reformatted. |
150 |
|
(setq reformatted (= (following-char) ?1)) |
151 |
|
|
152 |
|
;; Collect the label line, then get the attributes |
153 |
|
;; and the keywords from it. |
154 |
|
(setq label-line |
155 |
|
(buffer-substring (point) |
156 |
|
(save-excursion (forward-line 1) |
157 |
|
(point)))) |
158 |
|
(search-forward ",,") |
159 |
|
(unless (eolp) |
160 |
|
(setq keywords |
161 |
|
(buffer-substring (point) |
162 |
|
(progn (end-of-line) |
163 |
|
(1- (point))))) |
164 |
|
(setq keywords |
165 |
|
(replace-regexp-in-string ", " "," keywords))) |
166 |
|
|
167 |
|
(setq attrs |
168 |
|
(list |
169 |
|
(if (string-match ", answered," label-line) ?A ?-) |
170 |
|
(if (string-match ", deleted," label-line) ?D ?-) |
171 |
|
(if (string-match ", edited," label-line) ?E ?-) |
172 |
|
(if (string-match ", filed," label-line) ?F ?-) |
173 |
|
(if (string-match ", resent," label-line) ?R ?-) |
174 |
|
(if (string-match ", unseen," label-line) ?\ ?-) |
175 |
|
(if (string-match ", stored," label-line) ?S ?-))) |
176 |
|
|
177 |
|
;; Delete the special Babyl lines at the start, |
178 |
|
;; and the ***EOOH*** line, and the reformatted header if any. |
179 |
|
(goto-char (point-min)) |
180 |
|
(if reformatted |
181 |
|
(progn |
182 |
|
(forward-line 2) |
183 |
|
;; Delete Summary-Line headers. |
184 |
|
(let ((case-fold-search t)) |
185 |
|
(while (looking-at "Summary-Line:") |
186 |
|
(forward-line 1))) |
187 |
|
(delete-region (point-min) (point)) |
188 |
|
;; Delete the old reformatted header. |
189 |
|
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n") |
190 |
|
(forward-line -1) |
191 |
|
(let ((start (point))) |
192 |
|
(search-forward "\n\n") |
193 |
|
(delete-region start (point)))) |
194 |
|
;; Not reformatted. Delete the special |
195 |
|
;; lines before the real header. |
196 |
|
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n") |
197 |
|
(delete-region (point-min) (point))) |
198 |
|
|
199 |
|
;; Some operations on the message header itself. |
200 |
|
(goto-char (point-min)) |
201 |
|
(save-restriction |
202 |
|
(narrow-to-region |
203 |
|
(point-min) |
204 |
|
(save-excursion (search-forward "\n\n" nil 'move) (point))) |
205 |
|
|
206 |
|
;; Fetch or construct what we should use in the `From ' line. |
207 |
|
(setq mail-from |
208 |
|
(or (mail-fetch-field "Mail-From") |
209 |
|
(concat "From " |
210 |
|
(mail-strip-quoted-names (or (mail-fetch-field "from") |
211 |
|
(mail-fetch-field "really-from") |
212 |
|
(mail-fetch-field "sender") |
213 |
|
"unknown")) |
214 |
|
" " (current-time-string)))) |
215 |
|
|
216 |
|
;; If the message specifies a coding system, use it. |
217 |
|
(let ((maybe-coding (mail-fetch-field "X-Coding-System"))) |
218 |
|
(if maybe-coding |
219 |
|
(setq coding (intern maybe-coding)))) |
220 |
|
|
221 |
|
;; Delete the Mail-From: header field if any. |
222 |
|
(when (re-search-forward "^Mail-from:" nil t) |
223 |
|
(beginning-of-line) |
224 |
|
(delete-region (point) |
225 |
|
(progn (forward-line 1) (point))))) |
226 |
|
|
227 |
|
(goto-char (point-min)) |
228 |
|
;; Insert the `From ' line. |
229 |
|
(insert mail-from "\n") |
230 |
|
;; Record the keywords and attributes in our special way. |
231 |
|
(insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n") |
232 |
|
(when keywords |
233 |
|
(insert "X-BABYL-V6-KEYWORDS: " keywords "\n")) |
234 |
|
(goto-char (point-min)) |
235 |
|
;; ``Quote'' "\nFrom " as "\n>From " |
236 |
|
;; (note that this isn't really quoting, as there is no requirement |
237 |
|
;; that "\n[>]+From " be quoted in the same transparent way.) |
238 |
|
(let ((case-fold-search nil)) |
239 |
|
(while (search-forward "\nFrom " nil t) |
240 |
|
(forward-char -5) |
241 |
|
(insert ?>))) |
242 |
|
;; Write it to the original buffer. |
243 |
|
(append-to-buffer thisbuf (point-min) (point-max))))) |
244 |
|
(kill-buffer temp-buffer))) |
245 |
|
|
246 |
(provide 'unrmail) |
(provide 'unrmail) |
247 |
|
|
248 |
;;; unrmail.el ends here |
;;; unrmail.el ends here |
249 |
|
|
250 |
|
;;; arch-tag: 14c6290d-60b2-456f-8909-5c2387de6acb |