notmuch.el: Fix stale reference to non-existing variable.
[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 (require 'cl)
23 (require 'mm-view)
24
25 (defvar notmuch-show-mode-map
26   (let ((map (make-sparse-keymap)))
27     ; I don't actually want all of these toggle commands occupying
28     ; keybindings. They steal valuable key-binding space, are hard
29     ; to remember, and act globally rather than locally.
30     ;
31     ; Will be much preferable to switch to direct manipulation for
32     ; toggling visibility of these components. Probably using
33     ; overlays-at to query and manipulate the current overlay.
34     (define-key map "a" 'notmuch-show-archive-thread)
35     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
36     (define-key map "b" 'notmuch-show-toggle-body-read-visible)
37     (define-key map "c" 'notmuch-show-toggle-citations-visible)
38     (define-key map "h" 'notmuch-show-toggle-headers-visible)
39     (define-key map "m" 'message-mail)
40     (define-key map "n" 'notmuch-show-next-message)
41     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
42     (define-key map "p" 'notmuch-show-previous-message)
43     (define-key map (kbd "C-n") 'notmuch-show-next-line)
44     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
45     (define-key map "q" 'kill-this-buffer)
46     (define-key map "r" 'notmuch-show-reply)
47     (define-key map "s" 'notmuch-show-toggle-signatures-visible)
48     (define-key map "v" 'notmuch-show-view-all-mime-parts)
49     (define-key map "w" 'notmuch-show-view-raw-message)
50     (define-key map "x" 'kill-this-buffer)
51     (define-key map "+" 'notmuch-show-add-tag)
52     (define-key map "-" 'notmuch-show-remove-tag)
53     (define-key map (kbd "DEL") 'notmuch-show-rewind)
54     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
55     (define-key map "|" 'notmuch-show-pipe-message)
56     (define-key map "?" 'describe-mode)
57     map)
58   "Keymap for \"notmuch show\" buffers.")
59 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
60
61 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
62   "Pattern to match a line that separates content from signature.
63
64 The regexp can (and should) include $ to match the end of the
65 line, but should not include ^ to match the beginning of the
66 line. This is because notmuch may have inserted additional space
67 for indentation at the beginning of the line. But notmuch will
68 move past the indentation when testing this pattern, (so that the
69 pattern can still test against the entire line).")
70
71 (defvar notmuch-show-signature-lines-max 12
72   "Maximum length of signature that will be hidden by default.")
73
74 (defvar notmuch-command "notmuch"
75   "Command to run the notmuch binary.")
76
77 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
78 (defvar notmuch-show-message-end-regexp      "\fmessage}")
79 (defvar notmuch-show-header-begin-regexp     "\fheader{")
80 (defvar notmuch-show-header-end-regexp       "\fheader}")
81 (defvar notmuch-show-body-begin-regexp       "\fbody{")
82 (defvar notmuch-show-body-end-regexp         "\fbody}")
83 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
84 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
85 (defvar notmuch-show-part-begin-regexp       "\fpart{")
86 (defvar notmuch-show-part-end-regexp         "\fpart}")
87 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
88
89 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
90 (defvar notmuch-show-depth-regexp " depth:\\([0-9]*\\) ")
91 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
92 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
93
94 (defvar notmuch-show-parent-buffer nil)
95 (defvar notmuch-show-body-read-visible nil)
96 (defvar notmuch-show-citations-visible nil)
97 (defvar notmuch-show-signatures-visible nil)
98 (defvar notmuch-show-headers-visible nil)
99
100 ; XXX: This should be a generic function in emacs somewhere, not here
101 (defun point-invisible-p ()
102   "Return whether the character at point is invisible.
103
104 Here visibility is determined by `buffer-invisibility-spec' and
105 the invisible property of any overlays for point. It doesn't have
106 anything to do with whether point is currently being displayed
107 within the current window."
108   (let ((prop (get-char-property (point) 'invisible)))
109     (if (eq buffer-invisibility-spec t)
110         prop
111       (or (memq prop buffer-invisibility-spec)
112           (assq prop buffer-invisibility-spec)))))
113
114 (defun notmuch-show-next-line ()
115   "Like builtin `next-line' but ensuring we end on a visible character.
116
117 By advancing forward until reaching a visible character.
118
119 Unlike builtin `next-line' this version accepts no arguments."
120   (interactive)
121   (set 'this-command 'next-line)
122   (call-interactively 'next-line)
123   (while (point-invisible-p)
124     (forward-char)))
125
126 (defun notmuch-show-previous-line ()
127   "Like builtin `previous-line' but ensuring we end on a visible character.
128
129 By advancing forward until reaching a visible character.
130
131 Unlike builtin `next-line' this version accepts no arguments."
132   (interactive)
133   (set 'this-command 'previous-line)
134   (call-interactively 'previous-line)
135   (while (point-invisible-p)
136     (forward-char)))
137
138 (defun notmuch-show-get-message-id ()
139   (save-excursion
140     (beginning-of-line)
141     (if (not (looking-at notmuch-show-message-begin-regexp))
142         (re-search-backward notmuch-show-message-begin-regexp))
143     (re-search-forward notmuch-show-id-regexp)
144     (buffer-substring (match-beginning 1) (match-end 1))))
145
146 (defun notmuch-show-get-filename ()
147   (save-excursion
148     (beginning-of-line)
149     (if (not (looking-at notmuch-show-message-begin-regexp))
150         (re-search-backward notmuch-show-message-begin-regexp))
151     (re-search-forward notmuch-show-filename-regexp)
152     (buffer-substring (match-beginning 1) (match-end 1))))
153
154 (defun notmuch-show-set-tags (tags)
155   (save-excursion
156     (beginning-of-line)
157     (if (not (looking-at notmuch-show-message-begin-regexp))
158         (re-search-backward notmuch-show-message-begin-regexp))
159     (re-search-forward notmuch-show-tags-regexp)
160     (let ((inhibit-read-only t)
161           (beg (match-beginning 1))
162           (end (match-end 1)))
163       (delete-region beg end)
164       (goto-char beg)
165       (insert (mapconcat 'identity tags " ")))))
166
167 (defun notmuch-show-get-tags ()
168   (save-excursion
169     (beginning-of-line)
170     (if (not (looking-at notmuch-show-message-begin-regexp))
171         (re-search-backward notmuch-show-message-begin-regexp))
172     (re-search-forward notmuch-show-tags-regexp)
173     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
174
175 (defun notmuch-show-add-tag (&rest toadd)
176   "Add a tag to the current message."
177   (interactive "sTag to add: ")
178   (apply 'notmuch-call-notmuch-process
179          (append (cons "tag"
180                        (mapcar (lambda (s) (concat "+" s)) toadd))
181                  (cons (notmuch-show-get-message-id) nil)))
182   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
183
184 (defun notmuch-show-remove-tag (&rest toremove)
185   "Remove a tag from the current message."
186   (interactive "sTag to remove: ")
187   (let ((tags (notmuch-show-get-tags)))
188     (if (intersection tags toremove :test 'string=)
189         (progn
190           (apply 'notmuch-call-notmuch-process
191                  (append (cons "tag"
192                                (mapcar (lambda (s) (concat "-" s)) toremove))
193                          (cons (notmuch-show-get-message-id) nil)))
194           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
195
196 (defun notmuch-show-archive-thread-maybe-mark-read (markread)
197   (save-excursion
198     (goto-char (point-min))
199     (while (not (eobp))
200       (if markread
201           (notmuch-show-remove-tag "unread" "inbox")
202         (notmuch-show-remove-tag "inbox"))
203       (if (not (eobp))
204           (forward-char))
205       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
206           (goto-char (point-max)))))
207   (let ((parent-buffer notmuch-show-parent-buffer))
208     (kill-this-buffer)
209     (if parent-buffer
210         (progn
211           (switch-to-buffer parent-buffer)
212           (forward-line)
213           (notmuch-search-show-thread)))))
214
215 (defun notmuch-show-mark-read-then-archive-thread ()
216   "Remove \"unread\" tag from each message, then archive and show next thread.
217
218 Archive each message currently shown by removing the \"unread\"
219 and \"inbox\" tag from each. Then kill this buffer and show the
220 next thread from the search from which this thread was originally
221 shown.
222
223 Note: This command is safe from any race condition of new messages
224 being delivered to the same thread. It does not archive the
225 entire thread, but only the messages shown in the current
226 buffer."
227   (interactive)
228   (notmuch-show-archive-thread-maybe-mark-read t))
229
230 (defun notmuch-show-archive-thread ()
231   "Archive each message in thread, and show next thread from search.
232
233 Archive each message currently shown by removing the \"inbox\"
234 tag from each. Then kill this buffer and show the next thread
235 from the search from which this thread was originally shown.
236
237 Note: This command is safe from any race condition of new messages
238 being delivered to the same thread. It does not archive the
239 entire thread, but only the messages shown in the current
240 buffer."
241   (interactive)
242   (notmuch-show-archive-thread-maybe-mark-read nil))
243
244 (defun notmuch-show-view-raw-message ()
245   "View the raw email of the current message."
246   (interactive)
247   (view-file (notmuch-show-get-filename)))
248
249 (defun notmuch-show-view-all-mime-parts ()
250   "Use external viewers (according to mailcap) to view all MIME-encoded parts."
251   (interactive)
252   (save-excursion
253     (let ((filename (notmuch-show-get-filename)))
254       (switch-to-buffer (generate-new-buffer (concat "*notmuch-mime-"
255                                                      filename
256                                                      "*")))
257       (insert-file-contents filename nil nil nil t)
258       (mm-display-parts (mm-dissect-buffer))
259       (kill-this-buffer))))
260
261 (defun notmuch-reply (query-string)
262   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
263   (call-process notmuch-command nil t nil "reply" query-string)
264   (goto-char (point-min))
265   (if (re-search-forward "^$" nil t)
266       (progn
267         (insert "--text follows this line--")
268         (forward-line)))
269   (message-mode))
270
271 (defun notmuch-show-reply ()
272   "Begin composing a reply to the current message in a new buffer."
273   (interactive)
274   (let ((message-id (notmuch-show-get-message-id)))
275     (notmuch-reply message-id)))
276
277 (defun notmuch-show-pipe-message (command)
278   "Pipe the contents of the current message to the given command.
279
280 The given command will be executed with the raw contents of the
281 current email message as stdin. Anything printed by the command
282 to stdout or stderr will appear in the *Messages* buffer."
283   (interactive "sPipe message to command: ")
284   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" (split-string (concat command " < " (notmuch-show-get-filename)))))
285
286 (defun notmuch-show-move-to-current-message-summary-line ()
287   "Move to the beginning of the one-line summary of the current message.
288
289 This gives us a stable place to move to and work from since the
290 summary line is always visible. This is important since moving to
291 an invisible location is unreliable, (the main command loop moves
292 point either forward or backward to the next visible character
293 when a command ends with point on an invisible character).
294
295 Emits an error if point is not within a valid message, (that is
296 not pattern of `notmuch-show-message-begin-regexp' could be found
297 by searching backward)."
298   (beginning-of-line)
299   (if (not (looking-at notmuch-show-message-begin-regexp))
300       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
301           (forward-line 2)
302         (error "Not within a valid message."))
303     (forward-line 2)))
304
305 (defun notmuch-show-last-message-p ()
306   "Predicate testing whether point is within the last message."
307   (save-window-excursion
308     (save-excursion
309       (notmuch-show-move-to-current-message-summary-line)
310       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
311
312 (defun notmuch-show-message-unread-p ()
313   "Preficate testing whether current message is unread."
314   (member "unread" (notmuch-show-get-tags)))
315
316 (defun notmuch-show-next-message ()
317   "Advance to the beginning of the next message in the buffer.
318
319 Moves to the last visible character of the current message if
320 already on the last message in the buffer."
321   (interactive)
322   (notmuch-show-move-to-current-message-summary-line)
323   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
324       (notmuch-show-move-to-current-message-summary-line)
325     (goto-char (- (point-max) 1))
326     (while (point-invisible-p)
327       (backward-char)))
328   (recenter 0))
329
330 (defun notmuch-show-find-next-message ()
331   "Returns the position of the next message in the buffer.
332
333 Or the position of the last visible character of the current
334 message if already within the last message in the buffer."
335   ; save-excursion doesn't save our window position
336   ; save-window-excursion doesn't save point
337   ; Looks like we have to use both.
338   (save-excursion
339     (save-window-excursion
340       (notmuch-show-next-message)
341       (point))))
342
343 (defun notmuch-show-next-unread-message ()
344   "Advance to the beginning of the next unread message in the buffer.
345
346 Moves to the last visible character of the current message if
347 there are no more unread messages past the current point."
348   (notmuch-show-next-message)
349   (while (and (not (notmuch-show-last-message-p))
350               (not (notmuch-show-message-unread-p)))
351     (notmuch-show-next-message))
352   (if (not (notmuch-show-message-unread-p))
353       (notmuch-show-next-message)))
354
355 (defun notmuch-show-next-open-message ()
356   "Advance to the next message which is not hidden.
357
358 If read messages are currently hidden, advance to the next unread
359 message. Otherwise, advance to the next message."
360   (if (or (memq 'notmuch-show-body-read buffer-invisibility-spec)
361           (assq 'notmuch-show-body-read buffer-invisibility-spec))
362       (notmuch-show-next-unread-message)
363     (notmuch-show-next-message)))
364
365 (defun notmuch-show-previous-message ()
366   "Backup to the beginning of the previous message in the buffer.
367
368 If within a message rather than at the beginning of it, then
369 simply move to the beginning of the current message."
370   (interactive)
371   (let ((start (point)))
372     (notmuch-show-move-to-current-message-summary-line)
373     (if (not (< (point) start))
374         ; Go backward twice to skip the current message's marker
375         (progn
376           (re-search-backward notmuch-show-message-begin-regexp nil t)
377           (re-search-backward notmuch-show-message-begin-regexp nil t)
378           (notmuch-show-move-to-current-message-summary-line)
379           ))
380     (recenter 0)))
381
382 (defun notmuch-show-find-previous-message ()
383   "Returns the position of the previous message in the buffer.
384
385 Or the position of the beginning of the current message if point
386 is originally within the message rather than at the beginning of
387 it."
388   ; save-excursion doesn't save our window position
389   ; save-window-excursion doesn't save point
390   ; Looks like we have to use both.
391   (save-excursion
392     (save-window-excursion
393       (notmuch-show-previous-message)
394       (point))))
395
396 (defun notmuch-show-mark-read-then-next-open-message ()
397   "Remove unread tag from current message, then advance to next unread message."
398   (interactive)
399   (notmuch-show-remove-tag "unread")
400   (notmuch-show-next-open-message))
401
402 (defun notmuch-show-rewind ()
403   "Do reverse scrolling compared to `notmuch-show-advance-marking-read-and-archiving'
404
405 Specifically, if the beginning of the previous email is fewer
406 than `window-height' lines from the current point, move to it
407 just like `notmuch-show-previous-message'.
408
409 Otherwise, just scroll down a screenful of the current message.
410
411 This command does not modify any message tags, (it does not undo
412 any effects from previous calls to
413 `notmuch-show-advance-marking-read-and-archiving'."
414   (interactive)
415   (let ((previous (notmuch-show-find-previous-message)))
416     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
417         (progn
418           (condition-case nil
419               (scroll-down nil)
420             ((beginning-of-buffer) nil))
421           (goto-char (window-start)))
422       (notmuch-show-previous-message))))
423
424 (defun notmuch-show-advance-marking-read-and-archiving ()
425   "Advance through buffer, marking read and archiving.
426
427 This command is intended to be one of the simplest ways to
428 process a thread of email. It does the following:
429
430 If the current message in the thread is not yet fully visible,
431 scroll by a near screenful to read more of the message.
432
433 Otherwise, (the end of the current message is already within the
434 current window), remove the \"unread\" tag (if present) from the
435 current message and advance to the next open message.
436
437 Finally, if there is no further message to advance to, and this
438 last message is already read, then archive the entire current
439 thread, (remove the \"inbox\" tag from each message). Also kill
440 this buffer, and display the next thread from the search from
441 which this thread was originally shown."
442   (interactive)
443   (let ((next (notmuch-show-find-next-message))
444         (unread (notmuch-show-message-unread-p)))
445     (if (> next (window-end))
446         (scroll-up nil)
447       (let ((last (notmuch-show-last-message-p)))
448         (notmuch-show-mark-read-then-next-open-message)
449         (if last
450             (notmuch-show-archive-thread))))))
451
452 (defun notmuch-show-markup-citations-region (beg end depth)
453   (goto-char beg)
454   (beginning-of-line)
455   (while (< (point) end)
456     (let ((beg-sub (point-marker))
457           (indent (make-string depth ? ))
458           (citation "[[:space:]]*>"))
459       (if (looking-at citation)
460           (progn
461             (while (looking-at citation)
462               (forward-line))
463             (let ((overlay (make-overlay beg-sub (point))))
464               (overlay-put overlay 'invisible 'notmuch-show-citation)
465               (overlay-put overlay 'before-string
466                            (concat indent
467                                    "[" (number-to-string (count-lines beg-sub (point)))
468                                    "-line citation. Press 'c' to show.]\n")))))
469       (move-to-column depth)
470       (if (looking-at notmuch-show-signature-regexp)
471           (let ((sig-lines (- (count-lines beg-sub end) 1)))
472             (if (<= sig-lines notmuch-show-signature-lines-max)
473                 (progn
474                   (overlay-put (make-overlay beg-sub end)
475                                'invisible 'notmuch-show-signature)
476                   (overlay-put (make-overlay beg (- beg-sub 1))
477                                'after-string
478                                (concat "\n" indent
479                                        "[" (number-to-string sig-lines)
480                                        "-line signature. Press 's' to show.]"))
481                   (goto-char end)))))
482       (forward-line))))
483
484 (defun notmuch-show-markup-part (beg end depth)
485   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
486       (progn
487         (forward-line)
488         (let ((beg (point-marker)))
489           (re-search-forward notmuch-show-part-end-regexp)
490           (let ((end (copy-marker (match-beginning 0))))
491             (goto-char end)
492             (if (not (bolp))
493                 (insert "\n"))
494             (indent-rigidly beg end depth)
495             (notmuch-show-markup-citations-region beg end depth)
496             ; Advance to the next part (if any) (so the outer loop can
497             ; determine whether we've left the current message.
498             (if (re-search-forward notmuch-show-part-begin-regexp nil t)
499                 (beginning-of-line)))))
500     (goto-char end)))
501
502 (defun notmuch-show-markup-parts-region (beg end depth)
503   (save-excursion
504     (goto-char beg)
505     (while (< (point) end)
506       (notmuch-show-markup-part beg end depth))))
507
508 (defun notmuch-show-markup-body (depth)
509   (re-search-forward notmuch-show-body-begin-regexp)
510   (forward-line)
511   (let ((beg (point-marker)))
512     (re-search-forward notmuch-show-body-end-regexp)
513     (let ((end (copy-marker (match-beginning 0))))
514       (notmuch-show-markup-parts-region beg end depth)
515       (if (not (notmuch-show-message-unread-p))
516           (overlay-put (make-overlay beg end)
517                        'invisible 'notmuch-show-body-read))
518       (set-marker beg nil)
519       (set-marker end nil)
520       )))
521
522 (defun notmuch-show-markup-header (depth)
523   (re-search-forward notmuch-show-header-begin-regexp)
524   (forward-line)
525   (let ((beg (point-marker)))
526     (end-of-line)
527     ; Inverse video for subject
528     (overlay-put (make-overlay beg (point)) 'face '((cons :inverse-video t)))
529     (forward-line 2)
530     (let ((beg-hidden (point-marker)))
531       (re-search-forward notmuch-show-header-end-regexp)
532       (beginning-of-line)
533       (let ((end (point-marker)))
534         (indent-rigidly beg end depth)
535         (overlay-put (make-overlay beg-hidden end)
536                      'invisible 'notmuch-show-header)
537         (set-marker beg nil)
538         (set-marker beg-hidden nil)
539         (set-marker end nil)
540         ))))
541
542 (defun notmuch-show-markup-message ()
543   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
544       (progn
545         (re-search-forward notmuch-show-depth-regexp)
546         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))
547           (notmuch-show-markup-header depth)
548           (notmuch-show-markup-body depth)))
549     (goto-char (point-max))))
550
551 (defun notmuch-show-hide-markers ()
552   (save-excursion
553     (goto-char (point-min))
554     (while (not (eobp))
555       (if (re-search-forward notmuch-show-marker-regexp nil t)
556           (progn
557             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
558                          'invisible 'notmuch-show-marker))
559         (goto-char (point-max))))))
560
561 (defun notmuch-show-markup-messages ()
562   (save-excursion
563     (goto-char (point-min))
564     (while (not (eobp))
565       (notmuch-show-markup-message)))
566   (notmuch-show-hide-markers))
567
568 (defun notmuch-show-toggle-citations-visible ()
569   "Toggle visibility of citations"
570   (interactive)
571   (if notmuch-show-citations-visible
572       (add-to-invisibility-spec 'notmuch-show-citation)
573     (remove-from-invisibility-spec 'notmuch-show-citation))
574   (set 'notmuch-show-citations-visible (not notmuch-show-citations-visible))
575   ; Need to force the redisplay for some reason
576   (force-window-update)
577   (redisplay t))
578
579 (defun notmuch-show-toggle-signatures-visible ()
580   "Toggle visibility of signatures"
581   (interactive)
582   (if notmuch-show-signatures-visible
583       (add-to-invisibility-spec 'notmuch-show-signature)
584     (remove-from-invisibility-spec 'notmuch-show-signature))
585   (set 'notmuch-show-signatures-visible (not notmuch-show-signatures-visible))
586   ; Need to force the redisplay for some reason
587   (force-window-update)
588   (redisplay t))
589
590 (defun notmuch-show-toggle-headers-visible ()
591   "Toggle visibility of header fields"
592   (interactive)
593   (if notmuch-show-headers-visible
594       (add-to-invisibility-spec 'notmuch-show-header)
595     (remove-from-invisibility-spec 'notmuch-show-header))
596   (set 'notmuch-show-headers-visible (not notmuch-show-headers-visible))
597   ; Need to force the redisplay for some reason
598   (force-window-update)
599   (redisplay t))
600
601 (defun notmuch-show-toggle-body-read-visible ()
602   "Toggle visibility of message bodies of read messages"
603   (interactive)
604   (if notmuch-show-body-read-visible
605       (add-to-invisibility-spec 'notmuch-show-body-read)
606     (remove-from-invisibility-spec 'notmuch-show-body-read))
607   (set 'notmuch-show-body-read-visible (not notmuch-show-body-read-visible))
608   ; Need to force the redisplay for some reason
609   (force-window-update)
610   (redisplay t))
611
612 ;;;###autoload
613 (defun notmuch-show-mode ()
614   "Major mode for viewing a thread with notmuch.
615
616 This buffer contains the results of the \"notmuch show\" command
617 for displaying a single thread of email from your email archives.
618
619 By default, various components of email messages, (citations,
620 signatures, already-read messages), are invisible to help you
621 focus on the most important things, (new text from unread
622 messages). See the various commands below for toggling the
623 visibility of hidden components.
624
625 The `notmuch-show-next-message' and
626 `notmuch-show-previous-message' commands, (bound to 'n' and 'p by
627 default), allow you to navigate to the next and previous
628 messages. Each time you navigate away from a message with
629 `notmuch-show-next-message' the current message will have its
630 \"unread\" tag removed.
631
632 You can add or remove tags from the current message with '+' and
633 '-'.  You can also archive all messages in the current
634 view, (remove the \"inbox\" tag from each), with
635 `notmuch-show-archive-thread' (bound to 'a' by default).
636
637 \\{notmuch-show-mode-map}"
638   (interactive)
639   (kill-all-local-variables)
640   (set (make-local-variable 'notmuch-show-headers-visible) t)
641   (notmuch-show-toggle-headers-visible)
642   (set (make-local-variable 'notmuch-show-body-read-visible) t)
643   (notmuch-show-toggle-body-read-visible)
644   (set (make-local-variable 'notmuch-show-citations-visible) t)
645   (notmuch-show-toggle-citations-visible)
646   (set (make-local-variable 'notmuch-show-signatures-visible) t)
647   (notmuch-show-toggle-signatures-visible)
648   (add-to-invisibility-spec 'notmuch-show-marker)
649   (use-local-map notmuch-show-mode-map)
650   (setq major-mode 'notmuch-show-mode
651         mode-name "notmuch-show")
652   (setq buffer-read-only t))
653
654 ;;;###autoload
655
656 (defgroup notmuch nil
657   "Notmuch mail reader for Emacs."
658   :group 'mail)
659
660 (defcustom notmuch-show-hook nil
661   "List of functions to call when notmuch displays a message."
662   :type 'hook
663   :options '(goto-address)
664   :group 'notmuch)
665
666 (defcustom notmuch-search-hook nil
667   "List of functions to call when notmuch displays the search results."
668   :type 'hook
669   :options '(hl-line-mode)
670   :group 'notmuch)
671
672 ; Make show mode a bit prettier, highlighting URLs and using word wrap
673
674 (defun notmuch-show-pretty-hook ()
675   (goto-address-mode 1)
676   (visual-line-mode))
677
678 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
679 (add-hook 'notmuch-search-hook
680           (lambda()
681             (hl-line-mode 1) ))
682
683 (defun notmuch-show (thread-id &optional parent-buffer)
684   "Run \"notmuch show\" with the given thread ID and display results.
685
686 The optional PARENT-BUFFER is the notmuch-search buffer from
687 which this notmuch-show command was executed, (so that the next
688 thread from that buffer can be show when done with this one)."
689   (interactive "sNotmuch show: ")
690   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
691     (switch-to-buffer buffer)
692     (notmuch-show-mode)
693     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
694     (let ((proc (get-buffer-process (current-buffer)))
695           (inhibit-read-only t))
696       (if proc
697           (error "notmuch search process already running for query `%s'" thread-id)
698         )
699       (erase-buffer)
700       (goto-char (point-min))
701       (save-excursion
702         (call-process notmuch-command nil t nil "show" thread-id)
703         (notmuch-show-markup-messages)
704         )
705       (run-hooks 'notmuch-show-hook)
706       ; Move straight to the first unread message
707       (if (not (notmuch-show-message-unread-p))
708           (progn
709             (notmuch-show-next-unread-message)
710             ; But if there are no unread messages, go back to the
711             ; beginning of the buffer, and open up the bodies of all
712             ; read message.
713             (if (not (notmuch-show-message-unread-p))
714                 (progn
715                   (goto-char (point-min))
716                   (notmuch-show-toggle-body-read-visible)))))
717       )))
718
719 (defvar notmuch-search-authors-width 40
720   "Number of columns to use to display authors in a notmuch-search buffer.")
721
722 (defvar notmuch-search-mode-map
723   (let ((map (make-sparse-keymap)))
724     (define-key map "a" 'notmuch-search-archive-thread)
725     (define-key map "b" 'notmuch-search-scroll-down)
726     (define-key map "f" 'notmuch-search-filter)
727     (define-key map "m" 'message-mail)
728     (define-key map "n" 'next-line)
729     (define-key map "o" 'notmuch-search-toggle-order)
730     (define-key map "p" 'previous-line)
731     (define-key map "q" 'kill-this-buffer)
732     (define-key map "r" 'notmuch-search-reply-to-thread)
733     (define-key map "s" 'notmuch-search)
734     (define-key map "t" 'notmuch-search-filter-by-tag)
735     (define-key map "x" 'kill-this-buffer)
736     (define-key map (kbd "RET") 'notmuch-search-show-thread)
737     (define-key map "+" 'notmuch-search-add-tag)
738     (define-key map "-" 'notmuch-search-remove-tag)
739     (define-key map "<" 'beginning-of-buffer)
740     (define-key map ">" 'notmuch-search-goto-last-thread)
741     (define-key map "=" 'notmuch-search-refresh-view)
742     (define-key map "\M->" 'notmuch-search-goto-last-thread)
743     (define-key map " " 'notmuch-search-scroll-up)
744     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
745     (define-key map "?" 'describe-mode)
746     map)
747   "Keymap for \"notmuch search\" buffers.")
748 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
749
750 (defvar notmuch-search-query-string)
751 (defvar notmuch-search-oldest-first)
752
753 (defun notmuch-search-scroll-up ()
754   "Scroll up, moving point to last message in thread if at end."
755   (interactive)
756   (condition-case nil
757       (scroll-up nil)
758     ((end-of-buffer) (notmuch-search-goto-last-thread))))
759
760 (defun notmuch-search-scroll-down ()
761   "Scroll down, moving point to first message in thread if at beginning."
762   (interactive)
763   ; I don't know why scroll-down doesn't signal beginning-of-buffer
764   ; the way that scroll-up signals end-of-buffer, but c'est la vie.
765   ;
766   ; So instead of trapping a signal we instead check whether the
767   ; window begins on the first line of the buffer and if so, move
768   ; directly to that position. (We have to count lines since the
769   ; window-start position is not the same as point-min due to the
770   ; invisible thread-ID characters on the first line.
771   (if (equal (count-lines (point-min) (window-start)) 1)
772       (goto-char (window-start))
773     (scroll-down nil)))
774
775 (defun notmuch-search-goto-last-thread (&optional arg)
776   "Move point to the last thread in the buffer."
777   (interactive "^P")
778   (end-of-buffer arg)
779   (forward-line -1))
780
781 ;;;###autoload
782 (defun notmuch-search-mode ()
783   "Major mode for searching mail with notmuch.
784
785 This buffer contains the results of a \"notmuch search\" of your
786 email archives. Each line in the buffer represents a single
787 thread giving a relative date for the thread and a subject.
788
789 Pressing RET on any line displays that thread. The '+' and '-'
790 keys can be used to add or remove tags from a thread. The 'a' key
791 is a convenience key for archiving a thread (removing the
792 \"inbox\" tag).
793
794 Other useful commands are `notmuch-search-filter' for filtering
795 the current search based on an additional query string,
796 `notmuch-search-filter-by-tag' for filtering to include only
797 messages with a given tag, and `notmuch-search' to execute a new,
798 global search.
799
800 \\{notmuch-search-mode-map}"
801   (interactive)
802   (kill-all-local-variables)
803   (make-local-variable 'notmuch-search-query-string)
804   (make-local-variable 'notmuch-search-oldest-first)
805   (set (make-local-variable 'scroll-preserve-screen-position) t)
806   (add-to-invisibility-spec 'notmuch-search)
807   (use-local-map notmuch-search-mode-map)
808   (setq truncate-lines t)
809   (setq major-mode 'notmuch-search-mode
810         mode-name "notmuch-search")
811   (setq buffer-read-only t))
812
813 (defun notmuch-search-find-thread-id ()
814   (save-excursion
815     (beginning-of-line)
816     (let ((beg (point)))
817       (re-search-forward "thread:[a-fA-F0-9]*" nil t)
818       (filter-buffer-substring beg (point)))))
819
820 (defun notmuch-search-markup-this-thread-id ()
821   (beginning-of-line)
822   (let ((beg (point)))
823     (if (re-search-forward "thread:[a-fA-F0-9]*" nil t)
824         (progn
825           (forward-char)
826           (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search)
827           (re-search-forward ".*\\[[0-9]*/[0-9]*\\] \\([^;]*\\)\\(;\\)")
828           (let* ((authors (buffer-substring (match-beginning 1) (match-end 1)))
829                  (authors-length (length authors)))
830             ;; Drop the semi-colon
831             (replace-match "" t nil nil 2)
832             (if (<= authors-length notmuch-search-authors-width)
833                 (replace-match (concat authors (make-string
834                                                 (- notmuch-search-authors-width
835                                                    authors-length) ? )) t t nil 1)
836               (replace-match (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...") t t nil 1)))))))
837
838 (defun notmuch-search-markup-thread-ids ()
839   (save-excursion
840     (goto-char (point-min))
841     (while (not (eobp))
842       (notmuch-search-markup-this-thread-id)
843       (forward-line))))
844
845 (defun notmuch-search-show-thread ()
846   (interactive)
847   (let ((thread-id (notmuch-search-find-thread-id)))
848     (if (> (length thread-id) 0)
849         (notmuch-show thread-id (current-buffer))
850       (error "End of search results"))))
851
852 (defun notmuch-search-reply-to-thread ()
853   "Begin composing a reply to the entire current thread in a new buffer."
854   (interactive)
855   (let ((message-id (notmuch-search-find-thread-id)))
856     (notmuch-reply message-id)))
857
858 (defun notmuch-call-notmuch-process (&rest args)
859   "Synchronously invoke \"notmuch\" with the given list of arguments.
860
861 Output from the process will be presented to the user as an error
862 and will also appear in a buffer named \"*Notmuch errors*\"."
863   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
864     (with-current-buffer error-buffer
865         (erase-buffer))
866     (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
867         (point)
868       (progn
869         (with-current-buffer error-buffer
870           (let ((beg (point-min))
871                 (end (- (point-max) 1)))
872             (error (buffer-substring beg end))
873             ))))))
874
875 (defun notmuch-search-set-tags (tags)
876   (save-excursion
877     (end-of-line)
878     (re-search-backward "(")
879     (forward-char)
880     (let ((beg (point))
881           (inhibit-read-only t))
882       (re-search-forward ")")
883       (backward-char)
884       (let ((end (point)))
885         (delete-region beg end)
886         (insert (mapconcat  'identity tags " "))))))
887
888 (defun notmuch-search-get-tags ()
889   (save-excursion
890     (end-of-line)
891     (re-search-backward "(")
892     (let ((beg (+ (point) 1)))
893       (re-search-forward ")")
894       (let ((end (- (point) 1)))
895         (split-string (buffer-substring beg end))))))
896
897 (defun notmuch-search-add-tag (tag)
898   (interactive "sTag to add: ")
899   (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
900   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
901
902 (defun notmuch-search-remove-tag (tag)
903   (interactive "sTag to remove: ")
904   (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
905   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
906
907 (defun notmuch-search-archive-thread ()
908   "Archive the current thread (remove its \"inbox\" tag).
909
910 This function advances point to the next line when finished."
911   (interactive)
912   (notmuch-search-remove-tag "inbox")
913   (forward-line))
914
915 (defun notmuch-search (query &optional oldest-first)
916   "Run \"notmuch search\" with the given query string and display results."
917   (interactive "sNotmuch search: ")
918   (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
919     (switch-to-buffer buffer)
920     (notmuch-search-mode)
921     (set 'notmuch-search-query-string query)
922     (set 'notmuch-search-oldest-first oldest-first)
923     (let ((proc (get-buffer-process (current-buffer)))
924           (inhibit-read-only t))
925       (if proc
926           (error "notmuch search process already running for query `%s'" query)
927         )
928       (erase-buffer)
929       (goto-char (point-min))
930       (save-excursion
931         (if oldest-first
932             (call-process notmuch-command nil t nil "search" "--sort=oldest-first" query)
933           (call-process notmuch-command nil t nil "search" "--sort=newest-first" query))
934         (notmuch-search-markup-thread-ids)
935         ))
936     (run-hooks 'notmuch-search-hook)))
937
938 (defun notmuch-search-refresh-view ()
939   "Refresh the current view.
940
941 Kills the current buffer and runs a new search with the same
942 query string as the current search. If the current thread is in
943 the new search results, then point will be placed on the same
944 thread. Otherwise, point will be moved to attempt to be in the
945 same relative position within the new buffer."
946   (interactive)
947   (let ((here (point))
948         (oldest-first notmuch-search-oldest-first)
949         (thread (notmuch-search-find-thread-id))
950         (query notmuch-search-query-string))
951     (kill-this-buffer)
952     (notmuch-search query oldest-first)
953     (goto-char (point-min))
954     (if (re-search-forward (concat "^" thread) nil t)
955         (beginning-of-line)
956       (goto-char here))))
957
958 (defun notmuch-search-toggle-order ()
959   "Toggle the current search order.
960
961 By default, the \"inbox\" view created by `notmuch' is displayed
962 in chronological order (oldest thread at the beginning of the
963 buffer), while any global searches created by `notmuch-search'
964 are displayed in reverse-chronological order (newest thread at
965 the beginning of the buffer).
966
967 This command toggles the sort order for the current search.
968
969 Note that any filtered searches created by
970 `notmuch-search-filter' retain the search order of the parent
971 search."
972   (interactive)
973   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
974   (notmuch-search-refresh-view))
975
976 (defun notmuch-search-filter (query)
977   "Filter the current search results based on an additional query string.
978
979 Runs a new search matching only messages that match both the
980 current search results AND the additional query string provided."
981   (interactive "sFilter search: ")
982   (notmuch-search (concat notmuch-search-query-string " and " query) notmuch-search-oldest-first))
983
984 (defun notmuch-search-filter-by-tag (tag)
985   "Filter the current search results based on a single tag.
986
987 Runs a new search matching only messages that match both the
988 current search results AND that are tagged with the given tag."
989   (interactive "sFilter by tag: ")
990   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
991
992 (defun notmuch ()
993   "Run notmuch to display all mail with tag of 'inbox'"
994   (interactive)
995   (notmuch-search "tag:inbox" t))
996
997 (setq mail-user-agent 'message-user-agent)
998
999 (provide 'notmuch)