(defvar kmail-directory (expand-file-name "~/mail/"))
(defvar kmail-pobox (format "po:%s" (getenv "USER")))
(defvar kmail-target-file (concat kmail-directory "inbox.temp"))
(defvar kmail-map nil)
(defvar kmail-auto-headers t)
(defvar kmail-inc-buffer)

(require 'mail-utils)

(progn
  (or (keymapp kmail-map)
      (setq kmail-map (make-keymap)))
  (suppress-keymap kmail-map)
  (define-key global-map "\C-xf" 'kmail-find-folder)
  (define-key kmail-map "n" 'kmail-next)
  (define-key kmail-map "p" 'kmail-prev)
  (define-key kmail-map "i" 'kmail-inc)
  (define-key kmail-map "t" 'kmail-test)
  (define-key kmail-map "f" 'kmail-find-folder)
  (define-key kmail-map "d" 'kmail-delete)
  (define-key kmail-map "u" 'kmail-undelete)
  (define-key kmail-map "^" 'kmail-refile)
  (define-key kmail-map "q" 'kmail-quit)
  (define-key kmail-map "x" 'kmail-execute)
  (define-key kmail-map "s" 'kmail-save)
  (define-key kmail-map "h" 'kmail-show-headers)
  (define-key kmail-map "." 'kmail-show-msg)
  (define-key kmail-map " " 'kmail-scroll-up)
  (define-key kmail-map "r" 'kmail-reply)
  (define-key kmail-map "a" 'kmail-reply)
  (define-key kmail-map "\C-?" 'kmail-scroll-down)
  (define-key kmail-map "\er" 'kmail-re-inc-test)
)
    

(defun kmail ()
  "   *** Kmail instructions ***"
  (interactive)
  (kmail-inc))

(defun kmail-what-line ()		;0 is the first line
  (save-excursion 
    (beginning-of-line)
    (+ (buffer-size) (forward-line (- (buffer-size))))))

(defun kmail-current-num ()
  (or kmail-current-num (kmail-what-line)))

(defun kmail-context ()
  (or kmail-current 
      (kmail-jump (kmail-current-num))))




(defun kmail-file-name (folder)
  (concat kmail-directory folder))

(defun kmail-headers-name ()
  (concat "*Headers-" kmail-folder "*"))

(defun kmail-headers-buffer ()
  (get-buffer (kmail-headers-name)))

(defun kmail-simplify (str)
  (let ((new (make-string (length str) ? ))
	(d 0)
	(p 0)
	(l (length str))
	(spadded t)
	ch)
    (while (< p l)
      (setq ch (aref str p))
      (if (memq ch '(?  ?\n ?\t))
	  (or spadded
	      (progn
		(aset new d 32)
		(setq d (1+ d))
		(setq spadded t)))
	(setq spadded nil)
	(aset new d ch)
	(setq d (1+ d)))
      (setq p (1+ p)))
    (substring new 0 d)))


(defun kmail-get-sender ()		;assumes point is at beginning of message, narrowed to header
  (or (mail-fetch-field "From")
      (mail-fetch-field "Sender")))

(defun kmail-narrow-to-header ()	;narrows to header of the current message
  (narrow-to-region (kt-marker kmail-current) 
		    (save-excursion (re-search-forward "^[ \t]*$") (point))))

(defun kmail-insert-summary-line ()
  (if (= (point) 0)
      (documentation 'kmail)
    (let* ((end (save-excursion (re-search-forward "^[ \t]*$") (point)))
	   (mend (save-excursion (forward-char 1) 
				 (if (search-forward "" (point-max) t) (backward-char 1) (goto-char (point-max)))
				 (point)))
	   (ss (save-restriction
		 (narrow-to-region (point) end)
		 (cons
		  (kmail-get-sender)
		  (mail-fetch-field "Subject"))))
	   (sender (or (car ss) "?????"))
	   (subject (or (cdr ss) ""))
	   (maxch (+ end (- 150 (length subject))))
	   (summary
	    (if (<= maxch end) subject
	      (concat subject
		      (kmail-simplify (buffer-substring end (min maxch mend))))))
	   (sline
	    (concat "-- "
		    (substring (format "%-20s" sender) 0 20)
		    " "
		    summary)))
      (insert
       (substring sline 0 (min (length sline) 100))))))


(defun kmail-inc ()
  (interactive)
  (setq kmail-inc-buffer nil)		;use default
  (let ((errors (get-buffer-create " *movemail errors*")))
    (buffer-flush-undo errors)
    (set-process-sentinel
     (start-process "movemail" errors 
		    (expand-file-name "movemail" exec-directory)
		    kmail-pobox kmail-target-file)
     'kmail-inc-continue))
  (message "Moving mail... "))

(defun kmail-inc-continue (&optional proc stat)
  (interactive)
  (let ((errors (if proc (process-buffer proc) (get-buffer-create " *movemail errors*")))
	(inbox (or kmail-inc-buffer (kmail-find-folder-nosort "inbox"))))
    (if (buffer-modified-p errors)
	(progn
	  (display-buffer errors)
	  (error "*** Movemail failed!"))
      (if (not (file-exists-p kmail-target-file))
	  (progn
	    (display-buffer inbox)
	    (message "No mail to incorporate!"))
	(message "Incorporating mail...")
	(display-buffer inbox)
	(set-buffer inbox)
	(let ((msg kmail-current-num)
	      (new 0))
	  (widen)
	  (goto-char (point-max))
	  (insert-file kmail-target-file)
	  (narrow-to-region (point) (mark))
	  (while (re-search-forward "?\n?" (point-max) t)
	    (setq new (1+ new))
	    (replace-match "" t t)
	    (kmail-insert-summary-line)
	    (let ((p (point)))
	      (forward-line 1)
	      (end-of-line)
	      (delete-region p (point))))
	  (goto-char (1- (point-max)))
	  (if (looking-at "")
	      (delete-char 1))
	  (delete-file kmail-target-file)
	  (kmail-sort)
	  (kmail-jump msg)
	  (message "Incorporating mail...done: %d new" new))))))

(defun kmail-inc-from-file (fname)
  (interactive "fInc to this folder from movemail-format file: ")
  (setq kmail-inc-buffer kmail-buffer)
  (let ((errors (get-buffer-create " *movemail errors*")))
    (buffer-flush-undo errors)
    (set-process-sentinel
     (start-process "movemail" errors 
		    "/bin/cp" fname kmail-target-file)
     'kmail-inc-continue))
  (message "Moving mail... "))




(defun kmail-find-folder-nosort (folname)
  (let* ((name (kmail-file-name folname))
	 (b (get-file-buffer name)))
    (if (not b)
	(progn
	  (setq b (find-file-noselect name))
	  (set-buffer b)
	  (goto-char (point-min))
	  (insert " - ***KMAIL HELP***\nWelcome to Kmail, and all that.\n")
	  (set-buffer-modified-p nil)
	  (make-local-variable 'kmail-folder)
	  (make-local-variable 'kmail-toc)
	  (make-local-variable 'kmail-current)
	  (make-local-variable 'kmail-current-num)
	  (make-local-variable 'kmail-num-messages)
	  (make-local-variable 'kmail-mode-info)
	  (make-local-variable 'kmail-summary-buffer)
	  (make-local-variable 'kmail-buffer)
	  (setq kmail-folder folname)
	  (setq kmail-toc nil)
	  (setq kmail-current nil)
	  (setq kmail-current-num 0)
	  (setq kmail-num-messages 0)
	  (setq kmail-mode-info "0/0")
	  (setq kmail-summary-buffer nil)
	  (setq kmail-buffer b)		;pointer to myself!
	  (setq major-mode 'kmail-mode)
	  (setq mode-name "Kmail")
	  (setq mode-line-format
		(list "-- Kmail: %b " 'kmail-mode-info " %-"))
	  (use-local-map kmail-map)
	  ))
    b))

(defun kmail-find-folder-noselect (folname)
  (let* ((name (kmail-file-name folname))
	 (b (get-file-buffer name)))
    (if (not b)
	(progn
	  (setq b (kmail-find-folder-nosort folname))
	  (set-buffer b)
	  (kmail-sort)
	  (kmail-jump 0)))
    b))
  

(defun kmail-find-folder (name)
  (interactive "sFind folder named: ")
  (switch-to-buffer (kmail-find-folder-noselect name))
  (if kmail-auto-headers
      (switch-to-buffer-other-window (kmail-headers-buffer))))

  
;; Each entry of the TOC is a list... a message marker, and a fate.
;;   The summary field starts with two chars:
;;     The first is the message's "dealt" status:
;;       '-' ... unseen
;;       ' ' ... read
;;       'D' ... marked for deletion
;;       '^' ... marked for refile
;;     The second is the message's "responded" status:
;;       'A' ... answered
;;       'F' ... forwarded
;;       '-' ... none 

(defmacro kt-make (marker fate) (list 'list marker fate))
(defmacro kt-marker (toc) (list 'car toc))
(defmacro kt-fate (toc) (list 'car (list 'cdr toc)))
(defmacro kt-set-fate (toc fate) (list 'setcar  (list 'cdr toc) fate))

(defun kmail-goto-summary (&optional which-msg)
  (goto-char (kt-marker (or which-msg kmail-current)))
  (forward-line -1)
  (forward-char 1))

(defun kmail-set-status (ch)
  (let ((b (kmail-headers-buffer))
	(n kmail-current-num))
    (save-excursion
      (save-restriction
	(widen)
	(kmail-goto-summary)
	(delete-char 1)
	(insert-char ch 1)
	(if b
	    (progn
	      (set-buffer b)
	      (save-excursion
		(goto-line (1+ n))
		(delete-char 1)
		(insert-char ch 1))))))))


(defun kmail-sort ()
  (message "Sorting %s..." kmail-folder)
  (save-restriction
    (widen)
    (setq kmail-toc nil)
    (setq kmail-num-messages -1)
    (goto-char (point-max))
    (let (eol)
      (while (search-backward "" (point-min) t)
	(setq kmail-num-messages (1+ kmail-num-messages))
	(setq eol (save-excursion (end-of-line) (point)))
	(setq kmail-toc 
	      (cons 
	       (kt-make
		(set-marker (make-marker) (1+ eol))
		nil)
	       kmail-toc))))
    (if (or kmail-auto-headers (kmail-headers-buffer))
	(kmail-recalc-headers)))
  (message "Sorting %s...done" kmail-folder))


(defun kmail-message-status ()
  (let ((ch (aref (kt-flags kmail-current) 0)))
    (cond
     ((eq ch ?-) 'unseen)
     ((eq ch ? ) 'read))))

(defun kmail-reply-status ()
  (let ((ch (aref (kt-flags kmail-current) 1)))
    (cond
     ((eq ch ?-) 'none)
     ((eq ch ?A) 'answered)
     ((eq ch ?F) 'forwarded))))


(defun kmail-touch-mode-line ()
  (setq kmail-mode-info 
	(format "%d/%d %s" 
		kmail-current-num 
		kmail-num-messages 
		(or (kt-fate kmail-current) "")))
  (set-buffer-modified-p (buffer-modified-p)))

(defun kmail-narrow (start)
  (widen)
  (goto-char (1+ start))
  (if (search-forward "" (point-max) t)
      (backward-char 1)
    (goto-char (point-max)))
  (narrow-to-region start (point)))
  

(defun kmail-jump (msg)
  (interactive "nJump to message: ")
  (set-buffer kmail-buffer)
  (let ((toc-entry (nth msg kmail-toc)))
    (if (and toc-entry (>= msg 0))
	(progn
	  (save-excursion
	    (save-restriction
	      (widen)
	      (setq kmail-current toc-entry)
	      (setq kmail-current-num msg)
	      (kmail-goto-summary)
	      (if (looking-at "-")
		  (kmail-set-status ? ))
	      (let ((b (kmail-headers-buffer)))
		(if b
		    (progn
		      (set-buffer b)
		      (goto-line (1+ msg)))))))
	  (kmail-touch-mode-line)
	  (kmail-narrow (car toc-entry))
	  (let ((w (get-buffer-window kmail-buffer)))
	    (if w
		(set-window-start w (point-min)))))
      (message "Message %d out of range in folder %s" msg kmail-folder))))

(defun kmail-show-msg ()
  (interactive)
  (kmail-context)
  (set-window-start (display-buffer kmail-buffer) (point-min)))


(defun kmail-next ()
  (interactive)
  (kmail-jump (1+ (kmail-current-num))))



(defun kmail-prev ()
  (interactive)
  (kmail-jump (1- (kmail-current-num))))




(defun kmail-quit ()
  (interactive)
  (set-buffer kmail-buffer)
  (let* ((b kmail-buffer)
	 (hb (kmail-headers-buffer))
	 (bw (get-buffer-window b))
	 (hbw (and hb (get-buffer-window hb))))
    (and bw (not (one-window-p)) (delete-window bw))
    (and hbw (not (one-window-p)) (delete-window hbw))
    (bury-buffer b)
    (bury-buffer hb)
    (if (memq (current-buffer) (list b hb))
	(switch-to-buffer nil t))))




(defun kmail-delete ()
  (interactive)
  (kmail-context)
  (if (= kmail-current-num 0)
      (error "You can't delete the 0th message!"))
  (kt-set-fate kmail-current "Deleted")
  (kmail-set-status ?D)
  (kmail-touch-mode-line)
  (kmail-next))

(defun kmail-refile (folder)
  (interactive "sRefile to folder: ")
  (kmail-context)
  (if (= kmail-current-num 0)
      (error "You can't refile the 0th message!"))
  (kt-set-fate kmail-current (concat "Refiled: " folder))
  (kmail-set-status ?^)
  (kmail-touch-mode-line)
  (kmail-next))
  
(defun kmail-undelete ()
  (interactive)
  (kmail-context)
  (kt-set-fate kmail-current nil)
  (kmail-set-status ? )
  (kmail-touch-mode-line))

(defun kmail-execute ()
  (interactive)
  (kmail-context)
  (message "Processing deletes and refiles...")  
  (widen)
  (let ((toc kmail-toc)
	(n 0)
	touched-folders
	m)
    (while (setq toc (cdr toc))
      (setq n (1+ n))
      (setq m (car toc))
      (if (setq fate (kt-fate m))
	  (cond
	   ((string-match "^Deleted" fate)
	    (goto-char (kt-marker m))
	    (search-backward "")
	    (kmail-narrow (point))
	    (delete-region (point-min) (point-max))
	    (widen))
	   ((string-match "^Refiled: \\(.*\\)" fate)
	    (goto-char (kt-marker m))
	    (search-backward "")
	    (kmail-narrow (point))
	    (let* ((fname (kmail-file-name (substring fate (match-beginning 1) (match-end 1))))
		   (b (get-file-buffer fname))
		   (kb (current-buffer))
		   (cur kmail-current)
		   str)
	      (if b
		  (progn		;move message to other buffer
		    (setq str (buffer-substring (point-min) (point-max)))
		    (set-buffer b)
		    (save-restriction
		      (widen)
		      (goto-char (point-max))
		      (insert str)
		      (or (memq b touched-folders)
			  (setq touched-folders (cons b touched-folders)))
		    (set-buffer kb)))
		(write-region (point-min) (point-max) fname t 1)))
	    (delete-region (point-min) (point-max))
	    (widen))
	   (t
	    (error "Bad fate for message %d" n)))))
    (save-excursion
      (while touched-folders
	(set-buffer (car touched-folders))
	(kmail-sort)
	(setq touched-folders (cdr touched-folders)))))
  (kmail-save)
  (kmail-sort)
  (kmail-jump 0)
  (kmail-quit)
  (message "Processing deletes and refiles...done"))


(defun kmail-save ()
  (interactive)
  (kmail-context)
  (save-restriction
    (widen)
    (goto-char (point-min))
    (if (search-forward "" (point-max) t 2)
	(backward-char 1)
      (goto-char (point-max)))
    (write-region (point) (point-max) (buffer-file-name) nil t)))

(defun kmail-recalc-headers ()
  (message "Calculating headers...")
  (let ((toc kmail-toc)
	(b (current-buffer))
	(hb (kmail-headers-buffer))
	str)
    (or hb
	(progn
	  (setq hb (get-buffer-create (kmail-headers-name)))
	  (set-buffer hb)
	  (setq major-mode 'kmail-headers)
	  (setq mode-name "Kmail:Headers")
	  (use-local-map kmail-map)
	  (make-local-variable 'kmail-buffer)
	  (setq kmail-buffer b)))
    (set-buffer hb)
    (delete-region (point-min) (point-max))
    (while toc
      (set-buffer b)
      (kmail-goto-summary (car toc))
      (setq str (buffer-substring (point) (progn (forward-line 1) (point))))
      (set-buffer hb)
      (insert str)
      (setq toc (cdr toc)))
    (set-buffer b))
  (message "Calculating headers...done"))

(defun kmail-show-headers ()
  (interactive)
  (if kmail-current
      (progn
	(if (not (kmail-headers-buffer))
	    (kmail-recalc-headers))
	(switch-to-buffer-other-window (kmail-headers-buffer)))
    (or (one-window-p) (delete-window (selected-window)))
    (switch-to-buffer kmail-buffer)))

(defun kmail-scroll-down ()
  (interactive)
  (let ((w (selected-window))
	(kw (get-buffer-window kmail-buffer)))
    (if kw
	(progn
	  (select-window kw)
	  (scroll-down)
	  (select-window w))
      (display-buffer kmail-buffer))))

(defun kmail-scroll-up ()
  (interactive)
  (let ((w (selected-window))
	(kw (get-buffer-window kmail-buffer)))
    (if kw
	(progn
	  (select-window kw)
	  (scroll-up)
	  (select-window w))
      (display-buffer kmail-buffer))))

(defun kmail-reply (who)		;Pass 'all or 'sender
  (interactive 
   (list 
    (let (ch)
      (while (progn
	       (message "Reply to (all or sender): ")
	       (not (memq (setq ch (read-char)) '(?a ?s))))
	(beep))
      (cdr (assq ch '((?a . all) (?s . sender)))))))
  (kmail-context)
  (save-restriction
    (kmail-narrow-to-header)
    (let* ((sndr (or (mail-fetch-field "Reply-to") (kmail-get-sender)))
	   (ccs (and (eq who 'all) (mail-fetch-field "cc" nil t)))
	   (recip (and (eq who 'all) (mail-fetch-field "to" nil t)))
	   (allccs (if ccs (concat recip ", " ccs) recip)))
      (mail-other-window 
       nil 
       sndr
       (mail-fetch-field "subject")
       (concat "In reply to " (mail-fetch-field "message-id"))
       allccs
       (current-buffer)))))