# HG changeset patch # User Richard M. Stallman # Date 750138397 0 # Node ID 38a0f0209707fb64b4abd0eacedea801ad5cfa28 # Parent 4324c797a9e3fa1aaec3e2ac5b239a46dce5c07f (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. diff -r 4324c797a9e3 -r 38a0f0209707 lisp/mail/rmailout.el --- a/lisp/mail/rmailout.el Sat Oct 09 03:46:09 1993 +0000 +++ b/lisp/mail/rmailout.el Sat Oct 09 03:46:37 1993 +0000 @@ -154,6 +154,10 @@ 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 @@ (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 @@ (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