;;!emacs
;;
;; 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:     24-Nov-91 at 20:44:41 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
;;; ************************************************************************

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

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

;;; Overlay version of this function from sendmail.el to include
;;; Hyperbole buttons.

(defun sendmail-send-it ()
  (let ((errbuf (if mail-interactive
		    (generate-new-buffer " sendmail errors")
		  0))
	(tembuf (generate-new-buffer " sendmail temp"))
	(case-fold-search nil)
	delimline
	(mailbuf (current-buffer)))
    (save-restriction
      (widen)
      (unwind-protect
	  (save-excursion
	    (set-buffer tembuf)
	    (erase-buffer)
	    (insert-buffer-substring mailbuf)
	    (goto-char (point-max))
	    ;; require one newline at the end.
	    (or (= (preceding-char) ?\n)
		(insert ?\n))
	    ;; Change header-delimiter to be what sendmail expects.
	    (goto-char (point-min))
	    (re-search-forward
	     (concat "^" (regexp-quote mail-header-separator) "\n"))
	    (replace-match "\n")
	    (backward-char 1)
	    (setq delimline (point-marker))
	    (if mail-aliases
		(expand-mail-aliases (point-min) delimline))
	    ;; Added by Bob Weiner, 11/22/91.
	    (if (fboundp 'sendmail-delete-sender)
		(sendmail-delete-sender))
	    (goto-char (point-min))
	    ;; ignore any blank lines in the header
	    (while (and (re-search-forward "\n\n\n*" delimline t)
			(< (point) delimline))
	      (replace-match "\n"))
	    (let ((case-fold-search t))
	      ;; Find and handle any FCC fields.
	      (goto-char (point-min))
	      (if (re-search-forward "^FCC:" delimline t)
		  (mail-do-fcc delimline))
	      ;; If there is a From and no Sender, put in a Sender.
	      (goto-char (point-min))
	      (and (re-search-forward "^From:"  delimline t)
		   (not (save-excursion
			  (goto-char (point-min))
			  (re-search-forward "^Sender:" delimline t)))
		   (progn
		     (forward-line 1)
		     (insert "Sender: " (user-login-name) "\n")))
	      ;; don't send out a blank subject line
	      (goto-char (point-min))
	      (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
		  (replace-match ""))
	      (if mail-interactive
		  (save-excursion
		    (set-buffer errbuf)
		    (erase-buffer))))
	    (apply 'call-process-region
		   (append (list (point-min) (point-max)
				 (if (boundp 'sendmail-program)
				     sendmail-program
				   "/usr/lib/sendmail")
				 nil errbuf nil
				 "-oi" "-t")
			   ;; Always specify who from,
			   ;; since some systems have broken sendmails.
			   (list "-f" (user-login-name))
			   ;; These mean "report errors by mail"
			   ;; and "deliver in background".
			   (if (null mail-interactive) '("-oem" "-odb"))))
	    (if mail-interactive
		(save-excursion
		  (set-buffer errbuf)
		  (goto-char (point-min))
		  (while (re-search-forward "\n\n* *" nil t)
		    (replace-match "; "))
		  (if (not (zerop (buffer-size)))
		      (error "Sending...failed to %s"
			     (buffer-substring (point-min) (point-max)))))))
	(kill-buffer tembuf)
	(if (bufferp errbuf)
	    (kill-buffer errbuf))))))

(provide 'hsmail)