summaryrefslogtreecommitdiff
path: root/.emacs.d/init-notmuch.el
blob: 805ef194a84674c20e7117dd279d60c06eb82f02 (plain)
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
;;; notmuch-config.el --- Sean's notmuch config -*- lexical-binding: t -*-

(require 'cl-lib)
(require 'dash)
(require 'notmuch)
(require 'notmuch-hello)
(require 'notmuch-message)

(define-key notmuch-hello-mode-map [f9] 'spw/next-unread-group)
(define-key notmuch-message-mode-map "\C-c\C-s" 'message-goto-subject)

(define-key notmuch-show-part-map "\C-c|" 'spw/notmuch-import-gpg)
(define-key notmuch-show-part-map "a"     'spw/notmuch-show-apply-part-projectile)

;; we want these not to be adjacent keys
(define-key notmuch-search-mode-map [f5] 'spw/spam-message)
(define-key notmuch-search-mode-map [f7] 'spw/kill-thread)
(define-key notmuch-search-mode-map [f9] 'spw/next-unread-group)

;; ditto
(define-key notmuch-show-mode-map [f5] 'spw/spam-message)
(define-key notmuch-show-mode-map [f7] 'spw/kill-thread)

(define-key notmuch-tree-mode-map "o" 'spw/notmuch-tree-reader)
(define-key notmuch-tree-mode-map "C" 'spw/notmuch-tree-catchup)

;; ditto
(define-key notmuch-tree-mode-map [f5] 'spw/spam-message)
(define-key notmuch-tree-mode-map [f7] 'spw/kill-thread)
(define-key notmuch-tree-mode-map [f9] 'spw/next-unread-group)

;;;; ---- preferences & variables ----

(setq notmuch-show-all-tags-list t)

(setq
 notmuch-tagging-keys '(("u" ("+unread") "Mark as unread")
                        ("s" ("-unread" "+spam") "Mark as spam")

                        ;;  'm' for 'mute'
                        ("m" ("-unread" "+spw::killed") "Kill thread")

                        ;; for work mail sent to a personal address, or similar
                        ("w" ("+spw::work") "Mark as work-related")

                        ("b" ("+spw::browse") "Mark for browsing")
                        ("d" ("-unread" "+deleted") "Send to trash")
                        ("f" ("-unread" "+flagged") "Unread->flagged")
                        ("F" ("-flagged") "Unflag message"))

 ;; default is t, but given that notmuch searches run to the
 ;; beginning of time, and we are likely to want recent mail, we want
 ;; newer e-mails at the top
 notmuch-search-oldest-first nil

 ;; don't collapse cited text
 ;; We ought to be able to just remove
 ;; `notmuch-wash-excerpt-citations' from
 ;; `notmuch-show-insert-text/plain-hook', but that function is also
 ;; responsible for colouring cited text (this is an upstream bug:
 ;; that function does the colouring for performance reasons but the
 ;; right answer is to use fontlocking, not overlays, for the colouring)
 notmuch-wash-citation-lines-prefix 10000
 notmuch-wash-citation-lines-suffix 10000

 send-mail-function 'sendmail-send-it

 ;; always decrypt & verify PGP parts
 notmuch-crypto-process-mime t

 ;; have Emacs set envelope-from to bypass any MTA rewriting
 mail-specify-envelope-from t
 message-sendmail-envelope-from 'header
 mail-envelope-from 'header

 notmuch-archive-tags '("-unread")
 notmuch-maildir-use-notmuch-insert t
 notmuch-fcc-dirs "sent -unread"

 ;; when 'unread' is being used as an inbox, want manual resolution
 ;; of messages
 notmuch-show-mark-read-function (lambda (beg end))
 notmuch-show-mark-read-tags nil
 ;; but always resolve when I write a reply
 notmuch-message-replied-tags '("-unread" "+replied")

 notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full)

;; these three vars get set in notmuch-groups.el
(defvar spw--lists-readall nil
  "Lists where I want to read all posts as if they're addressed
directly to me -- these get inserted into my main inbox
views.")
(defvar spw--lists-browse nil
  "Lists I want to read like newsgroups, though with no expiry
and manual catchup.

Two ways to read:

1. Access saved searches from `notmuch-hello', then use
`notmuch-search-filter' to look for something in particular.

2. Access using `spw--next-unread-group' to read new postings.")
(defvar spw--lists-archiveonly nil
  "Lists for which I'm subscribed only because I want to
    archive all postings.  Sieve script should be configured to
    mark as read.")
;; indeed, all marking as read should occur server-side

(advice-add 'notmuch-tree-archive-thread :after #'notmuch-tree-next-thread)



;;;; ---- functions ----

(defun spw--notmuch-import-gpg ()
  (interactive)
  (when (get-buffer "*notmuch-pipe*")
    (with-current-buffer "*notmuch-pipe*"
      (let ((buffer-read-only nil)) (erase-buffer))))
  (notmuch-show-pipe-message t "gpg --decrypt | gpg --import")
  (display-buffer "*notmuch-pipe*"))

;; unlike `notmuch-extract-thread-patches' and
;; `notmuch-extract-message-patches', it does not make sense to
;; check out a branch when performing an action which will not make
;; a commit.  If that's wanted, the code which calls
;; `spw--notmuch-show-apply-part-projectile' should perform the checkout
(defun spw--notmuch-show-apply-part-projectile ()
  (interactive)
  (let* ((repo (projectile-completing-read
                "Select projectile project: " projectile-known-projects))
         (default-directory (expand-file-name repo)))
    (notmuch-show-apply-to-current-part-handle
     (lambda (handle)
       (mm-pipe-part handle "git apply")))))

;; not available in `notmuch-search-mode' for now because we want to
;; apply spw::killed to only a single message, not a whole thread,
;; to minimise what gets committed to ~/lib/nmbug-spw
(defun spw--kill-thread ()
  (interactive)
  (case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("+spw::killed"))
     (notmuch-show-archive-thread-then-next))
    (notmuch-tree-mode
     (notmuch-tree-close-message-window)
     (notmuch-tree-tag '("+spw::killed"))
     (notmuch-tree-archive-thread)
     (unless (notmuch-tree-get-match)
       (notmuch-tree-next-matching-message))
     (notmuch-tree-show-message nil)))
  (message "thread killed"))

(defun spw--spam-message ()
  (interactive)
  (case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("-unread" "+spam"))
     (notmuch-show-archive-message-then-next-or-next-thread))
    (notmuch-tree-mode
     (notmuch-tree-tag '("-unread" "+spam"))
     (notmuch-tree-next-matching-message)))
  (message "thread marked as spam"))

(defun spw--notmuch-tree-reader ()
  (interactive)
  (with-current-buffer notmuch-tree-message-buffer
    (re-search-forward "^URL:\\( \\|\n\\)")
    (let ((url (buffer-substring-no-properties (point) (line-end-position))))
      (start-process "firefox" nil "firefox"
                     "-new-window"
                     (concat "about:reader?url=" url)))))



;;;; ---- more variables & functions, with connectives ----

(defvar spw/lists-browse-searches nil
  "Internal cache variable.")
(defvar spw/readall nil
  "Internal cache variable.")
(cl-flet* ((connective (word)
                       (apply-partially
                        (lambda (connec &rest queries)
                          (mapconcat (lambda (query) (concat "(" query ")"))
                                     (-flatten queries)
                                     (concat " " connec " ")))
                        word))
           (disjoin (connective "or"))
           (conjoin (connective "and"))
           (negate (query) (concat "not (" query ")"))
           (thread (query) (concat "thread:{" query "}")))

  (defvar spw--weekday-only-mail (disjoin "to:spwhitton@email.arizona.edu"
                                          "from:arizona.edu"
                                          (thread "tag:spw::work"))
    "Mail to be filtered out of processing views at the weekend.")

  (defun spw--standard-notmuch-saved-searches ()
    (interactive)
    (setq notmuch-saved-searches nil
          spw/lists-browse-searches nil)
    (when (file-exists-p (locate-user-emacs-file "notmuch-groups.el"))
      (load (locate-user-emacs-file "notmuch-groups"))
      (dolist (group spw--lists-browse)
        (let ((search
               (if (atom group)
                   ;; assume we got a List: search and extract the first
                   ;; component of the List-Id to use as the name of the
                   ;; search
                   (let ((name (if (string-match ":\\([^.]+\\)\\." group)
                                   (match-string 1 group)
                                 (error "Could not extract a list name"))))
                     `(:name ,name :search-type nil :sort-order newest-first
                             :query ,group))
                 ;; assume a plist and copy properties across
                 (let ((name (plist-get group :name))
                       (key (plist-get group :key))
                       (query (disjoin (plist-get group :queries))))
                   `(:name ,name :search-type nil :sort-order newest-first
                           :key ,key :query ,query)))))
          (add-to-list 'notmuch-saved-searches search t)
          (add-to-list 'spw/lists-browse-searches
                       (cons (plist-get search :name)
                             (conjoin "tag:unread" (plist-get search :query)))
                       t))))

    (setq spw/readall
          (conjoin
           (disjoin
            "folder:inbox"

            ;; can use this to include all mail addressed directly
            ;; to me in processing views, as an alternative to
            ;; relying on 'folder:inbox'
            ;; (mapcar (lambda (a) (concat "to:" a)) (notmuch-user-emails))

            spw--lists-readall)
           (negate (thread "tag:spw::browse"))))

    ;; now prepend views for processing the day's mail addressed to me
    (let* ((to-process (conjoin "tag:unread" spw/readall))
           (to-process-weekend (conjoin to-process
                                        (negate spw--weekday-only-mail))))
      (add-to-list 'notmuch-saved-searches
                   `(:name "weekend unread" :key "w" :search-type nil
                           :sort-order oldest-first
                           :query ,to-process-weekend))
      (add-to-list 'notmuch-saved-searches
                   `(:name "weekday unread" :key "u" :search-type nil
                           :sort-order oldest-first
                           :query ,to-process)))

    ;; append some miscellaneous views
    (add-to-list 'notmuch-saved-searches
                 '(:name "flagged" :key "f" :search-type tree
                         :query "tag:flagged" ) t)
    (add-to-list 'notmuch-saved-searches
                 `(:name "sent" :key "s" :search-type nil
                         :sort-order newest-first
                         :query ,(disjoin
                                  (mapcar
                                   (lambda (a) (concat "from:" a))
                                   (notmuch-user-emails))))
                 t)
    (add-to-list 'notmuch-saved-searches
                 '(:name "drafts" :key "D" :search-type nil
                         :sort-order newest-first
                         :query "tag:draft") t)
    (add-to-list 'notmuch-saved-searches
                 '(:name "imported series" :key "P" :search-type nil
                         :sort-order newest-first
                         :query "subject:\"/PATCH .+ imported/\"") t)

    ;; finally, groups/lists where I don't know how or whether I want to
    ;; follow them; I may have subscribed just to post something
    (let* ((categorised (disjoin
                         spw/readall
                         (mapcar (lambda (search)
                                   (if (atom search)
                                       search
                                     (plist-get search :queries)))
                                 spw--lists-browse)
                         spw--lists-archiveonly))
           (query `(:name "uncategorised unread" :key "U" :search-type nil
                          :sort-order newest-first
                          :query ,(conjoin "tag:unread"
                                           (negate categorised)))))
      (add-to-list 'notmuch-saved-searches query t)
      (add-to-list 'spw/lists-browse-searches
                   (cons "uncategorised unread"
                         (conjoin "tag:unread"
                                  (negate categorised))) t)))

  (unless spw/lists-browse-searches
    (spw--standard-notmuch-saved-searches))

  (defun spw/next-unread-group ()
    (interactive)
    (let ((already-looking (boundp 'spw--more-unread-groups))
          (queries (bound-and-true-p spw--more-unread-groups))
          (remaining))
      (when already-looking
        (notmuch-tree-close-message-window)
        (kill-buffer (current-buffer)))
      (if (or (and already-looking (not queries))
              (not (setq remaining (seq-drop-while
                                    (lambda (q)
                                      (zerop (string-to-number
                                              (notmuch-saved-search-count
                                               (cdr q)))))
                                    (or queries spw/lists-browse-searches)))))
          (notmuch-hello)
        (notmuch-tree (cdar remaining) nil nil
                      (concat "*notmuch-tree-saved-search-"
                              (caar remaining) "*"))
        (set (make-local-variable 'spw--more-unread-groups)
             (cdr remaining)))))

  ;; use on views produced by `spw--next-unread-group'
  (defun spw--notmuch-tree-catchup ()
    (interactive)
    (when (and (eq major-mode 'notmuch-tree-mode)
               (y-or-n-p "Are you sure you want to mark all as read?")
               spw/readall)
      (notmuch-tag (conjoin (notmuch-tree-get-query) (negate spw/readall))
                   '("-unread"))
      (notmuch-refresh-this-buffer))))