; -*- emacs-lisp -*-
(if (not (fboundp 'bbdb)) nil		; don't load if `xemacs -q'


(setq vm-print-command lpr-command
      vm-print-command-switches lpr-switches)


(require 'highlight-headers)
(set-face-foreground 'message-cited-text "magenta" 'global nil 'append)
(set-face-foreground 'message-headers "blue" 'global nil 'append)
;(set-face-foreground 'message-separator-face "green" 'global nil 'append)

(setq vm-summary-highlight-face 'yellow)

(setq vm-summary-thread-indent-level 1)
(setq vm-forwarding-digest-type nil)
(bbdb-insinuate-vm)

(setq vm-auto-decode-mime-messages t)


(if emacsx
    (progn
      (setq vm-mime-charset-font-alist
	    '(
	      ("iso-8859-1" . "-*-courier-medium-r-*-14-*-iso8859-1")
	      ("iso-8859-2" . "-*-courier-medium-r-*-14-*-iso8859-2")))

      (setq vm-honor-mime-content-disposition t
	    vm-auto-displayed-mime-content-types t ;'("text" "multipart")
	    )
      )
  (setq vm-mime-default-face-charsets '("us-ascii" "iso-8859-1" "iso-8859-2"))
)

;(require 'mime-setup)
;(require 'tm-vm)

;(require 'smiley)
;(defun vm-smiley-display ()
;  (interactive)
;  (save-excursion
;;;;    (set-buffer gnus-article-buffer)
;    (goto-char (point-min))
;    ;; We skip the headers.
;;    (unless (search-forward "\n\n" nil t)
;;    (goto-char (point-max))
;;)
;    (smiley-buffer (current-buffer) (point))))

;(add-hook 'vm-display-buffer-hook 'vm-smiley-display t)

(setq vm-mode-line-format
  '("" "  %&%& "
    (
;;;     "VM " vm-version ": "
     (vm-folder-read-only "read-only ")
     (vm-virtual-folder-definition (vm-virtual-mirror "mirrored "))
     "%b"
;;;     (vm-mail-buffer (vm-ml-sort-keys ("" " by " vm-ml-sort-keys)))
     (vm-message-list
      ("  " vm-ml-message-number
       "/" vm-ml-highest-message-number)
      (vm-folder-type
       "  (unrecognized folder type)"
       "  (no messages)")))
    (vm-message-list
     ("  %[" vm-ml-message-attributes-alist
      (vm-ml-labels ("; " vm-ml-labels)) "%]  ")
     ("  %[%]  "))
    "%p" "  " global-mode-string))



(setq vm-visible-headers '("From:"))

(setq-default vm-summary-show-threads t)
(setq vm-spool-file-suffixes '(".SPOOL")
      vm-crash-box-suffix ".CRASH"
      vm-spool-files (list (list "VMBOX" (getenv "MAIL") "VMBOX.CRASH")))


;;;(setq vm-mail-header-from "xxx@xxx.net (Your Name)")

(require 'vm-auto-archive)  ;;; auto FCC setting

(setq
 vm-auto-folder-alist
 (let ((gz-pat '(lambda () (concat (downcase (buffer-substring (match-beginning 1) (match-end 1))) ".gz"))))

   (list
;;;    (list "^From"
;;;	  (cons "t.cholewo" "tjchol01.gz"))
    (list "^From\\|^Sender"
	  (cons "linkit" "radke.gz")
	  (cons "zsh-" "beta.gz")
	  (cons "glasgow-haskell" "haskell.gz")
	  (cons "^touring\\|^randon" "touring.gz")

	  (cons "Krzysztof_Sieczkarek" "inolog.gz")
	  (cons "grzankowski" "grzankowski.gz")
	  (cons "^lohsmalb" "chojnowski.gz")
	  (cons "^wpl01" "robert.gz")

	  (cons "^tex-k" "tex-k.gz")
	  (cons "^xemacs-beta" "xemacs-beta.gz")
	  (cons "^lynx-dev" "beta.gz")
	  (cons "^mc" "mc.gz")

	  (cons "^edb-" "edb.gz")
	  (cons "^cs1" "bmg.gz")
	  (cons "^custsvc" "ch.gz")

	  (cons "majordomo" "listserv.gz")
	  (cons "listproc" "listserv.gz")
	  (cons "-request" "listserv.gz")

	  (cons "d.a.miller" "damill01.gz")
	  (cons "miller" "damill01.gz")
	  (cons "damon.miller" "damill01.gz")
	  (cons "^olekmali" "a0mali01.gz")
	  (cons "^z.lata" "zjlata01.gz")
	  (cons "s739" "natalia.gz")
	  (cons "ctan" "ctan.gz")
	  (cons "M.Tworek" "mitw.gz")
	  (cons "^andrej@" "kielbasi.gz")
	  (cons "kielbasinski" "kielbasi.gz")
	  (cons "s.jankowski" "sjank.gz")
	  (cons "jankowsk" "sjank.gz")
	  (cons "touring" "touring.gz")
	  (cons "cfcohe01"  "syscory.gz")
	  (cons "heinrich.ruser"  "ruser.gz")
	  (list "<\\([^ \t\n\f@%()<>]+\\)[@%]\\([^ \t\n\f<>()]+\\)>"  gz-pat)
	  (list "<\\([^>]+\\)>" gz-pat)
	  (list "\\([^ \t\n\f@%()<>]+\\)\\([@%]\\([^ \t\n\f<>()]+\\)\\)?" gz-pat))


    (list "^To"
;;;    (list "^From\\|^Sender"
	  (cons "linkit" "radke.gz")
	  (cons "zsh-" "beta.gz")
	  (cons "glasgow-haskell" "haskell.gz")
	  (cons "^touring\\|^randon" "touring.gz")

	  (cons "Krzysztof_Sieczkarek" "inolog.gz")
	  (cons "grzankowski" "grzankowski.gz")
	  (cons "^lohsmalb" "chojnowski.gz")
	  (cons "^wpl01" "robert.gz")

	  (cons "^tex-k" "tex-k.gz")
	  (cons "^xemacs-beta" "xemacs-beta.gz")
	  (cons "^lynx-dev" "beta.gz")
	  (cons "^mc" "mc.gz")

	  (cons "^edb-" "edb.gz")
	  (cons "^cs1" "bmg.gz")
	  (cons "^custsvc" "ch.gz")

	  (cons "majordomo" "listserv.gz")
	  (cons "listproc" "listserv.gz")
	  (cons "-request" "listserv.gz")

	  (cons "d.a.miller" "damill01.gz")
	  (cons "miller" "damill01.gz")
	  (cons "damon.miller" "damill01.gz")
	  (cons "^olekmali" "a0mali01.gz")
	  (cons "^z.lata" "zjlata01.gz")
	  (cons "s739" "natalia.gz")
	  (cons "ctan" "ctan.gz")
	  (cons "M.Tworek" "mitw.gz")
	  (cons "^andrej@" "kielbasi.gz")
	  (cons "kielbasinski" "kielbasi.gz")
	  (cons "s.jankowski" "sjank.gz")
	  (cons "jankowsk" "sjank.gz")
	  (cons "touring" "touring.gz")
	  (cons "cfcohe01"  "syscory.gz")
	  (cons "heinrich.ruser"  "ruser.gz")
	  (list "<\\([^ \t\n\f@%()<>]+\\)[@%]\\([^ \t\n\f<>()]+\\)>"  gz-pat)
	  (list "<\\([^>]+\\)>" gz-pat)
	  (list "\\([^ \t\n\f@%()<>]+\\)\\([@%]\\([^ \t\n\f<>()]+\\)\\)?" gz-pat))

	  )))

(setq vm-auto-archive-alist vm-auto-folder-alist)

(add-hook 'vm-reply-hook
	  (function
	   (lambda ()
	       (tjc-remove-headers "^References:.*\n\\(\t<.*>\n\\)*")
	       (vm-auto-fcc t))))

(defun tjc-end-of-header ()
  "Go to the mail header separator and return its position."
  (goto-char (point-min))
  (if (not (search-forward (concat "\n" mail-header-separator "\n") nil t))
      (error "Mail header separator not found"))
  (beginning-of-line 0)
  (point))

(defun tjc-header-search (regex)
  "Search for a header matched by regex. If not found return nil."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward regex (save-excursion (tjc-end-of-header)) t)))


(defun tjc-remove-headers (regex)
  "Remove all headers matching regex."
  (save-excursion
    (while (tjc-header-search regex)
      	(replace-match ""))))

(defun tjc-auto-fcc ()
  "Complete header using BBDB and insert corresponding FCC:."
  (interactive)
  (bbdb-complete-name)
  (if (and (char-equal (preceding-char) ?>)  ; successful match ends with ">"
	   (not (tjc-header-search "^FCC:.*\n"))) ; only first counts
	(vm-auto-fcc t)))


; newer mail-setup-hook
(add-hook 'vm-mail-mode-hook
	  (function
	   (lambda ()
	     (local-set-key "\C-ci" 'ispell-message)
	     (local-set-key "\^I" 'tjc-auto-fcc)
	     (local-set-key "" 'vm-auto-fcc)
	     (local-set-key "
" 'vm-auto-archive)

	     (bbdb-insinuate-sendmail)

;	 (setq fill-column 76)
;	 (setq fill-prefix "    ")
;         (save-excursion
;	   (goto-char (point-max))
;	   (insert "\n-- \n")  ; standard prefix to signature
;	   (shell-command "~/bin/rsq stdout" t))
)))

(defconst fake-from-alist
  '(
    ;; ("tjchol01" . "\"Tomasz J. Cholewo\" <T.Cholewo@ieee.org>")
    ("damill01" . "\"Damon A. Miller\" <D.A.Miller@ieee.org>")
    ("zjlata01" . "Zbigniew Lata <Z.Lata@ieee.org>")
    )
  "Pairs of usernames and From: headers to insert before sending a message."
)

(add-hook 'mail-send-hook
	  (function
	   (lambda()
	     (save-excursion
	       (tjc-end-of-header)
               (if (not (tjc-header-search "^From:")) ; From: override
                   (let ((from (assoc (user-real-login-name) fake-from-alist)))
                     (if from
                         (insert (concat "From: " (cdr from) "\n")))))
               (let ((file (expand-file-name "~/.face")))
                 (if (file-readable-p file)
		     (progn
		       (insert "X-Face: ")
		       (insert-file-contents file))))
;;;               (ispell-message)
))))


(add-hook 'vm-mode-hook
	  (function
	   (lambda()
	     (local-set-key "\r" (function (lambda ()
					     (interactive)
					     (vm-scroll-forward 1))))
             (make-local-variable 'scroll-in-place)
             (setq scroll-in-place nil)
	     (local-set-key "Q"
	       (function (lambda ()
			   (interactive)
			   (vm-expunge-folder)
			   (let ((l (list
;;				     (get-buffer (concat "*Preview-"
;;							 (buffer-name)
;;;							 (let ((b (buffer-name)))
;;;							   (and (string-match "^\\(.+\\)\\( Summary\\)$" b)
;;;							   (match-string 1 b)))
;;							 "*"))
				     (get-buffer "*MailCrypt*")
;;;				     (get-buffer "*MIME-out*")
				     (get-file-buffer (getenv "MAIL"))
                                     )))
			     (message "%s %s" (buffer-name) l)
			     (vm-quit)
			     (mapcar
			      (function (lambda (b)
					  (and b
					       (not (buffer-modified-p b))
					       (kill-buffer b))))
			      l))

			   (let ((b (get-buffer "bbdb")))
			     (if b
				 (progn
				   (set-buffer b)
				   (if (buffer-modified-p)
					 (save-buffer))
				   (kill-buffer b))))

			   )))
)))

;;; rmail
;(setq
;     mail-archive-file-name "~/mail/sent-mail"
;     mail-default-reply-to "tjchol01@starbase.spd.louisville.edu"
;      rmail-file-name "~/mail/inbox.rmail")


(setq vm-summary-uninteresting-senders (user-real-login-name)
      vm-summary-uninteresting-senders-arrow "To: "

      mail-header-separator "."
;      vm-in-reply-to-format "%F wrote:"

      vm-auto-folder-case-fold-search t ; so vm-auto-folder-alist is simpler
      vm-auto-get-new-mail t
      vm-auto-next-message nil          ; when you're at the bottom of the msg
      vm-delete-after-bursting t        ; why not?
      vm-edit-message-mode 'indented-text-mode ; slightly better than text-mode

;;;      vm-in-reply-to-format "%F's message\n     of \"%w, %m %d, %y %h %z\"\nregarding \"%s\"\n      id %i" ; just the way I like it!
;;;      vm-included-text-attribution-format "[ On %w, %m %d, %y at %h (%z), %F wrote: ]\n> Subject: %s\n>\n" ; just the way I like it!
;;;      vm-mail-header-from (concat (user-login-name) "@" (vm-fqdn) " (" (user-full-name) ")") ; this is also for ; resent-from
;;;      vm-summary-format "%3n%*%A %-18.18F %4y/%02M/%02d-%H %4l/%-5c %I\"%s\"\n"
                                        ; ah, that's better! (except %02d
                                        ; doesn't put leading zeros out)
      vm-tale-is-an-idiot t             ; sounds good to me!
      vm-virtual-folder-alist
      '(
	("STARBASE"
         (("~/mail")
          (author "spd\\.louisville\\.edu")))
        ("OLD"
         (("~/mail")
          (sent-before "31 Dec 1994 23:59:59 GMT")))
	)



      vm-virtual-mirror t

      vm-primary-inbox "~/mail/VMBOX"
      vm-confirm-mail-send nil
      vm-startup-with-summary t
      vm-inhibit-startup-message t
      vm-preview-lines t
      vm-preview-read-messages t
      vm-circular-folders t
      vm-reply-subject-prefix "Re: "
      vm-included-text-prefix "> "
      vm-included-text-attribution-format "%F wrote:\n"
      vm-forwarding-subject-format "%s (fwd from %F)"
      vm-confirm-new-folders t
      vm-folder-directory "~/mail/"
      vm-visit-when-saving nil
      vm-delete-after-saving t
      vm-move-after-deleting t
      vm-move-after-undeleting t
      vm-follow-summary-cursor t
      vm-delete-empty-folders nil ;!!!
      vm-summary-format "%*%UA %-17.17F %2M/%2d %4l %I%s\n"
;      vm-summary-format "%*%a %-17.17F (%-3.3m %2d) %4l %I%s\n"
;;; "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c %I\"%s\"\n"
      vm-use-toolbar nil
      vm-warp-mouse-to-new-frame t
      vm-move-messages-physically t
      vm-frame-per-folder nil
      vm-frame-per-composition nil
      highlight-headers-hack-x-face-p nil
      vm-display-xfaces t
;;;      mail-signature t
      )

)

(defun vm-summary-function-A (m)
  (concat
   (cond ((vm-deleted-flag m) "D")
	 ((vm-new-flag m) "N")
	 ((vm-unread-flag m) "U")
	 (t " "))
;   (cond ((vm-filed-flag m) "F")
;	 ((vm-written-flag m) "W")
;	 (t " "))
   (cond ((vm-replied-flag m) "R")
	 ((vm-forwarded-flag m) "Z")
	 ((vm-redistributed-flag m) "B")
	 (t " "))
;;   (cond ((vm-edited-flag m) "E")
;;	 (t " "))
))


;(defun vm-mail-signature-send-and-exit ()
;  "Ask if you want to add your signature file, then send and exit."
;  (interactive)
;  (if (y-or-n-p "Add mail signature? ")
;      (mail-signature nil))
;  (vm-mail-send-and-exit nil)
;  )

;(add-hook 'vm-mail-mode-hook
;          '(lambda ()
;	     ;; Other, no-related stuff
;;	     (define-key vm-mail-mode-map "\C-c\C-c" 'vm-mail-signature-send-and-exit)
;	     ;; Other, no-related stuff
;	     ))
;----


;   (add-hook 'mail-setup-hook
;             '(lambda ()
;                (mail-to)
;                (let ((month (and (string-match "^[^ ]+ \\([^ ]+\\)"
;                                                (current-time-string))
;                                  (substring (current-time-string)
;                                             (match-beginning 1)
;                                             (match-end 1)))))
;                  (insert "\nErrors-to: kenb@ti.com"
;                          "\nReply-to: kenb@ti.com"
;                          (if (and (boundp 'vm-folder-directory)
;                                   vm-folder-directory)
;                              (concat "\nFCC: "
;                                      (expand-file-name
;                                       (concat "archive/" month "-outbox")
;                                       vm-folder-directory))
;                            "")
;                          "\nX-Face:" x-face))
;                (mail-to)))
;
;   This automatically archives my sent mail by month, and sticks in the XFace
;   header on all outgoing mail.
;


;;; package for handling aliases in VM (from the ~/.mailrc aliases)
;(load-library "mailabbrev")
;(add-hook 'mail-setup-hook 'mail-abbrevs-setup)
;(setq mail-personal-alias-file nil)