.vm

;;;;
;;;;	.vm.el - startup initialisation for ViewMail
;;;;
;;;#ident	"@(#)HOME:.vm	37.1	21/03/23 11:43:04 (woods)"
;;;
;;; per-user start-up functions for GNU-emacs VM package (View-Mail)
;;;

(require 'sendmail)			; get this over with right away
(require 'message)			; and this too....
(require 'vm-menu)			; and this too....

(setq vm-version-number (string-to-number vm-version))

;;; Netscape (and Mozilla) use X Window properties to implement the "remote"
;;; control protocol.  So long as you have only one browser per user-id running
;;; on any given display then all you need to do is set the display and all
;;; should work just fine....
;;;
(defvar my-vm-netscape-display "xtremely:0"
  "Display name to pass to netscape in vm-netscape-program-switches.")

(defvar my-vm-galeon-program "galeon"
  "Name of program to use to run Galeon.")

(defvar my-vm-galeon-program-switches (list "--disable-sound")
  "List of command line switches to pass to Galeon (not including -n).")

(defun my-vm-mouse-send-url-to-galeon (url)
  (message "Sending URL to Galeon (opening new tab)...")
  (apply 'vm-run-background-command my-vm-galeon-program
	 (append my-vm-galeon-program-switches (list "-n" url)))
  (message "Sending URL to Galeon... done (opened new tab)"))

;;;
;;; dired stuff...
;;;

;;Message-ID: <cxjpv5he74u.fsf@engc.bu.edu>
;;References: <cajhfquqejw.fsf@faui5pc29.informatik.uni-erlangen.de>
;;Date: 06 Apr 1999 18:06:25 -0400
;;From: David Bakhash <cadet@bu.edu>
;;Organization: Boston University
;;Subject: Re: Selecting a special  mail
;;To: info-vm@uunet.uu.net
;;
;; I don't think that's feasible given the command interface that VM
;; has.  With some programming, you can probably figure out something,
;; but the best way to do it, of course, is to just use vm-visit-folder
;; instead of find-file.  If you visit with dired, then use the `r'
;; binding (XEmacs), and you will visit it with vm-visit-folder instead
;; of find-file.  If you're using GNU Emacs, then try this code out in
;; your ~/.emacs file:
;;
(defun dired-vm (&optional read-only)
  "Run VM on this file.
With prefix arg, visit folder read-only (this requires at least VM 5).
See also variable `dired-vm-read-only-folders'."
  (interactive "P")
  (let ((dir (dired-current-directory))
        (fil (dired-get-filename)))
    ;; take care to supply 2nd arg only if requested - may still run VM 4!
    (require 'vm)			; vm-visit-folder may not be an autoload
    (setq this-command 'vm-visit-folder) ; for vm window config
    (if read-only
        (vm-visit-folder fil t)
      (vm-visit-folder fil))
    ;; so that pressing `v' inside VM does prompt within current directory:
    (set (make-local-variable 'vm-folder-directory) dir)))

(add-hook 'dired-mode-hook
	  '(lambda ()
	     (require 'dired-x)
	     (define-key dired-mode-map "r" 'dired-vm)))

;;;
;;;	VM related things
;;;

(define-key vm-mode-map "/" 'vm-isearch-forward)
(define-key vm-mode-map "\em" 'vm-mark-message)
(define-key vm-mode-map "\eu" 'vm-unmark-message)

;; Hack using virtual folders to kill only unread messages matching the same
;; subject....
;; 
;; V S			; vm-create-virtual-folder-same-subject
;; M C unread RET	; vm-mark-messages-matching ...
;; M N			; vm-next-command-uses-marks
;; d 			; vm-delete-message
;; q			; vm-quit
;;(define-key vm-mode-map "k" 'vm-kill-unread-subject)
;;(define-key vm-mode-map "K" 'vm-kill-subject)

;; Kyle suggests this as the q&d way to be able to see all the parts of a
;; multipart/alternative message....
;;
(defun my-vm-unbind-vm-mime-display-internal-multipart/alternative ()
  "Get rid of vm-mime-display-internal-multipart/alternative so that buttons
for all parts will be displayed."
  (require 'vm-mime)
  (fmakunbound 'vm-mime-display-internal-multipart/alternative))
(add-hook 'vm-mode-hook 'my-vm-unbind-vm-mime-display-internal-multipart/alternative)

;; this is too "easy" -- need a confirmation, or just use the pull-down menu!
;(define-key vm-mode-map "+" 'vm-print-message)

(defvar my-vm-virtual-leftovers-folder "General Delivery"
  "The name of the virtual folder containing all the messages which are not
members of other virtual folders.  (It's created after all the others are
created by my-vm-visit-all-virtual-folders.)

NOTE:  Changes to this variable only take effect when your emacs session is
restarted.")

(defvar my-vm-virtual-spam-folder "zzzz Spam-I-Am zzzz"
  "The name of the spam virtual folder.

NOTE:  Changes to this variable only take effect when your .vm is reloaded.")

(defun my-vm-quit-all-virtual-folders ()
  "Quit from all of the virtual folders in vm-virtual-folder-alist."
  (interactive)
  (let ((vfolder vm-virtual-folder-alist))
    (while vfolder
      (save-excursion
	(condition-case error-data
	    (let ((vm-confirm-quit nil))
	      (set-buffer (concat "(" (car (car vfolder)) ")"))
	      (vm-quit))
	  (error nil))
	(setq vfolder (cdr vfolder))))))

(defun my-vm-visit-all-virtual-folders ()
  "Visit all of the virtual folders in vm-virtual-folder-alist."
  (interactive)
  (save-excursion
    (condition-case error-data
	(let ((vm-confirm-quit nil))
	  (set-buffer (concat "(" my-vm-virtual-leftovers-folder ")"))
	  (vm-quit))
      (error nil)))
  (let ((vfolder vm-virtual-folder-alist))
    (while vfolder
      (let ((vfname (car (car vfolder))))
	(if (not (string-equal vfname my-vm-virtual-leftovers-folder))
	    (vm-visit-virtual-folder vfname))
	(setq vfolder (cdr vfolder)))))
  (vm-visit-virtual-folder my-vm-virtual-leftovers-folder))

(define-key vm-mode-map "Va" 'my-vm-visit-all-virtual-folders)

(defun my-vm-resync-all-virtual-folders ()
  "Revisit all virtual folders to update them.  This doesn't seem to be
necessary any more with newer versions of VM, eg. 6.62."
  (interactive)
  (save-excursion
    ;; this is no longer necessary with newer versions of VM, eg. 6.62
    ;;(my-vm-quit-all-virtual-folders)
    ;; make sure all new messages are in their target folders so that the magic
    ;; for the General Delivery folder works....
    (my-vm-visit-all-virtual-folders)))

(defun my-vm-get-new-mail ()
  "Local version of vm-get-new-mail that updates all virtual folders in
vm-virtual-folder-alist."
  (interactive)
  (save-excursion
    ;; this is no longer necessar with newer versions of VM, eg. 6.62
    ;;(my-vm-quit-all-virtual-folders)
    ;; instead we only need to quit the "General Delivery" folder:
    (save-excursion
      (condition-case error-data
	  (let ((vm-confirm-quit nil))
	    (set-buffer (concat "(" my-vm-virtual-leftovers-folder ")"))
	    (vm-quit))
	(error nil)))
    (set-buffer (vm-get-file-buffer vm-primary-inbox))
    (vm-get-new-mail)
    ;; make sure all new messages are in their target folders so that the magic
    ;; for the General Delivery folder works....
    (my-vm-visit-all-virtual-folders)))

;; This overrides the normal binding of 'G' to vm-sort-messages....
(define-key vm-mode-map "G" 'my-vm-get-new-mail)

(defun my-vm-quit ()
  "Local version of vm-quit that quits all virtual buffers if quitting
vm-primary-inbox."
  (interactive)
  (vm-select-folder-buffer)
  (if (eq major-mode 'vm-virtual-mode)
      (vm-quit)
    (if (string-equal (buffer-file-name)
		      (expand-file-name vm-primary-inbox))
	(my-vm-quit-all-virtual-folders))
    (vm-quit)))

(define-key vm-mode-map "q" 'my-vm-quit)

(defun my-vm-quit-all ()
  "Quit from all buffers in VM-mode."
  (interactive)
  (save-excursion
    (mapcar '(lambda (buffer)
               (and (buffer-live-p buffer) (set-buffer buffer)
                    (eq major-mode 'vm-mode) (vm-quit)))
            (buffer-list))))

;; Does no harm if VM already exited.
(add-hook 'my-before-kill-emacs-hook 'my-vm-quit-all)

(defun my-vm-count-function ()
  "Return the number of buffers in vm-mode."
  (interactive)
  (let ((count 0))
    (save-excursion
      (mapcar '(lambda (buffer) (set-buffer buffer)
                 (and (eq major-mode 'vm-mode) (setq count (1+ count))))
              (buffer-list)))
    (if (interactive-p)
	(message "%s buffer%s in VM mode" count (if (> count 1) "s" ""))
      count)))

(defun my-vm-quit-last ()
  "Quit from VM.  If this is the last buffer in VM mode, prompt."
  (interactive)
  (let ((quit t))
    (and (= (my-vm-count-function) 1)
         (or (when (yes-or-no-p "Really exit VM? ")
               (my-vm-save-all-folders-deactivate)
               t)
             (setq quit nil)))
    (message "%s" (current-buffer))
    (when quit
      (vm-quit))))

(require 'ispell)
(add-hook 'vm-mail-mode-hook
	  (function (lambda () (local-set-key "\C-ci" 'ispell-message))))

(setq ispell-message-text-end
      (mapconcat (function identity)
		 (list ispell-message-text-end
		       "^-- $"		; XXX this is in orig, but it's not!
		       "^-----BEGIN PGP " ; PGP
		       "&This is a[-A-Z0-9 ]+digest" ; digest
		       )
		 "\\|"))

(require 'advice)
(defadvice vm-summarize (after my-vm-summarize activate)
  "Also call vm-emit-totals-blurb after vm-summarize."
  (vm-emit-totals-blurb))

;;From: Kevin Rodgers <ihs_4664@yahoo.com>
;;Newsgroups: gnu.emacs.vm.info
;;Subject: Re: Behavior of vm-delete-message
;;Date: Wed, 27 Oct 2004 16:45:17 -0600
;;Message-ID: <2uamo1F286pvsU1@uni-berlin.de>
;;
;;(defadvice vm-delete-message (before vm-follow-summary-cursor activate)
;;   "When called interactively, select the message at point in the summary
;;buffer."
;;   (when (interactive-p)
;;     (let ((vm-follow-summary-cursor t))
;;       (vm-follow-summary-cursor))))

(defun my-vm-auto-archive-messages ()
  "Local version of vm-auto-archive-messages that obtains user confirmation."
  (interactive)
  (if (y-or-n-p "Are you really sure you want to archive all messages???")
      (vm-auto-archive-messages)))

(define-key vm-mode-map "A" 'my-vm-auto-archive-messages)

;; this is done this way so that it remains compatible with pre-6.x VM
(defun my-vm-forward-message-using-rfc934 ()
  "Local version of vm-forward-message that uses rfc934 encapsulation and
avoids any MIME transfer encoding.  Pine 3.96 cannot show headers in MIME
message/rfc822 attachments."
  (interactive)
  (let ((vm-forwarding-digest-type "rfc934"))
    (vm-forward-message)
    (set (make-local-variable 'vm-send-using-mime) nil)))

(define-key vm-mode-map "Z" 'vm-forward-message) ; use default (mime)
(define-key vm-mode-map "z" 'my-vm-forward-message-using-rfc934)

;;;
;;;	vm-bogofilter support
;;;

(require 'vm-bogofilter)

(defun my-vm-quit-virtual-spam-folder ()
  "Quit from the virtual spam folder `my-vm-virtual-spam-folder' if not
currently visiting it."
  (let ((virtual-spam-folder-name (concat "(" my-vm-virtual-spam-folder ")")))
    (if (not (equal (buffer-name)
		    virtual-spam-folder-name))
	(save-excursion
	  (condition-case error-data
	      (let ((vm-confirm-quit nil))
		(set-buffer virtual-spam-folder-name)
		(vm-quit))
	    (error nil))))))

(defadvice vm-bogofilter-is-spam (after my-vm-bogofilter-is-spam activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(defadvice vm-bogofilter-is-clean (after my-vm-bogofilter-is-clean activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(defadvice vm-bogofilter-just-retag (after my-vm-bogofilter-just-retag activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(defadvice vm-bogofilter-new-spam (after my-vm-bogofilter-new-spam activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(defadvice vm-bogofilter-new-clean (after my-vm-bogofilter-new-clean activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(defadvice vm-bogofilter-update-and-tag (after my-vm-bogofilter-update-and-tag activate)
  "Also call `my-vm-quit-virtual-spam-folder' in case spam status changed."
  (my-vm-quit-virtual-spam-folder))

(define-key vm-mode-map "\C-cs" 'vm-bogofilter-new-spam)
(define-key vm-mode-map "\C-cS" 'vm-bogofilter-is-spam)
(define-key vm-mode-map "\C-cn" 'vm-bogofilter-new-clean)
(define-key vm-mode-map "\C-cN" 'vm-bogofilter-is-clean)
(define-key vm-mode-map "\C-ct" 'vm-bogofilter-test-if-spam)
(define-key vm-mode-map "\C-cT" 'vm-bogofilter-just-retag)
(define-key vm-mode-map "\C-cu" 'vm-bogofilter-update-and-tag)

;;;
;;; some more assistance for spam-handling
;;;

(defun my-vm-run-lookup-prog (progname args pop-buffer &optional bufname)
  "Run PROGNAME with ARGS into BUFNAME, visiting buffer if POP-BUFFER is
non-nil.  If BUFNAME is nil or not given then create it using PROGNAME."
  (if (not bufname)
      (setq bufname (concat "*VM-lookup-" progname "*")))
  (save-window-excursion		; bury-buffer buggers windows...
    (save-excursion
      (set-buffer (get-buffer-create bufname))
      (setq buffer-read-only nil)
      (erase-buffer)
      (if pop-buffer
	  ;; watch it in progress...
	  (apply 'start-process progname bufname progname args)
	;; wait for the output...
	(apply 'call-process progname nil '(t t) nil args))
      (if pop-buffer
	  (setq buffer-read-only t))
      (goto-char (point-min))
      (if pop-buffer
	  (let ((pop-up-windows t))
	    (pop-to-buffer (current-buffer)))
	(bury-buffer)))))

(defun my-vm-rblookup (ip-addr-or-name)
  "Run rblookup on the address or name given as IP-ADDR-OR-NAME, leaving output
in *VM-lookup-rblookup*."
  (interactive "sAddress or hostname for rblookup: ")
  (my-vm-run-lookup-prog "rblookup" (list ; "-v" is too verbose
				     ip-addr-or-name) (interactive-p)))

(defun my-vm-host-check (ip-addr)
  "Run `host -A' on the address given as IP-ADDR, leaving output in
*VM-lookup-host-A*."
  (interactive "sAddress or hostname for host -v -A: ")
  (if (not (interactive-p))
      (my-vm-run-lookup-prog "host" (list "-v" "-A" ip-addr) nil "*VM-lookup-host-A*"))
  (my-vm-run-lookup-prog "host" (list "-v" "-A" ip-addr) (interactive-p) "*VM-lookup-host-A*"))

(defun my-vm-jwhois (token)
  "Run jwhois on the address or name given as TOKEN, leaving output in
*VM-lookup-jwhois*."
  (interactive "sAddress or hostname for jwhois: ")
  (my-vm-run-lookup-prog "jwhois" (list token) (interactive-p)))

(defun my-vm-forward-spam ()
  "Local version of vm-forward-message that treats the message being forwarded
as spam and prepares information about its sources."
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  ;; note the magic use of `%UR', which calls `vm-summary-function-R'
  (let* ((vm-forwarding-subject-format
	  "forwarded spam/UCE from \"%UR\"\nSummary: original message sent %y/%M/%d-%h (%z)\n         with ID %i")
	 (mp (car (vm-select-marked-or-prefixed-messages 1)))
	 ;; we call `vm-summary-function-R' again to get the from-host string
	 (from-host (vm-summary-function-R mp)))
    ;; force simple encapsulation so the recipient doesn't need a MIME-capable
    ;; mailer to read this message...
    (my-vm-forward-message-using-rfc934)
    (string-match "[[)]\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)[])]" from-host)
    (let ((from-host-addr (match-string 1 from-host)))
      (mail-to)
      (insert "spam@cmds.spamcop.net")
      (replace-regexp "(locally authorised broken client using invalid hostname!) [^(]*" "INVALID-HOSTNAME")
      (undo-boundary)
      (if (<= (string-to-number from-host-addr) 0) ; XXX not a real test, but what the heck
	  (message (concat
		    "Apparently there is no IP address in `" from-host "'!"))
	(message (concat
		  "Getting info for `" from-host "' as `" from-host-addr "'..."))
	(my-vm-host-check from-host-addr)
	(my-vm-jwhois from-host-addr)
;;;	(my-vm-rblookup from-host-addr)
	(message (concat
		  "Getting info for `" from-host "' as `" from-host-addr "'... Done."))
	;; XXX this next bit should probably be a separate function....
	(let ((abuse-emails nil)
	      (look-for-more nil))
	  (save-window-excursion	; XXX is this necessary?
	    (save-excursion
	      (set-buffer (get-buffer "*VM-lookup-jwhois*"))
	      (setq case-fold-search t)
	      (goto-char (point-min))
	      (replace-string "
" "")	; XXX use the DOS EOL converter?
	      ;; XXX this next bit should also be a separate function as it is reused....
	      (goto-char (point-min))
	      ;; the obvious ARIN "{Org}AbuseEmail:" entries, plus other oddballs...
	      (while (re-search-forward "abuse.*mail[ \t]*:" nil t)
		(skip-chars-forward ": \t<" (point-at-eol))
		(let ((astart (point)))
		  (skip-chars-forward "^:, \"\t>" (point-at-eol))
		  (let ((addr (buffer-substring astart
						(point))))
		    (message "Found abuse*mail address: <%s>" addr)
		    (if (not (member addr abuse-emails))
			(setq abuse-emails (append abuse-emails
						   (list addr))))))
		(goto-char (point-at-eol)))
	      (if (or (not abuse-emails)
		      look-for-more)
		  (progn
		    (goto-char (point-min))
		    ;; the ARIN TechEmail: entries
		    (while (re-search-forward "tech.*mail[ \t]*:" nil t)
		      (skip-chars-forward ": \t<" (point-at-eol))
		      (let ((astart (point)))
			(skip-chars-forward "^:, \"\t>" (point-at-eol))
			(let ((addr (buffer-substring astart
						      (point))))
			  (message "Found tech*mail address: <%s>" addr)
			  (setq look-for-more t) ; go on for admins too!
			  (if (not (member addr abuse-emails))
			      (setq abuse-emails (append abuse-emails
							 (list addr))))))
		      (goto-char (point-at-eol))))
		(message "[Not looking for more tech*mail entries..."))
	      (if (or (not abuse-emails)
		      look-for-more)
		  (progn
		    (goto-char (point-min))
		    ;; the ARIN AdminEmail: entries
		    (while (re-search-forward "admin.*mail[ \t]*:" nil t)
		      (skip-chars-forward ": \t<" (point-at-eol))
		      (let ((astart (point)))
			(skip-chars-forward "^:, \"\t>" (point-at-eol))
			(let ((addr (buffer-substring astart
						      (point))))
			  (message "Found admin*mail address: <%s>" addr)
			  (setq look-for-more nil)
			  (if (not (member addr abuse-emails))
			      (setq abuse-emails (append abuse-emails
							 (list addr))))))
		      (goto-char (point-at-eol))))
		(message "[Not looking for more admin*mail entries..."))
	      ;; anything else that might look obvious
	      (progn
		(goto-char (point-min))
		(while (search-forward "abuse@" nil t)
		  (goto-char (match-beginning 0))
		  (skip-chars-backward "^:, \t<" (point-at-bol))
		  (let ((astart (point)))
		    (skip-chars-forward "^:, \"\t>" (point-at-eol))
		    (let ((addr (buffer-substring astart
						  (point))))
		      (message "Found abuse@ address: <%s>" addr)
		      (if (string-equal addr "mail-abuse@nic.br")
			  (setq look-for-more t))
		      (if (not (member addr abuse-emails))
			  (setq abuse-emails (append abuse-emails
						     (list addr))))))
		  (goto-char (point-at-eol))))
	      (if (or (not abuse-emails)
		      look-for-more)
		  (progn
		    (goto-char (point-min))
		    ;; other *mail: entries
		    (while (re-search-forward "mail[ \t]*:" nil t)
		      (skip-chars-forward ": \t<" (point-at-eol))
		      (let ((astart (point)))
			(skip-chars-forward "^:, \"\t>" (point-at-eol))
			(let ((addr (buffer-substring astart
						      (point))))
			  (message "Found mail: address: <%s>" addr)
			  (setq look-for-more nil)
			  (if (not (member addr abuse-emails))
			      (setq abuse-emails (append abuse-emails
							 (list addr))))))
		      (goto-char (point-at-eol))))
		(message "[Not looking for more mail: entries..."))
	      (if (or (not abuse-emails)
		      look-for-more)
		  (progn
		    (goto-char (point-min))
		    ;; the whois.nic.ad.jp entries
		    (while (search-forward "[Reply Mail]" nil t)
		      (skip-chars-forward ": \t<" (point-at-eol))
		      (let ((astart (point)))
			(skip-chars-forward "^, \"\t>" (point-at-eol))
			(let ((addr (buffer-substring astart
						      (point))))
			  (message "Found reply-mail address: <%s>" addr)
			  (setq look-for-more nil)
			  (if (not (member addr abuse-emails))
			      (setq abuse-emails (append abuse-emails
							 (list addr))))))
		      (goto-char (point-at-eol))))
		(message "[Not looking for more reply-mail entries..."))
	      (if (or (not abuse-emails)
		      look-for-more)
		  (progn
		    (goto-char (point-min))
		    ;; whois servers that use the old un-tagged format
		    (while (search-forward "@" nil t)
		      (skip-chars-backward "^:, \t<" (point-at-bol))
		      (let ((astart (point)))
			(skip-chars-forward "^:, \"\t>" (point-at-eol))
			(let ((addr (buffer-substring astart
						      (point))))
			  (message "Found un-tagged address: <%s>" addr)
			  (if (not (member addr abuse-emails))
			      (setq abuse-emails (append abuse-emails
							 (list addr))))))
		      (goto-char (point-at-eol))))
		(message "[Not looking for more reply-mail entries..."))
	      ;; deal with those most stupid idiots using the *.rima-tde.net reverse-DNS
	      (progn
		(goto-char (point-min))
		(while (search-forward "nemesys@" nil t)
		  (if (not (member "You MUST have an ABUSE Mailbox <abuse@rima-tde.net>" abuse-emails))
		      (setq abuse-emails (append abuse-emails
						 (list
						  "You MUST have an ABUSE Mailbox <abuse@rima-tde.net>"))))
		  (goto-char (match-beginning 0))
		  (skip-chars-backward "^:, \t<" (point-at-bol))
		  (let ((astart (point)))
		    (skip-chars-forward "^, \"\t>" (point-at-eol))
		    (let ((addr (buffer-substring astart
						  (point))))
		      (message "Found nemesys@ address: <%s>" addr)
		      (if (not (member addr abuse-emails))
			  (setq abuse-emails (append abuse-emails
						     (list addr))))))
		  (goto-char (point-at-eol))))))
	  (if abuse-emails
	      (progn
		(message "Found addresses: ")
		(princ abuse-emails t)
		;; XXX should do something to remove "mailto:" prefixes from
		;; the likes of proxad.net's addresses.
		(mail-to)
		(insert (concat ", "
				(mapconcat 'append abuse-emails ", "))))))
	(mail-text)
	(insert (concat "\n$ host -v -A " from-host-addr "\n"))
	(insert-buffer-substring "*VM-lookup-host-A*")
	(insert "\n")
;;;	(undo-boundary)
;;;	(insert (concat "\n$ jwhois " from-host-addr "\n"))
;;;	(insert-buffer-substring "*VM-lookup-jwhois*")
;;;	(insert "\n")
;;;	(undo-boundary)
;;;	(insert (concat "\n$ rblookup " from-host-addr "\n"))
;;;	(insert-buffer-substring "*VM-lookup-rblookup*")
;;;	(insert "\n")
	(undo-boundary)
	(mail-to)))))

(define-key vm-mode-map "\eZ" 'my-vm-forward-spam) ; use default (mime)

(defun my-vm-forward-fraud ()
  "Local version of vm-forward-message that treats the message being forwarded
as fraud and prepares information about its sources."
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  ;; note the magic use of `%UR', which calls `vm-summary-function-R'
  (let* ((vm-forwarding-subject-format
	  "forwarded FRAUD from \"%UR\"\nSummary: original message sent %y/%M/%d-%h (%z)\n         with ID %i")
	 (mp (car (vm-select-marked-or-prefixed-messages 1)))
	 ;; we call `vm-summary-function-R' again to get the from-host string
	 (from-host (vm-summary-function-R mp)))
    ;; force simple encapsulation so the recipient doesn't need a MIME-capable
    ;; mailer to read this message...
    (my-vm-forward-message-using-rfc934)
    (string-match "[[)]\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)[])]" from-host)
    (let ((from-host-addr (match-string 1 from-host)))
      (mail-to)
      (insert "spam@cmds.spamcop.net")
      (undo-boundary)
      (if (<= (string-to-number from-host-addr) 0) ; XXX not a real test, but what the heck
	  (message (concat
		    "Apparently there is no IP address in `" from-host "'!"))
	(message (concat
		  "Getting info for `" from-host "' as `" from-host-addr "'..."))
	(my-vm-host-check from-host-addr)
	(my-vm-jwhois from-host-addr)
	(message (concat
		  "Getting info for `" from-host "' as `" from-host-addr "'... Done."))
	(mail-text)
	(insert (concat "\n$ host -v -A " from-host-addr "\n"))
	(insert-buffer-substring "*VM-lookup-host-A*")
	(insert "\n")
	(undo-boundary)
	(insert (concat "\n$ jwhois " from-host-addr "\n"))
	(insert-buffer-substring "*VM-lookup-jwhois*")
	(insert "\n")
	(undo-boundary)))))

(define-key vm-mode-map "\eF" 'my-vm-forward-fraud) ; use default (mime)

(defun vm-summary-function-R (mp)
  "Local function to extract first interesting next-hop host from the received
headers of message MP.  Called by `vm-forward-message' when
`vm-forwarding-subject-format' contains the magic format string `%UR'."
  (let ((from-host nil)
	;; gather the content of all the received headers into a string and
	;; split this string into a list of words.
	(split-rcvd (split-string (vm-get-header-contents mp "Received:" " Received: "))))

    ;; search for the first word following an occurance of the keyword "from"
    ;; that is not followed by a host/addr string matching one that commonly
    ;; forwards messages to us.
    ;;
    ;;(message (concat "STARTING new parse of: " (mapconcat 'concat split-rcvd " ") "\n"))
    (while (and (>= (length split-rcvd) 2)
		(not from-host))
      (catch 'next-token
	(let ((key (car split-rcvd))
	      (value (car (cdr split-rcvd))))
	  ;;(message (concat "KEY is: '" key "', VALUE is: '" value "'"))
	  (if (string-equal key "from")
	      (progn
		(setq split-rcvd (cdr split-rcvd)) ; be sure to skip key ...
		;; This shouldn't happen, but sometimes mailers forget to
		;; properly quote hostnames that need quoting to appear in
		;; RFC-822 headers.  Also sometimes the optional comment
		;; containing the TCP info is in the next token.  Try
		;; concatenating another word if the value doesn't contain a
		;; commented IP address literal.
		(while (and (car (cdr split-rcvd))
			    (not (string-match "[[(][0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+[])]" value)))
		  ;; we also need to deal with incomplete timestamp lines --
		  ;; e.g. those that don't contain a TCP info comment
		  (setq split-rcvd (cdr split-rcvd))
		  (let ((next-token (car split-rcvd)))
		    (if (or (string-equal next-token "Received:")
			    (string-equal next-token "by"))
			;; seeing "Received:" or "by" means we need to restart
			;; collecting `value' again so throw away what have
			;; collected so far and continue the outer loop
			(progn
			  ;;(message (concat "FOUND '" next-token "', jumping to outer loop"))
			  (setq value "")
			  (throw 'next-token t))
		      ;; else we have a good token to append to `value'
		      ;;(message (concat "CURRENT value is: '" value "', APPENDING: '" next-token "'"))
		      (setq value (concat value
					  (if (and (not (string-equal "" value))
						   (not (string-match "(" next-token 0)))
					      " ")
					  next-token)))))
		(if (string-match "(client is using the wrong hostname!) *" value 0)
		    (setq value (replace-match "" t t value)))
		;; append any missing closing paren...
		(if (and (string-match ".*(" value 0)
			 (not (string-match ".*)" value 0)))
		    (setq value (concat value ")")))
		;; skip all the mailers were I have local aliases forwarded to me
		;;(message (concat "FINAL value is: '" value "'"))
		(if (and (not (string-match ".*\\.weird\\.com *\\(( *\\[204\\.92\\.254.[0-9]+\\][^\)]*)\\)?" value 0))
			 (not (string-match "whome.planix.com *\\(([204.29.161.33])\\)?" value 0))
			 (not (string-match "druid.net *\\(([216.126.72.98])\\)?" value 0))
			 (not (string-match "gateway.tectrol.com *\\(([207.219.105.6])\\)?" value 0))
			 (not (string-match "gateway.tectrol.com *\\((gateway.tectrol.ca[207.219.105.6])\\)?" value 0))
			 (not (string-match "server.proxy.net *\\(([198.96.186.33])\\)?" value 0))
			 (not (string-match "fw.protagon.com *\\(([216.191.74.18])\\)?" value 0))
			 (not (string-match "mail.netbsd.org *\\(([155.53.1.253])\\)?" value 0)) ; this doesn't work well -- qmail SUCKS!
			 (not (string-match "camomile.cloud9.net *\\(([168.100.1.3])\\)?" value 0))
			 (not (string-match "russian-caravan.cloud9.net *\\(([168.100.1.4])\\)?" value 0))
			 (not (string-match "localhost *\\((localhost [127.0.0.1])\\)?" value 0)) ; also for cloud9.net
			 (not (string-match "localhost.cloud9.net *\\((localhost.cloud9.net [127.0.0.1])\\)?" value 0))
			 (not (string-match "camomile.cloud9.net *\\((localhost.cloud9.net [127.0.0.1])\\)?" value 0))
			 (not (string-match "russian-caravan.cloud9.net *\\((localhost [127.0.0.1])\\)?" value 0))
			 (not (string-match "corporate.aci.on.ca *\\(([205.207.148.249])\\)?" value 0))
			 (not (string-match "corporate.aci.on.ca *\\(([205.207.148.12])\\)?" value 0))
			 (not (string-match "corporate.aci.on.ca *\\((dns.aci.on.ca[205.207.148.12])\\)?" value 0))
			 (not (string-match "aci.on.ca *\\((ipass.aci.on.ca[205.207.148.15])\\)?" value 0))
			 (not (string-match "admin.aci.on.ca *\\(([205.207.148.250])\\)?" value 0))
			 (not (string-match "public.aci.on.ca *\\(([205.207.148.251])\\)?" value 0))
			 (not (string-match "aci.on.ca *\\(([205.207.148.251])\\)?" value 0)))
		    (setq from-host value))))
	  (setq split-rcvd (cdr split-rcvd)))))
    (if (not from-host)
	(setq from-host "(unknown)"))
    ;; return the string containing the most interesting next-hop host
    from-host))

;;;
;;; from Jukka Partanen <jukka.partanen@research.nokia.com>.
;;;
(if (>= vm-version-number 6.0)
    (progn
      (defun vm-mime-delete-mime-body-part (&optional layout)
	"Delete the mime body part at the point"
	(interactive)
	(if (not layout)
	    (setq layout
		  (if (and vm-fsfemacs-p (= emacs-major-version 19))
		      (let (o-list (overlays-at (point)))
			(while (and o-list
				    (not (overlay-get (car o-list) 'vm-mime-layout)))
			  (setq o-list (cdr o-list)))
			(car o-list))
		    (extent-at (point) nil 'vm-mime-layout))))
	(let ((mp vm-message-pointer)
	      start end buf)
	  (if (not layout)
	      (error "No MIME body at point!"))
	  (if (not (vectorp layout))
	      (setq layout (vm-extent-property layout 'vm-mime-layout)))
	  (setq start  (vm-mm-layout-header-start layout)
		end    (vm-mm-layout-body-end layout)
		buf	 (marker-buffer start))
	  (save-excursion
	    (set-buffer buf)
	    (vm-save-restriction
	     (widen)
	     (narrow-to-region (vm-headers-of (vm-real-message-of (car mp)))
			       (vm-text-end-of (vm-real-message-of (car mp))))
	     (let ((buffer-read-only nil)
		   (type (vm-get-header-contents (car mp) "Content-Type:"))
		   boundary)
	       (setq type (vm-mime-parse-content-header type ?\;))
	       (while type
		 (if (string-match "^boundary=" (car type))
		     (setq boundary (car (vm-parse (car type) "=\\(.+\\)"))
			   type nil)
		   (setq type (cdr type))))
	       (if (not boundary)
		   (error "Cannot find MIME boundary!"))
	       (goto-char start)
	       (if (not (re-search-backward (concat "\n--"
						    (regexp-quote boundary))
					    (point-min) t))
		   (error "Cannot find MIME boundary!"))
	       (delete-region (point) end)
	       (if (and (looking-at (concat "\n*--" (regexp-quote boundary) "--"))
			(not (re-search-backward (concat "^--"
							 (regexp-quote boundary))
						 (point-min) t)))
		   (insert (concat "\n--" boundary "\n\n")))))
	    (vm-discard-cached-data)
	    (vm-set-edited-flag-of (car mp) t)
	    (vm-show-current-message))))
      (define-key vm-mode-map "X" 'vm-mime-delete-mime-body-part)))

;;;
;;; some more enhancements
;;;
;;; borrowed from gnuspost.el and then greatly re-mangled....
;;;

;; a real nasty hack to force a reload to re-eval all the variable settings
;; that use mail-local-domain-name...
;;
;; ARGH!  This doesn't seem to be working!
;;
(defadvice set-new-mail-local-domain-name (after my-vm-set-new-mail-local-domain-name activate)
  "Also call vm-load-init-file after set-new-local-domain-name."
  (vm-load-init-file t))

(if (not (fboundp 'vm-generate-message-id))
    (defun vm-generate-message-id ()
      "Generate unique Message-Id value for user."
      (concat "<" (vm-unique-id) "@" (system-name) ">")))

(if (not (fboundp 'vm-unique-id))
    (defun vm-unique-id ()
      "Generate unique ID from user name and current time."
      (let ((date (current-time-string))
	    (name (user-login-name)))
	(if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
			  date)
	    (concat (upcase name) "."
		    (substring date (match-beginning 6) (match-end 6)) ;Year
		    (substring date (match-beginning 1) (match-end 1)) ;Month
		    (substring date (match-beginning 2) (match-end 2)) ;Day
		    (substring date (match-beginning 3) (match-end 3)) ;Hour
		    (substring date (match-beginning 4) (match-end 4)) ;Minute
		    (substring date (match-beginning 5) (match-end 5)) ;Second
		    )
	  (error "Cannot understand current-time-string: %s." date)))))

;;;
;;; this borrowed from gnus-art.el....
;;;
(defun vm-url-unhex (x)
  "Convert X from a hex representation to the actual value."
  (if (> x ?9)
      (if (>= x ?a)
          (+ 10 (- x ?a))
        (+ 10 (- x ?A)))
    (- x ?0)))

;;;
;;; this also borrowed from gnus-art.el....
;;;
(defun vm-url-unhex-string (str &optional allow-newlines)
  "Return a string with the %XX embedded codes removed from the url giving in STR.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding."
  (setq str (or str ""))
  (let ((tmp "")
        (case-fold-search t))
    (while (string-match "%[0-9a-f][0-9a-f]" str)
      (let* ((start (match-beginning 0))
             (ch1 (vm-url-unhex (elt str (+ start 1))))
             (code (+ (* 16 ch1)
                      (vm-url-unhex (elt str (+ start 2))))))
        (setq tmp (concat
		  tmp (substring str 0 start)
		  (cond
		   (allow-newlines
		    (char-to-string code))
		   ((or (= code ?\n) (= code ?\r))
		    " ")
		   (t (char-to-string code))))
	     str (substring str (match-end 0)))))
    (setq tmp (concat tmp str))
    tmp))

;;; Turn this horror of a URL:
;;;
;;;	http://angelfire.com%40%77%77%77%2E%63%79ber%67%61%74%65w%61%79%2E%6E%65%74/t%68e%72%65%6D%6F%76e%31/r%65%6Do%76%65%2E%68%74%6D#@f%72%65%65%79%65%6C%6C%6Fw.%63%6F%6D/%6D%65%6D%62%65%72%73/b%69%67%6Der%63%68a%6E%74%73%74%75%66%66/i%6Edex%2E%68%74%6D%6C
;;;
;;; into this at least semi-readable URL:
;;;
;;;	http://angelfire.com@www.cybergateway.net/theremove1/remove.htm#@freeyellow.com/members/bigmerchantstuff/index.html
;;;
(defun vm-url-unhex-region (beg end)
  "Remove %XX embedded codes in a URL marked as the current region."
  (interactive "r")
  (if (integerp end)			; dunno -- was in morse.el (allow point + extent?)
      (setq end (copy-marker end)))
  (save-excursion
    (let ((str (buffer-substring beg end)))
      (goto-char beg)
      (delete-region beg end)
      (insert (vm-url-unhex-string str)))))


;;; Message-ID: <4vnura$cgr@nnrp1.news.primenet.com>
;;; From: edwinh@primenet.com (Edwin Huffstutler)
;;; Date: 24 Aug 1996 15:14:02 -0700
;;; Subject: Remove "extra" text from replies
;;; Summary: functions to remove .sigs, double citations
;;; 
;;; Create a function to nuke a .sig from replied-to mail (if it exists).
;;; Find the end of the buffer, back up over my .sig, then delete up to
;;; the beginning of the quoted .sig.
;;
(defun citation-kill-sig ()
  "Nuke a .sig from cited mail"
  (interactive)
  (save-excursion
    (goto-char (point-max))
    (search-backward-regexp "^-- $" 1 t)
    (let ((top-of-my-sig (point)))
      (search-backward-regexp
       (concat "^" vm-included-text-prefix "-- $") 1 t)
      (delete-region (point) top-of-my-sig)
      )))

(add-hook 'vm-reply-hook
	  'citation-kill-sig)

;;; more from: edwinh@primenet.com (Edwin Huffstutler)
;;; 
;;; This next one I bind to C-c C-d in a reply buffer, and it deletes anything
;;; that has been quoted twice, and removes included-text-prefixes on blank
;;; lines.  (I just think it looks cleaner that way, as I usually reply to
;;; each paragraph of the mail separately)
;;; 
;;; define a function to remove doubly-cited stuff
;;
(defun citation-kill-double ()
  "Remove doubly-cited text and extra lines in a mail message"
  (interactive)
  (save-excursion
    ;;; nuke the quoted quoted text
    ;;(beginning-of-buffer)
    ;;(replace-regexp
    ;; (concat "^" vm-included-text-prefix "\\sw*[>|}].*\n") "")
    ;;; get rid of citation prefix on blank lines
    (beginning-of-buffer)
    (replace-regexp
     (concat "^" vm-included-text-prefix "$") "")
    ;;; replace more than two newlines with just two
    (beginning-of-buffer)
    (replace-regexp "\n\n+" "\n\n")
    ;;; get rid of double attribution text
    ;;(beginning-of-buffer)
    ;;(replace-regexp
    ;; (concat "^" vm-included-text-prefix "\\[ .*wrote.*\\]\n\\|"
    ;;         "^" vm-included-text-prefix ".*wrote:\n") "")
    ))

(defun citation-set-kill-double-binding ()
  "Set the binding for citation-kill-double"
  (local-set-key "\C-c\C-d" 'citation-kill-double))

(add-hook 'vm-reply-hook
	  'citation-set-kill-double-binding)

;;; From: newsspam2@robf.de
;;; Newsgroups: gnu.emacs.vm.info
;;; Subject: Re: Why do only some links get tagged and highlighted as html links?
;;; Date: 24 Jun 2003 08:34:42 +0200
;;; Message-ID: <86n0g8asql.fsf@robf.de>
;;;
;;; Without actually testing this, something like the following
;;; should highlight all URLs ...
;;
(defun my-vm-energize-urls-in-message ()
   (interactive)
   (save-excursion
     (vm-select-folder-buffer)
     (if vm-presentation-buffer (set-buffer vm-presentation-buffer))
     (vm-energize-urls-in-message-region (point-min) (point-max))))

(define-key vm-mode-map "E" 'my-vm-energize-urls-in-message)

;;;
;;;	some additional stuff for sendmail.el et al that's not in ~/.emacs...
;;;

;;; From: bhoylma@advtech.USWest.COM (Bruce W. Hoylman)
;;; SENDER: info-vm-request@uunet.uu.net
;;; Subject: Re: Newbie wants VM to auto-archive mail like (shudder) pine
;;; Date: 30 May 1995 10:57:11 -0600
;;
;; Mail archive filename defun
;;
(defun set-mail-archive-file-name ()
  "Set `mail-archive-file-name' based on the current date."
  (let ((date (current-time-string)))
    (string-match
     "^\\([A-Z][a-z][a-z]\\) \\([A-Z][a-z][a-z]\\) \\([0-9 ][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\(:[0-9][0-9]\\) [0-9][0-9]\\([0-9][0-9]\\)"
     date)
    (setq mail-archive-file-name
	  (concat vm-folder-directory
		  ".outgoing/"
		  (substring date (match-beginning 6)
			     (match-end 6))
		  "-"
		  (substring date (match-beginning 2)
			     (match-end 2))))))
(set-mail-archive-file-name)
(add-hook 'vm-mail-mode-hook 'set-mail-archive-file-name)

(defvar mail-default-organization "~/.organization"
  "The default name of your organization (or a filename containing a string
defining the organization name), if not set in the environment variable
ORGANIZATION.  If not nil, takes precedence over the file
{$LOCAL,/usr}/lib/news/organization.")

(setq mail-default-headers
      (concat
       (if (< vm-version-number 6.0)
	   (concat "X-Mailer: ViewMail (vm) Version "
		   vm-version
		   "\n\twith "
		   (emacs-version)
		   "\n"))
       (if (or mail-x-face-file
	       mail-default-x-face)
	   (let* ((x-face-file (expand-file-name mail-x-face-file "~"))
		  (x-face nil))
	     (if (file-exists-p x-face-file)
		 (let ((x-face-buffer (generate-new-buffer
				       (generate-new-buffer-name
					"x-facebuf"))))
		   (save-excursion
		     (set-buffer x-face-buffer)
		     (insert-file-contents x-face-file)
		     (goto-char (point-max))
		     (setq x-face (buffer-string))
		     (not-modified)
		     (kill-buffer nil))))
	     (if (and (not x-face)	; XXX SOMETHING does this!
		      mail-default-x-face)
		 (concat "X-face:"
			 (or x-face mail-default-x-face))
	       nil)))
       (concat "Organization: "
	       (let* ((org-list (list (getenv "ORGANIZATION")
				      mail-default-organization
				      (concat (or (getenv "LOCAL")
						  "/usr/")
					      "lib/news/organization")))
		      (org nil))
		 (while (and (not org)
			     (cdr org-list))
		   (let ((org-file (car org-list)))
		     (setq org-list (cdr org-list))
		     (cond ((not org-file)
			    (setq org nil))
			   ((file-name-absolute-p org-file)
			    (setq org-file (expand-file-name org-file "/"))
			    (if (file-exists-p org-file)
				(let ((org-buffer (generate-new-buffer
						   (generate-new-buffer-name
						    "orgbuf"))))
				  (save-excursion
				    (set-buffer org-buffer)
				    (insert-file-contents org-file)
				    (goto-char (point-max))
				    (let ((fill-prefix "\t")
					  (fill-column 72))
				      (fill-region (point-min) (point-max)))
				    (let ((end-pt (point)))
				      (skip-chars-backward "\ \t\n")
				      (delete-region (point) end-pt))
				    (setq org (buffer-string))
				    (not-modified)
				    (kill-buffer nil)))))
			   (t
			    (setq org org-file)))))
		 org)
	       "\n")))			; mail-mode needs the trailing newline,
					; VM will cope either way

;;;
;;;	VM fontification support...
;;;
;;; Currently we're using font-lock-mode to highlight headers and such.
;;; Ideally we would use the XEmacs highlight-headers package instead.
;;;

(defface vm-test-region-face
  '((((class color)
      (background dark))
     (:background "SteelBlue" :stipple "gray3"))
    (((class color)
      (background light))
     (:background "LightSteelBlue" :stipple "gray3"))
    (((class grayscale)
      (background dark))
     (:background "LightGray" :foreground "black" :stipple "gray3"))
    (((class grayscale)
      (background light))
     (:background "DimGray" :foreground "White" :stipple "gray3"))
    (((class mono)
      (background dark))
     (:background "White" :foreground "black" :stipple "gray3"))
    (((class mono)
      (background light))
     (:background "black" :foreground "White" :stipple "gray3"))
    (t
     (:background "gray")))
  "Used for displaying a test region.")

(defface vm-citation-face
  '((((class color)
      (background dark))
     (:foreground "Khaki" :italic t))
    (((class color)
      (background light))
     (:foreground "FireBrick" :italic t))
    (t
     (:italic t)))
  "Face for VM citation contents.")
(defvar vm-citation-face		'vm-citation-face
  "Face name to use for citation text.")

;; VM header font faces

(defface vm-header-from_-face
  '((((class color)
      (background dark))
     (:foreground "White" :bold t))
    (((class color)
      (background light))
     (:foreground "black" :bold t))
    (t
     (:bold t)))
  "Face for From_ content.")
(defvar vm-header-from_-face		'vm-header-from_-face
  "Face name to use for From_ content.")

(defface vm-header-name-face
  '((((class color)
      (background dark))
     (:foreground "White" :bold t))
    (((class color)
      (background light))
     (:foreground "black" :bold t))
    (t
     (:bold t)))
  "Face for VM header names.")
(defvar vm-header-name-face		'vm-header-name-face
  "Face name to use for header name.")

(defface vm-resent-header-name-face
  '((((class color)
      (background dark))
     (:foreground "Red" :bold t :italic t :underline t))
    (((class color)
      (background light))
     (:foreground "DarkGreen" :bold t :italic t :underline t))
    (t
     (:bold t :italic t :underline t)))
  "Face for VM From: header contents.")

(defface vm-header-content-face
  '((((class color)
      (background dark))
     (:foreground "White" :italic t))
    (((class color)
      (background light))
     (:foreground "black" :italic t))
    (t
     (:italic t)))
  "Face for generic VM header contents.")
(defvar vm-header-content-face		'vm-header-content-face
  "Face name to use for contents.")

(defface vm-header-from-face
  '((((class color)
      (background dark))
     (:foreground "Red" :bold t :underline t))
    (((class color)
      (background light))
     (:foreground "DarkGreen" :bold t :underline t))
    (t
     (:bold t :underline t)))
  "Face for VM From: header contents.")
(defvar vm-header-from-face		'vm-header-from-face
  "Face name to use for subject header contents.")

(defface vm-header-organization-face
  '((((class color)
      (background dark))
     (:foreground "SlateBlue" :italic t))
    (((class color)
      (background light))
     (:foreground "DarkSlateBlue" :italic t))
    (t
     (:italic t)))
  "Face for VM Organization: contents.")
(defvar vm-header-organization-face	'vm-header-organization-face
  "Face name to use for subject header contents.")

(defface vm-header-reply-face
  '((((class color)
      (background dark))
     (:foreground "blue" :bold t :underline t))
    (((class color)
      (background light))
     (:foreground "NavyBlue" :bold t :underline t))
    (t
     (:bold t :underline t)))
  "Face for VM Reply-To: header contents.")
(defvar vm-header-reply-face		'vm-header-reply-face
  "Face name to use for reply header contents.")

(defface vm-header-to-face
  '((((class color)
      (background dark))
     (:foreground "Green" :bold t :italic t))
    (((class color)
      (background light))
     (:foreground "ForestGreen" :bold t :italic t))
    (t
     (:italic t)))
  "Face for VM To: contents.")
(defvar vm-header-to-face		'vm-header-to-face
  "Face name to use for to header contents.")

(defface vm-header-cc-face
  '((((class color)
      (background dark))
     (:foreground "OrangeRed" :bold t :underline t))
    (((class color)
      (background light))
     (:foreground "DarkSeaGreen" :bold t :underline t))
    (t
     (:bold t :underline t)))
  "Face for VM Cc: header contents.")
(defvar vm-header-cc-face		'vm-header-cc-face
  "Face name to use for CC header contents.")

(defface vm-header-subject-face
  '((((class color)
      (background dark))
     (:foreground "Yellow" :bold t :italic t :underline t))
    (((class color)
      (background light))
     (:foreground "IndianRed" :bold t :italic t :underline t))
    (t
     (:bold t :italic t :underline t)))
  "Face for VM Subject: header contents.")

(defvar vm-header-subject-face		'vm-header-subject-face
  "Face name to use for subject header contents.")

(defface vm-header-bogo-face
  '((((class color)
      (background dark))
     (:foreground "LawnGreen" :bold t :italic t :strike-through "PaleGreen"))
    (((class color)
      (background light))
     (:foreground "DarkOliveGreen" :bold t :italic t :strike-through "black"))
    (t
     (:bold t :italic t :strike-through t)))
  "Mail X-Bogosity: header face")
(defvar vm-header-bogo-face		'vm-header-bogo-face
  "Face name to use for bogo header contents.")

(defface vm-header-bogo-emph-face
  '((((class color)
      (background dark))
     (:foreground "Red" :bold t :italic t :strike-through "OrangeRed"))
    (((class color)
      (background light))
     (:foreground "IndiaRed3" :bold t :italic t :strike-through "black"))
    (t
     (:bold t :italic t :strike-through t)))
  "Mail bogofilter emphasis face")
(defvar vm-header-bogo-emph-face	'vm-header-bogo-emph-face
  "Face name to use for bogo header contents.")

;; Magic multi-line content regex from
;; http://www-xray.ast.cam.ac.uk/~gmorris/dotvm.txt
;;
(setq vm-font-lock-keywords
      (eval-when-compile
	(let* ((header-content "\\(.+\\)\\(\\(\n[ \t]+.*\\)*\\)")
	       (cite-chars "[>|}]")
	       (cite-prefix "A-Za-z")
	       (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
	  (list
	   '("^\\(From .*\\)\nX-VM"
	     (1 'vm-header-from_-face))
	   `(,(concat "^\\(Subject:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-subject-face nil t)
	     (3 'vm-header-subject-face nil t))
	   `(,(concat "^\\(From:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-from-face nil t)
	     (3 'vm-header-from-face nil t))
	   `(,(concat "^\\(Organization:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-organization-face nil t)
	     (3 'vm-header-organization-face nil t))
	   `(,(concat "^\\(Reply-To:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-reply-face nil t)
	     (3 'vm-header-reply-face nil t))
	   `(,(concat "^\\(To:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-to-face nil t)
	     (3 'vm-header-to-face nil t))
	   `(,(concat "^\\(Cc:\\) " header-content)
	     (1 'vm-header-name-face t t )
	     (2 'vm-header-cc-face nil t)
	     (3 'vm-header-cc-face nil t))
	   `("^\\(X-Bogosity:\\) \\([a-z]+\\)\\(.*\\)"
	     (1 'vm-header-bogo-face t t)
	     (2 'vm-header-bogo-emph-face nil t))
	   '("^X-Bogosity: .*\\(?:spamicity=\\)\\([.0-9]+\\)"
	     (1 'vm-header-bogo-emph-face t))
	   '("^X-Bogosity: .*\\(?:algorithm=\\)\\([a-z]+\\)"
	     (1 'vm-header-bogo-emph-face t))
	   ;; Resent-* headers
	   `(,(concat "^\\(resent-[^ \t\n:]+:\\) " header-content)
	     (1 'vm-resent-header-name-face t t)
	     (2 'vm-header-content-face nil t)
	     (3 'vm-header-content-face nil t))
	   ;; all the other headers
	   `(,(concat "^\\([a-z0-9_-]+:\\) " header-content)
	     (1 'vm-header-name-face t t)
	     (2 'vm-header-content-face nil t)
	     (3 'vm-header-content-face nil t))
	   ;; Citations -- this should only match in the body
	   ;; (borrowed from rmail-font-lock-keywords in rmail.el)
	   `(,cite-chars
	     (,(concat "\\=[ \t]*"
		       "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
		       "\\(" cite-chars "[ \t]*\\)\\)+"
		       "\\(.*\\)")
	      (beginning-of-line) (end-of-line)
	      (2 font-lock-constant-face nil t)
	      (4 vm-citation-face nil t)))))))

;;;; *** Rmail Local Fontification -- some clues for possible use with VM ***
;
;  (make-local-variable 'font-lock-defaults)
;  (setq font-lock-defaults
;        '(rmail-font-lock-keywords
;	  t nil nil nil
;	  (font-lock-maximum-size . nil)
;	  (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
;	  (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
;	  (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
;
;(defun rmail-fontify-buffer-function ()
;  ;; This function's symbol is bound to font-lock-fontify-buffer-function.
;  (make-local-hook 'rmail-show-message-hook)
;  (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
;  ;; If we're already showing a message, fontify it now.
;  (if rmail-current-message (rmail-fontify-message))
;  ;; Prevent Font Lock mode from kicking in.
;  (setq font-lock-fontified t))
;
;(defun rmail-unfontify-buffer-function ()
;  ;; This function's symbol is bound to font-lock-fontify-unbuffer-function.
;  (let ((modified (buffer-modified-p))
;	(buffer-undo-list t) (inhibit-read-only t)
;	before-change-functions after-change-functions
;	buffer-file-name buffer-file-truename)
;    (save-restriction
;      (widen)
;      (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
;      (remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
;      (font-lock-default-unfontify-buffer)
;      (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))
;
;(defun rmail-fontify-message ()
;  ;; Fontify the current message if it is not already fontified.
;  (if (text-property-any (point-min) (point-max) 'rmail-fontified nil)
;      (let ((modified (buffer-modified-p))
;	    (buffer-undo-list t) (inhibit-read-only t)
;	    before-change-functions after-change-functions
;	    buffer-file-name buffer-file-truename)
;	(save-excursion
;	  (save-match-data
;	    (add-text-properties (point-min) (point-max) '(rmail-fontified t))
;	    (font-lock-fontify-region (point-min) (point-max))
;	    (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))))
;

(defun vm-fontify ()
  "Turn on font-locking for a mail buffer."
  (make-local-variable 'font-lock-defaults)
  ;; fontify with keywords only (no syntax spec) [t] and ignore case [t]
  (set (make-local-variable 'font-lock-defaults)
       '(vm-font-lock-keywords t t))
  (turn-on-font-lock))

;; fontifying the whole buffer in older versions is too painful
;;
(if (>= emacs-major-version 21)
    (add-hook 'vm-mode-hook 'vm-fontify))

;; always fontify for presentation buffers -- they are just one message long.
;; Presentation buffers are used to display messages when some type of decoding
;; must be done to the message to make it presentable.  E.g. MIME decoding.
;;
(add-hook 'vm-presentation-mode-hook
	  'vm-fontify)

;; always fontify for composing new messages (note this has to be on
;; `vm-mail-hook', not on `vm-mail-setup-hook' or else the mail mode
;; fontification overrides)
;;
(add-hook 'vm-mail-hook
	  'vm-fontify)

;; always fontify for editing messages
;;
(add-hook 'vm-edit-message-hook
	  'vm-fontify)

;; This summary stuff is way too CPU intensive when you have as many virtual
;; folders open as I do (especially on a machine as slow as mine! ;-).
;;
;; Summary frame keywords
;(setq vm-summary-font-lock-keywords
;      '(("|> [^ ].*"		. font-lock-function-name-face)
;	("|>   .*"		. font-lock-comment-face)
;	("\\[list1\\]"		. font-lock-function-name-face)
;	("company1 \\| company2" . font-lock-function-name-face)
;	("\\[list2\\]"		. font-lock-variable-name-face)
;	("\\[list3\\]"		. font-lock-variable-name-face)
;	("\\[list4\\]"		. font-lock-type-face)
;	("\\[list5\\]"		. font-lock-comment-face)
;	("list6||\list7"	. font-lock-keyword-face)))

;(defun vm-summary-fontify ()
;  (make-local-variable 'font-lock-defaults)
;  (setq font-lock-defaults '(vm-summary-font-lock-keywords nil nil))
;  (turn-on-font-lock))

;(cond (window-system
;       (add-hook 'vm-summary-mode-hook
;		 'vm-summary-fontify)
;       (add-hook 'vm-summary-update-hook
;		 'vm-summary-fontify)
;       (add-hook 'vm-summary-mode-hook
;		 'vm-summary-fontify)
;       (add-hook 'vm-summary-update-hook
;		 'vm-summary-fontify)))

;;; Kyle's filladapt from http://www.wonderworks.com/
;;;
;;; WARNING:  elisp-file-in-load-path-p is a local function in my ~/.emacs.el
;;;
;;; The following has also been suggested:
;;;
;;;(add-hook 'mail-mode-hook
;;;       (lambda ()
;;;         (set (make-local-variable 'filladapt-token-table)
;;;          (cons '("\\(Resent-\\)?\\(To\\|C[Cc]\\|B[Cc][Cc]\\): " bullet)
;;;                filladapt-token-table)))
;;;       t)
;;;
(if (and (fboundp 'elisp-file-in-loadpath-p)
	 (elisp-file-in-loadpath-p "filladapt"))
    (progn
      (require 'filladapt)
      (add-hook 'message-mode-hook 'turn-on-filladapt-mode)
      (add-to-list 'filladapt-token-table '("To: " bullet))
      (add-to-list 'filladapt-token-table '("Resent-To: " bullet))
      (add-to-list 'filladapt-token-table '("BCC: " bullet))
      (add-to-list 'filladapt-token-table '("Resent-BCC: " bullet))
      (add-to-list 'filladapt-token-table '("Cc: " bullet))
      (add-to-list 'filladapt-token-table '("Resent-Cc: " bullet))))

;;; mailcrypt --- a simple interface to message encryption with PGP.
;;;
;;; WARNING:  elisp-file-in-load-path-p is a local function in my ~/.emacs.el
;;;
(if (and (fboundp 'elisp-file-in-loadpath-p)
	 (elisp-file-in-loadpath-p "mailcrypt"))
    (progn
      (load-library "mailcrypt")
      (mc-setversion "5.0")		; not using gpg :-)
      (setq mc-encrypt-for-me t)
      (setq mc-passwd-timeout 1800)
      (setq mc-pgp-always-sign t)
      ;; XXX this should be auto-set using the current 'From:'
      (setq mc-pgp50-user-id (concat (user-login-name) "@" mail-local-domain-name))
      (setq mc-pgp50-fetch-timeout 60)
      (setq mc-pgp50-keyserver-address "pgpkeys.mit.edu")
      (setq mc-pgp50-hkpserver-address "pgpkeys.mit.edu")
      (add-hook 'vm-mode-hook 'mc-install-read-mode)
      (add-hook 'vm-summary-mode-hook 'mc-install-read-mode)
      (add-hook 'vm-virtual-mode-hook 'mc-install-read-mode)
      (add-hook 'vm-mail-mode-hook 'mc-install-write-mode)))

;;;;
;;;;	 now the remaining bulk of the VM configuration variables:
;;;;

;; commented lines indicate changed values....  (from v6.75)
;;
(setq
;;;   vm-arrived-message-hook nil
;;;   vm-arrived-messages-hook nil
      vm-auto-center-summary nil	; never bother centering the arrow
      vm-auto-decode-mime-messages nil	; might miss text in preamble otherwise!
      vm-auto-displayed-mime-content-type-exceptions '("text/x-vcard"
						       "text/html"
						       ) ; vcard is *UGLY*
      vm-auto-displayed-mime-content-types '("text" ; all sub-parts implied
					     "multipart" ; all sub-parts implied
					     "message/rfc822"
					     ) ; we like text!
      vm-auto-folder-case-fold-search t	; so that vm-auto-folder-alist is simpler
      vm-auto-get-new-mail nil		; keep this manual for now
      vm-auto-next-message nil		; when you're at the bottom of the msg, stay there!
      vm-berkeley-mail-compatibility '(berkeley-unix netbsd)
      vm-check-folder-types t
      vm-circular-folders nil
      vm-confirm-new-folders t		; be careful!
      vm-confirm-quit t			; always ask about quitting
      vm-convert-folder-types t
      vm-crash-box "~/Mail/INBOX.CRASH"	; keep everything in the vm-folder-directory
      vm-crash-box-suffix nil
      vm-default-From_-folder-type 'From_
      vm-default-folder-permission-bits	?\600 ; (vm-octal 600), but vm-octal is not defined here
      vm-default-folder-type 'From_
      vm-default-new-folder-line-ending-type nil
      vm-default-window-configuration '((startup
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary)
					     (nil message))
					    ((nil nil nil t)
					     (nil nil nil nil))))))
					(quitting
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary)
					     (nil message))
					    ((nil nil nil t)
					     (nil nil nil nil))))))
					(reading-message
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary)
					     (nil message))
					    ((nil nil nil t)
					     (nil nil nil nil))))))
					(composing-message
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary) ; show summary too
					     (nil composition))
					    ((nil nil nil nil)
					     (nil nil nil t))))))
					(editing-message
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary) ; show summary too
					     (nil edit))
					    ((nil nil nil nil)
					     (nil nil nil t))))))
					(vm-summarize
					 ((((top . 70)
					    (left . 70)))
					  (((-
					     (0 0 80 10)
					     (0 10 80 40))
					    ((nil summary)
					     (nil message))
					    ((nil nil nil t)
					     (nil nil nil nil)))))))
      vm-delete-after-archiving nil
      vm-delete-after-bursting nil
      vm-delete-after-saving nil
      vm-delete-empty-folders t
      vm-digest-burst-type "guess"
      vm-digest-identifier-header-format "X-Digest: %s\n"
      vm-digest-center-preamble t
      vm-digest-preamble-format "\"%s\" (%F)"
      vm-digest-send-type (if (< vm-version-number 6.0)	; very pedantic...
			      "rfc934"
			    "mime")	; go for the good
;;;   vm-display-buffer-hook nil
      vm-display-using-mime t
      vm-display-xfaces t		; try this out
;;;   vm-edit-message-hook nil
      vm-edit-message-mode 'indented-text-mode ; slightly better than text-mode
      vm-fill-paragraphs-containing-long-lines nil
      vm-flush-interval t		; flush every change (emacs is unstable)
      vm-folder-directory "~/Mail/"	; my usual place
;;;   vm-folder-read-only nil		; don't set this (becomes buffer local!)
      vm-folders-summary-database "~/.vm.folders.db"
      vm-folders-summary-directories '("~/")
      vm-folders-summary-format "  %12f %4t total, %n new, %u unread, %s spooled, %d deleted\n"	; show deleted too
      vm-follow-summary-cursor t
;;;   vm-forward-message-hook nil
      vm-forwarded-headers nil
      vm-forwarding-digest-type  (if (< vm-version-number 6.0) ; very pedantic...
				     "rfc934"
				   "mime") ; go for the good
      vm-forwarding-subject-format "%s (forwarded)\nSummary: forwarded message from %F" ; much better!
      vm-frame-parameter-alist nil
      vm-frame-per-completion nil	; no extra frames!
      vm-frame-per-composition nil	; no extra frames!
      vm-frame-per-edit nil		; no extra frames!
      vm-frame-per-folder nil		; no extra frames!
      vm-frame-per-folders-summary nil
      vm-frame-per-help t		; ok, maybe one!
      vm-frame-per-summary nil
      vm-highlight-url-face 'bold-italic
      vm-highlighted-header-regexp "^From:\\|^Resent-[fF]rom:\\|^Subject:" ; highlight these headers
      vm-honor-page-delimiters nil
;;;   vm-icontopbm-program "icontopbm"	; properly set by code in vm-vars
;;;   vm-image-directory "/usr/local/share/emacs/site-lisp/vm/"
      vm-imagemagick-convert-program nil
      vm-imagemagick-identify-program nil
      vm-imap-bytes-per-session nil
      vm-imap-expunge-after-retrieving nil ; we'll do this manually, for now
      vm-imap-max-message-size nil
      vm-imap-messages-per-session nil
;;;   vm-imap-session-preauth-hook nil
;;;   vm-imap-server-list nil
      vm-in-reply-to-format "%i"
      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-included-text-discard-header-regexp nil
      vm-included-text-headers nil
      vm-included-text-prefix "> "
      vm-index-file-suffix nil
      vm-inhibit-startup-message t	; don't bother me with legalese
;;;   vm-init-file "~/.vm"
      vm-infer-mime-types t		; do guess application/octet-stream's
					; true type from attachment name using
					; vm-mime-attachment-auto-type-alist
      vm-invisible-header-regexp (concat "^Content-" "\\|"
					 "^In-[rR]eply-[tT]o:" "\\|"
					 "^[Mm]ail-[Ff]ollowup-[Tt]o:" "\\|"
					 "^Message-I[dD]:" "\\|"
					 "^M[iI][mM][eE]-" "\\|"
					 "^Old-Message-I[dD]:" "\\|"
					 "^Old-Return-Path:" "\\|"
					 "^Original-Message-I[dD]:" "\\|"
					 "^Original-Return-Path:" "\\|"
					 "^Path:" "\\|"
					 "^Received:" "\\|"
					 "^References:" "\\|"
					 "^Resent-Message-I[dD]:" "\\|"
					 "^Resent-Sender:" "\\|"
					 "^Return-Path:" "\\|"
					 "^Sender:" "\\|" "^SENDER:" "\\|"
					 "^Status:" "\\|"
					 "^X-[Aa]ck:" "\\|"
					 "^X-[Bb]een[Tt]here:" "\\|"
					 "^X-[fF]ace:" "\\|"
					 "^X-[lL]oop:" "\\|"
					 "^X-Mailman-Version:" "\\|"
					 "^X-[mM][iI][mM][eE]" "\\|"
					 "^X-[mM][sS][mM]ail" "\\|"
					 "^X-[Nn]o-[Aa]rchive:" "\\|"
					 "^X-Original-Received:" "\\|"
					 "^X-[pP][gG][pP]" "\\|"
					 "^X-PMAS" "\\|"
					 "^X-[rR][eE][fF]" "\\|"
					 "^X-Received:" "\\|"
					 "^X-Sender:" "\\|"
					 "^X-Sieve:" "\\|"
					 "^X-Status:" "\\|"
					 "^X-UIDL:" "\\|"
					 "^X-VM-" "\\|"
					 "^X[rR][eE][fF]:"
					 )	; these are all ugly!
      vm-jump-to-new-messages t
      vm-jump-to-unread-messages t
      vm-keep-crash-boxes "~/tmp/"	; crash inbox saviour
      vm-keep-sent-messages 30		; keep a few for reference
      vm-lynx-program "lynx"
      vm-mail-check-interval nil	; don't bother -- we don't show  mail-waiting indicator
      vm-mail-header-from  (concat "\"" (user-full-name) "\" <"
				   (user-login-name) "@" mail-local-domain-name ">") ; this is also for resent-from
      vm-mail-header-insert-date nil	; don't do this!
      vm-mail-header-insert-message-id nil ; don't do this either!
;;;   vm-mail-hook nil
;;;   vm-mail-mode-hook nil
;;;   vm-mail-send-hook nil
      vm-make-crash-box-name nil
      vm-make-spool-file-name nil
      vm-mime-7bit-composition-charset "us-ascii"
      vm-mime-8bit-composition-charset "iso-8859-1"
      vm-mime-8bit-text-transfer-encoding '8bit	; just send it, damn it!
						; messages containing lines
						; matching "^From " or "^\.$"
						; will cause
						; `vm-mime-8bit-text-transfer-encoding'
						; to be ignored and the message
						; to be encoded with
						; "quoted-printable" regardless
						; and regions containing any
						; NUL or CR chars will be
						; encoded with "binary"
      vm-mime-alternative-select-method '(favorite "text/plain" 'best-internal)
      vm-mime-attachment-auto-suffix-alist '(("image/jpeg" . ".jpeg") ; that's JPEG, not JPG!
					     ("image/gif" . ".gif")
					     ("image/png" . ".png")
					     ("image/tiff" . ".tiff")
					     ("image/xpm" . ".xpm")
					     ("text/html" . ".html")
					     ("audio/basic" . ".au")
					     ("audio/x-gsm" . ".gsm")
					     ("audio/mpeg" . ".mp3")
					     ("audio/ogg" . ".ogg")
					     ("audio/x-mpeg" . ".mp3")
					     ("video/mpeg" . ".mpeg") ; and MPEG!
					     ("video/quicktime" . ".mov")
					     ("application/mac-binhex40" . ".hqx")
					     ("application/postscript" . ".ps")
					     ("application/pdf" . ".pdf")
					     ("application/vnd.ms-excel" . ".xls")
					     ("application/x-dvi" . ".dvi")
					     ("application/zip" . ".zip"))
      vm-mime-attachment-auto-type-alist '(("\\.jpe?g$" . "image/jpeg")
					   ("\\.gif$" . "image/gif")
					   ("\\.png$" . "image/png")
					   ("\\.tiff?$" . "image/tiff")
					   ("\\.xpm$"   . "image/xpm")
					   ("\\.html?$" . "text/html")
					   ("\\.au$" . "audio/basic")
					   ("\\.gsm$" . "audio/x-gsm")
					   ("\\.mp3$" . "audio/mpeg")
					   ("\\.mpe?g$" . "video/mpeg")
					   ("\\.mov$" . "video/quicktime")
					   ("\\.dvi$" . "application/x-dvi")
					   ("\\.pdf$" . "application/pdf")
					   ("\\.e?ps$" . "application/postscript")
					   ("\\.xls$" . "application/vnd.ms-excel"))
      vm-mime-attachment-save-directory "~/" ; put us home by default
      vm-mime-avoid-folding-content-type t
      vm-mime-base64-decoder-program "base64-decode" ; let's assume it's installed
      vm-mime-base64-decoder-switches nil
      vm-mime-base64-encoder-program "base64-encode" ; let's assume it's installed
      vm-mime-base64-encoder-switches nil
      vm-mime-button-face 'gui-button-face
      vm-mime-button-format-alist '(("text" . "%-35.35(%d, %c%) [%k to %a]")
				    ("multipart/alternative" .
				     "%-35.35(%d%) [%k to %a]")
				    ("multipart/digest" .
				     "%-35.35(%d, %n message%s%) [%k to %a]")
				    ("multipart" .
				     "%-35.35(%d, %n part%s%) [%k to %a]")
				    ("message/partial" .
				     "%-35.35(%d, part %N (of %T)%) [%k to %a]")
				    ("message/external-body" .
				     "%-35.35(%d%) [%k to %a (%x)]")
				    ("message" . "%-35.35(%d%) [%k to %a]")
				    ("audio" . "%-35.35(%d%) [%k to %a]")
				    ("video" . "%-35.35(%d%) [%k to %a]")
				    ("image" . "%-35.35(%d%) [%k to %a]")
				    ("application/octet-stream" .
				     "%-35.35(%d, %f%) [%k to %a]")
				    )
      vm-mime-charset-converter-alist nil
      vm-mime-charset-font-alist '(("x-unknown" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-1")
				   ("us-ascii" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-1")
				   ("iso-8859-1" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-1")
				   ("iso-8859-2" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-2")
				   ("iso-8859-3" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-3")
				   ("iso-8859-4" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-4")
				   ("iso-8859-5" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-5")
				   ("iso-8859-7" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-7")
				   ("iso-8859-8" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-8")
				   ("iso-8859-9" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-9")
				   ("iso-8859-15" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-iso8859-1")
				   ("koi8" . "-etl-*-medium-r-normal-*-16-*-*-*-c-*-koi8-1")
				   )	; this should be smarter and use preferred-frame-font
      vm-mime-confirm-delete t
      vm-mime-decode-for-preview nil	; this is a huge bloody waste of time!
      vm-mime-default-face-charset-exceptions nil
      vm-mime-default-face-charsets '("us-ascii"
				      "iso-8859-1"
				      "iso-8859-15"
				      "x-unknown" ; pine sometimes uses x-unknown!
				      "Windows-1251" ; non-standard crappy M$ crud
				      "Windows-1252" ; non-standard crappy M$ crud
				      "Windows-1257" ; non-standard crappy M$ crud
				      )
      vm-mime-delete-after-saving nil
      vm-mime-delete-viewer-processes t
      vm-mime-digest-discard-header-regexp "X400-|x-uidl" ; yucky headers
      vm-mime-digest-headers nil	; digest all the rest
      vm-mime-display-function nil
      ;; the next should be set automatically from ~/.mailcap
      vm-mime-external-content-types-alist '(("image/gif" 	"xv") ; RMS hates GIF so it must be displayed externally
					     ("image"	 	"xv") ; so why not other types too?
;;;	use lynx -dump			     ("text/html" 	"xterm -e links") ; links RULES!
					     ("audio/mpeg" 	"mpg123")
					     ("audio/ogg" 	"ogg123")
					     ("audio/x-gsm"	"gsmplay %f")
					     ("audio/x-mpeg" 	"mpg123")
					     ("video/mpeg" 	"mpeg_play -dither fs4") ; need "-dither color2" on 16-bit or better displays
					     ("video" 		"xanim")
					     ("application/pdf" "gv -spartan -scale 2")
					     ("application/postscript" "gv -spartan -scale 2")
					     ) ; basically from the example
      vm-mime-forward-local-external-bodies nil
      vm-mime-ignore-composite-type-opaque-transfer-encoding t
      vm-mime-ignore-mime-version t
      vm-mime-ignore-missing-multipart-boundary t
      vm-mime-internal-content-type-exceptions '("text/html") ; always do HTML _externally_
      vm-mime-internal-content-types t
      vm-mime-max-message-size 100000	; that's more than big enough!
      ;;
      ;; is this the only way to get a charset alias into place?
      ;;
      ;;    vm-mime-mule-charset-to-coding-alist (append
      ;;					    vm-mime-mule-charset-to-coding-alist
      ;;					    '("gb2312" cn-gb-2312)
      ;;					    '("big5" chinese-big5))
      ;;
      ;;
      ;; Emacs-20 cannot handle UTF-8, but if you only expect Latin1 characters
      ;; you can do this:
      ;;
      ;; (add-to-list 'vm-mime-mule-charset-to-coding-alist '("utf-8" iso-8859-1))
      ;;
      ;; and within Emacs 19, you can
      ;;
      ;; (add-to-list 'vm-mime-charset-font-alist '("utf-8" . "some-font-spec"))
      ;;
      vm-mime-qp-decoder-program "qp-decode" ; assume it's there
      vm-mime-qp-decoder-switches nil
      vm-mime-qp-encoder-program "qp-encode" ; assume it's there
      vm-mime-qp-encoder-switches nil
      vm-mime-type-converter-alist '(("application/msword"	"text/plain"	"antiword -t -")
				     ("application/ms-word"	"text/plain"	"antiword -t -")
				     ("text/html" "text/plain" "lynx -dump -term=dumb -force_html -stdin")
				     )	; why I should even mention this, I do not know....
      vm-mime-use-image-strips t
      vm-mime-use-w3-for-text/html nil	; we don't do no stinking HTML in e-mail!!!
      vm-mime-uuencode-decoder-program "uudecode"
      vm-mime-uuencode-decoder-switches nil
;;;   vm-mode-hook nil
;;;   vm-mode-hooks nil			; old name, pre-6.0
      vm-mode-line-format '("" "  %&%& "
			    ("VM: " minor-mode-alist " "
			     (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
			       " (of " 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) ; show minor-mode
							   ; too, but not the
							   ; version ID, nor
							   ; the "mail-waiting"
							   ; indicator (it is
							   ; sufficient to use
							   ; xbuffy et al!)
      vm-mosaic-program "Mosaic"
      vm-mosaic-program-switches nil
      vm-move-after-deleting t		; keep on rolling
      vm-move-after-killing t		; keep on rolling
      vm-move-after-undeleting nil
      vm-move-messages-physically nil
      vm-movemail-program "movemail"
      vm-mutable-frames nil		; leave my frames alone!
      vm-mutable-windows t
;;; because of the silly way call-process works, and the horrid syntax
;;; of netscape's -remote option you'll need a script like this in order
;;; to start netscape on a remote host:
;;;
;; #! /bin/sh
;; 
;; NETSCAPEHOST=proven
;; NETSCAPEPATH=/usr/local/bin/netscape
;; 
;; if [ $# -eq 2 -a X"$1" = X"-remote" ] ; then
;; 	rsh $NETSCAPEHOST $NETSCAPEPATH -display $DISPLAY -remote "'$2'"
;; else
;; 	rsh $NETSCAPEHOST $NETSCAPEPATH -display $DISPLAY
;; fi
      vm-netscape-program "mozilla"
      vm-netscape-program-switches (list "-display" my-vm-netscape-display)
      vm-page-continuation-glyph "...press SPACE to see more..."
;;; defaults to (default-value 'fill-column)
;;;   vm-paragraph-fill-column
;;; eventually we'll use this:
;;;   vm-pop-auto-expunge-alist
      vm-pop-bytes-per-session nil
      vm-pop-expunge-after-retrieving t
      vm-pop-max-message-size nil
      vm-pop-messages-per-session nil
      vm-pop-md5-program "md5"
      vm-popup-menu-on-mouse-3 t
;;; shouldn't mess with this either????
;;;   vm-preferences-file "~/.vm.preferences"
      vm-preview-lines 4		; allow 4 lines of the body to show
      vm-preview-read-messages nil
      vm-primary-inbox "~/Mail/INBOX"	; keep everything in vm-folder-directory
      vm-print-command "mailp"		; pretty!
      vm-print-command-switches "-from -noburstpage" ; nifty!
;;;   vm-quit-hook nil
      vm-recognize-imap-maildrops "^\\(imap\\|imap-ssl\\|imap-ssh\\):[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:[^:]+"
      vm-recognize-pop-maildrops "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?[^:]+:[^:]+:[^:]+:[^:]+:[^:]+"
;;;   vm-reply-hook nil
      vm-reply-ignored-addresses (list (concat "\\("
					        "\\b"
						(user-login-name)
						"\\(\\s \\|$\\)"
					       "\\|"
					        "\\b"
						(user-login-name)
						"@\\(.*\\.\\)?"
						mail-local-domain-name
						"\\([^.]+\\|$\\)"
					       "\\)"))
					; just me!
      vm-reply-ignored-reply-tos nil
      vm-reply-subject-prefix "Re: "	; please do the semi-standard thing!
      vm-resend-bounced-discard-header-regexp "\\(X400-\\)?Received:\\|x-uidl:" ; hmmmm?
      vm-resend-bounced-headers nil	; keep the rest
;;;   vm-resend-bounced-message-hook nil
      vm-resend-discard-header-regexp "\\(\\(X400-\\)?Received:\\|Resent-\\|x-uidl:\\)"	; hmmmm?
      vm-resend-headers nil
;;;   vm-resend-message-hook nil
;;;   vm-retrieved-spooled-mail-hook nil
      vm-rfc1153-digest-discard-header-regexp "\\(X400-\\)?Received:\\|x-uidl:" ; hmmmm?
      vm-rfc1153-digest-headers nil	; keep the rest
      vm-rfc934-digest-discard-header-regexp "\\(X400-\\)?Received:\\|x-uidl:" ; hmmmm?
      vm-rfc934-digest-headers nil	; keep the rest
      vm-search-using-regexps nil
;;;   vm-select-message-hook nil
;;;   vm-select-new-message-hook nil
;;;   vm-select-unread-message-hook nil
;;;   vm-send-digest-hook nil
      vm-send-using-mime t
      vm-skip-deleted-messages 1	; don't bother if none to see...
      vm-skip-read-messages nil
      vm-spool-files (eval-and-compile (list ; defaults to just the value of
					; MAILPATH or MAIL
		       (list vm-primary-inbox
			     (getenv "MAIL")
			     vm-crash-box)
		       (list vm-primary-inbox
			     "pop:pop.weird.com:pop:pass:woods:*"
			     vm-crash-box)
		       (list (concat vm-primary-inbox ".almost")
			     "pop:almost.weird.com:pop:pass:woods:*"
			     (concat vm-crash-box ".almost"))
		       (list (concat vm-primary-inbox ".aci")
			     "imap-ssh:imap.aci.on.ca:imap:inbox:login:woods:*"
			     (concat vm-crash-box ".aci"))
		       (list (concat vm-primary-inbox ".soma")
			     "imap-ssl:mail.somanetworks.com:imap:inbox:login:woods:*"
			     (concat vm-crash-box ".soma"))
		       ))
      vm-spool-file-suffixes nil
;;;   vm-spooled-mail-waiting-hook nil
      vm-startup-with-summary t
      vm-strip-reply-headers nil
      vm-stunnel-program-additional-configuration-file nil
      vm-subject-significant-chars nil
      vm-summary-format "%3n%*%A %1.1L %-18.18F %4y/%02M/%02d-%H %4l/%-5c %I\"%s\"\n"
					; ah, that's better!
      vm-summary-highlight-face 'bold
;;;   vm-summary-mode-hook nil		; < 6.0?
;;;   vm-summary-mode-hooks nil
;;;   vm-summary-redo-hook nil
;;;   vm-summary-show-threads nil	; this is buffer-local
      vm-summary-thread-indent-level 2
      vm-summary-uninteresting-senders (concat "\\("
					        "\\b"
						(regexp-quote (user-login-name))
						"\\(\\s \\|$\\)"
					       "\\|"
					        "\\b"
						(regexp-quote (user-login-name))
						"@\\(.*\\.\\)?"
						"\\("
						(regexp-quote mail-local-domain-name)
						"\\|"
						(regexp-quote (or (if (string-match "\\." (system-name))
								      (system-name))
								  (concat
								   (system-name) mail-local-domain-name)))
						"\\|"
						(regexp-quote "weird.ca")
						"\\|"
						(regexp-quote "robohack.ca")
						"\\|"
						(regexp-quote "planix.com")
						"\\|"
						(regexp-quote "planix.ca")
						"\\)"
						"\\([^.]+\\|$\\)"
					       "\\)")
					; just me!
      vm-summary-uninteresting-senders-arrow "To: "
      vm-tale-is-an-idiot t		; sounds good to me!
      vm-temp-file-directory "~/tmp"	; better for keeping secrets!
      vm-thread-using-subject t
;;;   vm-toolbar-pixmap-directory "/usr/local/share/emacs/site-listp/vm/"
      vm-trust-From_-with-Content-Length nil
;;;   vm-uncompface-program "uncompface"	; properly set by code in vm-vars
;;;   vm-undisplay-buffer-hook nil
      vm-unforwarded-header-regexp "x-uidl:"	; hmmmm?
;;;   vm-url-browser 'vm-mouse-send-url-to-netscape ; don't use w3!
      vm-url-browser 'vm-mouse-send-url ; don't use w3!
;;;   vm-url-browser 'my-vm-mouse-send-url-to-galeon	; don't use w3!
      vm-url-browser-switches nil
      vm-url-retrieval-methods '(lynx wget url-w3)
      vm-url-search-limit 1000000	; the more the merrier
      vm-use-menus '(folder motion send mark label sort virtual undo dispose emacs
			    nil help)
      vm-use-toolbar '(next previous delete/undelete autofile file reply compose
			    print visit quit nil help)
;;;   vm-virtual-folder-alist			; see below....
      vm-virtual-folder-case-fold-search t	; I want everything to match!
      vm-virtual-mirror t
      vm-visible-headers '("Resent-Date:" "Date:"
			   "Newsgroups:"	; better for forwarded news
			   "Resent-From:" "From:"
			   "Organization:"
			   "Resent-Reply-To:" "Reply-To:"
			   "Resent-To:" "To:"
			   "Resent-Apparently-To:" "Apparently-To:"
			   "Resent-Cc:" "Cc:"
			   "Resent-Bcc:" "Bcc:"
			   "Delivered-To:"
			   "Subject:"
			   )		; vm-invisible-header-regexp is set,
					; this defines only the display order
;;;   vm-visit-folder-hook nil
      vm-visit-when-saving 0
      vm-warp-mouse-to-new-frame nil
      vm-wget-program "wget"
      vm-window-configuration-file nil		; don't allow saves
      )

;; This is how we pick the default save name.
;;
(setq vm-auto-folder-alist '(
			     ;; Subject: entries first:
			     ("^subject"
			      ("Recent Mail errors and/or statistics on the host \\([a-z-]+\\.\\)*aci\\.on\\.ca" . "planix/aci-smail-errors")
			      ("Recent Mail errors and/or statistics on the host [a-z-]*\\.protagon\\.com" . "planix/protagon.com-smail-errors")
			      ("Recent Mail errors and/or statistics on the host [a-z-]*\\.proxy\\.net" . "planix/proxy.net-smail-errors")
			      ("Recent Mail errors and/or statistics on the host [a-z-]*\\.weird\\.com" . "weird.com-smail-errors"))
			     ;; To: & Cc:, etc. entries here:
			     ("^\\(to\\|cc\\|resent-to\\|apparently-to\\|delivered-to\\)"
			      ("8lgm-advisories@8lgm.org" . "8lgm-l")
			      ("admin-l@io.org" . "planix/io-admin-l")
			      ("aegis-users@" . "aegis-users-l")
			      ("amanda-hackers@" . "amanda-hackers-l")
			      ("amanda-users@" . "amanda-users-l")
			      ("announce-vm@" . "bug-vm") ; merging too...
			      ("auto-net@" . "auto-net-l")
			      ("autoconf@" . "autoconf-l")
			      ("automake@" . "automake-l")
			      ("best-of-security@cyber.com.au" . "best-of-security-l")
			      ("bind@" . "bind-l")
			      ("bind-announce@isc.org" . "bind-announce-l")
			      ("bind-users@" . "bind-users-l")
			      ("bind-workers@" . "bind-workers-l")
			      ("bind9@" . "bind9-l")
			      ("bind9-users@" . "bind9-users-l")
			      ("bind9-bugs@" . "bind9-bugs-l")
			      ("bind9-workers@" . "bind9-workers-l")
			      ("bitkeeper-users@" . "bitkeeper-users-l")
			      ("bkl@" . "bitkeeper-license-l")
			      ("bug-vm@" . "bug-vm")
			      ("bugtraq@" . "bugtraq-l")
			      ("com-priv@.*psi.com" . "com-priv-l")
			      ("users@conserver.com" . "conserver-users-l")
			      ("datacenter@" . "datacenter-l")
			      ("cssc-users@gnu.org" . "cssc-users-l")
			      ("cyrus-announce@" . "cyrus-announce-l")
			      ("cyrus-devel@" . "cyrus-devel-l")
			      ("devel-cvs@" . "devel-cvs-l")
			      ("djb-qmailbeta@" . "djb-qmailbeta-l")
			      ("djb-qmail@" . "djb-qmail-l")
			      ("domain-policy@" . "domain-policy-l")
			      ("exim-users@" . "exim-users-l")
			      ("freenrg-l@" . "freenrg-l")
			      ("gnu-emacs-bug@" . "bug-gnu-emacs-l") ; just merge this
			      ("\\(hyperbole\\|hyperbole-announce\\)@" . "hyperbole-l")
			      ("iap@" . "iap-l")
			      ("info-cyrus@" . "info-cyrus-l")
			      ("info-vm@" . "bug-vm") ; just merge these....
			      ("ipfilter@" . "ipfilter-l")
			      ("ip-registry@" . "ip-registry-l")
			      ("isp-telco@" . "isp-telco-l")
			      ("jet-fuel@" . "jet-fuel-l")
			      ("lout@" . "lout-l")
			      ("lout-users@" . "lout-users-l")
			      ("NAMEDROPPERS@LISTS.INTERNIC.NET" . "namedroppers-l")
			      ("namedroppers@internic.net" . "namedroppers-l")
			      ("net-dist@nikhef.nl" . "nikhef.net-dist-l")
			      ("newdom@iiia.org" . "newdom-l")
			      ("pcl-cvs@" . "pcl-cvs-l")
			      ("pcl-cvs-auto-bugs@" . "pcl-cvs-l")
			      ("prcs-list@" . "prcs-l")
			      ("qotd@" . "qotd-l")
			      ("quotationoftheday@" . "qotd-l")
			      ("rc@hawkwind.utcs.toronto.edu" . "rc-l")
			      ("rescue@sunhelp.org" . "sunhelp-rescue-l")
			      ("rs-info@" . "rs-info-l")
			      ("shared-tld@" . "shared-tld-l")
			      ("smail3-bugs-fwd@" . "smail3-bugs-fwd-l")
			      ("smail3-devel@" . "smail3-devel-l")
			      ("smail3-maintainers@" . "smail3-maintainers-l")
			      ("smail3-users@" . "smail3-users-l")
			      ("smail3-wizards@" . "smail3-wizards-l")
			      ("spamtools@" . "spamtools-l")
			      ("sparcbook-owners@" . "sparcbook-owners-l")
			      ("squeak@" . "squeak-l")
			      ("squeak-dev@" . "squeak-l")
			      ("ssh@" . "ssh-l")
			      ("stk@" . "stk-l")
			      ("tkined@" . "tkined-l")
			      ("trn-test@" . "trn-test-l")
			      ("u-u@" . "u-u-l")
			      ("zmailer@" . "zmailer-l")
			      ;; various netbsd lists:
			      ("source-changes@netbsd.org" . "netbsd/source-changes")
			      ("pkgsrc-changes@netbsd.org" . "netbsd/pkgsrc-changes")
			      ("current-users@netbsd.org" . "netbsd/current-users")
			      ("\\(tech-[^@%]+\\)[@%]netbsd.org" .
			       (concat "netbsd/"
				       (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ("\\(netbsd-[^@%]+\\)[@%]" .
			       (concat "netbsd/"
				       (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ("\\(port-[^@%]+\\)[@%]" .
			       (concat "netbsd/"
				       (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ;; various other <type>-<subj>@ lists....
			      ("\\(bug-[^@%]+\\)[@%]" .
			       (concat (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ("\\(gnu-[^@%]+\\)[@%]" .
			       (concat (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ("\\(info-[^@%]+\\)[@%]" .
			       (concat (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      )
			     ;; Reply-to: entries here.
			     ("^reply-to"
			      ("Suns-at-Home@" . "suns-at-home-l")
			      )
			     ;; Sender: entries here.
			     ("^\\(sender\\|resent-sender\\)"
			      ("ciac-bulletin@" . "ciac-l")
			      ("ciac-notes@" . "ciac-l")
			      ("iap@vma.cc.nd.edu" . "iap-l")
			      ("geeks-admin@sunhelp.org" . "sungeeks-l")
			      ("owner-admin-l@io.org" . "planix/io-admin-l")
			      ("owner-datacenter@" . "datacenter-l")
			      ("owner-dce@" . "dce-l")
			      ("owner-devel-cvs@" . "devel-cvs-l")
			      ("owner-fwtk-users@" . "fwtk-l")
			      ("owner-namedroppers@internic.net" . "namedroppers-l")
			      ("mw-wod@" . "mw-wod-l")
			      ("owner-net-dist@nikhef.nl" . "nikhef.net-dist-l")
			      ("owner-pcl-cvs@" . "pcl-cvs-l")
			      ("owner-rs-info@internic.net" . "rs-info-l")
			      ("owner-vmailer-testers@" . "vmailer-testers-l")
			      ("owner-\\([^@%]+\\)[@%]netbsd.org" .
			       (concat "netbsd/"
				       (buffer-substring (match-beginning 1)
							 (match-end 1))))
			      ("rescue-admin@sunhelp.org" . "sunrescue-l")
			      )
			     ;; From: entries here.
			     ("^\\(from\\|resent-from\\)"
			      ("0xdeadbeef@" . "0xdeadbeef-l")
			      ("gegai@.*io\\.org" . "from/andy")
			      ("Andy_Mills@jdedwards\\.com" . "from/andy")
			      ("andy.mills@schwab.*\\.com" . "from/andy")
			      ("amills@infinetcomm.*\\.com" . "from/andy")
			      ("andy@nationalfibre.net" . "from/andy")
			      ("grant@slick.net" . "from/grant.officer")
			      ("hostmaster@GTS.NET" . "from/bdb")
			      ("hugh@phaedraV.com" . "from/hugh_gamble")
			      ("hugh@kink.PhaedraV.on.ca" . "from/hugh_gamble")
			      ("postmaster@GTS.NET" . "from/bdb")
			      ("news@GTS.NET" . "from/bdb")
			      ("usenet@GTS.NET" . "from/bdb")
			      ("gnats-bugs@netbsd\\.org" . "netbsd/gnats-bugs")
			      ("gnats-admin@netbsd\\.org" . "from/netbsd-gnats-bugs")
			      ("word@m-w.com" . "mw-wod-l")
			      ;; code to make auto-folder default to the user name of the sender.
			      ;; this should be last in the auto folder alist since it tends to
			      ;; always match something.
			      ("<\\([^ \t\n\f@%()<>]+\\)[@%]\\([^ \t\n\f<>()]+\\)>" .
			       (concat "from/"
				       (downcase (buffer-substring (match-beginning 1)
								   (match-end 1)))))
			      ("<\\([^>]+\\)>" .
			       (concat "from/"
				       (downcase (buffer-substring (match-beginning 1)
								   (match-end 1)))))
			      ("\\([^ \t\n\f@%()<>]+\\)\\([@%]\\([^ \t\n\f<>()]+\\)\\)?" .
			       (concat "from/"
				       (downcase (buffer-substring (match-beginning 1)
								   (match-end 1)))))
			      )
			     ))

;; This is the list of virtual folders created by my-vm-visit-all-virtual-folders
;;
;;   (VIRTUAL-FOLDER-NAME
;;     ( (FOLDER-NAME ...)
;;       (SELECTOR [ARG ...]) ... )
;;     ... )
;;
(setq vm-virtual-folder-alist
      (list
       (list (symbol-value 'my-vm-virtual-leftovers-folder)
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(not (virtual-folder-member))))
       (list (symbol-value 'my-vm-virtual-spam-folder)
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(header "^X-Bogosity: Yes")))
       (list "BUGTRAQ+INCIDENTS"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (header "^List-Id: <bugtraq.")
			(header "^List-Id: <incidents.")
			(recipient "incidents@securityfocus.com")
			(recipient "bugtraq@securityfocus.com"))))
       (list "CM-stuff"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "aegis-users@")
			(recipient "cssc-users@")
			(recipient "prcs-list@")
			(recipient "bitkeeper-users@")
			(recipient "bkl@")
			(recipient "shape-l@"))))
       (list "Datacentre-stuff"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "datacenter@")
			(recipient "dce@"))))
       (list "Languages"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "squeak@")
			(recipient "squeak-dev@")
			(recipient "stk@"))))

       (list "Monitoring"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "cricket-users@")))
       (list "NANOG"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "nanog@")
			(recipient "nanog-announce@"))))
       (list "Other-Lists"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "users@conserver.com")
			(recipient "announce@conserver.com"))))	; XXX no such list really
       (list "SSH"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "ssh@")
			(recipient "secureshell@securityfocus.com"))))
       (list "VM"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "bug-vm@")
			(recipient "announce-vm@")
			(recipient "info-vm@"))))
       (list "amanda"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "amanda-hackers@")
			(recipient "amanda-users@"))))
       (list "cvs"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "bug-cvs@")
			(recipient "commit-cvs@cyclic.com")
			(recipient "info-cvs@")
			(recipient "devel-cvs@"))))
       (list "cyrus"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "cyrus-announce@")
			(recipient "cyrus-devel")
			(recipient "info-cyrus@"))))
       (list "dns-stuff"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "domain-policy@")
			(recipient "namedroppers@")
			(recipient "bind-workers@")
			(recipient "bind-users@")
			(recipient "bind9-workers@")
			(recipient "bind9-users@")
			(recipient "bind9-bugs@")
			(recipient "comp-protocols-dns-bind@")
			(recipient "rs-info@"))))
       (list "jet-fuel"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "jet-fuel@")))
       (list "lout"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "lout@niif.spb.su")
			(recipient "lout@ptc.spbu.ru")
			(recipient "lout-users@lists.planix.com"))))
       (list "exim"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "exim-users@")
			(recipient "exim-announce@"))))
       (list "freebsd"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "freebsd-announe@")
			(recipient "freebsd-bugs@")
			(recipient "bugs@freebsd.org")
			(recipient "freebsd-stable@")
			(recipient "freebsd-security@"))))
       (list "ipfilter"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "ipfilter@")))
       (list "netbsd-current-users"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "current-users@")))
       (list "netbsd-other"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "netbsd-announce@")
			(recipient "netbsd-help@")
			(recipient "netbsd-ports@")
			(recipient "netbsd-users@")
			(header "^Delivered-To: netbsd-announce@")
			(header "^Delivered-To: netbsd-help@")
			(header "^Delivered-To: netbsd-ports@")
			(header "^Delivered-To: netbsd-users@"))))
       (list "netbsd-bugs"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "gnats-bugs@gnats.netbsd.org")
			(recipient "gnats-bugs@netbsd.org")
			(recipient "netbsd-bugs@")
			(header "^Delivered-To: netbsd-bugs"))))
       (list "netbsd-source-changes"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "source-changes@")
			(recipient "pkgsrc-changes@")
			(recipient "source@netbsd.org"))))
       (list "netbsd-tech"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "tech-embed@")
			(recipient "tech-install@")
			(recipient "tech-kern@")
			(recipient "tech-misc@")
			(recipient "tech-net@")
			(recipient "tech-perform@")
			(recipient "tech-ports@")
			(recipient "tech-security@")
			(recipient "tech-smp@")
			(recipient "tech-toolchain@")
			(recipient "tech-userlevel@")
			(recipient "tech-x11@")
			(header "^Delivered-To: tech-embed@")
			(header "^Delivered-To: tech-install@")
			(header "^Delivered-To: tech-kern@")
			(header "^Delivered-To: tech-misc@")
			(header "^Delivered-To: tech-net@")
			(header "^Delivered-To: tech-perform@")
			(header "^Delivered-To: tech-ports@")
			(header "^Delivered-To: tech-security@")
			(header "^Delivered-To: tech-smp@")
			(header "^Delivered-To: tech-toolchain@")
			(header "^Delivered-To: tech-userlevel@")
			(header "^Delivered-To: tech-x11@"))))
       (list "netbsd-pkgsrc"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "tech-pkg@")
			(header "^Delivered-To: tech-pkg@"))))
       (list "netbsd-port-alpha"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "port-alpha@")
			(header "^Delivered-To: port-alpha@"))))
       (list "netbsd-port-i386"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "port-i386@")
			(header "^Delivered-To: port-i386@"))))
       (list "netbsd-port-misc"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "port-arm32@")
			(recipient "port-mips@")
			(recipient "port-ofppc@")
			(recipient "port-pmax@")
			(recipient "port-powerpc@")
			(recipient "port-vax@")
			(header "^Delivered-To: port-arm32@")
			(header "^Delivered-To: port-mips@")
			(header "^Delivered-To: port-ofppc@")
			(header "^Delivered-To: port-pmax@")
			(header "^Delivered-To: port-powerpc@")
			(header "^Delivered-To: port-vax@"))))
       (list "netbsd-port-sun"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "port-sparc@")
			(recipient "port-sun3@")
			(header "^Delivered-To: port-sparc@")
			(header "^Delivered-To: port-sun3@"))))
       (list "pcl-cvs"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "pcl-cvs-auto-bugs@")
			(recipient "pcl-cvs@"))))
       (list "security-stuff"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "sectools@")
			(recipient "secpapers@"))))
       (list "smail3"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "smail3")))
       (list "spam-stuff"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "spamtools@")))
       (list "sunhelp"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (recipient "rescue@sunhelp.org")
			(recipient "geeks@sunhelp.org"))))
       (list "tkined"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(recipient "tkined@")))
       (list "vmailer"
	     (list (list (file-name-nondirectory (symbol-value 'vm-primary-inbox)))
		   '(or (header "^Delivered-To: postfix-users")
			(recipient "postfix-announce@")
			(recipient "postfix-testers@")
			(recipient "postfix-users@")
			(recipient "vmailer-testers@"))))
       ))

;;;
;;;	End Of File
;;;