Function: mail-do-fcc

mail-do-fcc is a byte-compiled function defined in sendmail.el.gz.

Signature

(mail-do-fcc HEADER-END)

Documentation

Find and act on any Fcc: headers in the current message before HEADER-END.

If a buffer is visiting the Fcc file, append to it before offering to save it, if it was modified initially. If this is an Rmail buffer, update Rmail as needed. If there is no buffer, just append to the file, in Babyl format if necessary.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/sendmail.el.gz
(defun mail-do-fcc (header-end)
  "Find and act on any Fcc: headers in the current message before HEADER-END.
If a buffer is visiting the Fcc file, append to it before
offering to save it, if it was modified initially.  If this is an
Rmail buffer, update Rmail as needed.  If there is no buffer,
just append to the file, in Babyl format if necessary."
  (unless (markerp header-end)
    (error "Value of `header-end' must be a marker"))
  (let (fcc-list
	(mailbuf (current-buffer)))
    (save-excursion
      (goto-char (point-min))
      (let ((case-fold-search t))
	(while (re-search-forward "^Fcc:[ \t]*" header-end t)
	  (push (buffer-substring (point)
				  (progn
				    (end-of-line)
				    (skip-chars-backward " \t")
				    (point)))
		fcc-list)
	  (delete-region (match-beginning 0)
			 (progn (forward-line 1) (point)))))
      (with-temp-buffer
	;; This initial newline is not written out if we create a new
	;; file (see below).
	(require 'mail-utils)
	(insert "\nFrom " (user-login-name) " "
		(let ((system-time-locale "C"))
		  (format-time-string "%a %b %e %T %z %Y"))
		"\nDate: " (message-make-date) "\n")
	(insert-buffer-substring mailbuf)
	;; Make sure messages are separated.
	(goto-char (point-max))
	(insert ?\n)
	(goto-char 2)
	;; ``Quote'' "^From " as ">From "
	;;  (note that this isn't really quoting, as there is no requirement
	;;   that "^[>]+From " be quoted in the same transparent way.)
	(let ((case-fold-search nil))
	  (while (search-forward "\nFrom " nil t)
	    (forward-char -5)
	    (insert ?>)))
	(dolist (fcc fcc-list)
	  (let* ((buffer (find-buffer-visiting fcc))
		 (curbuf (current-buffer))
		 dont-write-the-file
		 buffer-matches-file
		 (beg (point-min))	; the initial blank line
		 (end (point-max))
		 ;; After the ^From line.
		 (beg2 (save-excursion (goto-char (point-min))
				       (forward-line 2) (point))))
	    (if buffer
		;; File is present in a buffer => append to that buffer.
		(with-current-buffer buffer
		  (setq buffer-matches-file
			(and (not (buffer-modified-p))
			     (verify-visited-file-modtime buffer)))
		  (let ((msg (bound-and-true-p rmail-current-message))
			(buffer-read-only nil))
		    ;; If MSG is non-nil, buffer is in Rmail mode.
		    (if msg
			(let ((buff (generate-new-buffer " *mail-do-fcc")))
			  (unwind-protect
			      (progn
				(with-current-buffer buff
				  (insert-buffer-substring curbuf (1+ beg) end))
				(rmail-output-to-rmail-buffer buff msg))
			    (kill-buffer buff)))
		      ;; Output file not in Rmail mode => just insert
		      ;; at the end.
		      (save-restriction
			(widen)
			(goto-char (point-max))
			(insert-buffer-substring curbuf beg end)))
		    ;; Offer to save the buffer if it was modified
		    ;; before we started.
		    (unless buffer-matches-file
		      (if (y-or-n-p (format "Save file %s? " fcc))
			  (save-buffer))
		      (setq dont-write-the-file t)))))
	    ;; Append to the file directly, unless we've already taken
	    ;; care of it.
	    (unless dont-write-the-file
	      (if (and (file-exists-p fcc)
		       (mail-file-babyl-p fcc))
		  ;; If the file is a Babyl file, convert the message to
		  ;; Babyl format.  Even though Rmail no longer uses
		  ;; Babyl, this code can remain for the time being, on
		  ;; the off-chance one Fccs to a Babyl file that has
		  ;; not yet been converted to mbox.
		  (let ((coding-system-for-write
			 (or rmail-file-coding-system 'emacs-mule)))
		    (with-temp-buffer
		      (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: "
			      (mail-rfc822-date) "\n")
		      (insert-buffer-substring curbuf beg2 end)
		      (insert "\n\C-_")
		      (write-region (point-min) (point-max) fcc t)))
		;; Ensure there is a blank line between messages, but
		;; not at the very start of the file.
		(write-region (if (file-exists-p fcc)
				  (point-min)
				(1+ (point-min)))
			      (point-max) fcc t)))
	    (and buffer (not dont-write-the-file)
		 (with-current-buffer buffer
		   (set-visited-file-modtime)))))))))