Commit 49e4a58a authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(rmail-output): If message was shown with full headers,

copy the full headers (or each message copied) into the file.
New local var original-headers-p, header-beginning, mail-from.
Bind locals outside the while loop.  Kill tembuf only after loop.
If message has a saved mail-from field, use that.
Detect reaching end of rmail buffer; display # messages copied.
parent 6b77e539
......@@ -154,6 +154,10 @@ 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.
The optional third argument NOATTRIBUTE, if non-nil, says not
to set the `filed' attribute, and not to display a message."
(interactive
......@@ -175,22 +179,43 @@ to set the `filed' attribute, and not to display a message."
(file-name-directory rmail-last-file))))
(if (and (file-readable-p file-name) (rmail-file-p file-name))
(rmail-output-to-rmail-file file-name count)
(while (> count 0)
(let ((rmailbuf (current-buffer))
(tembuf (get-buffer-create " rmail-output"))
(case-fold-search t))
(let ((orig-count count)
(rmailbuf (current-buffer))
(case-fold-search t)
(tembuf (get-buffer-create " rmail-output"))
(original-headers-p
(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)
(while (> count 0)
(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
(set-buffer tembuf)
(erase-buffer)
(insert-buffer-substring rmailbuf)
(insert "\n")
(goto-char (point-min))
(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 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"))
;; ``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.)
......@@ -199,14 +224,26 @@ to set the `filed' attribute, and not to display a message."
(insert ?>))
(write-region (point-min) (point-max) file-name t
(if noattribute 'nomsg)))
(kill-buffer tembuf))
(or noattribute
(if (equal major-mode 'rmail-mode)
(rmail-set-attribute "filed" t)))
(setq count (1- count))
(if rmail-delete-after-output
(rmail-delete-forward)
(if (> count 0)
(rmail-next-undeleted-message 1))))))
(or noattribute
(if (equal major-mode 'rmail-mode)
(rmail-set-attribute "filed" 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 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))))
;;; rmailout.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment