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