chiark - git - mdw - profile/blob - vm

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