🚀 go-pugleaf

In message <STI.92May10235946@laphroaig.cs.hut.fi> Sami-Jaakko Tikka wrote:
>
> I'm even sure that should someone make the hack Kyle would gladly
> incorporate it to 'official' VM-distribution.

Wrong.  I wrote this over a year and a half ago.  I guess it's time to
post it again...

	-- Jamie

(defun vm-forward-message ()
  "Forward the current message to one or more third parties.
You will be placed in a Mail mode buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually."
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (if (eq last-command 'vm-next-command-uses-marks)
      (progn (setq this-command 'vm-next-command-uses-marks)
	     (command-execute 'vm-send-digest))
    (let ((b (current-buffer))
	  (dir default-directory)
	  (mp vm-message-pointer)
	  (old-point-min (point-min))
	  start)
      (save-restriction
	(widen)
	(vm-mail-internal
	 (format "forward of %s:%s" (buffer-name)
		 (vm-number-of (car vm-message-pointer)))
	 nil
	 (and vm-forwarding-subject-format
	      (vm-sprintf 'vm-forwarding-subject-format
			  (car mp))))
	(use-local-map (copy-keymap (current-local-map)))
	(local-set-key "\C-c\C-y" 'vm-yank-message)
	(local-set-key "\C-cy" 'vm-yank-message-other-folder)
	(local-set-key "\C-c\C-s" 'vm-mail-send)
	(local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
	(local-set-key "\C-c\C-v" vm-mode-map)
	(make-local-variable 'vm-forward-list)
	(setq vm-mail-buffer b
	      vm-system-state 'forwarding
	      vm-forward-list (list (car mp))
	      vm-message-pointer mp
	      default-directory dir)
	(goto-char (point-max))
	(insert "------- Start of forwarded message -------\n")
	(setq start (point))
	(let (message-start)
	  (save-excursion
	    (set-buffer b)
	    (let ((exposed (= old-point-min (vm-start-of (car mp)))))
	      (if (not exposed)
		  (setq message-start (vm-vheaders-of (car mp)))
		(goto-char (vm-start-of (car mp)))
		(forward-line 1)
		(setq message-start (point)))))
	  (insert-buffer-substring b message-start
				   (vm-text-end-of (car mp))))
	(if vm-rfc934-forwarding
	    (vm-rfc934-char-stuff-region start (point)))
	(if (not (= (preceding-char) ?\n)) (insert "\n"))
	(if (not (= (save-excursion (forward-char -1) (preceding-char)) ?\n))
	    (insert "\n"))
	(insert "------- End of forwarded message -------\n")
	(goto-char (point-min))
	(end-of-line)))))

(defun vm-send-digest (&optional prefix)
  "Send a digest of all messages in the current folder to recipients.
You will be placed in a *mail* buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually.

Prefix arg means to insert a list of preamble lines at the beginning of
the digest.  One line is generated for each message being digestified.
The variable vm-digest-preamble-format determines the format of the
preamble lines.

If invoked on marked messages (via vm-next-command-uses-marks),
only marked messages will be put into the digest."
  (interactive "P")
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (let ((b (current-buffer))
	(dir default-directory)
	(mp vm-message-pointer)
	;; prefix arg doesn't have "normal" meaning here, so only call
	;; vm-select-marked-or-prefixed-messages if we're using marks.
	(mlist (if (eq last-command 'vm-next-command-uses-marks)
		   (vm-select-marked-or-prefixed-messages 0)
		 vm-message-list))
	start)
    (save-restriction
      (widen)
      (vm-mail-internal (format "digest from %s" (buffer-name))
	nil
	(and vm-forwarding-subject-format
	     (vm-sprintf 'vm-forwarding-subject-format
			 (car mlist))))
      (use-local-map (copy-keymap (current-local-map)))
      (local-set-key "\C-c\C-y" 'vm-yank-message)
      (local-set-key "\C-cy" 'vm-yank-message-other-folder)
      (local-set-key "\C-c\C-s" 'vm-mail-send)
      (local-set-key "\C-c\C-c" 'vm-mail-send-and-exit)
      (local-set-key "\C-c\C-v" vm-mode-map)
      (make-local-variable 'vm-forward-list)
      (setq vm-mail-buffer b
	    vm-message-pointer mp
	    vm-system-state 'forwarding
	    vm-forward-list mlist
	    default-directory dir)
      (goto-char (point-max))
      (setq start (point)
	    mp mlist)
      (message "Building digest...")
      (while mp
	(insert "From \n")
	(insert-buffer-substring (marker-buffer (vm-start-of (car mp)))
				 ;; (vm-start-of (car mp))
				 (vm-vheaders-of (car mp))
				 (vm-end-of (car mp)))
	(setq mp (cdr mp)))
      (vm-digestify-region start (point))
      (goto-char start)
      (while (re-search-forward "^\\(---+\n\\)\n+" nil t)
	(delete-region (match-end 1) (match-end 0)))
      (goto-char start)
      (setq mp mlist)
      (if prefix
	  (progn
	    (message "Building digest preamble...")
	    (while mp
	      (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")
	      (if vm-digest-center-preamble
		  (progn
		    (forward-char -1)
		    (center-line)
		    (forward-char 1)))
	      (setq mp (cdr mp)))))
      (goto-char (point-min))
      (end-of-line)
      (message "Building digest... done"))))