-;;; 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, 2001 Free Software Foundation, Inc.
;;; Code:
-(require 'rmail)
(provide 'rmailout)
+(eval-when-compile
+ (require 'rmail)
+ (require 'rmaildesc))
+
+
;;;###autoload
(defcustom rmail-output-file-alist nil
"*Alist matching regexps to suggested output Rmail files.
(let ((read-file
(expand-file-name
(read-file-name
- (concat "Output message to Rmail file: (default "
+ (concat "Output message to Rmail (mbox) file: (default "
(file-name-nondirectory default-file)
") ")
(file-name-directory default-file)
read-file)
read-file)))))
+;;; mbox: deprecated
(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."
(or read-file (file-name-nondirectory default-file))
(file-name-directory default-file)))))))
+;;; mbox: ready
;;; 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 stay)
- "Append the current message to an Rmail file named FILE-NAME.
+ "Append the current message to an Rmail (mbox) 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.
(interactive
(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
- (file-name-directory rmail-default-rmail-file)))
- (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
- (rmail-output file-name count)
- (rmail-maybe-set-message-counters)
- (setq file-name (abbreviate-file-name file-name))
- (or (find-buffer-visiting file-name)
- (file-exists-p file-name)
- (if (yes-or-no-p
- (concat "\"" file-name "\" does not exist, create it? "))
- (let ((file-buffer (create-file-buffer file-name)))
- (save-excursion
- (set-buffer file-buffer)
- (rmail-insert-rmail-file-header)
- (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")))
- (while (> count 0)
- (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.
- (if (rmail-message-deleted-p rmail-current-message)
- (progn (setq redelete t)
- (rmail-set-attribute "deleted" nil)))
- (save-restriction
- (widen)
- ;; Decide whether to append to a file or to an Emacs buffer.
- (save-excursion
- (let ((buf (find-buffer-visiting file-name))
- (cur (current-buffer))
- (beg (1+ (rmail-msgbeg 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
- ;; Delete some fields while we output.
- (let ((obuf (current-buffer)))
- (set-buffer (get-buffer-create " rmail-out-temp"))
- (insert-buffer-substring obuf beg end)
- (rmail-delete-unwanted-fields)
- (append-to-file (point-min) (point-max) file-name)
- (set-buffer obuf)
- (kill-buffer (get-buffer " rmail-out-temp")))
- (append-to-file beg end file-name))
- (if (eq buf (current-buffer))
- (error "Can't output message to same file it's already in"))
- ;; File has been visited, in buffer BUF.
- (set-buffer buf)
- (let ((buffer-read-only nil)
- (msg (and (boundp 'rmail-current-message)
- rmail-current-message)))
- ;; If MSG is non-nil, buffer is in RMAIL mode.
- (if msg
- (progn
- ;; Turn on auto save mode, if it's off in this
- ;; buffer but enabled by default.
- (and (not buffer-auto-save-file-name)
- auto-save-default
- (auto-save-mode t))
- (rmail-maybe-set-message-counters)
- (widen)
- (narrow-to-region (point-max) (point-max))
- (insert-buffer-substring cur beg end)
- (goto-char (point-min))
- (widen)
- (search-backward "\n\^_")
- (narrow-to-region (point) (point-max))
- (rmail-delete-unwanted-fields)
- (rmail-count-new-messages t)
- (if (rmail-summary-exists)
- (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)))))))
- (rmail-set-attribute "filed" t))
- (if redelete (rmail-set-attribute "deleted" t))))
- (setq count (1- count))
- (if rmail-delete-after-output
- (unless
- (if (and (= count 0) stay)
- (rmail-delete-message)
- (rmail-delete-forward))
- (setq count 0))
- (if (> count 0)
- (unless
- (if (not stay) (rmail-next-undeleted-message 1))
- (setq count 0)))))))
+
+ ;; Use the 'rmail-output function to perform the output.
+ (rmail-output file-name count nil nil)
+ ;; Deal with the next message
+ (if rmail-delete-after-output
+ (unless
+ (if (and (= count 0) stay)
+ (rmail-delete-message)
+ (rmail-delete-forward))
+ (setq count 0))
+ (if (> count 0)
+ (unless
+ (if (not stay) (rmail-next-undeleted-message 1))
+ (setq count 0)))))
+
+;;; mbox: deprecated
;;;###autoload
(defcustom rmail-fields-not-to-output nil
"*Regexp describing fields to exclude when outputting a message to a file."
regexp)
:group 'rmail-output)
+;;; mbox: deprecated
;; Delete from the buffer header fields we don't want output.
;; NOT-RMAIL if t means this buffer does not have the full header
;; and *** EOOH *** that a message in an Rmail file has.
(delete-region (point)
(progn (forward-line 1) (point)))))))))
+;;; mbox: ready
;;; 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.
-A prefix argument N says to output N consecutive messages
-starting with the current one. Deleted messages are skipped and don't count.
-When called from lisp code, N may be omitted.
-
-If the pruned message header is shown on the current message, then
-messages will be appended with pruned headers; otherwise, messages
-will be appended with their original headers.
+(defun rmail-output (file-name &optional count noattribute ext)
+ "Append an mbox formatted message to the mbox formatted file named
+FILE-NAME. A prefix argument COUNT says to output COUNT consecutive
+messages starting with the current one. Deleted messages are skipped
+and don't count. When called from lisp code, COUNT may be omitted.
The default file name comes from `rmail-default-file',
which is updated to the name you use in this command.
The optional third argument NOATTRIBUTE, if non-nil, says not
to set the `filed' attribute, and not to display a message.
-The optional fourth argument FROM-GNUS is set when called from GNUS."
+The optional fourth argument EXT is set when called from outside of an
+Rmail function, for example by GNUS or Sendmail."
(interactive
(list (rmail-output-read-file-name)
(prefix-numeric-value current-prefix-arg)))
(expand-file-name file-name
(and rmail-default-file
(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-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 content-type)
- (while (> count 0)
- ;; Preserve the Mail-From and MIME-Version fields
- ;; even if they have been pruned.
- (or from-gnus
- (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)
- (or (bolp) (insert "\n"))
- (goto-char (point-min))
- (if mail-from
- (insert mail-from "\n")
- (insert "From "
- (mail-strip-quoted-names (or (mail-fetch-field "from")
- (mail-fetch-field "really-from")
- (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.)
- (let ((case-fold-search nil))
- (while (search-forward "\nFrom " nil t)
- (forward-char -5)
- (insert ?>)))
- (write-region (point-min) (point-max) file-name t
- (if noattribute 'nomsg)))
- (or noattribute
- (if (equal major-mode 'rmail-mode)
- (rmail-set-attribute "filed" t)))
- (setq count (1- count))
- (or from-gnus
- (let ((next-message-p
- (if rmail-delete-after-output
- (rmail-delete-forward)
- (if (> count 0)
- (rmail-next-undeleted-message 1))))
- (num-appended (- orig-count count)))
- (if (and next-message-p original-headers-p)
- (rmail-toggle-header))
- (if (and (> count 0) (not next-message-p))
- (progn
- (error
- (save-excursion
- (set-buffer rmailbuf)
- (format "Only %d message%s appended" num-appended
- (if (= num-appended 1) "" "s"))))
- (setq count 0))))))
- (kill-buffer tembuf))))
+ ;; Use the Rmail buffer, likely narrowed, as the message source
+ ;; unless being called from an external party, such as GNUS or
+ ;; Sendmail.
+ (unless ext
+ (set-buffer rmail-buffer))
+
+ (let ((orig-count count)
+ (src-buf (current-buffer))
+ (dst-buf (find-buffer-visiting file-name))
+ (current-message rmail-current-message)
+ (tembuf (get-buffer-create " rmail-output"))
+ (original-headers-p
+ (and (not ext) (not (rmail-msg-is-pruned)))))
+
+ ;; Output each message to the destination file.
+ (while (> count 0)
+ (save-excursion
+
+ ;; Copy the message, including all headers, to the temporary
+ ;; buffer.
+ (set-buffer tembuf)
+ (erase-buffer)
+ (insert-buffer-substring src-buf)
+
+ ;; Deal with MIME --- tbd.
+ ;;(when rmail-enable-mime ...
+
+ ;; Determine whether a buffer is already visiting the output
+ ;; file.
+ (if dst-buf
+
+ ;; The destination file is being visited. Update it.
+ (progn
+ (set-buffer dst-buf)
+
+ ;; Determine if the destination file is an Rmail file.
+ (let ((buffer-read-only nil)
+ (dst-current-message (and (boundp 'rmail-current-message)
+ rmail-current-message)))
+ (if dst-current-message
+
+ ;; The buffer is an Rmail buffer. Append the message.
+ (progn
+ (widen)
+ (narrow-to-region (point-max) (point-max))
+ (insert-buffer-substring src-buf)
+ (insert "\n")
+ (rmail-process-new-messages)
+ (rmail-show-message dst-current-message))
+
+ ;; The destination file is not an Rmail file, just
+ ;; insert at the end.
+ (goto-char (point-max))
+ (insert-buffer-substring src-buf))))
+
+ ;; The destination file is not being visited, just write out
+ ;; the processed message.
+ (write-region (point-min) (point-max) file-name t
+ (if noattribute 'nomsg))))
+
+ ;; Do housekeeping, such as setting the "Filed" attribute, if
+ ;; necessary and moving to the next message.
+ (or noattribute
+ (if (equal major-mode 'rmail-mode)
+ (progn
+ (rmail-set-attribute "filed" t current-message)
+ (setq current-message (1+ current-message)))))
+
+ ;; Determine if Rmail post output operations need to be handled.
+ (or ext
+
+ ;; They do. Move to the next non-deleted message.
+ (let ((next-message-p
+ (if rmail-delete-after-output
+ (rmail-delete-forward)
+ (if (> count 1)
+ (rmail-next-undeleted-message 1))))
+ (num-appended (- orig-count count)))
+ (if (and (> count 1) (not next-message-p))
+ (progn
+ (error
+ (save-excursion
+ (set-buffer src-buf)
+ (format "Only %d message%s appended" num-appended
+ (if (= num-appended 1) "" "s"))))
+ (setq count 0)))))
+
+ ;; Decrement the count for the next iteration. If an error has
+ ;; occurred, then count will be -1, which is every bit as good
+ ;; as 0.
+ (setq count (1- count)))
+ (kill-buffer tembuf)))
+
+;;; mbox: ready
;;;###autoload
(defun rmail-output-body-to-file (file-name)
"Write this message body to the file FILE-NAME.
(error "Operation aborted"))
(write-region (point) (point-max) file-name)
(if (equal major-mode 'rmail-mode)
- (rmail-set-attribute "stored" t)))
+ (rmail-desc-set-attribute rmail-desc-stored-index t rmail-current-message)))
(if rmail-delete-after-output
(rmail-delete-forward)))
projects / emacs.git / commitdiff