chiark - git - mdw - profile/blob - dot/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 bbdb-user-mail-names)
  37
  38 (defvar mdw-mailing-lists
  39   '("hibachi-dealers-members@chiark\\.greenend\\.org\\.uk"))
  40
  41 (setq vm-mime-external-content-types-alist
  42       '(("image/jpeg" "xdg-open")
  43         ("image/jpg" "xdg-open")
  44         ("image/gif" "xdg-open")
  45         ("image/bmp" "xdg-open")
  46         ("image/tiff" "xdg-open")
  47         ("application/postscript" "xdg-open")
  48         ("application/pdf" "xdg-open")))
  49
  50 (setq vm-url-browser "sensible-browser")
  51
  52 (setq vm-frame-parameter-alist
  53       '((folder ((width . 81) (height . 33)))
  54         (summary ((width . 81) (height . 33)))
  55         (primary-summary ((width . 81) (height . 33)))))
  56
  57 (setq vm-auto-folder-alist
  58       '(("delivered-to" ("root@" . "admin"))
  59         ("from" ("Cron Daemon" . "admin"))))
  60
  61 (defun join-strings (del strings)
  62   (with-output-to-string
  63     (if (null strings)
  64         nil
  65       (princ (car strings))
  66       (setq strings (cdr strings))
  67       (while strings
  68         (princ del)
  69         (princ (car strings))
  70         (setq strings (cdr strings))))))
  71
  72 (defun mdw-vm-fix-mailing-lists ()
  73   (save-restriction
  74     (save-excursion
  75       (or (vm-mail-mode-get-header-contents "Resent-To:")
  76           (vm-mail-mode-get-header-contents "Resent-Cc:")
  77           (vm-mail-mode-get-header-contents "Resent-Bcc:")
  78           (let ((mailing-list-regex (concat "\\<\\("
  79                                             (join-strings "\\|"
  80                                                           mdw-mailing-lists)
  81                                             "\\)\\>"))
  82                 (to (vm-mail-mode-get-header-contents "To:"))
  83                 (cc (vm-mail-mode-get-header-contents "Cc:")))
  84             (if (or (and to (string-match mailing-list-regex to))
  85                     (and cc (string-match mailing-list-regex cc)))
  86                 (let ((addrs (nconc (and to (vm-parse-addresses to))
  87                                     (and cc (vm-parse-addresses cc))))
  88                       (new nil))
  89                   (while addrs
  90                     (if (string-match mailing-list-regex (car addrs))
  91                         (setq new (cons (car addrs) new)))
  92                     (setq addrs (cdr addrs)))
  93                   (vm-mail-mode-remove-header "Cc:")
  94                   (vm-mail-mode-remove-header "To:")
  95                   (widen)
  96                   (goto-char (point-min))
  97                   (insert (format "To: %s\n" (join-strings ", " new))))))))))
  98
  99 (add-hook 'vm-reply-hook 'mdw-vm-fix-mailing-lists)
 100
 101 (defun mdw-mark-as-spam ()
 102   (interactive)
 103   (save-window-excursion
 104     (vm-pipe-message-to-command "userv spamd spam" 1))
 105   (vm-delete-message 1))
 106 (define-key vm-summary-mode-map "/" 'mdw-mark-as-spam)