mdw@git.distorted.org.uk Git - profile/blob - vm

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