-;;; 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
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'rmail)
+(provide 'rmailout)
;;;###autoload
(defcustom rmail-output-file-alist nil
sexp)))
:group 'rmail-output)
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
+(defun rmail-output-read-rmail-file-name ()
+ "Read the file name to use for `rmail-output-to-rmail-file'.
+Set `rmail-default-rmail-file' to this name as well as returning it."
+ (let ((default-file
+ (let (answer tail)
+ (setq tail rmail-output-file-alist)
+ ;; Suggest a file based on a pattern match.
+ (while (and tail (not answer))
+ (save-excursion
+ (set-buffer rmail-buffer)
+ (goto-char (point-min))
+ (if (re-search-forward (car (car tail)) nil t)
+ (setq answer (eval (cdr (car tail)))))
+ (setq tail (cdr tail))))
+ ;; If no suggestions, use same file as last time.
+ (expand-file-name (or answer rmail-default-rmail-file)))))
+ (let ((read-file
+ (expand-file-name
+ (read-file-name
+ (concat "Output message to Rmail file: (default "
+ (file-name-nondirectory default-file)
+ ") ")
+ (file-name-directory default-file)
+ (abbreviate-file-name default-file))
+ (file-name-directory default-file))))
+ ;; If the user enters just a directory,
+ ;; use the name within that directory chosen by the default.
+ (setq rmail-default-rmail-file
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ read-file)))))
+
+(defun rmail-output-read-file-name ()
+ "Read the file name to use for `rmail-output'.
+Set `rmail-default-file' to this name as well as returning it."
+ (let ((default-file
+ (let (answer tail)
+ (setq tail rmail-output-file-alist)
+ ;; Suggest a file based on a pattern match.
+ (while (and tail (not answer))
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward (car (car tail)) nil t)
+ (setq answer (eval (cdr (car tail)))))
+ (setq tail (cdr tail))))
+ ;; If no suggestion, use same file as last time.
+ (or answer rmail-default-file))))
+ (let ((read-file
+ (expand-file-name
+ (read-file-name
+ (concat "Output message to Unix mail file: (default "
+ (file-name-nondirectory default-file)
+ ") ")
+ (file-name-directory default-file)
+ (abbreviate-file-name default-file))
+ (file-name-directory default-file))))
+ (setq rmail-default-file
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ (expand-file-name
+ (or read-file (file-name-nondirectory default-file))
+ (file-name-directory default-file)))))))
+
+;;; There are functions elsewhere in Emacs that use this function;
+;;; look at them before you change the calling method.
;;;###autoload
-(defun rmail-output-to-rmail-file (file-name &optional count)
+(defun rmail-output-to-rmail-file (file-name &optional count stay)
"Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
If file is being visited, the message is appended to the Emacs
buffer visiting that file.
-If the file exists and is not an Rmail file,
-the message is appended in inbox format.
+If the file exists and is not an Rmail file, the message is
+appended in inbox format, the same way `rmail-output' does it.
The default file name comes from `rmail-default-rmail-file',
which is updated to the name you use in this command.
A prefix argument N says to output N consecutive messages
-starting with the current one. Deleted messages are skipped and don't count."
+starting with the current one. Deleted messages are skipped and don't count.
+
+If optional argument STAY is non-nil, then leave the last filed
+mesasge up instead of moving forward to the next non-deleted message."
(interactive
- (let ((default-file
- (let (answer tail)
- (setq tail rmail-output-file-alist)
- ;; Suggest a file based on a pattern match.
- (while (and tail (not answer))
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (car (car tail)) nil t)
- (setq answer (eval (cdr (car tail)))))
- (setq tail (cdr tail))))
- ;; If not suggestions, use same file as last time.
- (or answer rmail-default-rmail-file))))
- (list (setq rmail-default-rmail-file
- (let ((read-file
- (read-file-name
- (concat "Output message to Rmail file: (default "
- (file-name-nondirectory default-file)
- ") ")
- (file-name-directory default-file)
- default-file)))
- (if (file-directory-p read-file)
- (expand-file-name (file-name-nondirectory default-file)
- read-file)
- (expand-file-name
- (or read-file default-file)
- (file-name-directory default-file)))))
- (prefix-numeric-value current-prefix-arg))))
+ (list (rmail-output-read-rmail-file-name)
+ (prefix-numeric-value current-prefix-arg)))
(or count (setq count 1))
(setq file-name
(expand-file-name file-name
(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")))
(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.
(let ((buf (find-buffer-visiting file-name))
(cur (current-buffer))
(beg (1+ (rmail-msgbeg rmail-current-message)))
- (end (1+ (rmail-msgend rmail-current-message))))
+ (end (1+ (rmail-msgend rmail-current-message)))
+ (coding-system-for-write
+ (or rmail-file-coding-system
+ 'emacs-mule-unix)))
(if (not buf)
;; Output to a file.
(if rmail-fields-not-to-output
(rmail-select-summary
(rmail-update-summary)))
(rmail-show-message msg))
- ;; Output file not in rmail mode => just insert at the end.
- (narrow-to-region (point-min) (1+ (buffer-size)))
- (goto-char (point-max))
- (insert-buffer-substring cur beg end)
- (rmail-delete-unwanted-fields)))))))
+ ;; Output file not in rmail mode => just insert at the end.
+ (narrow-to-region (point-min) (1+ (buffer-size)))
+ (goto-char (point-max))
+ (insert-buffer-substring cur beg end)
+ (rmail-delete-unwanted-fields)))))))
(rmail-set-attribute "filed" t))
(if redelete (rmail-set-attribute "deleted" t))))
(setq count (1- count))
(if rmail-delete-after-output
- (rmail-delete-forward)
+ (unless
+ (if (and (= count 0) stay)
+ (rmail-delete-message)
+ (rmail-delete-forward))
+ (setq count 0))
(if (> count 0)
- (rmail-next-undeleted-message 1))))))
+ (unless
+ (if (not stay) (rmail-next-undeleted-message 1))
+ (setq count 0)))))))
;;;###autoload
(defcustom rmail-fields-not-to-output nil
;; 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.
(delete-region (point)
(progn (forward-line 1) (point)))))))))
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
+;;; There are functions elsewhere in Emacs that use this function;
+;;; look at them before you change the calling method.
;;;###autoload
(defun rmail-output (file-name &optional count noattribute from-gnus)
"Append this message to system-inbox-format mail file named FILE-NAME.
The optional fourth argument FROM-GNUS is set when called from GNUS."
(interactive
- (let ((default-file
- (let (answer tail)
- (setq tail rmail-output-file-alist)
- ;; Suggest a file based on a pattern match.
- (while (and tail (not answer))
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (car (car tail)) nil t)
- (setq answer (eval (cdr (car tail)))))
- (setq tail (cdr tail))))
- ;; If not suggestions, use same file as last time.
- (or answer rmail-default-file))))
- (list (setq rmail-default-file
- (let ((read-file
- (read-file-name
- (concat "Output message to Unix mail file: (default "
- (file-name-nondirectory default-file)
- ") ")
- (file-name-directory default-file)
- default-file)))
- (if (file-directory-p read-file)
- (expand-file-name (file-name-nondirectory default-file)
- read-file)
- (expand-file-name
- (or read-file default-file)
- (file-name-directory default-file)))))
- (prefix-numeric-value current-prefix-arg))))
+ (list (rmail-output-read-file-name)
+ (prefix-numeric-value current-prefix-arg)))
(or count (setq count 1))
(setq file-name
(expand-file-name file-name
(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)
+ mail-from mime-version content-type)
(while (> count 0)
+ ;; Preserve the Mail-From and MIME-Version fields
+ ;; even if they have been pruned.
(or from-gnus
- (setq mail-from
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (rmail-msgbeg rmail-current-message))
- (setq header-beginning (point))
- (search-forward "\n*** EOOH ***\n")
- (narrow-to-region header-beginning (point))
- (mail-fetch-field "Mail-From")))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (rmail-msgbeg rmail-current-message))
+ (setq header-beginning (point))
+ (search-forward "\n*** EOOH ***\n")
+ (narrow-to-region header-beginning (point))
+ (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)
- (insert "\n")
+ (or (bolp) (insert "\n"))
(goto-char (point-min))
(if mail-from
(insert mail-from "\n")
(mail-fetch-field "sender")
"unknown"))
" " (current-time-string) "\n"))
+ (if mime-version
+ (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.)
(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)
FILE-NAME defaults, interactively, from the Subject field of the message."
(interactive
(let ((default-file
- (mail-fetch-field "Subject")))
- (list (read-file-name
- "Output message body to file: "
- (file-name-directory default-file)
- default-file
- nil default-file))))
+ (or (mail-fetch-field "Subject")
+ rmail-default-body-file)))
+ (list (setq rmail-default-body-file
+ (read-file-name
+ "Output message body to file: "
+ (and default-file (file-name-directory default-file))
+ default-file
+ nil default-file)))))
+ (setq file-name
+ (expand-file-name file-name
+ (and rmail-default-body-file
+ (file-name-directory rmail-default-body-file))))
(save-excursion
(goto-char (point-min))
(search-forward "\n\n")
(if rmail-delete-after-output
(rmail-delete-forward)))
+;;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
;;; rmailout.el ends here