;;; u-vm-return-receipt.el --- function for handling return receipts
;;
;;  Author:     Ulf Jasper <ulf.jasper@web.de>
;;  Filename:   u-vm-return-receipt.el
;;  Created:    Summer 2000
;;  Keywords:   Customization
;;  Time-stamp: "17. October 2003, 19:52:05 (ulf)"
;;  Version:    $Id: u-vm-return-receipt.el,v 1.5 2001/02/02 19:47:56 ulf Exp $
;;
;;
;;  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 2 of the License, 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.,
;;  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;
;;; Commentary:
;;  
;;  This small package allows for (semi-) automatic sending of return
;;  receipts. The Return-Receipt header is not RFC-compliant, as I was
;;  told. However, if you are using
;;
;;  (setq mail-default-headers (concat "Return-Receipt-To: " user-mail-address))
;;
;;  you might want to answer return-receipts as well. In order to do this,
;;  place this file somewhere in your load-path and put the following into
;;  your Emacs startup-file (~/.emacs)
;;
;;  (require 'u-vm-return-receipt)
;;  (add-hook 'vm-select-new-message-hook 'u-return-receipt)
;; 
;;  The return-receipt message text was inspired by the mail agent of a WWW
;;  browser, which was quite popular at that time.
;;
;;
;;; History:
;; 
;;; Code:

(defvar u-vm-return-receipts-always nil
  "If t prepare and send(!) receipt-return without asking.")

(require 'mailheader)

(defun u-vm-return-receipt (&rest args)
  "Check for return-receipt request in mail buffer and prepare one.
Optional argument ARGS are not used!"
  (save-excursion
    (let (subject message-id)
      (goto-char (point-min))
      ;;(message "%s %s" (buffer-name) major-mode)
      (setq header-list (mail-header-extract))
      ;;(message "%s" header-list)
      (when header-list
	(setq sender (mail-header 'return-receipt-to header-list))
	;; is there a request?
	(if sender
	    ;; did i send it myself?
	    (if (not (string-match (user-login-name) sender))
		;; ask for confirmation
		(if (or u-vm-return-receipts-always
			(y-or-n-p
			 (format "Send a return receipt to %s? " sender)))
		    ;; prepare the receipt
		    (progn
		      ;; read the message
		      (setq subject    (mail-header 'subject header-list))
		      (setq date       (mail-header 'date header-list))
		      (setq message-id (mail-header 'message-id header-list))
		      ;; open mail buffer
		      (vm-mail sender)
		      ;; add some headers
		      (mail-subject)
		      (insert "Return Receipt: " subject)
		      (insert "\nReferences: " message-id)
		      ;; remove my own receipt request, if it has been inserted
		      ;; automatically
		      (goto-char (point-min))
		      (if (re-search-forward "^Return-Receipt-To: \\(.*\\)\n"
					     (point-max) t)
			  (replace-match ""))
		      ;; insert receipt text
		      (mail-text)
		      (insert
		       (format
			"
Your mail of %s regarding

     \"%s\"

has been received on %s.

Note: this Return Receipt only acknowledges that the message was
displayed on the recipient's machine. There is no guarantee that the
content has been read or understood.
"
			date subject (current-time-string)))
		      ;; automatically send receipt? 
		      (if u-vm-return-receipts-always
			  (vm-mail-send-and-exit 0))
		      )))))))
  t)
  
(provide 'u-vm-return-receipt)
;;; u-vm-return-receipt.el ends here