sexp)))
:group 'rmail-output)
+;;;###autoload
+(defcustom rmail-fields-not-to-output nil
+ "*Regexp describing fields to exclude when outputting a message to a file."
+ :type '(choice (const :tag "None" nil)
+ regexp)
+ :group 'rmail-output)
+
(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
(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."
- :type '(choice (const :tag "None" nil)
- 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.
-(defun rmail-delete-unwanted-fields (&optional not-rmail)
- (if rmail-fields-not-to-output
- (save-excursion
+(defun rmail-delete-unwanted-fields ()
+ "Delete from the buffer header fields we don't want output."
+ (when rmail-fields-not-to-output
+ (save-excursion
+ (let ((limit (rmail-header-get-limit))
+ (inhibit-point-motion-hooks t)
+ start)
(goto-char (point-min))
- ;; Find the end of the header.
- (if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
- (search-forward "\n\n" nil t))
- (let ((end (point-marker)))
- (goto-char (point-min))
- (while (re-search-forward rmail-fields-not-to-output end t)
- (beginning-of-line)
- (delete-region (point)
- (progn (forward-line 1) (point)))))))))
+ (while (re-search-forward rmail-fields-not-to-output limit t)
+ (forward-line 0)
+ (setq start (point))
+ (while (progn (forward-line 1) (looking-at "[ \t]+"))
+ (goto-char (line-end-position)))
+ (delete-region start (point)))))))
;;; 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 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.
+(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 COUNT says to output that many consecutive messages,
+starting with the current one. Deleted messages are skipped and don't count.
+When called from lisp code, COUNT may be omitted and defaults to 1.
+
+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.
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 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)))
+The optional fourth argument FROM-GNUS is set when called from GNUS."
+ (interactive
+ (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
(and rmail-default-file
(file-name-directory rmail-default-file))))
- ;; 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 ...
-
- (if (not dst-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))
- ;; The destination file is being visited. Update it.
- (with-current-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))))))
- ;; Do housekeeping, such as setting the "Filed" attribute, if
- ;; necessary and moving to the next message.
- (unless noattribute
- (if (equal major-mode 'rmail-mode)
- (rmail-set-attribute "filed" t current-message)
- (setq current-message (1+ current-message))))
- ;; Determine if Rmail post output operations need to be handled.
- (unless ext
- ;; They do. Move to the next non-deleted message.
- (let ((next-message-p
- (if rmail-delete-after-output
- (rmail-delete-forward)
- (when (> count 1)
- (rmail-next-undeleted-message 1))))
- (num-appended (- orig-count count)))
- (when (and (> count 1) (not next-message-p))
- (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)))
+ (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
+ (error "BABYL output not supported.")
+ (with-current-buffer rmail-buffer
+ (let ((orig-count count)
+ (rmailbuf (current-buffer))
+ (destbuf (find-buffer-visiting file-name))
+ (case-fold-search t))
+ (while (> count 0)
+ (with-temp-buffer
+ (insert-buffer-substring rmailbuf)
+ (when rmail-enable-mime
+ (setq buffer-file-coding-system
+ (or rmail-file-coding-system
+ 'raw-text)))
+ (rmail-delete-unwanted-fields)
+ (if (not destbuf)
+ ;; The destination file is not being visited, just write
+ ;; out the processed message.
+ (write-region (point-min) (point-max) file-name
+ t (when noattribute 'nomsg))
+ ;; The destination file is being visited. Update it.
+ (let ((msg-string (buffer-string)))
+ (with-current-buffer destbuf
+ ;; Determine if the destination file is an Rmail file.
+ (let ((buffer-read-only nil)
+ (dest-current-message
+ (and (boundp 'rmail-current-message)
+ rmail-current-message)))
+ (if dest-current-message
+ ;; The buffer is an Rmail buffer. Append the
+ ;; message.
+ (progn
+ (widen)
+ (narrow-to-region (point-max) (point-max))
+ (insert msg-string)
+ (insert "\n")
+ (rmail-process-new-messages)
+ (rmail-show-message dest-current-message))
+ ;; The destination file is not an Rmail file, just
+ ;; insert at the end.
+ (goto-char (point-max))
+ (insert msg-string)))))))
+ (unless noattribute
+ (when (equal major-mode 'rmail-mode)
+ (rmail-set-attribute "filed" t)))
+ (setq count (1- count))
+ (unless from-gnus
+ (let ((next-message-p
+ (if rmail-delete-after-output
+ (rmail-delete-forward)
+ (when (> count 0)
+ (rmail-next-undeleted-message 1))))
+ (num-appended (- orig-count count)))
+ (when (and next-message-p original-headers-p)
+ (rmail-toggle-header))
+ (when (and (> count 0) (not next-message-p))
+ (error (with-current-buffer rmailbuf
+ (format "Only %d message%s appended" num-appended
+ (if (= num-appended 1) "" "s"))))
+ (setq count 0)))))))))
;;;###autoload
(defun rmail-output-body-to-file (file-name)
projects / emacs.git / commitdiff