1 files changed, 233 insertions, 0 deletions

@@ -0,0 +1,233 @@
+;;; acdw-mail.el --- My email configuration  -*- lexical-binding: t; -*-
+
+;;; Code:
+
+(require 'cl-lib)
+
+;;; Variables
+
+(defcustom +message-send-dispatch-rules nil
+  "Alist to set variables based on the current from address."
+  :group 'message
+  :type '(alist :key-type (string :tag "From address")
+                :value-type (alist :tag "Rules"
+                                   :key-type (symbol :tag "Variable")
+                                   :value-type (sexp :tag "Value"))))
+
+(defcustom +notmuch-spam-tags '("+spam")
+  "List of tag changes to apply when marking a thread as spam."
+  :group 'notmuch
+  :type '(repeat string))
+
+;;; Functions
+
+(defun +message-send-set-variables ()
+  "Set variables for `message-send' depending on the From: header.
+Useful in `message-send-hook'."
+  (let ((from (message-fetch-field "from")))
+    (cl-loop for (var . val) in (cl-loop for (address . bindings)
+                                         in +message-send-dispatch-rules
+                                         if (string-match-p address from)
+                                         return bindings)
+             do (set (make-local-variable var) val))))
+
+;; Thanks to Alex Schroeder!
+;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
+(defun +message-check-for-signature-change (&rest ignore)
+  "Check for a change in the To: or Cc: fields"
+  (when (and (message--in-tocc-p)
+             (not (buffer-narrowed-p)))
+    (save-excursion
+      (goto-char (point-max))
+      (let ((end (point)))
+        (when (re-search-backward message-signature-separator nil t)
+          (delete-region (1- (match-beginning 0)) end)))
+      (message-insert-signature))))
+
+(defun +message-signature-setup ()
+  (make-local-variable 'after-change-functions)
+  (push '+message-check-for-signature-change after-change-functions))
+
+(defun +notmuch-field-match-p (field regexp)
+  "Return whether message FIELD matches REGEXP."
+  (string-match-p regexp (or (message-fetch-field field) "")))
+
+(defun +notmuch-query-concat (&rest queries)
+  "Concatenate `notmuch' QUERIES with AND."
+  (mapconcat #'identity queries " AND "))
+
+(defun +notmuch-goto (&optional prefix)
+  "Perform a saved `notmuch' search.
+Without a PREFIX argument, perform the first search in
+`notmuch-saved-searches'.  With a single PREFIX argument
+(\\[universal-argument]), prompt the user as to which saved
+search to perform.  With two PREFIX arguments, prompt the user
+for a free-form search.  With any other PREFIX argument, open
+`notmuch-hello'."
+  (interactive "P")
+  (pcase prefix
+    ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
+    ('(4) (notmuch-search
+           (plist-get (cl-find (completing-read "Saved search: "
+                                                (mapcar (lambda (elt)
+                                                          (plist-get elt :name))
+                                                        notmuch-saved-searches))
+                               :key (lambda (elt) (plist-get elt :name))
+                               :test #'equal)
+                      :query)))
+    ('(16) (notmuch-search))
+    (_ (notmuch-hello))))
+
+(defun +notmuch-search-mark-spam (&optional ham start end)
+  "Mark the current thread or region as spam.
+That is, add the tags in `+notmuch-spam-tags' to the message.
+With an optional HAM argument (interactively,
+\\[universal-argument]), mark the message as not-spam, or ham, by
+reversing the tag changes."
+  (interactive (cons current-prefix-arg (notmuch-interactive-region)))
+  (when +notmuch-spam-tags
+    (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham)
+                        start end))
+  (when (eq start end)
+    (notmuch-search-next-thread)))
+
+(defun +notmuch-tree-mark-spam (&optional ham)
+  "Mark the current message as spam.
+That is, add the tags in `+notmuch-spam-tags' to the message.
+With an optional HAM argument (interactively,
+\\[universal-argument]), mark the message as not-spam, or ham, by
+reversing the tag changes."
+  (interactive (cons current-prefix-arg (notmuch-interactive-region)))
+  (when +notmuch-spam-tags
+    (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham)))
+  (notmuch-tree-next-matching-message))
+
+(defun +notmuch-define-saved-search (name key search-type &rest queries)
+  "Wrapper to ease `notmuch-saved-searches' defining.
+NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
+`notmuch-saved-searches', which see.  QUERIES are all concatenated together with
+AND.  If QUERIES is prepended with more keyword arguments, those are added to
+the saved search as well."
+  (declare (indent 3))
+  (let (extra-keywords)
+    (while (keywordp (car queries))
+      (push (cadr queries) extra-keywords)
+      (push (car queries) extra-keywords)
+      (setf queries (cddr queries)))
+    (add-to-list 'notmuch-saved-searches
+                 (append (list :name name
+                               :key key
+                               :search-type search-type
+                               :query (apply #'+notmuch-query-concat queries))
+                         (reverse extra-keywords))
+                 :append
+                 (lambda (a b)
+                   (equal (plist-get a :name)
+                          (plist-get b :name))))))
+
+;;; Packages
+
+(use-package bbdb
+  :ensure t
+  :config
+  (setopt bbdb-complete-mail-allow-cycling t
+          bbdb-file (private/ "bbdb"))
+  (add-hook 'custom-allowed-after-load-hook
+            (defun bbdb@after-custom ()
+              (require 'bbdb)
+              (require 'bbdb-message)
+              (bbdb-initialize 'message))))
+
+(use-package bbdb-vcard
+  :ensure t
+  :after bbdb)
+
+(use-package notmuch
+  :when (executable-find "notmuch")
+  :load-path "~/usr/share/emacs/site-lisp/"
+  :defer t
+  :commands (notmuch-mua-new-mail
+             notmuch-search
+             notmuch-hello)
+  :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
+             "Notmuch configuration directory."
+             :makedir)
+  :config
+  ;; Options
+  (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
+          notmuch-address-save-filename (notmuch/ "addresses" t)
+          notmuch-address-use-company (featurep 'company)
+          notmuch-search-oldest-first nil
+          notmuch-archive-tags '("-inbox" "-unread")
+          notmuch-draft-tags '("+draft" "-inbox" "-unread")
+          +notmuch-spam-tags '("+spam" "+Spam")
+          mail-user-agent 'notmuch-user-agent
+          message-mail-user-agent t
+          notmuch-show-indent-content nil
+          message-kill-buffer-on-exit t
+          message-auto-save-directory nil
+          send-mail-function #'sendmail-send-it
+          mail-specify-envelope-from t
+          message-sendmail-envelope-from 'header
+          message-envelope-from 'header
+          notmuch-saved-searches nil)
+  ;; Key bindings
+  (keymap-global-set "C-c m" #'nomtuch-mua-new-mail)
+  (keymap-global-set "C-c n" #'+notmuch-goto)
+  (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
+  (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
+  (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
+  (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam)
+  ;; Saved searches
+  (+notmuch-define-saved-search "inbox+unread" "m" 'tree
+    "tag:inbox" "tag:unread" "NOT tag:Spam")
+  (+notmuch-define-saved-search "inbox" "i" 'tree
+    "tag:inbox" "NOT tag:Spam")
+  (+notmuch-define-saved-search "lists+unread" "l" 'tree
+    "tag:/List/" "tag:unread")
+  (+notmuch-define-saved-search "lists" "L" 'tree
+    "tag:/List/")
+  (+notmuch-define-saved-search "unread" "u" 'tree
+    "tag:unread" "NOT tag:Spam")
+  (+notmuch-define-saved-search "flagged" "f" 'tree
+    "tag:flagged")
+  (+notmuch-define-saved-search "sent" "t" 'tree
+    "tag:sent")
+  (+notmuch-define-saved-search "drafts" "d" 'tree
+    "tag:draft")
+  (+notmuch-define-saved-search "all mail" "a" 'tree "*")
+  ;; Hooks and advice
+  (add-hook 'message-send-hook #'+message-send-dispatch-rules)
+  (add-hook 'message-setup-hook #'+message-signature-setup)
+  (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
+  (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
+  (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
+
+  (define-advice notmuch-address-selection-function
+      (:override (prompt collection _) no-initial-input)
+    "Call `completing-read' with `notmuch-address-history'.
+This version doesn't add any initial-input."
+    (completing-read prompt collection nil nil nil 'notmuch-address-history))
+
+  (add-to-list 'notmuch-message-headers "List-Post" :append #'equal)
+  (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware)
+    "Make `notmuch-mua-new-reply' list-aware."
+    (let ((ml (notmuch-show-get-header :List-Post)))
+      (apply orig r)
+      (when ml
+        (with-buffer-modified-unmodified
+         (message-remove-header "To")
+         (message-add-header
+          (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
+                                                     ml)))
+         (messgage-goto-body)))))
+
+  (define-advice notmuch-tag (:filter-args (args) trim)
+    "Trim whitespace from ends of tags."
+    (list (car args) (mapcar #'string-trim (cadr args))))
+  ;; Load init file
+  ;; (load notmuch-init-file 'noerror)
+  )
+
+(provide 'acdw-mail)
+;;; acdw-mail.el ends here