1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*-
;;; Commentary:
;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't.
;;; Code:
(require 'cl-lib)
(require 'notmuch)
(defvar +notmuch-send-dispatch-rules nil
"Alist of from addresses and variables to set when sending.")
(defun +notmuch-query-concat (&rest queries)
"Concatenate notmuch queries."
(mapconcat #'identity queries " AND "))
(defun +send-mail-dispatch ()
"Dispatch mail sender, depending on account."
(let ((from (message-fetch-field "from")))
(dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules
if (string-match-p addr from) return vars))
(set (car vars) (cdr vars)))))
(defun +notmuch-correct-tags (args)
(list (car args) (mapcar #'string-trim (cadr args))))
(defun +notmuch-goto (&optional prefix)
"Go straight to a `notmuch' search.
Without PREFIX argument, go to the first one in
`notmuch-saved-searches'; with a PREFIX argument, prompt the user
for which saved search to go to; with a double PREFIX
argument (\\[universal-argument] \\[universal-argument]), prompt
for search."
(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 (el)
(plist-get el :name))
notmuch-saved-searches))
notmuch-saved-searches
:key (lambda (el) (plist-get el :name))
:test #'equal)
:query)))
(_ (notmuch-search))))
;; Don't add an initial input when completing addresses
(eval-after notmuch
(cond ((featurep 'el-patch)
(el-patch-feature notmuch)
(el-patch-defun notmuch-address-selection-function (prompt collection initial-input)
"Call (`completing-read'
PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
(completing-read
prompt collection nil nil
(el-patch-swap initial-input
nil)
'notmuch-address-history)))
(:else
(defun notmuch-address-selection-function (prompt collection initial-input)
"Call (`completing-read'
PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
(completing-read
prompt collection nil nil nil
'notmuch-address-history)))))
(defcustom +notmuch-spam-tags '("+spam" "+Spam")
"A list of tag changes to apply when marking a thread as spam."
:type '(repeat string))
(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end)
"Mark the current message as spam and move to the next."
(interactive "P")
(+notmuch-tree-mark-spam ham)
(notmuch-tree-next-matching-message))
(defun +notmuch-tree-mark-spam (&optional ham)
"Mark the current message as spam.
That is, apply the tag changes in `+notmuch-spam-tags' to it. If
an optional prefix HAM argument is given, the message will be
marked as not-spam (\"ham\"), i.e., the tag changes in
`+notmuch-spam-tags' will be reversed."
(interactive "P")
(when +notmuch-spam-tags
(notmuch-tree-tag
(notmuch-tag-change-list +notmuch-spam-tags ham))))
(defun +notmuch-search-mark-spam (&optional ham beg end)
"Mark the current thread or region as spam.
This adds the tags in `+notmuch-spam-tags' to the message. With
an optional HAM prefix argument, mark the messages as
not-spam (\"ham\").
This function advances the next thread when finished."
(interactive (cons current-prefix-arg (notmuch-interactive-region)))
(when +notmuch-spam-tags
(notmuch-search-tag
(notmuch-tag-change-list +notmuch-spam-tags ham) beg end))
(when (eq beg end)
(notmuch-search-next-thread)))
(defun +notmuch-tree-beginning (&optional arg)
"Move point to beginning of message or tree, depending on ARG."
(interactive "P")
(cond
((and (window-live-p notmuch-tree-message-window)
(not arg))
(with-selected-window notmuch-tree-message-window
(beginning-of-buffer)))
(:else (beginning-of-buffer))))
(defun +notmuch-tree-end (&optional arg)
"Move point to end of message or tree, depending on ARG."
(interactive "P")
(cond
((and (window-live-p notmuch-tree-message-window)
(not arg))
(with-selected-window notmuch-tree-message-window
(end-of-buffer)))
(:else (end-of-buffer))))
(defun +notmuch-make-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))))))
(provide '+notmuch)
;;; +notmuch.el ends here
|
