chiark - git - mdw - profile/blob - vm

   1 ;;; -*-emacs-lisp-*-
   2 ;;;
   3 ;;; Configuration for VM
   4
   5 (setq vm-reply-subject-prefix "Re: ")
   6 (setq vm-included-text-prefix "> ")
   7 (setq vm-included-text-attribution-format "%F <%f> wrote:\n\n")
   8 ;;(setq vm-spool-files '("/home/mdw/Mailbox"
   9 ;;                     "imap:tux.nsict.org:143:inbox:login:mdw:*"))
  10 (setq vm-folder-directory "~/Mail/")
  11 (setq vm-startup-with-summary t)
  12 (setq vm-skip-deleted-messages nil)
  13 (setq vm-circular-folders nil)
  14 (setq vm-preview-lines nil)
  15 (setq vm-highlighted-header-regexp "^From\\|^Subject")
  16 (setq vm-delete-after-saving t)
  17 (setq vm-move-after-deleting t)
  18 (setq vm-delete-empty-folders)
  19 (setq vm-mime-qp-encoder-program "mimencode")
  20 (setq vm-mime-qp-encoder-switches '("-q"))
  21 (setq vm-mime-qp-decoder-program "mimencode")
  22 (setq vm-mime-qp-decoder-switches '("-q" "-u"))
  23 (setq vm-mime-base64-encoder-program "mimencode")
  24 (setq vm-mime-base64-encoder-switches '("-b"))
  25 (setq vm-mime-base64-decoder-program "mimencode")
  26 (setq vm-mime-base64-decoder-switches '("-b" "-u"))
  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 (setq vm-reply-ignored-addresses '("mdw@excessus\\.demon\\.co\\.uk"
  32                                    "mdw@nsict\\.org" "mdw@eh\\.org"
  33                                    "mdw@ncipher\\.com"
  34                                    "mdw@distorted\\.org\\.uk"
  35                                    "mdw@metalzone\\.distorted\\.org\\.uk"
  36                                    "mwooding@ncipher\\.com"
  37                                    "tux@nsict\\.org"))
  38
  39 (defvar mdw-mailing-lists
  40   '("hibachi-dealers-members@chiark\\.greenend\\.org\\.uk"))
  41
  42 (setq vm-mime-external-content-types-alist
  43       '(("image/jpeg" "eog")
  44         ("image/jpg" "eog")
  45         ("image/gif" "eog")
  46         ("image/tiff" "eog")))
  47
  48 (setq vm-url-browser "galeon")
  49
  50 (setq vm-frame-parameter-alist
  51       '((folder ((width . 80) (height . 33)))
  52         (summary ((width . 80) (height . 33)))
  53         (primary-summary ((width . 80) (height . 33)))
  54          ))
  55
  56 (setq vm-auto-folder-alist
  57       '(("delivered-to" ("root@" . "admin"))))
  58
  59
  60 (defun join-strings (del strings)
  61   (with-output-to-string
  62     (if (null strings)
  63         nil
  64       (princ (car strings))
  65       (setq strings (cdr strings))
  66       (while strings
  67         (princ del)
  68         (princ (car strings))
  69         (setq strings (cdr strings))))))
  70
  71 (defun mdw-vm-fix-mailing-lists ()
  72   (save-restriction
  73     (save-excursion
  74       (or (vm-mail-mode-get-header-contents "Resent-To:")
  75           (vm-mail-mode-get-header-contents "Resent-Cc:")
  76           (vm-mail-mode-get-header-contents "Resent-Bcc:")
  77           (let ((mailing-list-regex (concat "\\<\\("
  78                                             (join-strings "\\|"
  79                                                           mdw-mailing-lists)
  80                                             "\\)\\>"))
  81                 (to (vm-mail-mode-get-header-contents "To:"))
  82                 (cc (vm-mail-mode-get-header-contents "Cc:")))
  83             (if (or (and to (string-match mailing-list-regex to))
  84                     (and cc (string-match mailing-list-regex cc)))
  85                 (let ((addrs (nconc (and to (vm-parse-addresses to))
  86                                     (and cc (vm-parse-addresses cc))))
  87                       (new nil))
  88                   (while addrs
  89                     (if (string-match mailing-list-regex (car addrs))
  90                         (setq new (cons (car addrs) new)))
  91                     (setq addrs (cdr addrs)))
  92                   (vm-mail-mode-remove-header "Cc:")
  93                   (vm-mail-mode-remove-header "To:")
  94                   (widen)
  95                   (goto-char (point-min))
  96                   (insert (format "To: %s\n" (join-strings ", " new))))))))))
  97
  98 (add-hook 'vm-reply-hook 'mdw-vm-fix-mailing-lists)