;;
;; Copyright (c) 1986, 1990 by The Trustees of Columbia University in
;; the City of New York.  Permission is granted to any individual or
;; institution to use, copy, or redistribute this software so long as it
;; is not sold for profit, provided this copyright notice is retained.
;;

;; $Header: /usr/local/src/mm/mm-0.94/mm/RCS/mmail.el,v 1.3 2005/05/31 14:43:11 beebe Exp beebe $

(defconst *mmail-buffers*
  '("*MM Outgoing*"			; outgoing message buffer
    "*MM In Reply To*"			; Message replying to
    "*MM Headers*"			; header buffer
    "*MM Message*")			; Old message
  "List of buffers for MM mode")

(defvar mmail-mode-hooks nil
  "list of functions to call when entering mmail-mode.  This is called 
after all of the mmail-mode buffers are set up.
")

;; gnuemacs mmail mode for editing messages in mm

(defun mmail-mode () "Read MM tempfile, and set up buffers."
  (interactive)
  (setq window-min-height 1)
  (define-key ctl-x-map "\^z" 'save-buffers-kill-emacs)
  (define-key ctl-x-map "\^w" 'mmail-write-file)
  (define-key esc-map "\t" 'mmail-tab-to-next-field)
  (let ((p nil)
	(fname nil)
	(used-buffers nil)
	(this-buffer (current-buffer))
	(buffers *mmail-buffers*))
    (switch-to-buffer "*scratch*" t)
    (set-buffer this-buffer)
    (goto-char (point-min))		; start at the very beginning
    (while (< (point) (point-max))	; for all files,
      (setq p (point))			; remember beginning of line
      (end-of-line 1)			; go to the end of the line
      (setq fname (buffer-substring p (point))) ; get the line as a filename
      (cond ((not (string= fname "nil")) ; if not a "nil" file
	     (find-file fname)	; read it in.
	     (text-mode)
	     (if buffers		; set the name
		 (rename-buffer (car buffers)))
	     (make-local-variable 'version-control)
	     (setq version-control 'never)
	     (setq used-buffers
		   (append used-buffers (list(car buffers))))))
      (setq buffers (cdr buffers)) ; buffer is used up
      (set-buffer this-buffer)
      (beginning-of-line 2))		; get next file
    (kill-buffer (current-buffer))	; all done, kill this temp buffer
    (switch-to-buffer "*scratch*" t)
    (mmail-mode-fix-buffers used-buffers)) ; and do buffer specific things
  (bury-buffer "*scratch*")
  (message 
   "Don't forget to save your buffers if you want your changes to take effect")
  (let ((hooks mmail-mode-hooks))
    (while (and hooks
		(not (funcall (car hooks))))
      (setq hooks (cdr hooks)))))

(defun mmail-mode-fix-buffers (buffers)
  (cond ((< 1 (length buffers))		; if more than one buffer
	 (split-window-vertically nil)	; then have two windows
	 (other-window 1)))
  (mmail-set-windows buffers 1)
  (select-window (get-buffer-window (car buffers))))


(defun mmail-set-windows (buffers windownum)
  (cond ((null buffers))
	(t (cond ((= 1 windownum)
		  (switch-to-buffer (car buffers)))
		 ((= 2 windownum)
		  (switch-to-buffer (car buffers))
		  (window-to-size))
		 (t (set-buffer (car buffers))))
	   (cond ((string= (car buffers) "*MM In Reply To*")
		  (setq buffer-read-only t)
		  (goto-char (point-min))
		  (re-search-forward "^$" (1- (point-max)) t)
		  (beginning-of-line 2)
		  (recenter 0))
		 ((string= (car buffers) "*MM Headers*")
		  (setq fill-prefix "	")
		  (auto-fill-mode 1)
		  (goto-char (point-min)))
		 ((string= (car buffers) "*MM Outgoing*")
		  (auto-fill-mode 1)
		  (goto-char (point-max)))
		 ((string= (car buffers) "*MM Message*")))
	   (other-window 1)
	   (mmail-set-windows (cdr buffers) (1+ windownum)))))

(defun mmail-write-file (filename)
  "Write file to FILENAME, but do not update filename or buffer name."
  (interactive "FWrite file: ")
  (write-region (point-min) (point-max) filename nil nil))
  
(defun mmail-tab-to-next-field ()
  (interactive)
  (let ((dot (point)))
    (or (re-search-forward "^[A-Za-z-]+: ?" nil t)
	(and (goto-char 1) (re-search-forward "^[A-Za-z-]+: ?" dot t))
	(and (goto-char dot) (indent-for-tab-command)))))


(defun window-to-size () "shrink a window to the size of the text in it"
  (interactive "")
  (let ((len 0))
    (if (> (setq len (- (window-height) (count-lines (point-min) (point-max))))
	   1)
	(shrink-window (1- len)))))



(mmail-mode)


