(rmail-convert-to-babyl-format): Display a message while converting to Babyl.

[gnu-emacs] / lisp / mail / rmailout.el

diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 3b7ea24fd7495fbe3d23e1f3f9ac7d13f302947d..0dd23d71d33ed9d8934e9e7b54d96c4c08550029 100644 (file)
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,6 +1,6 @@
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
+;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
 
-;; Copyright (C) 1985, 1987, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
@@ -22,6 +22,8 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Commentary:
+
 ;;; Code:
 
 (require 'rmail)
@@ -50,8 +52,7 @@ Set `rmail-default-rmail-file' to this name as well as returning it."
            ;; Suggest a file based on a pattern match.
            (while (and tail (not answer))
              (save-excursion
-               (if (eq major-mode 'rmail-summary-mode)
-                   (set-buffer rmail-buffer)) 
+               (set-buffer rmail-buffer)
                (goto-char (point-min))
                (if (re-search-forward (car (car tail)) nil t)
                    (setq answer (eval (cdr (car tail)))))
@@ -145,7 +146,10 @@ mesasge up instead of moving forward to the next non-deleted message."
              (save-excursion
                (set-buffer file-buffer)
                (rmail-insert-rmail-file-header)
-               (let ((require-final-newline nil))
+               (let ((require-final-newline nil)
+                     (coding-system-for-write
+                      (or rmail-file-coding-system
+                          'emacs-mule-unix)))
                  (write-region (point-min) (point-max) file-name t 1)))
              (kill-buffer file-buffer))
          (error "Output file does not exist")))
@@ -153,6 +157,7 @@ mesasge up instead of moving forward to the next non-deleted message."
       (let (redelete)
        (unwind-protect
            (progn
+             (set-buffer rmail-buffer)
              ;; Temporarily turn off Deleted attribute.
              ;; Do this outside the save-restriction, since it would
              ;; shift the place in the buffer where the visible text starts.
@@ -220,13 +225,13 @@ mesasge up instead of moving forward to the next non-deleted message."
          (if redelete (rmail-set-attribute "deleted" t))))
       (setq count (1- count))
       (if rmail-delete-after-output
-         (unless 
+         (unless
              (if (and (= count 0) stay)
                  (rmail-delete-message)
                (rmail-delete-forward))
            (setq count 0))
        (if (> count 0)
-           (unless 
+           (unless
                (if (not stay) (rmail-next-undeleted-message 1))
              (setq count 0)))))))
 
@@ -241,7 +246,7 @@ mesasge up instead of moving forward to the next non-deleted message."
 ;; NOT-RMAIL if t means this buffer does not have the full header
 ;; and *** EOOH *** that a message in an Rmail file has.
 (defun rmail-delete-unwanted-fields (&optional not-rmail)
-  (if rmail-fields-not-to-output 
+  (if rmail-fields-not-to-output
       (save-excursion
        (goto-char (point-min))
        ;; Find the end of the header.
@@ -284,20 +289,21 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
                               (file-name-directory rmail-default-file))))
   (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
       (rmail-output-to-rmail-file file-name count)
+    (set-buffer rmail-buffer)
     (let ((orig-count count)
          (rmailbuf (current-buffer))
          (case-fold-search t)
          (tembuf (get-buffer-create " rmail-output"))
          (original-headers-p
           (and (not from-gnus)
-               (save-excursion 
+               (save-excursion
                  (save-restriction
                    (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
                    (goto-char (point-min))
                    (forward-line 1)
                    (= (following-char) ?0)))))
          header-beginning
-         mail-from mime-version)
+         mail-from mime-version content-type)
       (while (> count 0)
        ;; Preserve the Mail-From and MIME-Version fields
        ;; even if they have been pruned.
@@ -309,14 +315,28 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
                (setq header-beginning (point))
                (search-forward "\n*** EOOH ***\n")
                (narrow-to-region header-beginning (point))
-               (setq mail-from
-                     (mail-fetch-field "Mail-From")
-                     mime-version
-                     (mail-fetch-field "MIME-Version")))))
+               (setq mail-from (mail-fetch-field "Mail-From"))
+               (unless rmail-enable-mime
+                 (setq mime-version (mail-fetch-field "MIME-Version")
+                       content-type (mail-fetch-field "Content-type"))))))
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
          (insert-buffer-substring rmailbuf)
+         (when rmail-enable-mime
+           (if original-headers-p
+               (delete-region (goto-char (point-min))
+                              (if (search-forward "\n*** EOOH ***\n")
+                                  (match-end 0)))
+             (goto-char (point-min))
+             (forward-line 2)
+             (delete-region (point-min)(point))
+             (search-forward "\n*** EOOH ***\n")
+             (delete-region (match-beginning 0)
+                            (if (search-forward "\n\n")
+                                (1- (match-end 0)))))
+           (setq buffer-file-coding-system (or rmail-file-coding-system
+                                               'raw-text)))
          (rmail-delete-unwanted-fields t)
          (or (bolp) (insert "\n"))
          (goto-char (point-min))
@@ -329,7 +349,8 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
                                                 "unknown"))
                    " " (current-time-string) "\n"))
          (if mime-version
-             (insert "MIME-Version: " mime-version "\n"))
+             (insert "MIME-Version: " mime-version
+                     "\nContent-type: " content-type "\n"))
          ;; ``Quote'' "\nFrom " as "\n>From "
          ;;  (note that this isn't really quoting, as there is no requirement
          ;;   that "\n[>]+From " be quoted in the same transparent way.)
@@ -353,7 +374,7 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
              (if (and next-message-p original-headers-p)
                  (rmail-toggle-header))
              (if (and (> count 0) (not next-message-p))
-                 (progn 
+                 (progn
                    (error
                     (save-excursion
                       (set-buffer rmailbuf)
@@ -392,4 +413,5 @@ FILE-NAME defaults, interactively, from the Subject field of the message."
   (if rmail-delete-after-output
       (rmail-delete-forward)))
 
+;;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
 ;;; rmailout.el ends here