🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.vm.bug
Article #9258

Re: FCC to an open folder fails

#9258
From: Jamie Zawinski
Date: Fri, 31 Jan 1992 21:31
102 lines
4280 bytes
In message <9201291654.AA16159@wendy-fate.UU.NET> kyle@wendy-fate.uu.net wrote:
>
> I don't support the use of FCC.  

Fortunately I do. :-)

(defun mail-do-fcc (header-end)
  (let (fcc-list
	(rmailbuf (current-buffer))
	(tembuf (generate-new-buffer " rmail output"))
	(case-fold-search t))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^FCC:[ \t]*" header-end t)
	(setq fcc-list (cons (buffer-substring (point)
					       (progn
						 (end-of-line)
						 (skip-chars-backward " \t")
						 (point)))
			     fcc-list))
	(delete-region (match-beginning 0)
		       (progn (forward-line 1) (point))))
      (set-buffer tembuf)
      (erase-buffer)
      (insert "\nFrom " (user-login-name) " "
	      (current-time-string) "\n")
      (insert-buffer-substring rmailbuf)
      ;; 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 ?>)))
      (while fcc-list
	(let ((buffer (get-file-buffer (car fcc-list))))
	  (if buffer
	      ;; File is present in a buffer => append to that buffer.
	      (let ((curbuf (current-buffer))
		    (beg (point-min)) (end (point-max)))
		(save-excursion
		  (set-buffer buffer)
		  (cond
		   ;;
		   ;; Append as a message to an RMAIL buffer.
		   ((eq major-mode 'rmail-mode)
		    (let ((b (point-min))
			  (e (point-max))
			  (buffer-read-only nil))
		      (unwind-protect
			  (progn
			    (widen)
			    (goto-char (point-max))
			    ;; This forces RMAIL's message counters to be
			    ;; recomputed when the next RMAIL operation is
			    ;; done on the buffer.
			    ;; See rmail-maybe-set-message-counters.
			    (setq rmail-total-messages nil)
			    (insert "\^L\n0, unseen,,\n*** EOOH ***")
			    ;; Should only insert From: if it's not there
			    ;; already, but...
			    (insert "\nFrom: " (user-login-name))
			    (insert "\nDate: " (current-time-string))
			    ;; insert a comma after the day-of-week.
			    (beginning-of-line) (forward-word 2) (insert ?,)
			    (end-of-line)
			    (insert "\n")
			    (insert-buffer-substring rmailbuf)
			    (insert "\n\C-_"))
			(narrow-to-region b e)
			(rmail-maybe-set-message-counters))))
		   ;;
		   ;; Append a message to a VM buffer.
		   ((eq major-mode 'vm-mode)
		    (let ((buffer-read-only nil))
		      (vm-save-restriction
		       (widen)
		       (goto-char (point-max))
		       (insert-buffer-substring curbuf beg end)
		       (vm-increment vm-messages-not-on-disk)
		       (vm-set-buffer-modified-p t)
		       (vm-clear-modification-flag-undos)
		       (vm-check-for-killed-summary)
		       (vm-assimilate-new-messages)
		       (vm-update-summary-and-mode-line))))
		   (t
		    ;; Append to an ordinary buffer as a Unix mail message.
		    (goto-char (point-max))
		    (insert-buffer-substring curbuf beg end)))))
	    ;; Else append to the file directly.
	    ;; (It's OK if it is an RMAIL or VM file -- the message will be
	    ;; parsed when the file is read in.)
	    (write-region
	     ;; Include a blank line before if file already exists.
	     (if (file-exists-p (car fcc-list)) (point-min) (1+ (point-min)))
	     (point-max) (car fcc-list) t)))
	(setq fcc-list (cdr fcc-list))))
    (kill-buffer tembuf)))
Technical Details
Message-ID: <9201312131.AA10659@thalidomide.lucid>
Path: arc1-ca.pugleaf.net!sparky!uunet!wendy-fate.uu.net!bug-vm
References: <OLANO.92Jan29011251@gemini.gemini> <RATINOX.92Jan29111617@splinter.coe.northeastern.edu> <9201291654.AA16159@wendy-fate.UU.NET>

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: f6829,ec94aee338af15e0
X-Google-Attributes: gidf6829,public
X-Google-ArrivalTime: 1992-01-31 13:39:11 PST
Newsgroups: gnu.emacs.vm.bug
Sender: bug-vm-request@uunet.uu.net
Date: Fri, 31 Jan 92 13:31:38 PST
Message-ID: <9201312131.AA10659@thalidomide.lucid>
X-Windows: It could be worse, but it'll take time.
From: Jamie Zawinski <jwz@lucid.com>
Subject: Re: FCC to an open folder fails
References: <OLANO.92Jan29011251@gemini.gemini>
 <RATINOX.92Jan29111617@splinter.coe.northeastern.edu>
 <9201291654.AA16159@wendy-fate.UU.NET>
Path: arc1-ca.pugleaf.net!sparky!uunet!wendy-fate.uu.net!bug-vm