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