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-delete-after-saving t
  15       vm-move-after-deleting t
  16       vm-delete-empty-folders)
  17
  18 (setq vm-mime-qp-encoder-program "mimencode"
  19       vm-mime-qp-encoder-switches '("-q")
  20       vm-mime-qp-decoder-program "mimencode"
  21       vm-mime-qp-decoder-switches '("-q" "-u")
  22       vm-mime-base64-encoder-program "mimencode"
  23       vm-mime-base64-encoder-switches '("-b")
  24       vm-mime-base64-decoder-program "mimencode"
  25       vm-mime-base64-decoder-switches '("-b" "-u"))
  26
  27 (setq vm-visible-headers '("resent-from:" "from:" "reply-to:" "sender:"
  28                            "to:" "apparently-to:" "cc:"
  29                            "subject:" "date:"
  30                            "delivered-to:" "return-path:"))
  31
  32 (setq vm-reply-ignored-addresses '("mdw@excessus\\.demon\\.co\\.uk"
  33                                    "mdw@nsict\\.org" "mdw@eh\\.org"
  34                                    "mdw@ncipher\\.com"
  35                                    "mwooding@ncipher\\.com"
  36                                    "submit@bugs\\.ncipher\\.com"
  37                                    "mdw@chiark\\.greenend\\.org\\.uk"
  38                                    "mdw@distorted\\.org\\.uk"
  39                                    "mdw@metalzone\\.distorted\\.org\\.uk"
  40                                    "tux@nsict\\.org"))
  41
  42 (defvar mdw-mailing-lists
  43   '("hibachi-dealers-members@chiark\\.greenend\\.org\\.uk"))
  44
  45 (setq vm-mime-external-content-types-alist
  46       '(("image/jpeg" "display")
  47         ("image/jpg" "display")
  48         ("image/gif" "display")
  49         ("image/bmp" "display")
  50         ("image/tiff" "display")
  51         ("application/postscript" "gv")
  52         ("application/pdf" "gv")))
  53
  54 (setq vm-url-browser "firefox")
  55
  56 (setq vm-frame-parameter-alist
  57       '((folder ((width . 81) (height . 33)))
  58         (summary ((width . 81) (height . 33)))
  59         (primary-summary ((width . 81) (height . 33)))))
  60
  61 (setq vm-auto-folder-alist
  62       '(("delivered-to" ("root@" . "admin"))))
  63
  64 (defun join-strings (del strings)
  65   (with-output-to-string
  66     (if (null strings)
  67         nil
  68       (princ (car strings))
  69       (setq strings (cdr strings))
  70       (while strings
  71         (princ del)
  72         (princ (car strings))
  73         (setq strings (cdr strings))))))
  74
  75 (defun mdw-vm-fix-mailing-lists ()
  76   (save-restriction
  77     (save-excursion
  78       (or (vm-mail-mode-get-header-contents "Resent-To:")
  79           (vm-mail-mode-get-header-contents "Resent-Cc:")
  80           (vm-mail-mode-get-header-contents "Resent-Bcc:")
  81           (let ((mailing-list-regex (concat "\\<\\("
  82                                             (join-strings "\\|"
  83                                                           mdw-mailing-lists)
  84                                             "\\)\\>"))
  85                 (to (vm-mail-mode-get-header-contents "To:"))
  86                 (cc (vm-mail-mode-get-header-contents "Cc:")))
  87             (if (or (and to (string-match mailing-list-regex to))
  88                     (and cc (string-match mailing-list-regex cc)))
  89                 (let ((addrs (nconc (and to (vm-parse-addresses to))
  90                                     (and cc (vm-parse-addresses cc))))
  91                       (new nil))
  92                   (while addrs
  93                     (if (string-match mailing-list-regex (car addrs))
  94                         (setq new (cons (car addrs) new)))
  95                     (setq addrs (cdr addrs)))
  96                   (vm-mail-mode-remove-header "Cc:")
  97                   (vm-mail-mode-remove-header "To:")
  98                   (widen)
  99                   (goto-char (point-min))
 100                   (insert (format "To: %s\n" (join-strings ", " new))))))))))
 101
 102 (add-hook 'vm-reply-hook 'mdw-vm-fix-mailing-lists)