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