;; -*- Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	~/.vm
;;
;;	Emacs VM (View-Mail) init file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst cjw-vmrc-version "$Id: vm.rc,v 1.61 2002/01/12 22:14:51 cwynne Exp $")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependencies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'bbdb)
(require 'mail-extr)
(require 'vm-vcard)
(require 'vm-pine)

(bbdb-initialize)
(bbdb-insinuate-vm)

; (require 'messagexmas)
; (require 'smiley)
; 
; (add-hook 'vm-select-message-hook 
;	  '(lambda () (smiley-region (point-min) (point-max))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Key bindings for VM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-key vm-mode-map	 [A]			 nil)
(define-key vm-mode-map	 [m]			'vm-continue-what-message-other-frame)
(define-key vm-mode-map
  [(control c) (control p)]				'vm-print-message)
(define-key vm-mode-map	 [?#]			'vm-expunge-folder)

(define-key vm-mail-mode-map
  [(control c)(control f)(control f)]	'mail-from)
(define-key vm-mail-mode-map
  [(control c)(control f)(control x)]	'mail-x-spool)
(define-key vm-mail-mode-map
  [(control c)(control q)]				'cjw-reformat-region-or-paragraph)
(define-key vm-mail-mode-map
  [(control c)(control w)]				'mail-insert-signature)
(define-key vm-mail-mode-map [(?\")]	'tex-insert-quote)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hooks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cjw-vm-mode-hooks nil nil
  (local-set-key [(shift down)] 'scroll-up-line)
  (local-set-key [(shift up)]	'scroll-down-line)
  )

(add-hook 'vm-mode-hook			'cjw-vm-mode-hooks)

(defun cjw-vm-edit-hooks nil nil
  (local-set-key [(control c)(control q)]
								'cjw-reformat-region-or-paragraph)
  )

(add-hook 'vm-edit-message-hook	'cjw-vm-edit-hooks)

(defun update-composition-buffer-name ()
  (if (and (eq major-mode 'mail-mode)
		   (save-match-data (string-match "^mail to " (buffer-name))))
	  (let ((to (mail-fetch-field "To"))
			(cc (mail-fetch-field "Cc"))
			(ellipsis ""))
		(setq to (vm-parse-addresses to)
			  cc (vm-parse-addresses cc))
		(if (or (cdr to)
				(and (car to) (car cc)))
			(setq ellipsis ", ..."))
		(setq bufname (or (car to) (car cc) "foo (?)")
			  bufname (funcall vm-chop-full-name-function bufname)
			  bufname (or (car bufname) (car (cdr bufname)))
			  bufname (format "mail to %s%s" bufname ellipsis))
		(if (equal bufname (buffer-name))
			nil
		  (rename-buffer bufname t)))))

(add-hook 'post-command-hook 'update-composition-buffer-name)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SuperCite
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ; Need to modify this function slightly as it has a bug which nukes
  ; one too many lines in the reply buffer.
(defun sc-mail-cleanup-blank-lines ()
  "Leave some blank lines after original mail headers are nuked.
The number of lines left is specified by `sc-blank-lines-after-headers'."
  (if sc-blank-lines-after-headers
	  (save-restriction
		(widen)
		(skip-chars-backward " \t\n")
		(forward-line 1)
		(beginning-of-line)
		(if (looking-at "[ \t]*$")
				(delete-region (regi-pos 'bol) (regi-pos 'bonl)))
		(insert-char ?\n sc-blank-lines-after-headers)))
  nil)

(setq sc-preferred-attribution-list 
	  '("sc-consult" "sc-lastchoice" "x-attribution"
		"firstname" "initials" "lastname"))

(defvar sc-attrib-selection-list-fromlist nil
  "plist to be converted into an alist and included as a From entry
   in the sc-attrib-selection-list.")

(defun cjw-bbdb-build-sc-attrib-list ()
  "Create an `sc-attrib-selection-list' from BBDB.	This uses a custom
notes field called `attribution' in the BBDB record."
  (let ((records (bbdb-records))
		(record	  nil)
		(net	  nil)
		(email	  nil)
		(notes	  nil)
		(note	  nil)
		(attrib	  nil)
		(pattern  nil)
		(atpos	  nil)
		)

	(setq sc-attrib-selection-list-fromlist nil)

	(while records
	  (setq record	(car records))
	  (setq records (cdr records))
	  (setq net		(bbdb-record-net	   record))
	  (setq notes	(bbdb-record-raw-notes record))
	  (setq attrib	 nil)

	  (while notes
		(setq note	(car notes))
		(setq notes (cdr notes))

		(if (eq 'attribution (car note))
			(setq attrib (cdr note)))
		)

	  (if attrib

		  (while net
			(setq email	  (car net))
			(setq net	  (cdr net))
			(setq atpos	  (+ (string-match "@" email) 1))
			(setq pattern (substring email 0 atpos))

			(setq sc-attrib-selection-list-fromlist
				  (append  sc-attrib-selection-list-fromlist 
						  (list pattern attrib)))
			))
	  ))
  )

(cjw-bbdb-build-sc-attrib-list)

(setq sc-attrib-selection-list
	  (list
	   (append
		'("From") 
		  (list
		   (plist-to-alist sc-attrib-selection-list-fromlist)
		   ))
	   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Extra functions for VM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar vm-folder-defn-file "~/.vm.folders"
  "File containing definitions, using VM-DEFINE-FOLDER, for all
VM folders.")

(defvar procmail-rc-file "~/.procmailrc"
  "Procmail configuration file.")

(defvar vm-auto-folder-alist-fromlist nil
  "plist to be converted into an alist and included as a From entry
   in the vm-auto-folder-alist.")

(defvar vm-defined-spool-files nil)

(defun vm-define-folder (folder savekeys)
  "Create mailbox, spools, and crashboxes, and set VM-AUTO-FOLDER-ALIST
patterns for the From: header."
  (setq vm-defined-spool-files 
		(append vm-defined-spool-files (list (vm-D-setdirs folder))))
  (let (pattern)
	(while savekeys
	  (setq pattern (car savekeys))
	  (setq vm-auto-folder-alist-fromlist
			(append vm-auto-folder-alist-fromlist (list pattern folder)))
	  (setq savekeys (cdr savekeys))
	  ))
  )

(defun rebuild-procmailrc (&optional arg)
  "Reconstruct PROCMAIL-RC-FILE if it is older than
VM-FOLDER-DEFN-FILE."
  (interactive "p")
  (save-window-excursion
	(if (or arg (file-newer-than-file-p 
	 (expand-file-name vm-folder-defn-file) (expand-file-name procmail-rc-file)))
	(shell-command "procmailgen &" nil)
	))
  )

; From Danek Duvall <duvall@lorien.princeton.edu>
(defun vm-D-setdirs (folder)
  "Function which expands to a list of three items, namely the 
mailbox, the spool, and the crashbox, for a given VM folder.
Should be used as an argument to a LIST defining VM-SPOOL-FILES."
  (list (concat vm-folder-directory folder)
		(concat vm-spooldir folder)
	(concat vm-crashdir folder)
	)
)

(defun vm-unspool (folder)
  "Quietly get new mail for the specified mailbox folder."
  (interactive "sMail folder: ")
  (save-window-excursion
	(vm-visit-folder-other-window folder)
	(vm-sort-messages "date")
	(vm-quit)
  )
)

(defun vm-unspool-all ()
  "Check all spool files for new mail.	See VM-UNSPOOL."
  (interactive)
  (let ((spool-files vm-spool-files)
	folder
	spool
	(count	0))
	(while spool-files
	  (setq folder (car spool-files))
	  (setq spool  (nth 1 folder))
	  (setq folder (car folder))
	  (if (or (eq folder vm-primary-inbox) (not (file-exists-p spool)))
	  nil
	(progn
	  (if (> (nth 7 (file-attributes spool)) 0)
		  (progn
		(+ count 1)
		(message "Checking %s ..." folder)
		(vm-unspool folder)))
	  )
	)
	  (setq spool-files (cdr spool-files))
	  )
	count
  )
)

(defvar cjw-mail-to-regex "[Dd]amaris\\|[Ll]isa" nil)

(defvar cjw-mail-sep-1	  "\n\nCJW\n\n--\n"		 nil)
(defvar cjw-mail-sep-2	  "\n\nColin\n\n--\n"	 nil)

(defun mail-signature-separator nil nil
  (interactive)
  (if (string-match cjw-mail-to-regex (this-mail-to))
	  (concat cjw-mail-sep-2)
	(concat cjw-mail-sep-1))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq
	 mail-default-headers					"Bcc: cwynne"
	 mail-extr-ignore-single-names			 nil
	 mail-self-blind						 nil
	 mail-signature-dir						"~/mail/.sigs/"
	 mail-signature-local					"~/.signature"
	 mail-signature-regexp					"tag\\..*"
	 vm-auto-center-summary					 t
	 vm-auto-displayed-mime-content-types	'("text" "text/plain"
											  "multipart" "image"
											  "message/rfc822")
	 vm-auto-displayed-mime-content-type-exceptions 
											'("text/html")
	 vm-auto-get-new-mail					 60
	 vm-circular-folders					'movement
	 vm-confirm-new-folders					 t
	 vm-confirm-quit						 nil
	 vm-crash-box							"~/mail/.crash/INBOX"
	 vm-delete-after-saving					 t
	 vm-delete-empty-folders				 nil
	 vm-default-folder-type					'From_-with-Content-Length
	 vm-default-From_-folder-type			'BellFrom_
;	 vm-fill-paragraphs-containing-long-lines
;											 72
	 vm-folder-directory					"~/mail/"
	 vm-follow-summary-cursor				 t
	 vm-forwarding-subject-format			"%s (fwd)"
	 vm-frame-per-composition				 t
	 vm-frame-per-edit						 t
	 vm-group-by							"date"
	 vm-honor-page-delimiters				 t
	 vm-included-text-attribution-format	"On %w, %d %m, %F wrote:\n\n"
	 vm-included-text-prefix				"> "
	 vm-infer-mime-types					 t
	 vm-keep-sent-messages					 4
	 vm-mime-base64-decoder-program			"mmencode"
	 vm-mime-base64-decoder-switches		'("-b" "-u")
	 vm-mime-base64-encoder-program			"mmencode"
	 vm-mime-base64-encoder-switches		'("-b")
	 vm-mime-default-face-charsets			'("us-ascii"     "windows-1251" 
											  "windows-1252" "koi8-r"
											  "X-roman8"     "iso-8859-1"
											  "unicode-1-1-utf-7" "utf-8")
	 vm-mime-alternative-select-method		'best-internal
	 vm-mime-internal-content-types			 t
	 vm-mime-internal-content-type-exceptions
											'("text/html")
	 vm-mime-type-converter-alist			'(
			("text/html"	"text/plain"	"lynx -force_html -stdin -dump"))
	 vm-move-after-deleting					 t
	 vm-move-messages-physically			 t
	 vm-mutable-frames						 t
	 vm-mutable-windows						 t
	 vm-page-continuation-glyph				"..."
;	 vm-paragraph-fill-column				 72
	 vm-preview-lines						 0
	 vm-preview-read-messages				 t
	 vm-primary-inbox						"~/mail/INBOX"
	 vm-print-command						"mailp"
	 vm-print-command-switches				'("-from" "-us")
	 vm-reply-ignored-addresses				'("cwynne")
	 vm-rigorous-threads					 t
	 vm-startup-with-summary				 1
	 vm-summary-format						
				"%*(%n)%1Up[%a] %-20.20UB  [%2d %.3m %.-2y](%5l)  %I%s\n"
	 vm-summary-uninteresting-senders		"cwynne\\|kazz\\|ua70"
	 vm-summary-uninteresting-senders-arrow	"* "
	 vm-thread-using-subject				 nil
	 vm-url-browser							'vm-mouse-send-url-to-netscape
	 vm-use-toolbar							 nil
	 vm-visible-headers						(cons "Content-Type"
												   vm-visible-headers)
	 vm-spooldir							"~/mail/.spool/"
	 vm-crashdir							"~/mail/.crash/"

	 ;;
	 ;; Virtual folders
	 ;;
	 vm-virtual-folder-alist
	 '(("pampero"							; Virtual folder name
		(("~/mail/sysadmin")				; Real folder name
		 (author "pampero\\|combsun1")))	; Criterion
	   ("personal"
		(("~/mail/inbox")
		 (recipient "cwynne\\|ua7o")))
	   ("reminder"
		(("~/mail/inbox")
		 (subject "^Reminder")))
	   ("summary"
		(("~/mail/sunadmin")
		 (subject "[Ss]\\(ummary\\|UMMARY\\)")))
	   )
)
	 ;;
	 ;; Archive list
	 ;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Set save alist
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(rebuild-procmailrc)
(setq vm-auto-folder-alist-fromlist nil)
(load-file (expand-file-name vm-folder-defn-file))

; For the most part this is pretty straightforward.	 Anything being
; defined for a From address should probably be taken care of in the
; definitions file vm-folder-defn-file.
(setq vm-auto-folder-alist
		(list 
	 '("Subject"
	   ("[Ss]\\(EMINAR\\|eminar\\)" . "seminar")
	   ("e[Bb]ay"					. "ebay"))
	 '("To"
	   ("bugreport"					. "admin")
	   ("jhu-sysadmins"				. "jhunetwork")
;	   ("nields-announce"			. "nields")
;	   ("sun-managers"				. "sunhelp")
	   ("sysadmin$\\|sysadmin@"		. "admin"))
	 (append '("From") (plist-to-alist vm-auto-folder-alist-fromlist)
		 (list '(".*" .
			 (let ((cell (mail-extract-address-components (match-string 0))))
			   (cond ((stringp (car cell))
				  (if (string-match " " (car cell))
					  (downcase (substring (car cell) 0 (match-beginning 0)))
					nil)))))
			   '("<\\([^ \t\n\f@%()<>]+\\)[@%]\\([^ \t\n\f<>()]+\\)>" .
			 (buffer-substring (match-beginning 1) (match-end 1)))
			   '("<\\([^>]+\\)>" .
			 (buffer-substring (match-beginning 1) (match-end 1)))
			   '("\\([^ \t\n\f@%()<>]+\\)\\([@%]\\([^ \t\n\f<>()]+\\)\\)?" .
			 (buffer-substring (match-beginning 1) (match-end 1)))))
	 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Set spools
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq vm-spool-files vm-defined-spool-files)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;