# HG changeset patch # User Glenn Morris # Date 1234838211 0 # Node ID 8ddbc5972ea9128e6c7d53709e553515a51a6585 # Parent cd6c733e7e2754d14d526b3c9cd543ca563dc36d (rmail-fields-not-to-output): Doc fix. (rmail-delete-unwanted-fields): Ignore case. Use line-beg-pos. (rmail-output, rmail-output-as-seen): Change the "from-gnus" argument to "not-rmail", and make it work. Simplify. diff -r cd6c733e7e27 -r 8ddbc5972ea9 lisp/mail/rmailout.el --- a/lisp/mail/rmailout.el Tue Feb 17 02:32:34 2009 +0000 +++ b/lisp/mail/rmailout.el Tue Feb 17 02:36:51 2009 +0000 @@ -47,7 +47,8 @@ :group 'rmail-output) (defcustom rmail-fields-not-to-output nil - "Regexp describing fields to exclude when outputting a message to a file." + "Regexp describing fields to exclude when outputting a message to a file. +The function `rmail-delete-unwanted-fields' uses this, ignoring case." :type '(choice (const :tag "None" nil) regexp) :group 'rmail-output) @@ -86,16 +87,16 @@ (defun rmail-delete-unwanted-fields (preserve) "Delete all headers matching `rmail-fields-not-to-output'. -Retains headers matching the regexp PRESERVE. The buffer should be -narrowed to just the header." +Retains headers matching the regexp PRESERVE. Ignores case. +The buffer should be narrowed to just the header." (if rmail-fields-not-to-output (save-excursion (goto-char (point-min)) - (while (re-search-forward rmail-fields-not-to-output nil t) - (beginning-of-line) - (unless (looking-at preserve) - (delete-region (point) - (progn (forward-line 1) (point)))))))) + (let ((case-fold-search t)) + (while (re-search-forward rmail-fields-not-to-output nil t) + (beginning-of-line) + (unless (looking-at preserve) + (delete-region (point) (line-beginning-position 2)))))))) (defun rmail-output-as-babyl (file-name nomsg) "Convert the current buffer's text to Babyl and output to FILE-NAME. @@ -391,7 +392,7 @@ ;;; 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) +(defun rmail-output (file-name &optional count noattribute not-rmail) "Append this message to mail file FILE-NAME. Writes mbox format, unless FILE-NAME exists and is Babyl format, in which case it writes Babyl. @@ -417,7 +418,8 @@ set the `filed' attribute, and not to display a \"Wrote file\" message (if writing a file directly). -The optional fourth argument FROM-GNUS is set when called from Gnus." +Set the optional fourth argument NOT-RMAIL non-nil if you call this +from a non-Rmail buffer. In this case, COUNT is ignored." (interactive (list (rmail-output-read-file-name) (prefix-numeric-value current-prefix-arg))) @@ -426,132 +428,120 @@ (expand-file-name file-name (and rmail-default-file (file-name-directory rmail-default-file)))) - ;; Warn about creating new file. (or (find-buffer-visiting file-name) (file-exists-p file-name) - (yes-or-no-p - (concat "\"" file-name "\" does not exist, create it? ")) + (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) (error "Output file does not exist")) - - (set-buffer rmail-buffer) - - (let ((orig-count count) - (case-fold-search t) - (tembuf (get-buffer-create " rmail-output")) - (babyl-format - (and (file-readable-p file-name) (mail-file-babyl-p file-name)))) - - (unwind-protect + (if noattribute (setq noattribute 'nomsg)) + (let ((babyl-format (and (file-readable-p file-name) + (mail-file-babyl-p file-name))) + (cur (current-buffer))) + (if not-rmail ; eg via message-fcc-handler-function + (with-temp-buffer + ;; FIXME need to ensure a From line for rmail-convert-to-babyl-format. + (insert-buffer-substring cur) + ;; Output in the appropriate format. + (if babyl-format + (rmail-output-as-babyl file-name noattribute) + (rmail-output-as-mbox file-name noattribute))) + ;; Called from an Rmail buffer. + (if rmail-buffer + (set-buffer rmail-buffer) + (error "There is no Rmail buffer")) + (let ((orig-count count) + beg end) (while (> count 0) - (with-current-buffer rmail-buffer - (let (cur beg end) - (setq beg (rmail-msgbeg rmail-current-message) - end (rmail-msgend rmail-current-message)) - ;; All access to the buffer's local variables is now finished... - (save-excursion - ;; ... so it is ok to go to a different buffer. - (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) - (setq cur (current-buffer)) - (save-restriction - (widen) - (with-current-buffer tembuf - (insert-buffer-substring cur beg end) - ;; Convert the text to one format or another and output. - (if babyl-format - (rmail-output-as-babyl file-name (if noattribute 'nomsg)) - (rmail-output-as-mbox file-name - (if noattribute 'nomsg)))))))) + (setq beg (rmail-msgbeg rmail-current-message) + end (rmail-msgend rmail-current-message)) + ;; All access to the buffer's local variables is now finished... + (save-excursion + ;; ... so it is ok to go to a different buffer. + (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) + (setq cur (current-buffer)) + (save-restriction + (widen) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (if babyl-format + (rmail-output-as-babyl file-name noattribute) + (rmail-output-as-mbox file-name noattribute))))) + (or noattribute ; mark message as "filed" + (rmail-set-attribute rmail-filed-attr-index t)) + (setq count (1- count)) + (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 (> count 0) (not next-message-p)) + (error "Only %d message%s appended" num-appended + (if (= num-appended 1) "" "s"))))))))) - ;; Mark message as "filed". - (unless noattribute - (rmail-set-attribute rmail-filed-attr-index t)) - - (setq count (1- count)) +;; FIXME nothing outside uses this, so NOT-RMAIL could be dropped. +;; FIXME this duplicates code from rmail-output. +(defun rmail-output-as-seen (file-name &optional count noattribute not-rmail) + "Append this message to mbox file named FILE-NAME. +The details are as for `rmail-output', except that: + i) the header is output as currently seen + ii) this function cannot write to Babyl files +iii) an Rmail buffer cannot be visiting FILE-NAME - (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 (> count 0) (not next-message-p)) - (error "Only %d message%s appended" num-appended - (if (= num-appended 1) "" "s")))))) - (kill-buffer tembuf)))) - -;; FIXME gnus does not use this function. -;; FIXME this duplicates much code from rmail-output. -(defun rmail-output-as-seen (file-name &optional count noattribute from-gnus) - "Append this message to mbox file named FILE-NAME. -The details are as for `rmail-output', except that the header is output -as currently seen, and that this function cannot write to Babyl files." +Note that if NOT-RMAIL is non-nil, there is no difference between this +function and `rmail-output'. This argument may be removed in future, +so you should call `rmail-output' directly in that case." (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)))) - (set-buffer rmail-buffer) - - ;; Warn about creating new file. - (or (find-buffer-visiting file-name) - (file-exists-p file-name) - (yes-or-no-p - (concat "\"" file-name "\" does not exist, create it? ")) - (error "Output file does not exist")) - + (if not-rmail + (rmail-output file-name count noattribute not-rmail) + (or count (setq count 1)) + (setq file-name + (expand-file-name file-name + (and rmail-default-file + (file-name-directory rmail-default-file)))) + ;; Warn about creating new file. + (or (find-buffer-visiting file-name) + (file-exists-p file-name) + (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) + (error "Output file does not exist")) + ;; FIXME why not? (if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) (error "Cannot output `as seen' to a Babyl file")) - - (let ((orig-count count) - (case-fold-search t) - (tembuf (get-buffer-create " rmail-output"))) - - (unwind-protect - (while (> count 0) - (let (cur beg end) - ;; If operating from whole-mbox buffer, get message bounds. - (if (not (rmail-buffers-swapped-p)) - (setq beg (rmail-msgbeg rmail-current-message) - end (rmail-msgend rmail-current-message))) - ;; All access to the buffer's local variables is now finished... - (save-excursion - (setq cur (current-buffer)) - (save-restriction - (widen) - ;; If operating from the view buffer, get the bounds. - (unless beg - (setq beg (point-min) - end (point-max))) - - (with-current-buffer tembuf - (insert-buffer-substring cur beg end) - ;; Convert the text to one format or another and output. - (rmail-output-as-mbox file-name - (if noattribute 'nomsg) - t))))) - - ;; Mark message as "filed". - (unless noattribute + (if noattribute (setq noattribute 'nomsg)) + (if rmail-buffer + (set-buffer rmail-buffer) + (error "There is no Rmail buffer")) + (let ((orig-count count) + (cur (current-buffer))) + (while (> count 0) + (let (beg end) + ;; If operating from whole-mbox buffer, get message bounds. + (or (rmail-buffers-swapped-p) + (setq beg (rmail-msgbeg rmail-current-message) + end (rmail-msgend rmail-current-message))) + (save-restriction + (widen) + ;; If operating from the view buffer, get the bounds. + (or beg + (setq beg (point-min) + end (point-max))) + (with-temp-buffer + (insert-buffer-substring cur beg end) + (rmail-output-as-mbox file-name noattribute t)))) + (or noattribute ; mark message as "filed" (rmail-set-attribute rmail-filed-attr-index 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 (> count 0) (not next-message-p)) - (error "Only %d message%s appended" num-appended - (if (= num-appended 1) "" "s")))))) - (kill-buffer tembuf)))) + (setq count (1- count)) + (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 (> count 0) (not next-message-p)) + (error "Only %d message%s appended" num-appended + (if (= num-appended 1) "" "s")))))))) ;;;###autoload