* mail/unrmail.el (unrmail): Make sure the message ends with two

[bpt/emacs.git] / lisp / mail / unrmail.el

diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 95ff727..e06c41b 100644 (file)
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -43,7 +43,8 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
     (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)
@@ -55,6 +56,7 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
       (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"))
@@ -106,11 +108,12 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
          (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)
@@ -130,14 +133,16 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
                  (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
@@ -172,6 +177,12 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
              (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
@@ -180,19 +191,25 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
               (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"))
-                               " " (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")))
                (if maybe-coding
-                   (setq coding (intern 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)
@@ -202,7 +219,7 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
 
            (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
@@ -215,9 +232,14 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
              (while (search-forward "\nFrom " nil t)
                (forward-char -5)
                (insert ?>)))
-           ;; Write it to the output file.
-           (write-region (point-min) (point-max) to-file t
-                         'nomsg))))
+           ;; Make sure the message ends with two newlines
+           (goto-char (point-max))
+           (unless (looking-back "\n\n")
+             (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)))