Mercurial > emacs
changeset 88128:b621daa96824
Attempt to minimize byte compilation warnings.
(rmail-output-to-rmail-file): Eliminate Babyl 5 code by using
(rmail-output).
(rmail-output): Generalize the use by GNUS; rewrite to reflect mbox as
the default format.
(rmail-output-body-to-file): Use the rmail message descriptor in
setting the "stored" attribute.
| author | Paul Reilly <pmr@pajato.com> |
|---|---|
| date | Sat, 15 Feb 2003 15:38:18 +0000 |
| parents | 9c783aa2b379 |
| children | 89e63d46028b |
| files | lisp/mail/rmailout.el |
| diffstat | 1 files changed, 130 insertions(+), 214 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mail/rmailout.el Sat Feb 15 15:12:08 2003 +0000 +++ b/lisp/mail/rmailout.el Sat Feb 15 15:38:18 2003 +0000 @@ -1,4 +1,4 @@ -;;; 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. @@ -26,9 +26,13 @@ ;;; 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. @@ -62,7 +66,7 @@ (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) @@ -76,6 +80,7 @@ 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." @@ -108,11 +113,12 @@ (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. @@ -130,111 +136,23 @@ (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." @@ -242,6 +160,7 @@ 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. @@ -259,18 +178,15 @@ (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. @@ -278,7 +194,8 @@ 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))) @@ -287,102 +204,101 @@ (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. @@ -409,7 +325,7 @@ (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)))