;;; Time-stamp: <2006-05-01 12:44:36 jcgs>

(require 'mail-inserts)

(defvar jcgs-use-feedmail nil
  "Whether to queue mail using feedmail.
Set non-nil in $COMMON/emacs/host-setup.el on my offline machines.")

(defvar jcgs-has-run-feedmail-queue nil
  "Whether we have yet run the feedmail queue in this emacs session.")

(add-lispdir "$GATHERED/emacs/feedmail")

(autoload 'feedmail-send-it "feedmail")
(autoload 'feedmail-run-the-queue "feedmail")
(autoload 'feedmail-run-the-queue-no-prompts "feedmail")
(autoload 'feedmail-mail-send-hook-splitter "feedmail")

(add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)

(add-hook 'feedmail-mail-send-hook
	  (lambda ()
	    (when jcgs-use-feedmail
	      ;; if we are using queue and are online,
	      ;; let it know that we still need to run
	      ;; the queue sometime
	      (setq jcgs-has-run-feedmail-queue nil))))

(setq feedmail-queue-runner-confirm-global t
      auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist)
      feedmail-queue-directory (substitute-in-file-name "$COMMON/mail/queue")
      feedmail-queue-draft-directory (substitute-in-file-name "$COMMON/mail/draft"))

(when jcgs-use-feedmail
  (setq send-mail-function 'feedmail-send-it
	feedmail-enable-queue t
	;; mail-enable-queue t
	feedmail-debug t
	))

(message "feedmail-queue-directory=%S feedmail-queue-draft-directory=%S"
	 feedmail-queue-directory
	 feedmail-queue-draft-directory)

(message "Old values for outgoing mail: user-mail-address=%S mail-host-address=%S"
	 user-mail-address mail-host-address)

(cond
 ((or jcgs-use-feedmail
      (string-match "ul.ie" system-name))
  (setq user-mail-address "john.sturdy@ul.ie"
	mail-host-address "ul.ie"
	))
 (t
  (setq user-mail-address "john@cb1.com"))
 )

(setq mail-default-reply-to user-mail-address
      mail-signature nil		; '(jcgs-insert-signature)
      mail-self-blind t
      mail-archive-file-name (expand-file-name "~/sent-mail")      )

(message "New values for outgoing mail: user-mail-address=%S mail-host-address=%S"
	 user-mail-address mail-host-address)

(defun jcgs-insert-signature ()
  "Insert my signature file."
  (if (y-or-n-p "Insert signature? ")
      (cond
       (t
	(insert-file-contents mail-signature-file)))))

;;;; improved setup of mail buffers

(defun jcgs-mail-mode-hook-function ()
  "Set up my mail composition buffers."
  (interactive)
  (setq sendmail-coding-system 'utf-8))

(add-hook 'mail-mode-hook 'jcgs-mail-mode-hook-function)

(defun mail-exch-to-cc ()
  "Exchange the To and CC lines in the current buffer."
  (interactive)
  (let (start end to cc)
    (save-excursion
      (goto-char (point-min))
      (re-search-forward "^To: *")
      (setq start (point))
      (end-of-line 1)
      (setq end (point)
	    to (buffer-substring start end))
      (delete-region start end)
      (goto-char (point-min))
      (re-search-forward "^CC: *")
      (setq start (point))
      (end-of-line 1)
      (setq end (point)
	    cc (buffer-substring start end))
      (delete-region start end)
      (insert to)
      (mail-position-on-field "To")
      (insert cc))))


(if (boundp 'mail-mode-map)
    (progn
      (define-key mail-mode-map "\M-\t" 'bbdb-complete-name)
      (define-key mail-mode-map "\C-c\M-t" 'mail-exch-to-cc)))

(defun mail-js:mail-setup-function ()
  "Nice setup of mail buffers."
  (save-excursion
    ;; (mail-position-on-field "X-Tension") (insert "5710")
    (mail-position-on-field "X-Attribution") (insert "jcgs")
    (goto-char (point-min))
    (if (not (and nil (y-or-n-p "Archive copy? ")))
	(delete-matching-lines "^FCC:"))
    (goto-char (point-min))
    (if (not (or t (y-or-n-p "Mail self blind? ")))
	(delete-matching-lines "^BCC:"))
    (goto-char (point-min))
    (if (save-excursion 
	  (re-search-forward "^CC: " (point-max) t))
	(if (and nil (not (y-or-n-p "Keep CC lines? ")))
	    (delete-matching-lines "^CC: ")))))

(defun headers-contain (pattern)
  "Return whether the headers of a message being prepared contain PATTERN."
  (let ((result (save-excursion
    (goto-char (point-min))
    (and (search-forward "--text follows this line--" (point-max) t)
	 (re-search-backward pattern (point-min) t)))))
    (message "Do headers contain %s? %s" pattern (if result "yes" "no"))
    result))

(defun mail-set-header (header value)
  "Set HEADER to VALUE."
  (save-excursion
    (message "Setting header %s to %s" header value)
    (goto-char (point-min))
    (if (and (search-forward "--text follows this line--" (point-max) t)
	     (re-search-backward (format "^%s: \\(.+\\)$" header) (point-min) t))
	(replace-match value t t nil 1))))

(defun mail-again (header value &rest forms)
  "Start a new message, with HEADER set to VALUE, but otherwise the same as the current one.
Optional FORMS are evaluated in the new message buffer."
  (interactive "sMail with header: 
sMail with %s set to: ")
  (if (string= (buffer-name) "*mail*")
      (rename-buffer (generate-new-buffer-name "*mail*")))
  (let ((message (buffer-string)))
    (save-window-excursion
      (mail)
      (message "Composing echo of message, with %s set to %s" header value)
      (rename-buffer (format "*mail %s %s*" header value))
      (erase-buffer)
      (insert message)
      (mail-set-header header value)
      (while forms
	(eval (car forms))
	(setq forms (cdr forms))))))

(defun mail-by-bcc (recipient)
  "Move RECIPIENT to the BCC list."
  (interactive "sMove to bcc: ")
  (if (save-excursion
	(goto-char (point-min))
	(and (search-forward "--text follows this line--" (point-max) t)
	     (re-search-backward (format "^\\(.+\\): %s" recipient) (point-min) t)))
      (let ((header (buffer-substring (match-beginning 1) (match-end 1))))
	(message "Moving recipient %s from %s to Bcc" recipient header)
	(mail-set-header header "john@cb1.com")
	(mail-set-header "Bcc" recipient))))

(defun jcgs-mail-send-hook ()
  "My mail sending hook."
  ;; currently empty
)

(add-hook 'mail-send-hook 'jcgs-mail-send-hook)

;; may also want to set mail-send-actions

(defvar thanks "Thanks!"
  "Thank-you message for the thank command.")

(defvar thanks-hist nil
  "History variable for thanks strings.")

(defun thank (thankstring)
  "Send a thank-you in response to the current message."
  (interactive
   (list
    (read-from-minibuffer "Message: "
			  thanks
			  nil
			  nil
			  'thanks-hist)))
  (vm-reply 1)
  (setq thanks thankstring)
  (insert thanks)
  (insert "\n\n__John\n")
  (vm-mail-send-and-exit nil)		; doesn't seem to use arg
  )

;;; end of email.el