;;!emacs
;; $Id: 
;;
;; FILE:         hsmail.el
;; SUMMARY:      Support for Hyperbole buttons in mail composer: mail.
;; USAGE:        GNU Emacs Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORG:          Brown U.
;;
;; ORIG-DATE:     9-May-91 at 04:50:20
;; LAST-MOD:     16-Nov-92 at 13:40:31 by Bob Weiner
;;
;; This file is part of Hyperbole.
;;
;; Copyright (C) 1991, Brown University and the Free Software Foundation, Inc.
;; Developed with support from Motorola Inc.
;; Available for use and distribution under the same terms as GNU Emacs.
;;
;; DESCRIPTION:  
;; DESCRIP-END.

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'sendmail)

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************


(defvar smail:comment '(format
			"Comments: Hyperbole mail buttons accepted, v%s.\n"
			hyperb:version)
  "Default comment form to evaluate and add to outgoing mail.
Set to the empty string, \"\", for no comment.")

;;; Used by 'mail-send' in Emacs "sendmail.el".
(if (boundp 'send-mail-function)
    (or (if (listp send-mail-function)
	    (if (equal (nth 2 send-mail-function) '(smail:widen))
		nil
	      (error "(hsmail): Set 'send-mail-function' to a symbol-name, not a list, before load.")))
	(setq send-mail-function
	      (list 'lambda nil '(smail:widen) (list send-mail-function))))
  (error "(hsmail): Install an Emacs \"sendmail.el\" which includes 'send-mail-function'."))

(if (fboundp 'mail-prefix-region)
    ;;
    ;; For compatibility with rsw-modified sendmail.el.
    (defvar mail-yank-hook
      (function
	(lambda ()
	  ;; Set off original message.
	  (mail-prefix-region (mark) (point))))
      "Hook to run mail yank preface function.
Expects point and mark to be set to the region to preface.")
  ;;
  ;; Else for compatibility with Supercite.
  (defvar mail-indention-spaces 3
  "Number of spaces to indent when yanking a mail reply.")
  ;;
  ;; If you create your own yank hook, set this variable rather than
  ;; 'mail-yank-hook' from above.
  (defvar mail-yank-hooks
    (function
      (lambda ()
	(indent-rigidly (point) (mark) mail-indention-spaces)))
    "Hook to run mail yank citation function.
Expects point and mark to be set to the region to cite."))

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(defun smail:comment-add (&optional comment-form)
  "Adds a comment to the current outgoing message.
Optional COMMENT-FORM is evaluated to obtain the string to add to the
message.  If not given, 'smail:comment' is evaluated by default."
  (let ((comment (eval (or comment-form smail:comment))))
    (if comment
	(save-excursion
	  (goto-char (point-min))
	  (and (search-forward mail-header-separator nil t)
	       (not (search-backward comment nil t))
	       (progn (beginning-of-line) (insert comment)))))))

(defun smail:widen ()
  "Widens outgoing mail buffer to include Hyperbole button data."
  (if (fboundp 'mail+narrow) (mail+narrow) (widen)))

;; Overlay this function from "sendmail.el" to include Hyperbole button
;; data when yanking in a message and to highlight buttons if possible.
(defun mail-yank-original (arg)
  "Insert the message being replied to, if any.
Puts point before the text and mark after.
Applies 'mail-yank-hook' or 'mail-yank-hooks' to text.
Just \\[universal-argument] as argument means don't apply hooks
and don't delete any header fields.

If supercite is in use, header fields are never deleted.
Use (setq sc-nuke-mail-headers-p t) to have them removed."
  (interactive "P")
  (if mail-reply-buffer
      (let ((start (point)) opoint)
	(delete-windows-on mail-reply-buffer)
	(unwind-protect
	    (progn
	      (save-excursion
		(set-buffer mail-reply-buffer)
		;; Might be called from newsreader before any
		;; Hyperbole mail reader support has been autoloaded.
		(cond ((fboundp 'rmail:msg-widen) (rmail:msg-widen))
		      ((eq major-mode 'news-reply-mode) (widen))))
	      (setq opoint (point))
	      (insert-buffer mail-reply-buffer)
	      (hmail:msg-narrow)
	      (if (fboundp 'ep:but-create) (ep:but-create))
	      (if (consp arg)
		  nil
		;; Don't ever remove headers if user uses Supercite package.
		;; He then can set a parameter there that will do the removal.
		(or (hypb:supercite-p)
		    (mail-yank-clear-headers start (mark)))
		(cond ((boundp 'mail-yank-hook) (run-hooks 'mail-yank-hook))
		      ((boundp 'mail-yank-hooks) (run-hooks 'mail-yank-hooks))
		      ((and (boundp 'mail-yank-prefix) mail-yank-prefix)
		       (save-excursion
			 (goto-char start)
			 (while (< (point) (mark))
			   (insert mail-yank-prefix)
			   (forward-line 1))))
		      (t ;; (null mail-yank-prefix)
			(indent-rigidly start (mark)
					(if arg
					    (prefix-numeric-value arg) 3))))
		(goto-char (min (point-max) (mark)))
		(set-mark opoint)
		(delete-region (point) ; Remove trailing blank lines.
			       (progn (re-search-backward "[^ \^I\^L\n]")
				      (end-of-line)
				      (point))))
	      (or (eq major-mode 'news-reply-mode)
		  (exchange-point-and-mark))
	      (if (not (eolp)) (insert ?\n))
	      )
	  (save-excursion
	    (set-buffer mail-reply-buffer)
	    (hmail:msg-narrow))))))

;;; ************************************************************************
;;; Private variables
;;; ************************************************************************

(var:append 'mail-setup-hook '(smail:comment-add))

(provide 'hsmail)