;;; Mailing, forwarding, and replying commands for VM
;;; Copyright (C) 1989 Kyle E. Jones
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(require 'vm)

(defun vm-do-reply (to-all include-text)
  (vm-follow-summary-cursor)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (vm-error-if-folder-empty)
  (save-restriction
    (widen)
    (let ((mail-buffer (current-buffer))
	  (text-start (vm-text-of (car vm-message-pointer)))
	  (text-end (vm-text-end-of (car vm-message-pointer)))
	  (mp vm-message-pointer)
	  to cc subject message-id tmp)
      (cond ((setq to (vm-get-header-contents (car mp) "Reply-To")))
	    ((setq to (vm-get-header-contents (car mp) "From")))
	    ((setq to (vm-grok-From_-author (car mp))))
	    (t (error "Cannot find a From: or Reply-To: header in message")))
      (setq subject (vm-get-header-contents (car mp) "Subject")
	    message-id (and vm-in-reply-to-format
			    (vm-sprintf 'vm-in-reply-to-format (car mp))))
      (if to-all
	  (progn
	    (setq cc (vm-get-header-contents (car mp) "To"))
	    (setq tmp (vm-get-header-contents (car mp) "Cc"))
	    (if tmp
		(if cc
		    (setq cc (concat cc ",\n\t" tmp))
		  (setq cc tmp)))))
      (if vm-strip-reply-headers
	  (let ((mail-use-rfc822 t))
	    (require 'mail-utils)
	    (and to (setq to (mail-strip-quoted-names to)))
	    (and cc (setq cc (mail-strip-quoted-names cc)))))
      (if (mail nil to subject message-id cc)
	  (progn
	    (use-local-map (copy-keymap (current-local-map)))
	    (local-set-key "\C-c\C-y" 'vm-yank-message)
	    (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)
	    (setq vm-mail-buffer mail-buffer
		  vm-message-pointer mp)
	    (cond (include-text
		   (goto-char (point-max))
		   (insert-buffer-substring mail-buffer text-start text-end)
		   (goto-char (- (point) (- text-end text-start)))
		   (save-excursion
		     (if vm-included-text-attribution-format
			 (insert (vm-sprintf
				  'vm-included-text-attribution-format
				  (car mp))))
		     (while (and (re-search-forward "^" nil t) (not (eobp)))
		       (replace-match vm-included-text-prefix t t))))))))))

(defun vm-yank-message (n prefix)
  "Yank message number N into the current buffer at point.

This command is meant to be used in VM created *mail* buffers; the
yanked message comes from the mail buffer containing the message you
are replying to, forwarding, or invoked VM's mail command from.

All message headers are yanked along with the text.  Point is left
before the inserted text, the mark after.  Any hook functions bound to
mail-yank-hooks are run, aftert inserting the text and setting point
and mark.

Prefix arg means to ignore mail-yank-hooks, don't set the mark, prepend the
value of vm-included-text-prefix to every yanked line, and don't yank any
headers other than those specified in vm-visible-headers."
  (interactive
   (list
    (let (default (result 0) prompt)
      (save-excursion
	(if (and vm-mail-buffer (buffer-name vm-mail-buffer))
	    (set-buffer vm-mail-buffer))
	(setq default (and vm-message-pointer
			   (vm-number-of (car vm-message-pointer)))
	      prompt (if default
			 (format "Yank message number: (default %s) "
				 default)
		       "Yank message number: "))
	(while (zerop result)
	  (setq result (read-string prompt))
	  (and (string= result "") default (setq result default))
	  (setq result (string-to-int result))))
      result )
    current-prefix-arg ))
  (if (not (bufferp vm-mail-buffer))
      (error "This is not a VM *mail* buffer."))
  (if (null (buffer-name vm-mail-buffer))
      (error "The mail buffer containing message %d has been killed." n))
  (let ((b (current-buffer)) (start (point)) mp end)
    (save-restriction
      (widen)
      (save-excursion
	(set-buffer vm-mail-buffer)
	(setq mp (nthcdr (1- n) vm-message-list))
	(if (null mp)
	    (error "No such message."))
	(save-restriction
	  (widen)
	  (append-to-buffer b (if prefix
				  (vm-vheaders-of (car mp))
				(vm-start-of (car mp)))
			    (vm-text-end-of (car mp)))
	  (setq end (vm-marker (+ start (- (vm-text-end-of (car mp))
					   (if prefix
					       (vm-vheaders-of (car mp))
					     (vm-start-of (car mp))))) b))))
      (if prefix
	  (save-excursion
	    (while (and (< (point) end) (re-search-forward "^" end t))
	      (replace-match vm-included-text-prefix t t)
	      (forward-line)))
	;; Delete UNIX From or MMDF ^A^A^A^A line
	(delete-region (point) (progn (forward-line) (point)))
	(push-mark end)
	(run-hooks 'mail-yank-hooks)))))

(defun vm-mail-send-and-exit (arg)
  "Just like mail-send-and-exit except that VM marks the appropriate message
as having been replied to, if appropriate."
  (interactive "P")
  (let ((reply-buf (current-buffer)))
    (mail-send-and-exit arg)
    (save-excursion
      (set-buffer reply-buf)
      (vm-mark-replied))))

(defun vm-mail-send ()
  "Just like mail-send except that VM marks the appropriate message
as having been replied to, if appropriate."
  (interactive)
  (mail-send)
  (vm-mark-replied))

(defun vm-mark-replied ()
  (if (and (bufferp vm-mail-buffer) (buffer-name vm-mail-buffer))
      (save-excursion
	(let ((mp vm-message-pointer))
	  (set-buffer vm-mail-buffer)
	  (cond ((and (memq (car mp) vm-message-list)
		      (null (vm-replied-flag (car mp))))
		 (vm-set-replied-flag (car mp) t)
		 (vm-update-summary-and-mode-line)))))))

(defun vm-reply ()
  "Reply to the sender of the current message.
You will be deposited into a standard Emacs *mail* buffer to compose and
send your message.  See the documentation for the function `mail' for
more info.

Note that the normal binding of C-c C-y in the *mail* buffer is
automatically changed to vm-yank-message during a reply.  This allows
you to yank any message from the current folder into a reply.

Normal VM commands may be accessed in the reply buffer by prefixing them
with C-c C-v."
  (interactive)
  (vm-do-reply nil nil))

(defun vm-reply-include-text ()
  "Reply to the sender (only) of the current message and include text
from the message.  See the documentation for function vm-reply for details."
  (interactive)
  (vm-do-reply nil t))

(defun vm-followup ()
  "Reply to all recipients of the current message.
See the documentation for the function vm-reply for details."
  (interactive)
  (vm-do-reply t nil))

(defun vm-followup-include-text ()
  "Reply to all recipients of the current message and include text from
the message.  See the documentation for the function vm-reply for details."
  (interactive)
  (vm-do-reply t t))

(defun vm-forward-message ()
  "Forward the current message to one or more third parties.
You will be placed in a *mail* buffer as is usual with replies, but you
must fill in the To: and Subject: headers manually." 
  (interactive)
  (vm-follow-summary-cursor)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (vm-error-if-folder-empty)
  (let ((b (current-buffer))
	(m (car vm-message-pointer))
	(start))
    (save-restriction
      (widen)
      (cond ((mail nil nil (and vm-forwarding-subject-format
				(vm-sprintf 'vm-forwarding-subject-format m)))
	     (use-local-map (copy-keymap (current-local-map)))
	     (local-set-key "\C-c\C-y" 'vm-yank-message)
	     (local-set-key "\C-c\C-v" vm-mode-map)
	     (setq vm-mail-buffer b)
	     (goto-char (point-max))
	     (insert "------- Start of forwarded message -------\n")
	     (setq start (point))
	     (insert-buffer-substring b
				      (save-excursion
					(set-buffer b)
					(goto-char (vm-start-of m))
					(forward-line 1)
					(point))
				      (vm-text-end-of m))
	     (if vm-rfc934-forwarding
		 (vm-rfc934-char-stuff-region start (point)))
	     (insert "------- End of forwarded message -------\n")
	     (goto-char (point-min))
	     (end-of-line))))))

(defun vm-mail ()
  "Send a mail message from within VM."
  (interactive)
  (vm-follow-summary-cursor)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (let ((mail-buffer (current-buffer)))
    (cond ((mail)
	   (use-local-map (copy-keymap (current-local-map)))
	   (local-set-key "\C-c\C-y" 'vm-yank-message)
	   (local-set-key "\C-c\C-v" vm-mode-map)
	   (setq vm-mail-buffer mail-buffer)))))

(defun vm-send-digest ()
  "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." 
  (interactive)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (vm-error-if-folder-empty)
  (let ((b (current-buffer))
	(start))
    (save-restriction
      (widen)
      (cond
       ((mail)
	(use-local-map (copy-keymap (current-local-map)))
	(local-set-key "\C-c\C-y" 'vm-yank-message)
	(local-set-key "\C-c\C-v" vm-mode-map)
	(setq vm-mail-buffer b)
	(goto-char (point-max))
	(setq start (point))
	(insert-buffer-substring b)
	(vm-digestify-region start (point))
	(goto-char (point-min))
	(end-of-line))))))
