X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab59163d52a8d1c41edb40fd793dc8de582f7cc1..d33e73c1eb79ebf599a896a4e05ec9cc28f470b2:/lisp/mail/rmailout.el diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 3b7ea24fd7..0dd23d71d3 100644 --- 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