;;; unrmail.el --- convert Rmail Babyl files to mailbox files
-;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
(message "Done")
(kill-emacs (if error 1 0))))
-(declare-function mail-strip-quoted-names "mail-utils" (address))
+(declare-function mail-mbox-from "mail-utils" ())
+(defvar rmime-magic-string) ; in rmime.el, if you have it
;;;###autoload
(defun unrmail (file to-file)
(setq from (point))
(goto-char (point-max))
(search-backward "\n\^_" from 'mv)
- (setq to (point))
+ (if (= from (setq to (point)))
+ (error "The input file contains no messages"))
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
(from-buffer (current-buffer)))
;; Process the messages one by one.
- (while (search-forward "\^_\^l" nil t)
+ (while (re-search-forward "^\^_\^l" nil t)
(let ((beg (point))
(end (save-excursion
- (if (search-forward "\^_" nil t)
- (1- (point)) (point-max))))
+ (if (re-search-forward "^\^_\\(\^l\\|\\'\\)" nil t)
+ (match-beginning 0)
+ (point-max))))
(coding 'raw-text)
label-line attrs keywords
mail-from reformatted)
(buffer-substring (point)
(save-excursion (forward-line 1)
(point))))
- (search-forward ",,")
+ (re-search-forward ",, ?")
(unless (eolp)
(setq keywords
(buffer-substring (point)
(progn (end-of-line)
(1- (point)))))
- (setq keywords
- (replace-regexp-in-string ", " "," keywords)))
+ ;; Mbox rmail needs the spaces. Bug#2303.
+ ;;; (setq keywords
+ ;;; (replace-regexp-in-string ", " "," keywords))
+ )
(setq attrs
(list
(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
(save-excursion (search-forward "\n\n" nil 'move) (point)))
;; Fetch or construct what we should use in the `From ' line.
- (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"))
- " "
- (let ((date (mail-fetch-field "date")))
- (or
- (and date
- (setq date
- (ignore-errors
- (format-time-string
- "%a %b %e %T %Y"
- (date-to-time date)))))
- (current-time-string))))))
+ (setq mail-from (or (let ((from (mail-fetch-field "Mail-From")))
+ ;; mail-mbox-from (below) returns a
+ ;; string that ends in a newline, but
+ ;; 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")))
(goto-char (point-min))
;; Insert the `From ' line.
- (insert mail-from "\n")
+ (insert mail-from)
;; Record the keywords and attributes in our special way.
(insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n")
(when keywords
(while (search-forward "\nFrom " nil t)
(forward-char -5)
(insert ?>)))
+ (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
(provide 'unrmail)
-;; arch-tag: 14c6290d-60b2-456f-8909-5c2387de6acb
;;; unrmail.el ends here