chiark - git - mdw - profile/blob - dot/vm

   1 ;;; -*-emacs-lisp-*-
   2 ;;;
   3 ;;; Configuration for VM
   4
   5 (require 'auth-source)
   6
   7 (setq vm-reply-subject-prefix "Re: "
   8       vm-included-text-prefix "> "
   9       vm-included-text-attribution-format "%F <%f> wrote:\n\n"
  10       vm-folder-directory "~/Mail/"
  11       vm-startup-with-summary t
  12       vm-skip-deleted-messages nil
  13       vm-circular-folders nil
  14       vm-preview-lines nil
  15       vm-highlighted-header-regexp "^From\\|^Subject"
  16       vm-movemail-program "movemail-hack"
  17       vm-mail-header-from (format "Mark Wooding <%s>"
  18                                   (or (mdw-config 'email)
  19                                       "mdw@distorted.org.uk"))
  20       vm-delete-after-saving t
  21       vm-move-after-deleting t
  22       vm-delete-empty-folders nil)
  23
  24 (setq auth-sources '("~/.gnus.authinfo")
  25       vm-imap-max-message-size 0
  26       vm-imap-refer-to-inbox-by-account-name t
  27       vm-imap-save-to-server t
  28       vm-imap-account-alist
  29       '(("imap-ssl:mail.distorted.org.uk:993:*:login:mdw:*"
  30          "distorted")
  31         ("imap-ssl:mail.distorted.org.uk:993:*:login:markw:*"
  32          "markw-distorted")
  33         ("imap-ssl:imap.dovecot.chiark.greenend.org.uk:993:*:login:mdw:*"
  34          "mdw-chiark")
  35         ("imap-ssl:imap.dovecot.chiark.greenend.org.uk:993:*:login:mwooding:*"
  36          "mwooding-chiark")
  37         ("imap-ssl:imap.gmail.com:993:*:login:distorted.mdw@gmail.com:*"
  38          "google")))
  39
  40 (and (eq (terminal-coding-system) 'utf-8)
  41      (add-to-list 'vm-mime-default-face-charsets "utf-8"))
  42
  43 (setq vm-mime-qp-encoder-program nil
  44       vm-mime-qp-decoder-program nil
  45       vm-mime-base64-encoder-program nil
  46       vm-mime-base64-decoder-program nil)
  47
  48 (setq vm-visible-headers '("resent-from:" "from:" "reply-to:" "sender:"
  49                            "to:" "apparently-to:" "cc:"
  50                            "subject:" "date:"
  51                            "delivered-to:" "return-path:"))
  52
  53 (setq vm-reply-ignored-addresses
  54       (let ((pat bbdb-user-mail-names))
  55         (if (string-prefix-p "^" pat)
  56             (setq pat (substring pat 1)))
  57         (if (string-suffix-p "$" pat)
  58             (setq pat (substring pat 0 (1- (length pat)))))
  59         (cons (concat "\\<" pat "\\>") nil)))
  60
  61 (defvar mdw-mailing-lists
  62   '("hibachi-dealers-members@chiark\\.greenend\\.org\\.uk"))
  63
  64 (setq vm-mime-external-content-types-alist
  65       '(("image/jpeg" "xdg-open")
  66         ("image/jpg" "xdg-open")
  67         ("image/gif" "xdg-open")
  68         ("image/bmp" "xdg-open")
  69         ("image/tiff" "xdg-open")
  70         ("application/postscript" "xdg-open")
  71         ("application/pdf" "xdg-open")))
  72
  73 (setq vm-url-browser "sensible-browser")
  74
  75 (setq vm-frame-parameter-alist
  76       '((folder ((width . 81) (height . 33)))
  77         (summary ((width . 81) (height . 33)))
  78         (primary-summary ((width . 81) (height . 33)))))
  79
  80 (setq vm-auto-folder-alist
  81       '(("delivered-to" ("root@" . "admin"))
  82         ("from" ("Cron Daemon" . "admin"))))
  83
  84 (defun join-strings (del strings)
  85   (with-output-to-string
  86     (if (null strings)
  87         nil
  88       (princ (car strings))
  89       (setq strings (cdr strings))
  90       (while strings
  91         (princ del)
  92         (princ (car strings))
  93         (setq strings (cdr strings))))))
  94
  95 (defun mdw-vm-fix-mailing-lists ()
  96   (save-restriction
  97     (save-excursion
  98       (or (vm-mail-mode-get-header-contents "Resent-To:")
  99           (vm-mail-mode-get-header-contents "Resent-Cc:")
 100           (vm-mail-mode-get-header-contents "Resent-Bcc:")
 101           (let ((mailing-list-regex (concat "\\<\\("
 102                                             (join-strings "\\|"
 103                                                           mdw-mailing-lists)
 104                                             "\\)\\>"))
 105                 (to (vm-mail-mode-get-header-contents "To:"))
 106                 (cc (vm-mail-mode-get-header-contents "Cc:")))
 107             (if (or (and to (string-match mailing-list-regex to))
 108                     (and cc (string-match mailing-list-regex cc)))
 109                 (let ((addrs (nconc (and to (vm-parse-addresses to))
 110                                     (and cc (vm-parse-addresses cc))))
 111                       (new nil))
 112                   (while addrs
 113                     (if (string-match mailing-list-regex (car addrs))
 114                         (setq new (cons (car addrs) new)))
 115                     (setq addrs (cdr addrs)))
 116                   (vm-mail-mode-remove-header "Cc:")
 117                   (vm-mail-mode-remove-header "To:")
 118                   (widen)
 119                   (goto-char (point-min))
 120                   (insert (format "To: %s\n" (join-strings ", " new))))))))))
 121
 122 (add-hook 'vm-reply-hook 'mdw-vm-fix-mailing-lists)
 123
 124 (defun mdw-mark-as-spam ()
 125   (interactive)
 126   (save-window-excursion
 127     (vm-pipe-message-to-command "userv spamd spam" 1))
 128   (vm-delete-message 1))
 129 (define-key vm-summary-mode-map "/" 'mdw-mark-as-spam)