dot/vm: Set a `From' header when composing mail.

[profile] / dot / vm

;;; -*-emacs-lisp-*-
;;;
;;; Configuration for VM

(require 'auth-source)

(setq vm-reply-subject-prefix "Re: "
      vm-included-text-prefix "> "
      vm-included-text-attribution-format "%F <%f> wrote:\n\n"
      vm-folder-directory "~/Mail/"
      vm-startup-with-summary t
      vm-skip-deleted-messages nil
      vm-circular-folders nil
      vm-preview-lines nil
      vm-highlighted-header-regexp "^From\\|^Subject"
      vm-movemail-program "movemail-hack"
      vm-mail-header-from (format "Mark Wooding <%s>"
				  (or (mdw-config 'email)
				      "mdw@distorted.org.uk"))
      vm-delete-after-saving t
      vm-move-after-deleting t
      vm-delete-empty-folders nil)

(setq auth-sources '("~/.gnus.authinfo")
      vm-imap-max-message-size 0
      vm-imap-refer-to-inbox-by-account-name t
      vm-imap-save-to-server t
      vm-imap-account-alist
      '(("imap-ssl:mail.distorted.org.uk:993:*:login:mdw:*"
	 "distorted")
	("imap-ssl:mail.distorted.org.uk:993:*:login:markw:*"
	 "markw-distorted")
	("imap-ssl:imap.dovecot.chiark.greenend.org.uk:993:*:login:mdw:*"
	 "mdw-chiark")
	("imap-ssl:imap.dovecot.chiark.greenend.org.uk:993:*:login:mwooding:*"
	 "mwooding-chiark")
	("imap-ssl:imap.gmail.com:993:*:login:distorted.mdw@gmail.com:*"
	 "google")))

(and (eq (terminal-coding-system) 'utf-8)
     (add-to-list 'vm-mime-default-face-charsets "utf-8"))

(setq vm-mime-qp-encoder-program nil
      vm-mime-qp-decoder-program nil
      vm-mime-base64-encoder-program nil
      vm-mime-base64-decoder-program nil)

(setq vm-visible-headers '("resent-from:" "from:" "reply-to:" "sender:"
			   "to:" "apparently-to:" "cc:"
			   "subject:" "date:"
			   "delivered-to:" "return-path:"))

(setq vm-reply-ignored-addresses
      (let ((pat bbdb-user-mail-names))
	(if (string-prefix-p "^" pat)
	    (setq pat (substring pat 1)))
	(if (string-suffix-p "$" pat)
	    (setq pat (substring pat 0 (1- (length pat)))))
	(cons (concat "\\<" pat "\\>") nil)))

(defvar mdw-mailing-lists
  '("hibachi-dealers-members@chiark\\.greenend\\.org\\.uk"))

(setq vm-mime-external-content-types-alist
      '(("image/jpeg" "xdg-open")
	("image/jpg" "xdg-open")
	("image/gif" "xdg-open")
	("image/bmp" "xdg-open")
	("image/tiff" "xdg-open")
	("application/postscript" "xdg-open")
	("application/pdf" "xdg-open")))

(setq vm-url-browser "sensible-browser")

(setq vm-frame-parameter-alist
      '((folder ((width . 81) (height . 33)))
	(summary ((width . 81) (height . 33)))
	(primary-summary ((width . 81) (height . 33)))))

(setq vm-auto-folder-alist
      '(("delivered-to" ("root@" . "admin"))
	("from" ("Cron Daemon" . "admin"))))

(defun join-strings (del strings)
  (with-output-to-string
    (if (null strings)
	nil
      (princ (car strings))
      (setq strings (cdr strings))
      (while strings
	(princ del)
	(princ (car strings))
	(setq strings (cdr strings))))))

(defun mdw-vm-fix-mailing-lists ()
  (save-restriction
    (save-excursion
      (or (vm-mail-mode-get-header-contents "Resent-To:")
	  (vm-mail-mode-get-header-contents "Resent-Cc:")
	  (vm-mail-mode-get-header-contents "Resent-Bcc:")
	  (let ((mailing-list-regex (concat "\\<\\("
					    (join-strings "\\|"
							  mdw-mailing-lists)
					    "\\)\\>"))
		(to (vm-mail-mode-get-header-contents "To:"))
		(cc (vm-mail-mode-get-header-contents "Cc:")))
	    (if (or (and to (string-match mailing-list-regex to))
		    (and cc (string-match mailing-list-regex cc)))
		(let ((addrs (nconc (and to (vm-parse-addresses to))
				    (and cc (vm-parse-addresses cc))))
		      (new nil))
		  (while addrs
		    (if (string-match mailing-list-regex (car addrs))
			(setq new (cons (car addrs) new)))
		    (setq addrs (cdr addrs)))
		  (vm-mail-mode-remove-header "Cc:")
		  (vm-mail-mode-remove-header "To:")
		  (widen)
		  (goto-char (point-min))
		  (insert (format "To: %s\n" (join-strings ", " new))))))))))

(add-hook 'vm-reply-hook 'mdw-vm-fix-mailing-lists)

(defun mdw-mark-as-spam ()
  (interactive)
  (save-window-excursion
    (vm-pipe-message-to-command "userv spamd spam" 1))
  (vm-delete-message 1))
(define-key vm-summary-mode-map "/" 'mdw-mark-as-spam)