Function: unrmail
unrmail is an autoloaded, interactive and byte-compiled function
defined in unrmail.el.gz.
Signature
(unrmail FILE TO-FILE)
Documentation
Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE.
The variable unrmail-mbox-format controls which mbox format to use.
Probably introduced at or before Emacs version 19.1.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/mail/unrmail.el.gz
;;;###autoload
(defun unrmail (file to-file)
"Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE.
The variable `unrmail-mbox-format' controls which mbox format to use."
(interactive "fUnrmail (babyl file): \nFUnrmail into (new mailbox file): ")
(with-temp-buffer
;; Read in the old Rmail file with no decoding.
(let ((coding-system-for-read 'raw-text))
(insert-file-contents file))
;; But make it multibyte.
(set-buffer-multibyte t)
(setq buffer-file-coding-system 'raw-text-unix)
(if (not (looking-at "BABYL OPTIONS"))
(error "This file is not in Babyl format"))
;; Decode the file contents just as Rmail did.
(let ((coding-system rmail-file-coding-system)
from to)
(goto-char (point-min))
(search-forward "\n\^_" nil t) ; Skip BABYL header.
(setq from (point))
(goto-char (point-max))
(search-backward "\n\^_" from 'mv)
(if (= from (setq to (point)))
(error "The input file contains no messages"))
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
;; earlier versions did that with the current buffer's encoding.
;; So we want to favor detection of emacs-mule (whose normal
;; priority is quite low), but still allow detection of other
;; encodings if emacs-mule won't fit.
(car (with-coding-priority '(emacs-mule)
(detect-coding-region from to)))))
(unless (memq coding-system
'(undecided undecided-unix))
(set-buffer-modified-p t) ; avoid locking when decoding
(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)
;; We currently don't use this value, but maybe we should.
(setq save-buffer-coding-system
(or coding-system 'undecided)))
;; Default the directory of TO-FILE based on where FILE is.
(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)))
;; Process the messages one by one.
(while (re-search-forward "^\^_\^l" nil t)
(let ((beg (point))
(end (save-excursion
(if (re-search-forward "^\^_\\(\^l\\|\\'\\)" nil t)
(match-beginning 0)
(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)
;; Record whether the header is reformatted.
(setq reformatted (= (following-char) ?1))
;; Collect the label line, then get the attributes
;; and the keywords from it.
(setq label-line
(buffer-substring (point)
(save-excursion (forward-line 1)
(point))))
(re-search-forward ",, ?")
(unless (eolp)
(setq keywords
(buffer-substring (point)
(progn (end-of-line)
(1- (point)))))
;; Mbox rmail needs the spaces. Bug#2303.
;;; (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 ", retried," label-line) ?R ?-)
(if (string-match ", forwarded," label-line) ?S ?-)
(if (string-match ", unseen," label-line) ?U ?-)
(if (string-match ", resent," label-line) ?r ?-)))
;; Delete the special Babyl lines at the start,
;; and the ***EOOH*** line, and the reformatted header if any.
(goto-char (point-min))
(if reformatted
(progn
(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))))
;; Not reformatted. Delete the special
;; lines before the real header.
(re-search-forward "^[*][*][*] EOOH [*][*][*]\n")
(delete-region (point-min) (point)))
;; Handle rmime formatting.
(when (require 'rmime nil t)
(let ((start (point)))
(while (search-forward rmime-magic-string nil t))
(delete-region start (point))))
;; Some operations on the message header itself.
(goto-char (point-min))
(save-restriction
(narrow-to-region
(point-min)
(save-excursion (search-forward "\n\n" nil 'move) (point)))
;; Fetch or construct what we should use in the `From ' line.
(setq mail-from (or (let ((from (mail-fetch-field "Mail-From")))
;; mail-mbox-from (below) returns a
;; string that ends in a newline, but
;; mail-fetch-field does not, so
;; we append a newline here.
(if from
(format "%s\n" from)))
(mail-mbox-from)))
;; If the message specifies a coding system, use it.
(let ((maybe-coding (mail-fetch-field "X-Coding-System")))
(if maybe-coding
(setq coding
;; Force Unix EOLs.
(coding-system-change-eol-conversion
(intern maybe-coding) 0))
;; If there's no X-Coding-System header, assume the
;; message was never decoded.
(setq coding 'raw-text-unix)))
;; Delete the Mail-From: header field if any.
(when (re-search-forward "^Mail-from:" nil t)
(beginning-of-line)
(delete-region (point)
(progn (forward-line 1) (point)))))
(goto-char (point-min))
;; Insert the `From ' line.
(insert mail-from)
;; Record the keywords and attributes in our special way.
(insert "X-RMAIL-ATTRIBUTES: " (apply #'string attrs) "\n")
(when keywords
(insert "X-RMAIL-KEYWORDS: " keywords "\n"))
;; Convert From to >From, etc.
(let ((case-fold-search nil)
(fromline (if (eq 'mboxrd unrmail-mbox-format)
"^>*From "
"^From ")))
(while (re-search-forward fromline nil t)
(beginning-of-line)
(insert ?>)
(forward-line 1)))
(goto-char (point-max))
;; Add terminator blank line to message.
(insert "\n")
;; Write it to the output file, suitably encoded.
(let ((coding-system-for-write coding))
(write-region (point-min) (point-max) to-file t
'nomsg)))))
(kill-buffer temp-buffer))
(message "Writing messages to %s...done" to-file)))