Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; unrmail.el --- convert Rmail files to mailbox files |
76550a57 | 2 | |
5eba27ea | 3 | ;;; Copyright (C) 1992, 2002 Free Software Foundation, Inc. |
8548041d | 4 | |
070c251e | 5 | ;; Maintainer: FSF |
e9571d2a ER |
6 | ;; Keywords: mail |
7 | ||
8548041d RS |
8 | ;; This file is part of GNU Emacs. |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
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 | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
8548041d | 24 | |
60370d40 PJ |
25 | ;;; Commentary: |
26 | ||
76550a57 ER |
27 | ;;; Code: |
28 | ||
8548041d RS |
29 | (defvar command-line-args-left) ;Avoid 'free variable' warning |
30 | ||
31 | ;;;###autoload | |
32 | (defun batch-unrmail () | |
28925d74 | 33 | "Convert Rmail files to system inbox format. |
8548041d RS |
34 | Specify the input Rmail file names as command line arguments. |
35 | For each Rmail file, the corresponding output file name | |
36 | is made by adding `.mail' at the end. | |
37 | 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) | |
39 | (if (not noninteractive) | |
40 | (error "`batch-unrmail' is to be used only with -batch")) | |
41 | (let ((error nil)) | |
42 | (while command-line-args-left | |
43 | (or (unrmail (car command-line-args-left) | |
44 | (concat (car command-line-args-left) ".mail")) | |
45 | (setq error t)) | |
46 | (setq command-line-args-left (cdr command-line-args-left))) | |
47 | (message "Done") | |
48 | (kill-emacs (if error 1 0)))) | |
49 | ||
50 | ;;;###autoload | |
51 | (defun unrmail (file to-file) | |
28925d74 | 52 | "Convert Rmail file FILE to system inbox format file TO-FILE." |
4eb5bf46 | 53 | (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ") |
5eba27ea | 54 | (let ((message-count 1) |
efde1132 RS |
55 | ;; Prevent rmail from making, or switching to, a summary buffer. |
56 | (rmail-display-summary nil) | |
5eba27ea RS |
57 | (rmail-delete-after-output nil) |
58 | (temp-buffer (get-buffer-create " unrmail"))) | |
8548041d | 59 | (rmail file) |
a538e583 KH |
60 | ;; Default the directory of TO-FILE based on where FILE is. |
61 | (setq to-file (expand-file-name to-file default-directory)) | |
5eba27ea RS |
62 | (condition-case () |
63 | (delete-file to-file) | |
64 | (file-error nil)) | |
4eb5bf46 | 65 | (message "Writing messages to %s..." to-file) |
5eba27ea RS |
66 | (save-restriction |
67 | (widen) | |
68 | (while (<= message-count rmail-total-messages) | |
69 | (let ((beg (rmail-msgbeg message-count)) | |
70 | (end (rmail-msgbeg (1+ message-count))) | |
71 | (from-buffer (current-buffer)) | |
72 | (coding (or rmail-file-coding-system 'raw-text)) | |
73 | label-line attrs keywords | |
74 | header-beginning mail-from) | |
75 | (save-excursion | |
76 | (goto-char (rmail-msgbeg message-count)) | |
77 | (setq header-beginning (point)) | |
78 | (search-forward "\n*** EOOH ***\n") | |
79 | (forward-line -1) | |
80 | (search-forward "\n\n") | |
81 | (save-restriction | |
82 | (narrow-to-region header-beginning (point)) | |
83 | (setq mail-from | |
84 | (or (mail-fetch-field "Mail-From") | |
85 | (concat "From " | |
86 | (mail-strip-quoted-names (or (mail-fetch-field "from") | |
87 | (mail-fetch-field "really-from") | |
88 | (mail-fetch-field "sender") | |
89 | "unknown")) | |
90 | " " (current-time-string)))))) | |
91 | (with-current-buffer temp-buffer | |
92 | (setq buffer-undo-list t) | |
93 | (erase-buffer) | |
94 | (setq buffer-file-coding-system coding) | |
95 | (insert-buffer-substring from-buffer beg end) | |
96 | (goto-char (point-min)) | |
97 | (forward-line 1) | |
98 | (setq label-line | |
99 | (buffer-substring (point) | |
100 | (progn (forward-line 1) | |
101 | (point)))) | |
102 | (forward-line -1) | |
103 | (search-forward ",,") | |
104 | (unless (eolp) | |
105 | (setq keywords | |
106 | (buffer-substring (point) | |
107 | (progn (end-of-line) | |
108 | (1- (point))))) | |
109 | (setq keywords | |
110 | (replace-regexp-in-string ", " "," keywords))) | |
111 | ||
112 | (setq attrs | |
113 | (list | |
114 | (if (string-match ", answered," label-line) ?A ?-) | |
115 | (if (string-match ", deleted," label-line) ?D ?-) | |
116 | (if (string-match ", edited," label-line) ?E ?-) | |
117 | (if (string-match ", filed," label-line) ?F ?-) | |
118 | (if (string-match ", resent," label-line) ?R ?-) | |
119 | (if (string-match ", unseen," label-line) ?\ ?-) | |
120 | (if (string-match ", stored," label-line) ?S ?-))) | |
121 | (unrmail-unprune) | |
122 | (goto-char (point-min)) | |
123 | (insert mail-from "\n") | |
124 | (insert "X-BABYL-V6-ATTRIBUTES: " (apply 'string attrs) "\n") | |
125 | (when keywords | |
126 | (insert "X-BABYL-V6-KEYWORDS: " keywords "\n")) | |
127 | (goto-char (point-min)) | |
128 | ;; ``Quote'' "\nFrom " as "\n>From " | |
129 | ;; (note that this isn't really quoting, as there is no requirement | |
130 | ;; that "\n[>]+From " be quoted in the same transparent way.) | |
131 | (let ((case-fold-search nil)) | |
132 | (while (search-forward "\nFrom " nil t) | |
133 | (forward-char -5) | |
134 | (insert ?>))) | |
135 | (write-region (point-min) (point-max) to-file t | |
136 | 'nomsg))) | |
137 | (setq message-count (1+ message-count)))) | |
4eb5bf46 | 138 | (message "Writing messages to %s...done" to-file))) |
76550a57 | 139 | |
5eba27ea RS |
140 | (defun unrmail-unprune () |
141 | (let* ((pruned | |
142 | (save-excursion | |
143 | (goto-char (point-min)) | |
144 | (forward-line 1) | |
145 | (= (following-char) ?1)))) | |
146 | (if pruned | |
147 | (progn | |
148 | (goto-char (point-min)) | |
149 | (forward-line 2) | |
150 | ;; Delete Summary-Line headers. | |
151 | (let ((case-fold-search t)) | |
152 | (while (looking-at "Summary-Line:") | |
153 | (forward-line 1))) | |
154 | (delete-region (point-min) (point)) | |
155 | ;; Delete the old reformatted header. | |
156 | (re-search-forward "^[*][*][*] EOOH [*][*][*]\n") | |
157 | (forward-line -1) | |
158 | (let ((start (point))) | |
159 | (search-forward "\n\n") | |
160 | (delete-region start (point)))) | |
161 | ;; Delete everything up to the real header. | |
162 | (goto-char (point-min)) | |
163 | (re-search-forward "^[*][*][*] EOOH [*][*][*]\n") | |
164 | (delete-region (point-min) (point))) | |
165 | (goto-char (point-min)) | |
166 | (when (re-search-forward "^Mail-from:") | |
167 | (beginning-of-line) | |
168 | (delete-region (point) | |
169 | (progn (forward-line 1) (point)))))) | |
170 | ||
171 | ||
896546cd RS |
172 | (provide 'unrmail) |
173 | ||
76550a57 | 174 | ;;; unrmail.el ends here |
5eba27ea | 175 | |
6b61353c | 176 | ;;; arch-tag: 14c6290d-60b2-456f-8909-5c2387de6acb |