notmuch.el: Add command to (a)rchive a thread from notmuch-show mode.
[notmuch] / notmuch.el
1 ; notmuch.el --- run notmuch within emacs
2 ;
3 ; Copyright © Carl Worth
4 ;
5 ; This file is part of Notmuch.
6 ;
7 ; Notmuch is free software: you can redistribute it and/or modify it
8 ; under the terms of the GNU General Public License as published by
9 ; the Free Software Foundation, either version 3 of the License, or
10 ; (at your option) any later version.
11 ;
12 ; Notmuch is distributed in the hope that it will be useful, but
13 ; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 ; General Public License for more details.
16 ;
17 ; You should have received a copy of the GNU General Public License
18 ; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
19 ;
20 ; Authors: Carl Worth <cworth@cworth.org>
21 ;
22 ; Much of notmuch.el was written by looking at the implementation of
23 ; compile.el from the emacs distribution source which has the
24 ; following copyright and authorsip (and the identical license as
25 ; above):
26 ;
27 ; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
28 ;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
29 ;   Free Software Foundation, Inc.
30
31 ; Authors: Roland McGrath <roland@gnu.org>,
32 ;           Daniel Pfeiffer <occitan@esperanto.org>
33
34 (defvar notmuch-show-mode-map
35   (let ((map (make-sparse-keymap)))
36     ; I don't actually want all of these toggle commands occupying
37     ; keybindings. They steal valuable key-binding space, are hard
38     ; to remember, and act globally rather than locally.
39     ;
40     ; Will be much preferable to switch to direct manipulation for
41     ; toggling visibility of these components. Probably using
42     ; overlays-at to query and manipulate the current overlay.
43     (define-key map "a" 'notmuch-show-archive-thread)
44     (define-key map "b" 'notmuch-show-toggle-body-read-visible)
45     (define-key map "c" 'notmuch-show-toggle-citations-visible)
46     (define-key map "h" 'notmuch-show-toggle-headers-visible)
47     (define-key map "n" 'notmuch-show-mark-read-then-next-message)
48     (define-key map "p" 'notmuch-show-previous-message)
49     (define-key map "q" 'kill-this-buffer)
50     (define-key map "s" 'notmuch-show-toggle-signatures-visible)
51     (define-key map "x" 'kill-this-buffer)
52     (define-key map "+" 'notmuch-show-add-tag)
53     (define-key map "-" 'notmuch-show-remove-tag)
54     map)
55   "Keymap for \"notmuch show\" buffers.")
56 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
57
58 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
59 (defvar notmuch-show-message-end-regexp      "\fmessage}")
60 (defvar notmuch-show-header-begin-regexp     "\fheader{")
61 (defvar notmuch-show-header-end-regexp       "\fheader}")
62 (defvar notmuch-show-body-begin-regexp       "\fbody{")
63 (defvar notmuch-show-body-end-regexp         "\fbody}")
64 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
65 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
66 (defvar notmuch-show-part-begin-regexp       "\fpart{")
67 (defvar notmuch-show-part-end-regexp         "\fpart}")
68 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
69
70 (defvar notmuch-show-id-regexp "ID: \\(.*\\)$")
71 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
72
73 (defun notmuch-show-get-message-id ()
74   (save-excursion
75     (beginning-of-line)
76     (if (not (looking-at notmuch-show-message-begin-regexp))
77         (re-search-backward notmuch-show-message-begin-regexp))
78     (re-search-forward notmuch-show-id-regexp)
79     (buffer-substring (match-beginning 1) (match-end 1))))
80
81 (defun notmuch-show-set-tags (tags)
82   (save-excursion
83     (beginning-of-line)
84     (if (not (looking-at notmuch-show-message-begin-regexp))
85         (re-search-backward notmuch-show-message-begin-regexp))
86     (re-search-forward notmuch-show-tags-regexp)
87     (let ((inhibit-read-only t)
88           (beg (match-beginning 1))
89           (end (match-end 1)))
90       (delete-region beg end)
91       (goto-char beg)
92       (insert (mapconcat 'identity tags " ")))))
93
94 (defun notmuch-show-get-tags ()
95   (save-excursion
96     (beginning-of-line)
97     (if (not (looking-at notmuch-show-message-begin-regexp))
98         (re-search-backward notmuch-show-message-begin-regexp))
99     (re-search-forward notmuch-show-tags-regexp)
100     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
101
102 (defun notmuch-show-add-tag (tag)
103   (interactive "sTag to add: ")
104   (notmuch-call-notmuch-process "tag" (concat "+" tag) (concat "id:" (notmuch-show-get-message-id)))
105   (notmuch-show-set-tags (delete-dups (sort (cons tag (notmuch-show-get-tags)) 'string<))))
106
107 (defun notmuch-show-remove-tag (tag)
108   (interactive "sTag to remove: ")
109   (notmuch-call-notmuch-process "tag" (concat "-" tag) (concat "id:" (notmuch-show-get-message-id)))
110   (notmuch-show-set-tags (delete tag (notmuch-show-get-tags))))
111
112 (defun notmuch-show-archive-thread ()
113   "Archive each message currrently shown by removing the \"inbox\" tag from each.
114
115 This command is safe from any race condition of new messages
116 being delivered to the same thread. It does not archive the
117 entire thread, but only the messages shown in the current
118 buffer."
119   (interactive)
120   (save-excursion
121     (goto-char (point-min))
122     (while (not (eobp))
123       (notmuch-show-remove-tag "inbox")
124       (if (not (eobp))
125           (forward-char))
126       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
127           (goto-char (point-max))))))
128
129 (defun notmuch-show-next-message ()
130   "Advance point to the beginning of the next message in the buffer.
131
132 Does nothing if already on the last message."
133   (interactive)
134   ; First, ensure we get off the current message marker
135   (if (not (eobp))
136       (forward-char))
137   (re-search-forward notmuch-show-message-begin-regexp nil t)
138   ; This dance might look pointless, but it's important. I originally
139   ; just had (beginning-of-line) here which looked right on the
140   ; display but actually put point all the way back to the first
141   ; character of the first invisible line. That is, it put point into
142   ; the closing markers of the previous message rather than at the
143   ; beginning of the current message. And that in turn meant that
144   ; looking up the current message-ID would actually return the
145   ; previous message ID.
146   ;
147   ; So this dance ensures that we're actually on the current message
148   ; when it looks like we are.
149   (end-of-visible-line)
150   (beginning-of-line)
151   (recenter 0))
152
153 (defun notmuch-show-previous-message ()
154   "Backup to the beginning of the previous message in the buffer.
155
156 Does nothing if already on the first message in the buffer."
157   (interactive)
158   ; First, ensure we get off the current message marker
159   (if (not (bobp))
160       (previous-line))
161   (re-search-backward notmuch-show-message-begin-regexp nil t)
162   ; This dance might look pointless, but it's important. I originally
163   ; just had (beginning-of-line) here which looked right on the
164   ; display but actually put point all the way back to the first
165   ; character of the first invisible line. That is, it put point into
166   ; the closing markers of the previous message rather than at the
167   ; beginning of the current message. And that in turn meant that
168   ; looking up the current message-ID would actually return the
169   ; previous message ID.
170   ;
171   ; So this dance ensures that we're actually on the current message
172   ; when it looks like we are.
173   (end-of-visible-line)
174   (beginning-of-line)
175   (recenter 0))
176
177 (defun notmuch-show-mark-read-then-next-message ()
178   "Remove uread tag from current message, then advance to next message."
179   (interactive)
180   (if (member "unread" (notmuch-show-get-tags))
181       (notmuch-show-remove-tag "unread"))
182   (notmuch-show-next-message))
183
184 (defun notmuch-show-markup-citations-region (beg end)
185   (goto-char beg)
186   (beginning-of-line)
187   (while (< (point) end)
188     (let ((beg-sub (point)))
189       (if (looking-at ">")
190           (progn
191             (while (looking-at ">")
192               (next-line))
193             (let ((overlay (make-overlay beg-sub (point))))
194               (overlay-put overlay 'invisible 'notmuch-show-citation)
195               (overlay-put overlay 'before-string
196                            (concat "[" (number-to-string (count-lines beg-sub (point)))
197                                    " quoted lines.]")))))
198       (if (looking-at "--[ ]?$")
199           (let ((overlay (make-overlay beg-sub end)))
200             (overlay-put overlay 'invisible 'notmuch-show-signature)
201             (overlay-put overlay 'before-string
202                          (concat "[" (number-to-string (count-lines beg-sub (point)))
203                                  "-line signature.]"))
204             (goto-char end)))
205       (next-line))))
206
207 (defun notmuch-show-markup-body ()
208   (re-search-forward notmuch-show-body-begin-regexp)
209   (next-line 1)
210   (beginning-of-line)
211   (let ((beg (point)))
212     (re-search-forward notmuch-show-body-end-regexp)
213     (let ((end (match-beginning 0)))
214       (if (not (member "unread" (notmuch-show-get-tags)))
215           (overlay-put (make-overlay beg end)
216                        'invisible 'notmuch-show-body-read))
217       (notmuch-show-markup-citations-region beg end))))
218
219 (defun notmuch-show-markup-header ()
220   (re-search-forward notmuch-show-header-begin-regexp)
221   (next-line 2)
222   (beginning-of-line)
223   (let ((beg (point)))
224     (re-search-forward notmuch-show-header-end-regexp)
225     (overlay-put (make-overlay beg (match-beginning 0))
226                  'invisible 'notmuch-show-header)))
227
228 (defun notmuch-show-markup-message ()
229   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
230       (progn
231         (notmuch-show-markup-header)
232         (notmuch-show-markup-body))
233     (goto-char (point-max))))
234
235 (defun notmuch-show-hide-markers ()
236   (save-excursion
237     (goto-char (point-min))
238     (while (not (eobp))
239       (if (re-search-forward notmuch-show-marker-regexp nil t)
240           (progn
241             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
242                          'invisible 'notmuch-show-marker))
243         (goto-char (point-max))))))
244
245 (defun notmuch-show-markup-messages ()
246   (save-excursion
247     (goto-char (point-min))
248     (while (not (eobp))
249       (notmuch-show-markup-message)))
250   (notmuch-show-hide-markers))
251
252 (defun notmuch-show-toggle-citations-visible ()
253   "Toggle visibility of citations"
254   (interactive)
255   (if notmuch-show-citations-visible
256       (add-to-invisibility-spec 'notmuch-show-citation)
257     (remove-from-invisibility-spec 'notmuch-show-citation))
258   (set 'notmuch-show-citations-visible (not notmuch-show-citations-visible))
259   ; Need to force the redisplay for some reason
260   (force-window-update)
261   (redisplay t))
262
263 (defun notmuch-show-toggle-signatures-visible ()
264   "Toggle visibility of signatures"
265   (interactive)
266   (if notmuch-show-signatures-visible
267       (add-to-invisibility-spec 'notmuch-show-signature)
268     (remove-from-invisibility-spec 'notmuch-show-signature))
269   (set 'notmuch-show-signatures-visible (not notmuch-show-signatures-visible))
270   ; Need to force the redisplay for some reason
271   (force-window-update)
272   (redisplay t))
273
274 (defun notmuch-show-toggle-headers-visible ()
275   "Toggle visibility of header fields"
276   (interactive)
277   (if notmuch-show-headers-visible
278       (add-to-invisibility-spec 'notmuch-show-header)
279     (remove-from-invisibility-spec 'notmuch-show-header))
280   (set 'notmuch-show-headers-visible (not notmuch-show-headers-visible))
281   ; Need to force the redisplay for some reason
282   (force-window-update)
283   (redisplay t))
284
285 (defun notmuch-show-toggle-body-read-visible ()
286   "Toggle visibility of message bodies of read messages"
287   (interactive)
288   (if notmuch-show-body-read-visible
289       (add-to-invisibility-spec 'notmuch-show-body-read)
290     (remove-from-invisibility-spec 'notmuch-show-body-read))
291   (set 'notmuch-show-body-read-visible (not notmuch-show-body-read-visible))
292   ; Need to force the redisplay for some reason
293   (force-window-update)
294   (redisplay t))
295
296 ;;;###autoload
297 (defun notmuch-show-mode ()
298   "Major mode for handling the output of \"notmuch show\""
299   (interactive)
300   (kill-all-local-variables)
301   (set (make-local-variable 'notmuch-show-headers-visible) t)
302   (notmuch-show-toggle-headers-visible)
303   (set (make-local-variable 'notmuch-show-body-read-visible) t)
304   (notmuch-show-toggle-body-read-visible)
305   (set (make-local-variable 'notmuch-show-citations-visible) t)
306   (notmuch-show-toggle-citations-visible)
307   (set (make-local-variable 'notmuch-show-signatures-visible) t)
308   (notmuch-show-toggle-signatures-visible)
309   (add-to-invisibility-spec 'notmuch-show-marker)
310   (use-local-map notmuch-show-mode-map)
311   (setq major-mode 'notmuch-show-mode
312         mode-name "notmuch-show")
313   (setq buffer-read-only t))
314
315 (defun notmuch-show (thread-id)
316   "Run \"notmuch show\" with the given thread ID and display results."
317   (interactive "sNotmuch show: ")
318   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
319     (switch-to-buffer buffer)
320     (notmuch-show-mode)
321     (let ((proc (get-buffer-process (current-buffer)))
322           (inhibit-read-only t))
323       (if proc
324           (error "notmuch search process already running for query `%s'" query)
325         )
326       (erase-buffer)
327       (goto-char (point-min))
328       (save-excursion
329         (call-process "notmuch" nil t nil "show" thread-id)
330         (notmuch-show-markup-messages)
331         )
332       )))
333
334 (defvar notmuch-search-mode-map
335   (let ((map (make-sparse-keymap)))
336     (define-key map "a" 'notmuch-search-archive-thread)
337     (define-key map "f" 'notmuch-search-filter)
338     (define-key map "n" 'next-line)
339     (define-key map "p" 'previous-line)
340     (define-key map "q" 'kill-this-buffer)
341     (define-key map "s" 'notmuch-search)
342     (define-key map "x" 'kill-this-buffer)
343     (define-key map "\r" 'notmuch-search-show-thread)
344     (define-key map "+" 'notmuch-search-add-tag)
345     (define-key map "-" 'notmuch-search-remove-tag)
346     (define-key map "<" 'beginning-of-buffer)
347     (define-key map ">" 'notmuch-search-goto-last-thread)
348     (define-key map "=" 'notmuch-search-refresh-view)
349     (define-key map "\M->" 'notmuch-search-goto-last-thread)
350     map)
351   "Keymap for \"notmuch search\" buffers.")
352 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
353
354 (defun notmuch-search-goto-last-thread (&optional arg)
355   "Move point to the last thread in the buffer."
356   (interactive "^P")
357   (end-of-buffer arg)
358   (beginning-of-line))
359
360 ;;;###autoload
361 (defun notmuch-search-mode ()
362   "Major mode for handling the output of \"notmuch search\""
363   (interactive)
364   (kill-all-local-variables)
365   (make-local-variable 'notmuch-search-query-string)
366   (use-local-map notmuch-search-mode-map)
367   (setq major-mode 'notmuch-search-mode
368         mode-name "notmuch-search")
369   (setq buffer-read-only t))
370
371 (defun notmuch-search-find-thread-id ()
372   (save-excursion
373     (beginning-of-line)
374     (let ((beg (point)))
375       (re-search-forward "[a-fA-F0-9]*")
376       (filter-buffer-substring beg (point)))))
377
378 (defun notmuch-search-markup-this-thread-id ()
379   (beginning-of-line)
380   (let ((beg (point)))
381     (re-search-forward "[a-fA-F0-9]*")
382     (forward-char)
383     (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search)))
384
385 (defun notmuch-search-markup-thread-ids ()
386   (save-excursion
387     (goto-char (point-min))
388     (while (not (eobp))
389       (notmuch-search-markup-this-thread-id)
390       (next-line))))
391
392 (defun notmuch-search-hide-thread-ids ()
393   (interactive)
394   (add-to-invisibility-spec 'notmuch-search))
395
396 (defun notmuch-search-show-thread-ids ()
397   (interactive)
398   (remove-from-invisibility-spec 'notmuch-search))
399
400 (defun notmuch-search-show-thread ()
401   (interactive)
402   (notmuch-show (notmuch-search-find-thread-id)))
403
404 (defun notmuch-call-notmuch-process (&rest args)
405   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
406     (with-current-buffer error-buffer
407         (erase-buffer))
408     (if (eq (apply 'call-process "notmuch" nil error-buffer nil args) 0)
409         (point)
410       (progn
411         (with-current-buffer error-buffer
412           (let ((beg (point-min))
413                 (end (- (point-max) 1)))
414             (error (buffer-substring beg end))
415             ))))))
416
417 (defun notmuch-search-set-tags (tags)
418   (save-excursion
419     (end-of-line)
420     (re-search-backward "(")
421     (forward-char)
422     (let ((beg (point))
423           (inhibit-read-only t))
424       (re-search-forward ")")
425       (backward-char)
426       (let ((end (point)))
427         (delete-region beg end)
428         (insert (mapconcat  'identity tags " "))))))
429
430 (defun notmuch-search-get-tags ()
431   (save-excursion
432     (end-of-line)
433     (re-search-backward "(")
434     (let ((beg (+ (point) 1)))
435       (re-search-forward ")")
436       (let ((end (- (point) 1)))
437         (split-string (buffer-substring beg end))))))
438
439 (defun notmuch-search-add-tag (tag)
440   (interactive "sTag to add: ")
441   (notmuch-call-notmuch-process "tag" (concat "+" tag) (concat "thread:" (notmuch-search-find-thread-id)))
442   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
443
444 (defun notmuch-search-remove-tag (tag)
445   (interactive "sTag to remove: ")
446   (notmuch-call-notmuch-process "tag" (concat "-" tag) (concat "thread:" (notmuch-search-find-thread-id)))
447   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
448
449 (defun notmuch-search-archive-thread ()
450   (interactive)
451   (notmuch-search-remove-tag "inbox"))
452
453 (defun notmuch-search (query)
454   "Run \"notmuch search\" with the given query string and display results."
455   (interactive "sNotmuch search: ")
456   (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
457     (switch-to-buffer buffer)
458     (notmuch-search-mode)
459     (set 'notmuch-search-query-string query)
460     (let ((proc (get-buffer-process (current-buffer)))
461           (inhibit-read-only t))
462       (if proc
463           (error "notmuch search process already running for query `%s'" query)
464         )
465       (erase-buffer)
466       (goto-char (point-min))
467       (save-excursion
468         (call-process "notmuch" nil t nil "search" query)
469         (notmuch-search-markup-thread-ids)
470         ; A well-behaved program ends its output with a newline, but we
471         ; don't actually want the blank line at the end of the file.
472         (goto-char (point-max))
473         (if (looking-at "^$")
474             (delete-backward-char 1)
475           )
476         ))))
477
478 (defun notmuch-search-refresh-view ()
479   "Refresh the current view.
480
481 Kills the current buffer and runs a new search with the same
482 query string as the current search. If the current thread is in
483 the new search results, then point will be placed on the same
484 thread. Otherwise, point will be moved to attempt to be in the
485 same relative position within the new buffer."
486   (interactive)
487   (let ((here (point))
488         (thread (notmuch-search-find-thread-id))
489         (query notmuch-search-query-string))
490     (kill-this-buffer)
491     (notmuch-search query)
492     (goto-char (point-min))
493     (if (re-search-forward (concat "^" thread) nil t)
494         (beginning-of-line)
495       (goto-char here))))
496
497 (defun notmuch-search-filter (query)
498   "Run \"notmuch search\" to refine the current search results.
499
500 A search string will be constructed by appending QUERY to the
501 current search string, and the results of \"notmuch search\" for
502 the combined query will be displayed."
503   (interactive "sFilter search: ")
504   (notmuch-search (concat notmuch-search-query-string " and " query)))
505
506 (defun notmuch ()
507   "Run notmuch to display all mail with tag of 'inbox'"
508   (interactive)
509   (notmuch-search "tag:inbox"))
510
511 (provide 'notmuch)