diff options
author | Case Duckworth | 2023-01-12 16:39:38 -0600 |
---|---|---|
committer | Case Duckworth | 2023-01-12 16:39:38 -0600 |
commit | 22b0a6b56ffe8c423047ee25440dce79a990610c (patch) | |
tree | e6aa91334f4d9f74009fcb83f04165fe04468afe /lisp/acdw-mail.el | |
parent | Meh (diff) | |
download | emacs-22b0a6b56ffe8c423047ee25440dce79a990610c.tar.gz emacs-22b0a6b56ffe8c423047ee25440dce79a990610c.zip |
Make it work for ... $work
Diffstat (limited to 'lisp/acdw-mail.el')
-rw-r--r-- | lisp/acdw-mail.el | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el new file mode 100644 index 0000000..d0ee28e --- /dev/null +++ b/lisp/acdw-mail.el | |||
@@ -0,0 +1,233 @@ | |||
1 | ;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | ;;; Variables | ||
8 | |||
9 | (defcustom +message-send-dispatch-rules nil | ||
10 | "Alist to set variables based on the current from address." | ||
11 | :group 'message | ||
12 | :type '(alist :key-type (string :tag "From address") | ||
13 | :value-type (alist :tag "Rules" | ||
14 | :key-type (symbol :tag "Variable") | ||
15 | :value-type (sexp :tag "Value")))) | ||
16 | |||
17 | (defcustom +notmuch-spam-tags '("+spam") | ||
18 | "List of tag changes to apply when marking a thread as spam." | ||
19 | :group 'notmuch | ||
20 | :type '(repeat string)) | ||
21 | |||
22 | ;;; Functions | ||
23 | |||
24 | (defun +message-send-set-variables () | ||
25 | "Set variables for `message-send' depending on the From: header. | ||
26 | Useful in `message-send-hook'." | ||
27 | (let ((from (message-fetch-field "from"))) | ||
28 | (cl-loop for (var . val) in (cl-loop for (address . bindings) | ||
29 | in +message-send-dispatch-rules | ||
30 | if (string-match-p address from) | ||
31 | return bindings) | ||
32 | do (set (make-local-variable var) val)))) | ||
33 | |||
34 | ;; Thanks to Alex Schroeder! | ||
35 | ;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically | ||
36 | (defun +message-check-for-signature-change (&rest ignore) | ||
37 | "Check for a change in the To: or Cc: fields" | ||
38 | (when (and (message--in-tocc-p) | ||
39 | (not (buffer-narrowed-p))) | ||
40 | (save-excursion | ||
41 | (goto-char (point-max)) | ||
42 | (let ((end (point))) | ||
43 | (when (re-search-backward message-signature-separator nil t) | ||
44 | (delete-region (1- (match-beginning 0)) end))) | ||
45 | (message-insert-signature)))) | ||
46 | |||
47 | (defun +message-signature-setup () | ||
48 | (make-local-variable 'after-change-functions) | ||
49 | (push '+message-check-for-signature-change after-change-functions)) | ||
50 | |||
51 | (defun +notmuch-field-match-p (field regexp) | ||
52 | "Return whether message FIELD matches REGEXP." | ||
53 | (string-match-p regexp (or (message-fetch-field field) ""))) | ||
54 | |||
55 | (defun +notmuch-query-concat (&rest queries) | ||
56 | "Concatenate `notmuch' QUERIES with AND." | ||
57 | (mapconcat #'identity queries " AND ")) | ||
58 | |||
59 | (defun +notmuch-goto (&optional prefix) | ||
60 | "Perform a saved `notmuch' search. | ||
61 | Without a PREFIX argument, perform the first search in | ||
62 | `notmuch-saved-searches'. With a single PREFIX argument | ||
63 | (\\[universal-argument]), prompt the user as to which saved | ||
64 | search to perform. With two PREFIX arguments, prompt the user | ||
65 | for a free-form search. With any other PREFIX argument, open | ||
66 | `notmuch-hello'." | ||
67 | (interactive "P") | ||
68 | (pcase prefix | ||
69 | ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) | ||
70 | ('(4) (notmuch-search | ||
71 | (plist-get (cl-find (completing-read "Saved search: " | ||
72 | (mapcar (lambda (elt) | ||
73 | (plist-get elt :name)) | ||
74 | notmuch-saved-searches)) | ||
75 | :key (lambda (elt) (plist-get elt :name)) | ||
76 | :test #'equal) | ||
77 | :query))) | ||
78 | ('(16) (notmuch-search)) | ||
79 | (_ (notmuch-hello)))) | ||
80 | |||
81 | (defun +notmuch-search-mark-spam (&optional ham start end) | ||
82 | "Mark the current thread or region as spam. | ||
83 | That is, add the tags in `+notmuch-spam-tags' to the message. | ||
84 | With an optional HAM argument (interactively, | ||
85 | \\[universal-argument]), mark the message as not-spam, or ham, by | ||
86 | reversing the tag changes." | ||
87 | (interactive (cons current-prefix-arg (notmuch-interactive-region))) | ||
88 | (when +notmuch-spam-tags | ||
89 | (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham) | ||
90 | start end)) | ||
91 | (when (eq start end) | ||
92 | (notmuch-search-next-thread))) | ||
93 | |||
94 | (defun +notmuch-tree-mark-spam (&optional ham) | ||
95 | "Mark the current message as spam. | ||
96 | That is, add the tags in `+notmuch-spam-tags' to the message. | ||
97 | With an optional HAM argument (interactively, | ||
98 | \\[universal-argument]), mark the message as not-spam, or ham, by | ||
99 | reversing the tag changes." | ||
100 | (interactive (cons current-prefix-arg (notmuch-interactive-region))) | ||
101 | (when +notmuch-spam-tags | ||
102 | (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham))) | ||
103 | (notmuch-tree-next-matching-message)) | ||
104 | |||
105 | (defun +notmuch-define-saved-search (name key search-type &rest queries) | ||
106 | "Wrapper to ease `notmuch-saved-searches' defining. | ||
107 | NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in | ||
108 | `notmuch-saved-searches', which see. QUERIES are all concatenated together with | ||
109 | AND. If QUERIES is prepended with more keyword arguments, those are added to | ||
110 | the saved search as well." | ||
111 | (declare (indent 3)) | ||
112 | (let (extra-keywords) | ||
113 | (while (keywordp (car queries)) | ||
114 | (push (cadr queries) extra-keywords) | ||
115 | (push (car queries) extra-keywords) | ||
116 | (setf queries (cddr queries))) | ||
117 | (add-to-list 'notmuch-saved-searches | ||
118 | (append (list :name name | ||
119 | :key key | ||
120 | :search-type search-type | ||
121 | :query (apply #'+notmuch-query-concat queries)) | ||
122 | (reverse extra-keywords)) | ||
123 | :append | ||
124 | (lambda (a b) | ||
125 | (equal (plist-get a :name) | ||
126 | (plist-get b :name)))))) | ||
127 | |||
128 | ;;; Packages | ||
129 | |||
130 | (use-package bbdb | ||
131 | :ensure t | ||
132 | :config | ||
133 | (setopt bbdb-complete-mail-allow-cycling t | ||
134 | bbdb-file (private/ "bbdb")) | ||
135 | (add-hook 'custom-allowed-after-load-hook | ||
136 | (defun bbdb@after-custom () | ||
137 | (require 'bbdb) | ||
138 | (require 'bbdb-message) | ||
139 | (bbdb-initialize 'message)))) | ||
140 | |||
141 | (use-package bbdb-vcard | ||
142 | :ensure t | ||
143 | :after bbdb) | ||
144 | |||
145 | (use-package notmuch | ||
146 | :when (executable-find "notmuch") | ||
147 | :load-path "~/usr/share/emacs/site-lisp/" | ||
148 | :defer t | ||
149 | :commands (notmuch-mua-new-mail | ||
150 | notmuch-search | ||
151 | notmuch-hello) | ||
152 | :preface (defdir notmuch/ (sync/ "emacs/notmuch/") | ||
153 | "Notmuch configuration directory." | ||
154 | :makedir) | ||
155 | :config | ||
156 | ;; Options | ||
157 | (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) | ||
158 | notmuch-address-save-filename (notmuch/ "addresses" t) | ||
159 | notmuch-address-use-company (featurep 'company) | ||
160 | notmuch-search-oldest-first nil | ||
161 | notmuch-archive-tags '("-inbox" "-unread") | ||
162 | notmuch-draft-tags '("+draft" "-inbox" "-unread") | ||
163 | +notmuch-spam-tags '("+spam" "+Spam") | ||
164 | mail-user-agent 'notmuch-user-agent | ||
165 | message-mail-user-agent t | ||
166 | notmuch-show-indent-content nil | ||
167 | message-kill-buffer-on-exit t | ||
168 | message-auto-save-directory nil | ||
169 | send-mail-function #'sendmail-send-it | ||
170 | mail-specify-envelope-from t | ||
171 | message-sendmail-envelope-from 'header | ||
172 | message-envelope-from 'header | ||
173 | notmuch-saved-searches nil) | ||
174 | ;; Key bindings | ||
175 | (keymap-global-set "C-c m" #'nomtuch-mua-new-mail) | ||
176 | (keymap-global-set "C-c n" #'+notmuch-goto) | ||
177 | (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) | ||
178 | (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) | ||
179 | (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread) | ||
180 | (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam) | ||
181 | ;; Saved searches | ||
182 | (+notmuch-define-saved-search "inbox+unread" "m" 'tree | ||
183 | "tag:inbox" "tag:unread" "NOT tag:Spam") | ||
184 | (+notmuch-define-saved-search "inbox" "i" 'tree | ||
185 | "tag:inbox" "NOT tag:Spam") | ||
186 | (+notmuch-define-saved-search "lists+unread" "l" 'tree | ||
187 | "tag:/List/" "tag:unread") | ||
188 | (+notmuch-define-saved-search "lists" "L" 'tree | ||
189 | "tag:/List/") | ||
190 | (+notmuch-define-saved-search "unread" "u" 'tree | ||
191 | "tag:unread" "NOT tag:Spam") | ||
192 | (+notmuch-define-saved-search "flagged" "f" 'tree | ||
193 | "tag:flagged") | ||
194 | (+notmuch-define-saved-search "sent" "t" 'tree | ||
195 | "tag:sent") | ||
196 | (+notmuch-define-saved-search "drafts" "d" 'tree | ||
197 | "tag:draft") | ||
198 | (+notmuch-define-saved-search "all mail" "a" 'tree "*") | ||
199 | ;; Hooks and advice | ||
200 | (add-hook 'message-send-hook #'+message-send-dispatch-rules) | ||
201 | (add-hook 'message-setup-hook #'+message-signature-setup) | ||
202 | (autoload 'visual-fill-column-mode "visual-fill-column" nil t) | ||
203 | (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) | ||
204 | (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) | ||
205 | |||
206 | (define-advice notmuch-address-selection-function | ||
207 | (:override (prompt collection _) no-initial-input) | ||
208 | "Call `completing-read' with `notmuch-address-history'. | ||
209 | This version doesn't add any initial-input." | ||
210 | (completing-read prompt collection nil nil nil 'notmuch-address-history)) | ||
211 | |||
212 | (add-to-list 'notmuch-message-headers "List-Post" :append #'equal) | ||
213 | (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) | ||
214 | "Make `notmuch-mua-new-reply' list-aware." | ||
215 | (let ((ml (notmuch-show-get-header :List-Post))) | ||
216 | (apply orig r) | ||
217 | (when ml | ||
218 | (with-buffer-modified-unmodified | ||
219 | (message-remove-header "To") | ||
220 | (message-add-header | ||
221 | (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" | ||
222 | ml))) | ||
223 | (messgage-goto-body))))) | ||
224 | |||
225 | (define-advice notmuch-tag (:filter-args (args) trim) | ||
226 | "Trim whitespace from ends of tags." | ||
227 | (list (car args) (mapcar #'string-trim (cadr args)))) | ||
228 | ;; Load init file | ||
229 | ;; (load notmuch-init-file 'noerror) | ||
230 | ) | ||
231 | |||
232 | (provide 'acdw-mail) | ||
233 | ;;; acdw-mail.el ends here | ||