(defvar command-line-args-left)
(defun batch-unrmail ()
"Convert Rmail files to system inbox format.
Specify the input Rmail file names as command line arguments.
For each Rmail file, the corresponding output file name
is made by adding `.mail' at the end.
For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
(if (not noninteractive)
(error "`batch-unrmail' is to be used only with -batch"))
(let ((error nil))
(while command-line-args-left
(or (unrmail (car command-line-args-left)
(concat (car command-line-args-left) ".mail"))
(setq error t))
(setq command-line-args-left (cdr command-line-args-left)))
(message "Done")
(kill-emacs (if error 1 0))))
(defun unrmail (file to-file)
"Convert Rmail file FILE to system inbox format file TO-FILE."
(interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
(with-temp-buffer
(let ((coding-system-for-read 'raw-text))
(insert-file-contents file))
(set-buffer-multibyte t)
(if (not (looking-at "BABYL OPTIONS"))
(error "This file is not in Babyl format"))
(let ((modifiedp (buffer-modified-p))
(coding-system rmail-file-coding-system)
from to)
(goto-char (point-min))
(search-forward "\n\^_" nil t) (setq from (point))
(goto-char (point-max))
(search-backward "\n\^_" from 'mv)
(setq to (point))
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
(car (detect-coding-with-priority
from to
'((coding-category-emacs-mule . emacs-mule))))))
(unless (memq coding-system
'(undecided undecided-unix))
(set-buffer-modified-p t) (let ((buffer-undo-list t))
(decode-coding-region from to coding-system))
(setq coding-system last-coding-system-used))
(setq buffer-file-coding-system nil)
(setq save-buffer-coding-system
(or coding-system 'undecided)))
(setq to-file (expand-file-name to-file default-directory))
(condition-case ()
(delete-file to-file)
(file-error nil))
(message "Writing messages to %s..." to-file)
(goto-char (point-min))
(let ((temp-buffer (get-buffer-create " unrmail"))
(from-buffer (current-buffer)))
(while (search-forward "\^_\^l" nil t)
(let ((beg (point))
(end (save-excursion
(if (search-forward "\^_" nil t)
(1- (point)) (point-max))))
(coding 'raw-text)
label-line attrs keywords
mail-from reformatted)
(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 reformatted (= (following-char) ?1))
(setq label-line
(buffer-substring (point)
(save-excursion (forward-line 1)
(point))))
(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 ?-)))
(goto-char (point-min))
(if reformatted
(progn
(forward-line 2)
(let ((case-fold-search t))
(while (looking-at "Summary-Line:")
(forward-line 1)))
(delete-region (point-min) (point))
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
(forward-line -1)
(let ((start (point)))
(search-forward "\n\n")
(delete-region start (point))))
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
(delete-region (point-min) (point)))
(goto-char (point-min))
(save-restriction
(narrow-to-region
(point-min)
(save-excursion (search-forward "\n\n" nil 'move) (point)))
(setq mail-from
(or (mail-fetch-field "Mail-From")
(concat "From "
(mail-strip-quoted-names (or (mail-fetch-field "from")
(mail-fetch-field "really-from")
(mail-fetch-field "sender")
"unknown"))
" " (current-time-string))))
(let ((maybe-coding (mail-fetch-field "X-Coding-System")))
(if maybe-coding
(setq coding (intern maybe-coding))))
(when (re-search-forward "^Mail-from:" nil t)
(beginning-of-line)
(delete-region (point)
(progn (forward-line 1) (point)))))
(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))
(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))))
(kill-buffer temp-buffer))
(message "Writing messages to %s...done" to-file)))
(provide 'unrmail)