changeset 4836:38a0f0209707

(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.

--- 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