notmuch.el: add a submap (on "z" for "ztash") to stash things.
[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 ; This is an emacs-based interface to the notmuch mail system.
23 ;
24 ; You will first need to have the notmuch program installed and have a
25 ; notmuch database built in order to use this. See
26 ; http://notmuchmail.org for details.
27 ;
28 ; To install this software, copy it to a directory that is on the
29 ; `load-path' variable within emacs (a good candidate is
30 ; /usr/local/share/emacs/site-lisp). If you are viewing this from the
31 ; notmuch source distribution then you can simply run:
32 ;
33 ;       sudo make install-emacs
34 ;
35 ; to install it.
36 ;
37 ; Then, to actually run it, add:
38 ;
39 ;       (require 'notmuch)
40 ;
41 ; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
42 ; or run:
43 ;
44 ;       emacs -f notmuch
45 ;
46 ; Have fun, and let us know if you have any comment, questions, or
47 ; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
48 ; required, but is available from http://notmuchmail.org).
49
50 (require 'cl)
51 (require 'mm-view)
52 (require 'message)
53
54 (defvar notmuch-show-stash-map
55   (let ((map (make-sparse-keymap)))
56     (define-key map "c" 'notmuch-show-stash-cc)
57     (define-key map "d" 'notmuch-show-stash-date)
58     (define-key map "F" 'notmuch-show-stash-filename)
59     (define-key map "f" 'notmuch-show-stash-from)
60     (define-key map "m" 'notmuch-show-stash-message-id)
61     (define-key map "s" 'notmuch-show-stash-subject)
62     (define-key map "T" 'notmuch-show-stash-tags)
63     (define-key map "t" 'notmuch-show-stash-to)
64     map)
65   "Submap for stash commands"
66   )
67
68 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
69
70 (defvar notmuch-show-mode-map
71   (let ((map (make-sparse-keymap)))
72     (define-key map "?" 'notmuch-help)
73     (define-key map "q" 'kill-this-buffer)
74     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
75     (define-key map (kbd "C-n") 'notmuch-show-next-line)
76     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
77     (define-key map (kbd "TAB") 'notmuch-show-next-button)
78     (define-key map "s" 'notmuch-search)
79     (define-key map "m" 'message-mail)
80     (define-key map "f" 'notmuch-show-forward-current)
81     (define-key map "r" 'notmuch-show-reply)
82     (define-key map "|" 'notmuch-show-pipe-message)
83     (define-key map "w" 'notmuch-show-save-attachments)
84     (define-key map "V" 'notmuch-show-view-raw-message)
85     (define-key map "v" 'notmuch-show-view-all-mime-parts)
86     (define-key map "b" 'notmuch-show-toggle-current-body)
87     (define-key map "h" 'notmuch-show-toggle-current-header)
88     (define-key map "-" 'notmuch-show-remove-tag)
89     (define-key map "+" 'notmuch-show-add-tag)
90     (define-key map "X" 'notmuch-show-mark-read-then-archive-then-exit)
91     (define-key map "x" 'notmuch-show-archive-thread-then-exit)
92     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
93     (define-key map "a" 'notmuch-show-archive-thread)
94     (define-key map "p" 'notmuch-show-previous-message)
95     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
96     (define-key map "n" 'notmuch-show-next-message)
97     (define-key map (kbd "DEL") 'notmuch-show-rewind)
98     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
99     (define-key map "z" 'notmuch-show-stash-map)
100     map)
101   "Keymap for \"notmuch show\" buffers.")
102 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
103
104 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
105   "Pattern to match a line that separates content from signature.
106
107 The regexp can (and should) include $ to match the end of the
108 line, but should not include ^ to match the beginning of the
109 line. This is because notmuch may have inserted additional space
110 for indentation at the beginning of the line. But notmuch will
111 move past the indentation when testing this pattern, (so that the
112 pattern can still test against the entire line).")
113
114 (defvar notmuch-show-signature-button-format
115   "[ %d-line signature. Click/Enter to toggle visibility. ]"
116   "String used to construct button text for hidden signatures
117
118 Can use up to one integer format parameter, i.e. %d")
119
120 (defvar notmuch-show-citation-button-format
121   "[ %d more citation lines. Click/Enter to toggle visibility. ]"
122   "String used to construct button text for hidden citations.
123
124 Can use up to one integer format parameter, i.e. %d")
125
126 (defvar notmuch-show-signature-lines-max 12
127   "Maximum length of signature that will be hidden by default.")
128
129 (defvar notmuch-show-citation-lines-prefix 4
130   "Always show at least this many lines of a citation.
131
132 If there is one more line, show that, otherwise collapse
133 remaining lines into a button.")
134
135 (defvar notmuch-command "notmuch"
136   "Command to run the notmuch binary.")
137
138 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
139 (defvar notmuch-show-message-end-regexp      "\fmessage}")
140 (defvar notmuch-show-header-begin-regexp     "\fheader{")
141 (defvar notmuch-show-header-end-regexp       "\fheader}")
142 (defvar notmuch-show-body-begin-regexp       "\fbody{")
143 (defvar notmuch-show-body-end-regexp         "\fbody}")
144 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
145 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
146 (defvar notmuch-show-part-begin-regexp       "\fpart{")
147 (defvar notmuch-show-part-end-regexp         "\fpart}")
148 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
149
150 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
151 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
152 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
153 (defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
154
155 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
156
157 (defvar notmuch-show-parent-buffer nil)
158 (defvar notmuch-show-body-read-visible nil)
159 (defvar notmuch-show-citations-visible nil)
160 (defvar notmuch-show-signatures-visible nil)
161 (defvar notmuch-show-headers-visible nil)
162
163 ; XXX: This should be a generic function in emacs somewhere, not here
164 (defun point-invisible-p ()
165   "Return whether the character at point is invisible.
166
167 Here visibility is determined by `buffer-invisibility-spec' and
168 the invisible property of any overlays for point. It doesn't have
169 anything to do with whether point is currently being displayed
170 within the current window."
171   (let ((prop (get-char-property (point) 'invisible)))
172     (if (eq buffer-invisibility-spec t)
173         prop
174       (or (memq prop buffer-invisibility-spec)
175           (assq prop buffer-invisibility-spec)))))
176
177 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
178   (let ((tag-list
179          (with-output-to-string
180            (with-current-buffer standard-output
181              (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
182     (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
183
184 (defun notmuch-show-next-line ()
185   "Like builtin `next-line' but ensuring we end on a visible character.
186
187 By advancing forward until reaching a visible character.
188
189 Unlike builtin `next-line' this version accepts no arguments."
190   (interactive)
191   (set 'this-command 'next-line)
192   (call-interactively 'next-line)
193   (while (point-invisible-p)
194     (forward-char)))
195
196 (defun notmuch-show-previous-line ()
197   "Like builtin `previous-line' but ensuring we end on a visible character.
198
199 By advancing forward until reaching a visible character.
200
201 Unlike builtin `previous-line' this version accepts no arguments."
202   (interactive)
203   (set 'this-command 'previous-line)
204   (call-interactively 'previous-line)
205   (while (point-invisible-p)
206     (forward-char)))
207
208 (defun notmuch-show-get-message-id ()
209   (save-excursion
210     (beginning-of-line)
211     (if (not (looking-at notmuch-show-message-begin-regexp))
212         (re-search-backward notmuch-show-message-begin-regexp))
213     (re-search-forward notmuch-show-id-regexp)
214     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
215
216 (defun notmuch-show-get-filename ()
217   (save-excursion
218     (beginning-of-line)
219     (if (not (looking-at notmuch-show-message-begin-regexp))
220         (re-search-backward notmuch-show-message-begin-regexp))
221     (re-search-forward notmuch-show-filename-regexp)
222     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
223
224 (defun notmuch-show-set-tags (tags)
225   (save-excursion
226     (beginning-of-line)
227     (if (not (looking-at notmuch-show-message-begin-regexp))
228         (re-search-backward notmuch-show-message-begin-regexp))
229     (re-search-forward notmuch-show-tags-regexp)
230     (let ((inhibit-read-only t)
231           (beg (match-beginning 1))
232           (end (match-end 1)))
233       (delete-region beg end)
234       (goto-char beg)
235       (insert (mapconcat 'identity tags " ")))))
236
237 (defun notmuch-show-get-tags ()
238   (save-excursion
239     (beginning-of-line)
240     (if (not (looking-at notmuch-show-message-begin-regexp))
241         (re-search-backward notmuch-show-message-begin-regexp))
242     (re-search-forward notmuch-show-tags-regexp)
243     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
244
245 (defun notmuch-show-get-bcc ()
246   "Return BCC address(es) of current message"
247   (notmuch-show-get-header-field 'bcc))
248
249 (defun notmuch-show-get-cc ()
250   "Return CC address(es) of current message"
251   (notmuch-show-get-header-field 'cc))
252
253 (defun notmuch-show-get-date ()
254   "Return Date of current message"
255   (notmuch-show-get-header-field 'date))
256
257 (defun notmuch-show-get-from ()
258   "Return From address of current message"
259   (notmuch-show-get-header-field 'from))
260
261 (defun notmuch-show-get-subject ()
262   "Return Subject of current message"
263   (notmuch-show-get-header-field 'subject))
264
265 (defun notmuch-show-get-to ()
266   "Return To address(es) of current message"
267   (notmuch-show-get-header-field 'to))
268
269 (defun notmuch-show-get-header-field (name)
270   "Retrieve the header field NAME from the current message.
271 NAME should be a symbol, in lower case, as returned by
272 mail-header-extract-no-properties"
273   (let* ((result (assoc name (notmuch-show-get-header)))
274         (val (and result (cdr result))))
275     val))
276
277 (defun notmuch-show-get-header ()
278   "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
279 where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
280 pseudoheader summary"
281   (require 'mailheader)
282   (save-excursion
283     (beginning-of-line)
284     (if (not (looking-at notmuch-show-message-begin-regexp))
285         (re-search-backward notmuch-show-message-begin-regexp))
286     (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
287     (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
288           (beg (point)))
289       (re-search-forward notmuch-show-header-end-regexp)
290       (let ((text (buffer-substring beg (match-beginning 0))))
291         (with-temp-buffer
292           (insert text)
293           (goto-char (point-min))
294           (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
295             (delete-region (match-beginning 1) (match-end 1))
296             (forward-line)
297             )
298           (goto-char (point-min))
299           (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
300
301 (defun notmuch-show-add-tag (&rest toadd)
302   "Add a tag to the current message."
303   (interactive
304    (list (notmuch-select-tag-with-completion "Tag to add: ")))
305   (apply 'notmuch-call-notmuch-process
306          (append (cons "tag"
307                        (mapcar (lambda (s) (concat "+" s)) toadd))
308                  (cons (notmuch-show-get-message-id) nil)))
309   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
310
311 (defun notmuch-show-remove-tag (&rest toremove)
312   "Remove a tag from the current message."
313   (interactive
314    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
315   (let ((tags (notmuch-show-get-tags)))
316     (if (intersection tags toremove :test 'string=)
317         (progn
318           (apply 'notmuch-call-notmuch-process
319                  (append (cons "tag"
320                                (mapcar (lambda (s) (concat "-" s)) toremove))
321                          (cons (notmuch-show-get-message-id) nil)))
322           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
323
324 (defun notmuch-show-archive-thread-maybe-mark-read (markread)
325   (save-excursion
326     (goto-char (point-min))
327     (while (not (eobp))
328       (if markread
329           (notmuch-show-remove-tag "unread" "inbox")
330         (notmuch-show-remove-tag "inbox"))
331       (if (not (eobp))
332           (forward-char))
333       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
334           (goto-char (point-max)))))
335   (let ((parent-buffer notmuch-show-parent-buffer))
336     (kill-this-buffer)
337     (if parent-buffer
338         (progn
339           (switch-to-buffer parent-buffer)
340           (forward-line)
341           (notmuch-search-show-thread)))))
342
343 (defun notmuch-show-mark-read-then-archive-thread ()
344   "Remove unread tags from thread, then archive and show next thread.
345
346 Archive each message currently shown by removing the \"unread\"
347 and \"inbox\" tag from each. Then kill this buffer and show the
348 next thread from the search from which this thread was originally
349 shown.
350
351 Note: This command is safe from any race condition of new messages
352 being delivered to the same thread. It does not archive the
353 entire thread, but only the messages shown in the current
354 buffer."
355   (interactive)
356   (notmuch-show-archive-thread-maybe-mark-read t))
357
358 (defun notmuch-show-archive-thread ()
359   "Archive each message in thread, then show next thread from search.
360
361 Archive each message currently shown by removing the \"inbox\"
362 tag from each. Then kill this buffer and show the next thread
363 from the search from which this thread was originally shown.
364
365 Note: This command is safe from any race condition of new messages
366 being delivered to the same thread. It does not archive the
367 entire thread, but only the messages shown in the current
368 buffer."
369   (interactive)
370   (notmuch-show-archive-thread-maybe-mark-read nil))
371
372 (defun notmuch-show-archive-thread-then-exit ()
373   "Archive each message in thread, then exit back to search results."
374   (interactive)
375   (notmuch-show-archive-thread)
376   (kill-this-buffer))
377
378 (defun notmuch-show-mark-read-then-archive-then-exit ()
379   "Remove unread tags from thread, then archive and exit to search results."
380   (interactive)
381   (notmuch-show-mark-read-then-archive-thread)
382   (kill-this-buffer))
383
384 (defun notmuch-show-view-raw-message ()
385   "View the raw email of the current message."
386   (interactive)
387   (view-file (notmuch-show-get-filename)))
388
389 (defmacro with-current-notmuch-show-message (&rest body)
390   "Evaluate body with current buffer set to the text of current message"
391   `(save-excursion
392      (let ((filename (notmuch-show-get-filename)))
393        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
394          (with-current-buffer buf
395            (insert-file-contents filename nil nil nil t)
396            ,@body)
397          (kill-buffer buf)))))
398
399 (defun notmuch-show-view-all-mime-parts ()
400   "Use external viewers to view all attachments from the current message."
401   (interactive)
402   (with-current-notmuch-show-message
403    ; We ovverride the mm-inline-media-tests to indicate which message
404    ; parts are already sufficiently handled by the original
405    ; presentation of the message in notmuch-show mode. These parts
406    ; will be inserted directly into the temporary buffer of
407    ; with-current-notmuch-show-message and silently discarded.
408    ;
409    ; Any MIME part not explicitly mentioned here will be handled by an
410    ; external viewer as configured in the various mailcap files.
411    (let ((mm-inline-media-tests '(
412                                   ("text/.*" ignore identity)
413                                   ("application/pgp-signature" ignore identity)
414                                   ("multipart/alternative" ignore identity)
415                                   ("multipart/mixed" ignore identity)
416                                   ("multipart/related" ignore identity)
417                                  )))
418      (mm-display-parts (mm-dissect-buffer)))))
419
420 (defun notmuch-foreach-mime-part (function mm-handle)
421   (cond ((stringp (car mm-handle))
422          (dolist (part (cdr mm-handle))
423            (notmuch-foreach-mime-part function part)))
424         ((bufferp (car mm-handle))
425          (funcall function mm-handle))
426         (t (dolist (part mm-handle)
427              (notmuch-foreach-mime-part function part)))))
428
429 (defun notmuch-count-attachments (mm-handle)
430   (let ((count 0))
431     (notmuch-foreach-mime-part
432      (lambda (p)
433        (let ((disposition (mm-handle-disposition p)))
434          (and (listp disposition)
435               (or (equal (car disposition) "attachment")
436                   (and (equal (car disposition) "inline")
437                        (assq 'filename disposition)))
438               (incf count))))
439      mm-handle)
440     count))
441
442 (defun notmuch-save-attachments (mm-handle &optional queryp)
443   (notmuch-foreach-mime-part
444    (lambda (p)
445      (let ((disposition (mm-handle-disposition p)))
446        (and (listp disposition)
447             (or (equal (car disposition) "attachment")
448                 (and (equal (car disposition) "inline")
449                      (assq 'filename disposition)))
450             (or (not queryp)
451                 (y-or-n-p
452                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
453             (mm-save-part p))))
454    mm-handle))
455
456 (defun notmuch-show-save-attachments ()
457   "Save all attachments from the current message."
458   (interactive)
459   (with-current-notmuch-show-message
460    (let ((mm-handle (mm-dissect-buffer)))
461      (notmuch-save-attachments
462       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
463   (message "Done"))
464
465 (defun notmuch-reply (query-string)
466   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
467   (call-process notmuch-command nil t nil "reply" query-string)
468   (message-insert-signature)
469   (goto-char (point-min))
470   (if (re-search-forward "^$" nil t)
471       (progn
472         (insert "--text follows this line--")
473         (forward-line)))
474   (message-mode))
475
476 (defun notmuch-show-reply ()
477   "Begin composing a reply to the current message in a new buffer."
478   (interactive)
479   (let ((message-id (notmuch-show-get-message-id)))
480     (notmuch-reply message-id)))
481
482 (defun notmuch-show-forward-current ()
483   "Forward the current message."
484   (interactive)
485   (with-current-notmuch-show-message
486    (message-forward)))
487
488 (defun notmuch-show-pipe-message (command)
489   "Pipe the contents of the current message to the given command.
490
491 The given command will be executed with the raw contents of the
492 current email message as stdin. Anything printed by the command
493 to stdout or stderr will appear in the *Messages* buffer."
494   (interactive "sPipe message to command: ")
495   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
496          (list command " < " (shell-quote-argument (notmuch-show-get-filename)))))
497
498 (defun notmuch-show-move-to-current-message-summary-line ()
499   "Move to the beginning of the one-line summary of the current message.
500
501 This gives us a stable place to move to and work from since the
502 summary line is always visible. This is important since moving to
503 an invisible location is unreliable, (the main command loop moves
504 point either forward or backward to the next visible character
505 when a command ends with point on an invisible character).
506
507 Emits an error if point is not within a valid message, (that is
508 no pattern of `notmuch-show-message-begin-regexp' could be found
509 by searching backward)."
510   (beginning-of-line)
511   (if (not (looking-at notmuch-show-message-begin-regexp))
512       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
513           (forward-line 2)
514         (error "Not within a valid message."))
515     (forward-line 2)))
516
517 (defun notmuch-show-last-message-p ()
518   "Predicate testing whether point is within the last message."
519   (save-window-excursion
520     (save-excursion
521       (notmuch-show-move-to-current-message-summary-line)
522       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
523
524 (defun notmuch-show-message-unread-p ()
525   "Predicate testing whether current message is unread."
526   (member "unread" (notmuch-show-get-tags)))
527
528 (defun notmuch-show-message-open-p ()
529   "Predicate testing whether current message is open (body is visible)."
530   (let ((btn (previous-button (point) t)))
531     (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type))
532       (setq btn (previous-button (button-start btn))))
533     (not (invisible-p (button-get btn 'invisibility-spec)))))
534
535 (defun notmuch-show-next-message ()
536   "Advance to the beginning of the next message in the buffer.
537
538 Moves to the last visible character of the current message if
539 already on the last message in the buffer.
540
541 Returns nil if already on the last message in the buffer."
542   (interactive)
543   (notmuch-show-move-to-current-message-summary-line)
544   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
545       (progn
546         (notmuch-show-move-to-current-message-summary-line)
547         (recenter 0)
548         t)
549     (goto-char (- (point-max) 1))
550     (while (point-invisible-p)
551       (backward-char))
552     (recenter 0)
553     nil))
554
555 (defun notmuch-show-find-next-message ()
556   "Returns the position of the next message in the buffer.
557
558 Or the position of the last visible character of the current
559 message if already within the last message in the buffer."
560   ; save-excursion doesn't save our window position
561   ; save-window-excursion doesn't save point
562   ; Looks like we have to use both.
563   (save-excursion
564     (save-window-excursion
565       (notmuch-show-next-message)
566       (point))))
567
568 (defun notmuch-show-next-unread-message ()
569   "Advance to the beginning of the next unread message in the buffer.
570
571 Moves to the last visible character of the current message if
572 there are no more unread messages past the current point."
573   (notmuch-show-next-message)
574   (while (and (not (notmuch-show-last-message-p))
575               (not (notmuch-show-message-unread-p)))
576     (notmuch-show-next-message))
577   (if (not (notmuch-show-message-unread-p))
578       (notmuch-show-next-message)))
579
580 (defun notmuch-show-next-open-message ()
581   "Advance to the next open message (that is, body is not invisible)."
582   (while (and (notmuch-show-next-message)
583               (not (notmuch-show-message-open-p)))))
584
585 (defun notmuch-show-previous-message ()
586   "Backup to the beginning of the previous message in the buffer.
587
588 If within a message rather than at the beginning of it, then
589 simply move to the beginning of the current message."
590   (interactive)
591   (let ((start (point)))
592     (notmuch-show-move-to-current-message-summary-line)
593     (if (not (< (point) start))
594         ; Go backward twice to skip the current message's marker
595         (progn
596           (re-search-backward notmuch-show-message-begin-regexp nil t)
597           (re-search-backward notmuch-show-message-begin-regexp nil t)
598           (notmuch-show-move-to-current-message-summary-line)
599           ))
600     (recenter 0)))
601
602 (defun notmuch-show-find-previous-message ()
603   "Returns the position of the previous message in the buffer.
604
605 Or the position of the beginning of the current message if point
606 is originally within the message rather than at the beginning of
607 it."
608   ; save-excursion doesn't save our window position
609   ; save-window-excursion doesn't save point
610   ; Looks like we have to use both.
611   (save-excursion
612     (save-window-excursion
613       (notmuch-show-previous-message)
614       (point))))
615
616 (defun notmuch-show-mark-read-then-next-open-message ()
617   "Remove unread tag from this message, then advance to next open message."
618   (interactive)
619   (notmuch-show-remove-tag "unread")
620   (notmuch-show-next-open-message))
621
622 (defun notmuch-show-rewind ()
623   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-marking-read-and-archiving]).
624
625 Specifically, if the beginning of the previous email is fewer
626 than `window-height' lines from the current point, move to it
627 just like `notmuch-show-previous-message'.
628
629 Otherwise, just scroll down a screenful of the current message.
630
631 This command does not modify any message tags, (it does not undo
632 any effects from previous calls to
633 `notmuch-show-advance-marking-read-and-archiving'."
634   (interactive)
635   (let ((previous (notmuch-show-find-previous-message)))
636     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
637         (progn
638           (condition-case nil
639               (scroll-down nil)
640             ((beginning-of-buffer) nil))
641           (goto-char (window-start)))
642       (notmuch-show-previous-message))))
643
644 (defun notmuch-show-advance-marking-read-and-archiving ()
645   "Advance through thread, marking read and archiving.
646
647 This command is intended to be one of the simplest ways to
648 process a thread of email. It does the following:
649
650 If the current message in the thread is not yet fully visible,
651 scroll by a near screenful to read more of the message.
652
653 Otherwise, (the end of the current message is already within the
654 current window), remove the \"unread\" tag (if present) from the
655 current message and advance to the next open message.
656
657 Finally, if there is no further message to advance to, and this
658 last message is already read, then archive the entire current
659 thread, (remove the \"inbox\" tag from each message). Also kill
660 this buffer, and display the next thread from the search from
661 which this thread was originally shown."
662   (interactive)
663   (let ((next (notmuch-show-find-next-message))
664         (unread (notmuch-show-message-unread-p)))
665     (if (> next (window-end))
666         (scroll-up nil)
667       (let ((last (notmuch-show-last-message-p)))
668         (notmuch-show-mark-read-then-next-open-message)
669         (if last
670             (notmuch-show-archive-thread))))))
671
672 (defun notmuch-show-next-button ()
673   "Advance point to the next button in the buffer."
674   (interactive)
675   (forward-button 1))
676
677 (defun notmuch-show-previous-button ()
678   "Move point back to the previous button in the buffer."
679   (interactive)
680   (backward-button 1))
681
682 (defun notmuch-toggle-invisible-action (cite-button)
683   (let ((invis-spec (button-get cite-button 'invisibility-spec)))
684         (if (invisible-p invis-spec)
685             (remove-from-invisibility-spec invis-spec)
686           (add-to-invisibility-spec invis-spec)
687           ))
688   (force-window-update)
689   (redisplay t))
690
691 (defun notmuch-show-toggle-current-body ()
692   "Toggle the display of the current message body."
693   (interactive)
694   (save-excursion
695     (notmuch-show-move-to-current-message-summary-line)
696     (unless (button-at (point))
697       (notmuch-show-next-button))
698     (push-button))
699   )
700
701 (defun notmuch-show-toggle-current-header ()
702   "Toggle the display of the current message header."
703   (interactive)
704   (save-excursion
705     (notmuch-show-move-to-current-message-summary-line)
706     (forward-line)
707     (unless (button-at (point))
708       (notmuch-show-next-button))
709     (push-button))
710   )
711
712 (define-button-type 'notmuch-button-invisibility-toggle-type
713   'action 'notmuch-toggle-invisible-action
714   'follow-link t
715   'face 'font-lock-comment-face)
716 (define-button-type 'notmuch-button-citation-toggle-type 'help-echo "mouse-1, RET: Show citation"
717   :supertype 'notmuch-button-invisibility-toggle-type)
718 (define-button-type 'notmuch-button-signature-toggle-type 'help-echo "mouse-1, RET: Show signature"
719   :supertype 'notmuch-button-invisibility-toggle-type)
720 (define-button-type 'notmuch-button-headers-toggle-type 'help-echo "mouse-1, RET: Show headers"
721   :supertype 'notmuch-button-invisibility-toggle-type)
722 (define-button-type 'notmuch-button-body-toggle-type
723   'help-echo "mouse-1, RET: Show message"
724   'face 'notmuch-message-summary-face
725   :supertype 'notmuch-button-invisibility-toggle-type)
726
727 (defun notmuch-show-citation-regexp (depth)
728   "Build a regexp for matching citations at a given DEPTH (indent)"
729   (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth)))
730     (concat "\\(?:^" line-regexp
731             "\\(?:[[:space:]]*\n" line-regexp
732             "\\)?\\)+")))
733
734 (defun notmuch-show-region-to-button (beg end type prefix button-text)
735   "Auxilary function to do the actual making of overlays and buttons
736
737 BEG and END are buffer locations. TYPE should a string, either
738 \"citation\" or \"signature\". PREFIX is some arbitrary text to
739 insert before the button, probably for indentation.  BUTTON-TEXT
740 is what to put on the button."
741
742 ;; This uses some slightly tricky conversions between strings and
743 ;; symbols because of the way the button code works. Note that
744 ;; replacing intern-soft with make-symbol will cause this to fail,
745 ;; since the newly created symbol has no plist.
746
747   (let ((overlay (make-overlay beg end))
748         (invis-spec (make-symbol (concat "notmuch-" type "-region")))
749         (button-type (intern-soft (concat "notmuch-button-"
750                                           type "-toggle-type"))))
751     (add-to-invisibility-spec invis-spec)
752     (overlay-put overlay 'invisible invis-spec)
753     (goto-char (1+ end))
754     (save-excursion
755       (goto-char (1- beg))
756       (insert prefix)
757       (insert-button button-text
758                      'invisibility-spec invis-spec
759                      :type button-type)
760       )))
761
762
763 (defun notmuch-show-markup-citations-region (beg end depth)
764   "Markup citations, and up to one signature in the given region"
765   ;; it would be nice if the untabify was not required, but
766   ;; that would require notmuch to indent with spaces.
767   (untabify beg end)
768   (let ((citation-regexp (notmuch-show-citation-regexp depth))
769         (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
770                                   notmuch-show-signature-regexp))
771         (indent (concat "\n" (make-string depth ? ))))
772     (goto-char beg)
773     (beginning-of-line)
774     (while (and (< (point) end)
775                 (re-search-forward citation-regexp end t))
776       (let* ((cite-start (match-beginning 0))
777              (cite-end  (match-end 0))
778              (cite-lines (count-lines cite-start cite-end)))
779         (when (> cite-lines (1+ notmuch-show-citation-lines-prefix))
780           (goto-char cite-start)
781           (forward-line notmuch-show-citation-lines-prefix)
782           (notmuch-show-region-to-button
783            (point) cite-end
784            "citation"
785            indent
786            (format notmuch-show-citation-button-format
787                    (- cite-lines notmuch-show-citation-lines-prefix))
788            ))))
789     (if (and (< (point) end)
790              (re-search-forward signature-regexp end t))
791         (let* ((sig-start (match-beginning 0))
792                (sig-end (match-end 0))
793                (sig-lines (1- (count-lines sig-start end))))
794           (if (<= sig-lines notmuch-show-signature-lines-max)
795               (notmuch-show-region-to-button
796                sig-start
797                end
798                "signature"
799                indent
800                (format notmuch-show-signature-button-format sig-lines)
801                ))))))
802
803 (defun notmuch-show-markup-part (beg end depth)
804   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
805       (progn
806         (let (mime-message mime-type)
807           (save-excursion
808             (re-search-forward notmuch-show-contentype-regexp end t)
809             (setq mime-type (car (split-string (buffer-substring
810                                                 (match-beginning 1) (match-end 1))))))
811
812           (if (equal mime-type "text/html")
813               (let ((filename (notmuch-show-get-filename)))
814                 (with-temp-buffer
815                   (insert-file-contents filename nil nil nil t)
816                   (setq mime-message (mm-dissect-buffer)))))
817           (forward-line)
818           (let ((beg (point-marker)))
819             (re-search-forward notmuch-show-part-end-regexp)
820             (let ((end (copy-marker (match-beginning 0))))
821               (goto-char end)
822               (if (not (bolp))
823                   (insert "\n"))
824               (indent-rigidly beg end depth)
825               (if (not (eq mime-message nil))
826                   (save-excursion
827                     (goto-char beg)
828                     (forward-line -1)
829                     (let ((handle-type (mm-handle-type mime-message))
830                           mime-type)
831                       (if (sequencep (car handle-type))
832                           (setq mime-type (car handle-type))
833                         (setq mime-type (car (car (cdr handle-type))))
834                         )
835                       (if (equal mime-type "text/html")
836                           (mm-display-part mime-message))))
837                 )
838               (notmuch-show-markup-citations-region beg end depth)
839               ; Advance to the next part (if any) (so the outer loop can
840               ; determine whether we've left the current message.
841               (if (re-search-forward notmuch-show-part-begin-regexp nil t)
842                   (beginning-of-line)))))
843         (goto-char end))
844     (goto-char end)))
845
846 (defun notmuch-show-markup-parts-region (beg end depth)
847   (save-excursion
848     (goto-char beg)
849     (while (< (point) end)
850       (notmuch-show-markup-part beg end depth))))
851
852 (defun notmuch-show-markup-body (depth match btn)
853   "Markup a message body, (indenting, buttonizing citations,
854 etc.), and conditionally hiding the body itself if the message
855 has been read and does not match the current search.
856
857 DEPTH specifies the depth at which this message appears in the
858 tree of the current thread, (the top-level messages have depth 0
859 and each reply increases depth by 1). MATCH indicates whether
860 this message is regarded as matching the current search. BTN is
861 the button which is used to toggle the visibility of this
862 message.
863
864 When this function is called, point must be within the message, but
865 before the delimiter marking the beginning of the body."
866   (re-search-forward notmuch-show-body-begin-regexp)
867   (forward-line)
868   (let ((beg (point-marker)))
869     (re-search-forward notmuch-show-body-end-regexp)
870     (let ((end (copy-marker (match-beginning 0))))
871       (notmuch-show-markup-parts-region beg end depth)
872       (let ((invis-spec (make-symbol "notmuch-show-body-read")))
873         (overlay-put (make-overlay beg end)
874                      'invisible invis-spec)
875         (button-put btn 'invisibility-spec invis-spec)
876         (if (not (or (notmuch-show-message-unread-p) match))
877             (add-to-invisibility-spec invis-spec)))
878       (set-marker beg nil)
879       (set-marker end nil)
880       )))
881
882 (defun notmuch-fontify-headers ()
883   (while (looking-at "[[:space:]]")
884     (forward-char))
885   (if (looking-at "[Tt]o:")
886       (progn
887         (overlay-put (make-overlay (point) (re-search-forward ":"))
888                      'face 'message-header-name)
889         (overlay-put (make-overlay (point) (re-search-forward ".*$"))
890                      'face 'message-header-to))
891     (if (looking-at "[B]?[Cc][Cc]:")
892         (progn
893           (overlay-put (make-overlay (point) (re-search-forward ":"))
894                        'face 'message-header-name)
895           (overlay-put (make-overlay (point) (re-search-forward ".*$"))
896                        'face 'message-header-cc))
897       (if (looking-at "[Ss]ubject:")
898           (progn
899             (overlay-put (make-overlay (point) (re-search-forward ":"))
900                          'face 'message-header-name)
901             (overlay-put (make-overlay (point) (re-search-forward ".*$"))
902                          'face 'message-header-subject))
903         (if (looking-at "[Ff]rom:")
904             (progn
905               (overlay-put (make-overlay (point) (re-search-forward ":"))
906                            'face 'message-header-name)
907               (overlay-put (make-overlay (point) (re-search-forward ".*$"))
908                            'face 'message-header-other)))))))
909
910 (defun notmuch-show-markup-header (message-begin depth)
911   "Buttonize and decorate faces in a message header.
912
913 MESSAGE-BEGIN is the position of the absolute first character in
914 the message (including all delimiters that will end up being
915 invisible etc.). This is to allow a button to reliably extend to
916 the beginning of the message even if point is positioned at an
917 invisible character (such as the beginning of the buffer).
918
919 DEPTH specifies the depth at which this message appears in the
920 tree of the current thread, (the top-level messages have depth 0
921 and each reply increases depth by 1)."
922   (re-search-forward notmuch-show-header-begin-regexp)
923   (forward-line)
924   (let ((beg (point-marker))
925         (summary-end (copy-marker (line-beginning-position 2)))
926         (subject-end (copy-marker (line-end-position 2)))
927         (invis-spec (make-symbol "notmuch-show-header"))
928         (btn nil))
929     (re-search-forward notmuch-show-header-end-regexp)
930     (beginning-of-line)
931     (let ((end (point-marker)))
932       (indent-rigidly beg end depth)
933       (goto-char beg)
934       (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type))
935       (forward-line)
936       (add-to-invisibility-spec invis-spec)
937       (overlay-put (make-overlay subject-end end)
938                    'invisible invis-spec)
939       (make-button (line-beginning-position) subject-end
940                    'invisibility-spec invis-spec
941                    :type 'notmuch-button-headers-toggle-type)
942       (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:")
943         (beginning-of-line)
944         (notmuch-fontify-headers)
945         (forward-line)
946         )
947       (goto-char end)
948       (insert "\n")
949       (set-marker beg nil)
950       (set-marker summary-end nil)
951       (set-marker subject-end nil)
952       (set-marker end nil)
953       )
954   btn))
955
956 (defun notmuch-show-markup-message ()
957   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
958       (let ((message-begin (match-beginning 0)))
959         (re-search-forward notmuch-show-depth-match-regexp)
960         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
961               (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2))))
962               (btn nil))
963           (setq btn (notmuch-show-markup-header message-begin depth))
964           (notmuch-show-markup-body depth match btn)))
965     (goto-char (point-max))))
966
967 (defun notmuch-show-hide-markers ()
968   (save-excursion
969     (goto-char (point-min))
970     (while (not (eobp))
971       (if (re-search-forward notmuch-show-marker-regexp nil t)
972           (progn
973             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
974                          'invisible 'notmuch-show-marker))
975         (goto-char (point-max))))))
976
977 (defun notmuch-show-markup-messages ()
978   (save-excursion
979     (goto-char (point-min))
980     (while (not (eobp))
981       (notmuch-show-markup-message)))
982   (notmuch-show-hide-markers))
983
984 (defun notmuch-documentation-first-line (symbol)
985   "Return the first line of the documentation string for SYMBOL."
986   (let ((doc (documentation symbol)))
987     (if doc
988         (with-temp-buffer
989           (insert (documentation symbol t))
990           (goto-char (point-min))
991           (let ((beg (point)))
992             (end-of-line)
993             (buffer-substring beg (point))))
994       "")))
995
996 (defun notmuch-prefix-key-description (key)
997   "Given a prefix key code, return a human-readable string representation.
998
999 This is basically just `format-kbd-macro' but we also convert ESC to M-."
1000   (let ((desc (format-kbd-macro (vector key))))
1001     (if (string= desc "ESC")
1002         "M-"
1003       (concat desc " "))))
1004
1005 ; I would think that emacs would have code handy for walking a keymap
1006 ; and generating strings for each key, and I would prefer to just call
1007 ; that. But I couldn't find any (could be all implemented in C I
1008 ; suppose), so I wrote my own here.
1009 (defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
1010   "For a key binding, return a string showing a human-readable
1011 representation of the prefixed key as well as the first line of
1012 documentation from the bound function.
1013
1014 For a mouse binding, return nil."
1015   (let ((key (car binding))
1016         (action (cdr binding)))
1017     (if (mouse-event-p key)
1018         nil
1019       (if (keymapp action)
1020           (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
1021                 (as-list))
1022             (map-keymap (lambda (a b)
1023                           (push (cons a b) as-list))
1024                         action)
1025             (mapconcat substitute as-list "\n"))
1026         (concat prefix (format-kbd-macro (vector key))
1027                 "\t"
1028                 (notmuch-documentation-first-line action))))))
1029
1030 (defalias 'notmuch-substitute-one-command-key
1031   (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil))
1032
1033 (defun notmuch-substitute-command-keys (doc)
1034   "Like `substitute-command-keys' but with documentation, not function names."
1035   (let ((beg 0))
1036     (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
1037       (let ((map (substring doc (match-beginning 1) (match-end 1))))
1038         (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
1039                                             (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
1040       (setq beg (match-end 0)))
1041     doc))
1042
1043 (defun notmuch-help ()
1044   "Display help for the current notmuch mode."
1045   (interactive)
1046   (let* ((mode major-mode)
1047          (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
1048     (with-current-buffer (generate-new-buffer "*notmuch-help*")
1049       (insert doc)
1050       (goto-char (point-min))
1051       (set-buffer-modified-p nil)
1052       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
1053
1054 ;;;###autoload
1055 (defun notmuch-show-mode ()
1056   "Major mode for viewing a thread with notmuch.
1057
1058 This buffer contains the results of the \"notmuch show\" command
1059 for displaying a single thread of email from your email archives.
1060
1061 By default, various components of email messages, (citations,
1062 signatures, already-read messages), are hidden. You can make
1063 these parts visible by clicking with the mouse button or by
1064 pressing RET after positioning the cursor on a hidden part, (for
1065 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
1066
1067 Reading the thread sequentially is well-supported by pressing
1068 \\[notmuch-show-advance-marking-read-and-archiving]. This will scroll the current message (if necessary),
1069 advance to the next message, or advance to the next thread (if
1070 already on the last message of a thread). As each message is
1071 scrolled away its \"unread\" tag will be removed, and as each
1072 thread is scrolled away the \"inbox\" tag will be removed from
1073 each message in the thread.
1074
1075 Other commands are available to read or manipulate the thread more
1076 selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without
1077 removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without
1078 scrolling through with \\[notmuch-show-advance-marking-read-and-archiving]).
1079
1080 You can add or remove arbitary tags from the current message with
1081 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
1082
1083 All currently available key bindings:
1084
1085 \\{notmuch-show-mode-map}"
1086   (interactive)
1087   (kill-all-local-variables)
1088   (add-to-invisibility-spec 'notmuch-show-marker)
1089   (use-local-map notmuch-show-mode-map)
1090   (setq major-mode 'notmuch-show-mode
1091         mode-name "notmuch-show")
1092   (setq buffer-read-only t))
1093
1094 (defgroup notmuch nil
1095   "Notmuch mail reader for Emacs."
1096   :group 'mail)
1097
1098 (defcustom notmuch-show-hook nil
1099   "List of functions to call when notmuch displays a message."
1100   :type 'hook
1101   :options '(goto-address)
1102   :group 'notmuch)
1103
1104 (defcustom notmuch-search-hook nil
1105   "List of functions to call when notmuch displays the search results."
1106   :type 'hook
1107   :options '(hl-line-mode)
1108   :group 'notmuch)
1109
1110 (defun notmuch-show-do-stash (text)
1111     (kill-new text)
1112     (message (concat "Saved: " text)))
1113
1114 (defun notmuch-show-stash-cc ()
1115   "Copy CC field of current message to kill-ring."
1116   (interactive)
1117   (notmuch-show-do-stash (notmuch-show-get-cc)))
1118
1119 (defun notmuch-show-stash-date ()
1120   "Copy date of current message to kill-ring."
1121   (interactive)
1122   (notmuch-show-do-stash (notmuch-show-get-date)))
1123
1124 (defun notmuch-show-stash-filename ()
1125   "Copy filename of current message to kill-ring."
1126   (interactive)
1127   (notmuch-show-do-stash (notmuch-show-get-filename)))
1128
1129 (defun notmuch-show-stash-from ()
1130   "Copy From address of current message to kill-ring."
1131   (interactive)
1132   (notmuch-show-do-stash (notmuch-show-get-from)))
1133
1134 (defun notmuch-show-stash-message-id ()
1135   "Copy message-id of current message to kill-ring."
1136   (interactive)
1137   (notmuch-show-do-stash (notmuch-show-get-message-id)))
1138
1139 (defun notmuch-show-stash-subject ()
1140   "Copy Subject field of current message to kill-ring."
1141   (interactive)
1142   (notmuch-show-do-stash (notmuch-show-get-subject)))
1143
1144 (defun notmuch-show-stash-tags ()
1145   "Copy tags of current message to kill-ring as a comma separated list."
1146   (interactive)
1147   (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
1148
1149 (defun notmuch-show-stash-to ()
1150   "Copy To address of current message to kill-ring."
1151   (interactive)
1152   (notmuch-show-do-stash (notmuch-show-get-to)))
1153
1154 ; Make show mode a bit prettier, highlighting URLs and using word wrap
1155
1156 (defun notmuch-show-pretty-hook ()
1157   (goto-address-mode 1)
1158   (visual-line-mode))
1159
1160 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
1161 (add-hook 'notmuch-search-hook
1162           (lambda()
1163             (hl-line-mode 1) ))
1164
1165 (defun notmuch-show (thread-id &optional parent-buffer query-context)
1166   "Run \"notmuch show\" with the given thread ID and display results.
1167
1168 The optional PARENT-BUFFER is the notmuch-search buffer from
1169 which this notmuch-show command was executed, (so that the next
1170 thread from that buffer can be show when done with this one).
1171
1172 The optional QUERY-CONTEXT is a notmuch search term. Only messages from the thread
1173 matching this search term are shown if non-nil. "
1174   (interactive "sNotmuch show: ")
1175   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
1176     (switch-to-buffer buffer)
1177     (notmuch-show-mode)
1178     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
1179     (let ((proc (get-buffer-process (current-buffer)))
1180           (inhibit-read-only t))
1181       (if proc
1182           (error "notmuch search process already running for query `%s'" thread-id)
1183         )
1184       (erase-buffer)
1185       (goto-char (point-min))
1186       (save-excursion
1187         (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id))
1188                 (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args)))
1189           (apply 'call-process args)
1190           (when (and (eq (buffer-size) 0) query-context)
1191             (apply 'call-process basic-args)))
1192         (notmuch-show-markup-messages)
1193         )
1194       (run-hooks 'notmuch-show-hook)
1195       ; Move straight to the first open message
1196       (if (not (notmuch-show-message-open-p))
1197           (notmuch-show-next-open-message))
1198       )))
1199
1200 (defvar notmuch-search-authors-width 40
1201   "Number of columns to use to display authors in a notmuch-search buffer.")
1202
1203 (defvar notmuch-search-mode-map
1204   (let ((map (make-sparse-keymap)))
1205     (define-key map "?" 'notmuch-help)
1206     (define-key map "q" 'kill-this-buffer)
1207     (define-key map "x" 'kill-this-buffer)
1208     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
1209     (define-key map "b" 'notmuch-search-scroll-down)
1210     (define-key map " " 'notmuch-search-scroll-up)
1211     (define-key map "<" 'notmuch-search-first-thread)
1212     (define-key map ">" 'notmuch-search-last-thread)
1213     (define-key map "p" 'notmuch-search-previous-thread)
1214     (define-key map "n" 'notmuch-search-next-thread)
1215     (define-key map "r" 'notmuch-search-reply-to-thread)
1216     (define-key map "m" 'message-mail)
1217     (define-key map "s" 'notmuch-search)
1218     (define-key map "o" 'notmuch-search-toggle-order)
1219     (define-key map "=" 'notmuch-search-refresh-view)
1220     (define-key map "t" 'notmuch-search-filter-by-tag)
1221     (define-key map "f" 'notmuch-search-filter)
1222     (define-key map [mouse-1] 'notmuch-search-show-thread)
1223     (define-key map "*" 'notmuch-search-operate-all)
1224     (define-key map "a" 'notmuch-search-archive-thread)
1225     (define-key map "-" 'notmuch-search-remove-tag)
1226     (define-key map "+" 'notmuch-search-add-tag)
1227     (define-key map (kbd "RET") 'notmuch-search-show-thread)
1228     map)
1229   "Keymap for \"notmuch search\" buffers.")
1230 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
1231
1232 (defvar notmuch-search-query-string)
1233 (defvar notmuch-search-oldest-first t
1234   "Show the oldest mail first in the search-mode")
1235
1236 (defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
1237
1238 (defun notmuch-search-scroll-up ()
1239   "Move forward through search results by one window's worth."
1240   (interactive)
1241   (condition-case nil
1242       (scroll-up nil)
1243     ((end-of-buffer) (notmuch-search-last-thread))))
1244
1245 (defun notmuch-search-scroll-down ()
1246   "Move backward through the search results by one window's worth."
1247   (interactive)
1248   ; I don't know why scroll-down doesn't signal beginning-of-buffer
1249   ; the way that scroll-up signals end-of-buffer, but c'est la vie.
1250   ;
1251   ; So instead of trapping a signal we instead check whether the
1252   ; window begins on the first line of the buffer and if so, move
1253   ; directly to that position. (We have to count lines since the
1254   ; window-start position is not the same as point-min due to the
1255   ; invisible thread-ID characters on the first line.
1256   (if (equal (count-lines (point-min) (window-start)) 0)
1257       (goto-char (point-min))
1258     (scroll-down nil)))
1259
1260 (defun notmuch-search-next-thread ()
1261   "Select the next thread in the search results."
1262   (interactive)
1263   (forward-line 1))
1264
1265 (defun notmuch-search-previous-thread ()
1266   "Select the previous thread in the search results."
1267   (interactive)
1268   (forward-line -1))
1269
1270 (defun notmuch-search-last-thread ()
1271   "Select the last thread in the search results."
1272   (interactive)
1273   (goto-char (point-max))
1274   (forward-line -2))
1275
1276 (defun notmuch-search-first-thread ()
1277   "Select the first thread in the search results."
1278   (interactive)
1279   (goto-char (point-min)))
1280
1281 (defface notmuch-message-summary-face
1282  '((((class color) (background light)) (:background "#f0f0f0"))
1283    (((class color) (background dark)) (:background "#303030")))
1284  "Face for the single-line message summary in notmuch-show-mode."
1285  :group 'notmuch)
1286
1287 (defface notmuch-tag-face
1288   '((((class color)
1289       (background dark))
1290      (:foreground "OliveDrab1"))
1291     (((class color)
1292       (background light))
1293      (:foreground "navy blue" :bold t))
1294     (t
1295      (:bold t)))
1296   "Notmuch search mode face used to highligh tags."
1297   :group 'notmuch)
1298
1299 (defvar notmuch-tag-face-alist nil
1300   "List containing the tag list that need to be highlighed")
1301
1302 (defvar notmuch-search-font-lock-keywords  nil)
1303
1304 ;;;###autoload
1305 (defun notmuch-search-mode ()
1306   "Major mode displaying results of a notmuch search.
1307
1308 This buffer contains the results of a \"notmuch search\" of your
1309 email archives. Each line in the buffer represents a single
1310 thread giving a summary of the thread (a relative date, the
1311 number of matched messages and total messages in the thread,
1312 participants in the thread, a representative subject line, and
1313 any tags).
1314
1315 Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
1316 keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
1317 is a convenience for archiving a thread (removing the \"inbox\"
1318 tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all
1319 threads in the current buffer.
1320
1321 Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
1322 based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include
1323 only messages with a given tag, and '\\[notmuch-search]' to execute a new, global
1324 search.
1325
1326 Complete list of currently available key bindings:
1327
1328 \\{notmuch-search-mode-map}"
1329   (interactive)
1330   (kill-all-local-variables)
1331   (make-local-variable 'notmuch-search-query-string)
1332   (make-local-variable 'notmuch-search-oldest-first)
1333   (set (make-local-variable 'scroll-preserve-screen-position) t)
1334   (add-to-invisibility-spec 'notmuch-search)
1335   (use-local-map notmuch-search-mode-map)
1336   (setq truncate-lines t)
1337   (setq major-mode 'notmuch-search-mode
1338         mode-name "notmuch-search")
1339   (setq buffer-read-only t)
1340   (if (not notmuch-tag-face-alist)
1341       (add-to-list 'notmuch-search-font-lock-keywords (list
1342                 "(\\([^)]*\\))$" '(1  'notmuch-tag-face)))
1343     (let ((notmuch-search-tags (mapcar 'car notmuch-tag-face-alist)))
1344       (loop for notmuch-search-tag  in notmuch-search-tags
1345             do (add-to-list 'notmuch-search-font-lock-keywords (list
1346                         (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
1347                         `(1  ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
1348   (set (make-local-variable 'font-lock-defaults)
1349          '(notmuch-search-font-lock-keywords t)))
1350
1351 (defun notmuch-search-find-thread-id ()
1352   "Return the thread for the current thread"
1353   (get-text-property (point) 'notmuch-search-thread-id))
1354
1355 (defun notmuch-search-find-authors ()
1356   "Return the authors for the current thread"
1357   (get-text-property (point) 'notmuch-search-authors))
1358
1359 (defun notmuch-search-find-subject ()
1360   "Return the subject for the current thread"
1361   (get-text-property (point) 'notmuch-search-subject))
1362
1363 (defun notmuch-search-show-thread ()
1364   "Display the currently selected thread."
1365   (interactive)
1366   (let ((thread-id (notmuch-search-find-thread-id)))
1367     (if (> (length thread-id) 0)
1368         (notmuch-show thread-id (current-buffer) notmuch-search-query-string)
1369       (error "End of search results"))))
1370
1371 (defun notmuch-search-reply-to-thread ()
1372   "Begin composing a reply to the entire current thread in a new buffer."
1373   (interactive)
1374   (let ((message-id (notmuch-search-find-thread-id)))
1375     (notmuch-reply message-id)))
1376
1377 (defun notmuch-call-notmuch-process (&rest args)
1378   "Synchronously invoke \"notmuch\" with the given list of arguments.
1379
1380 Output from the process will be presented to the user as an error
1381 and will also appear in a buffer named \"*Notmuch errors*\"."
1382   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
1383     (with-current-buffer error-buffer
1384         (erase-buffer))
1385     (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
1386         (point)
1387       (progn
1388         (with-current-buffer error-buffer
1389           (let ((beg (point-min))
1390                 (end (- (point-max) 1)))
1391             (error (buffer-substring beg end))
1392             ))))))
1393
1394 (defun notmuch-search-set-tags (tags)
1395   (save-excursion
1396     (end-of-line)
1397     (re-search-backward "(")
1398     (forward-char)
1399     (let ((beg (point))
1400           (inhibit-read-only t))
1401       (re-search-forward ")")
1402       (backward-char)
1403       (let ((end (point)))
1404         (delete-region beg end)
1405         (insert (mapconcat  'identity tags " "))))))
1406
1407 (defun notmuch-search-get-tags ()
1408   (save-excursion
1409     (end-of-line)
1410     (re-search-backward "(")
1411     (let ((beg (+ (point) 1)))
1412       (re-search-forward ")")
1413       (let ((end (- (point) 1)))
1414         (split-string (buffer-substring beg end))))))
1415
1416 (defun notmuch-search-add-tag (tag)
1417   "Add a tag to the currently selected thread.
1418
1419 The tag is added to messages in the currently selected thread
1420 which match the current search terms."
1421   (interactive
1422    (list (notmuch-select-tag-with-completion "Tag to add: ")))
1423   (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
1424   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
1425
1426 (defun notmuch-search-remove-tag (tag)
1427   "Remove a tag from the currently selected thread.
1428
1429 The tag is removed from messages in the currently selected thread
1430 which match the current search terms."
1431   (interactive
1432    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id))))
1433   (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
1434   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
1435
1436 (defun notmuch-search-archive-thread ()
1437   "Archive the currently selected thread (remove its \"inbox\" tag).
1438
1439 This function advances the next thread when finished."
1440   (interactive)
1441   (notmuch-search-remove-tag "inbox")
1442   (forward-line))
1443
1444 (defun notmuch-search-process-sentinel (proc msg)
1445   "Add a message to let user know when \"notmuch search\" exits"
1446   (let ((buffer (process-buffer proc))
1447         (status (process-status proc))
1448         (exit-status (process-exit-status proc)))
1449     (if (memq status '(exit signal))
1450         (if (buffer-live-p buffer)
1451             (with-current-buffer buffer
1452               (save-excursion
1453                 (let ((inhibit-read-only t))
1454                   (goto-char (point-max))
1455                   (if (eq status 'signal)
1456                       (insert "Incomplete search results (search process was killed).\n"))
1457                   (if (eq status 'exit)
1458                       (progn
1459                         (insert "End of search results.")
1460                         (if (not (= exit-status 0))
1461                             (insert (format " (process returned %d)" exit-status)))
1462                         (insert "\n"))))))))))
1463
1464 (defun notmuch-search-process-filter (proc string)
1465   "Process and filter the output of \"notmuch search\""
1466   (let ((buffer (process-buffer proc)))
1467     (if (buffer-live-p buffer)
1468         (with-current-buffer buffer
1469           (save-excursion
1470             (let ((line 0)
1471                   (more t)
1472                   (inhibit-read-only t))
1473               (while more
1474                 (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
1475                     (let* ((thread-id (match-string 1 string))
1476                            (date (match-string 2 string))
1477                            (count (match-string 3 string))
1478                            (authors (match-string 4 string))
1479                            (authors-length (length authors))
1480                            (subject (match-string 5 string))
1481                            (tags (match-string 6 string)))
1482                       (if (> authors-length 40)
1483                           (set 'authors (concat (substring authors 0 (- 40 3)) "...")))
1484                       (goto-char (point-max))
1485                       (let ((beg (point-marker)))
1486                         (insert (format "%s %-7s %-40s %s (%s)\n" date count authors subject tags))
1487                         (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
1488                         (put-text-property beg (point-marker) 'notmuch-search-authors authors)
1489                         (put-text-property beg (point-marker) 'notmuch-search-subject subject))
1490                       (set 'line (match-end 0)))
1491                   (set 'more nil))))))
1492       (delete-process proc))))
1493
1494 (defun notmuch-search-operate-all (action)
1495   "Add/remove tags from all matching messages.
1496
1497 Tis command adds or removes tags from all messages matching the
1498 current search terms. When called interactively, this command
1499 will prompt for tags to be added or removed. Tags prefixed with
1500 '+' will be added and tags prefixed with '-' will be removed.
1501
1502 Each character of the tag name may consist of alphanumeric
1503 characters as well as `_.+-'.
1504 "
1505   (interactive "sOperation (+add -drop): notmuch tag ")
1506   (let ((action-split (split-string action " +")))
1507     ;; Perform some validation
1508     (let ((words action-split))
1509       (when (null words) (error "No operation given"))
1510       (while words
1511         (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
1512           (error "Action must be of the form `+thistag -that_tag'"))
1513         (setq words (cdr words))))
1514     (apply 'notmuch-call-notmuch-process "tag"
1515            (append action-split (list notmuch-search-query-string) nil))))
1516
1517 ;;;###autoload
1518 (defun notmuch-search (query &optional oldest-first)
1519   "Run \"notmuch search\" with the given query string and display results."
1520   (interactive "sNotmuch search: ")
1521   (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
1522     (switch-to-buffer buffer)
1523     (notmuch-search-mode)
1524     (set 'notmuch-search-query-string query)
1525     (set 'notmuch-search-oldest-first oldest-first)
1526     (let ((proc (get-buffer-process (current-buffer)))
1527           (inhibit-read-only t))
1528       (if proc
1529           (error "notmuch search process already running for query `%s'" query)
1530         )
1531       (erase-buffer)
1532       (goto-char (point-min))
1533       (save-excursion
1534         (let ((proc (start-process-shell-command
1535                      "notmuch-search" buffer notmuch-command "search"
1536                      (if oldest-first "--sort=oldest-first" "--sort=newest-first")
1537                      (shell-quote-argument query))))
1538           (set-process-sentinel proc 'notmuch-search-process-sentinel)
1539           (set-process-filter proc 'notmuch-search-process-filter))))
1540     (run-hooks 'notmuch-search-hook)))
1541
1542 (defun notmuch-search-refresh-view ()
1543   "Refresh the current view.
1544
1545 Kills the current buffer and runs a new search with the same
1546 query string as the current search. If the current thread is in
1547 the new search results, then point will be placed on the same
1548 thread. Otherwise, point will be moved to attempt to be in the
1549 same relative position within the new buffer."
1550   (interactive)
1551   (let ((here (point))
1552         (oldest-first notmuch-search-oldest-first)
1553         (thread (notmuch-search-find-thread-id))
1554         (query notmuch-search-query-string))
1555     (kill-this-buffer)
1556     (notmuch-search query oldest-first)
1557     (goto-char (point-min))
1558     (if (re-search-forward (concat "^" thread) nil t)
1559         (beginning-of-line)
1560       (goto-char here))))
1561
1562 (defun notmuch-search-toggle-order ()
1563   "Toggle the current search order.
1564
1565 By default, the \"inbox\" view created by `notmuch' is displayed
1566 in chronological order (oldest thread at the beginning of the
1567 buffer), while any global searches created by `notmuch-search'
1568 are displayed in reverse-chronological order (newest thread at
1569 the beginning of the buffer).
1570
1571 This command toggles the sort order for the current search.
1572
1573 Note that any filtered searches created by
1574 `notmuch-search-filter' retain the search order of the parent
1575 search."
1576   (interactive)
1577   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
1578   (notmuch-search-refresh-view))
1579
1580 (defun notmuch-search-filter (query)
1581   "Filter the current search results based on an additional query string.
1582
1583 Runs a new search matching only messages that match both the
1584 current search results AND the additional query string provided."
1585   (interactive "sFilter search: ")
1586   (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query) (concat "( " query " )") query)))
1587     (notmuch-search (concat notmuch-search-query-string " and " grouped-query) notmuch-search-oldest-first)))
1588
1589 (defun notmuch-search-filter-by-tag (tag)
1590   "Filter the current search results based on a single tag.
1591
1592 Runs a new search matching only messages that match both the
1593 current search results AND that are tagged with the given tag."
1594   (interactive
1595    (list (notmuch-select-tag-with-completion "Filter by tag: ")))
1596   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
1597
1598
1599 ;;;###autoload
1600 (defun notmuch ()
1601   "Run notmuch to display all mail with tag of 'inbox'"
1602   (interactive)
1603   (notmuch-search "tag:inbox" notmuch-search-oldest-first))
1604
1605 (setq mail-user-agent 'message-user-agent)
1606
1607 (defvar notmuch-folder-mode-map
1608   (let ((map (make-sparse-keymap)))
1609     (define-key map "?" 'notmuch-help)
1610     (define-key map "x" 'kill-this-buffer)
1611     (define-key map "q" 'kill-this-buffer)
1612     (define-key map "m" 'message-mail)
1613     (define-key map "e" 'notmuch-folder-show-empty-toggle)
1614     (define-key map ">" 'notmuch-folder-last)
1615     (define-key map "<" 'notmuch-folder-first)
1616     (define-key map "=" 'notmuch-folder)
1617     (define-key map "s" 'notmuch-search)
1618     (define-key map [mouse-1] 'notmuch-folder-show-search)
1619     (define-key map (kbd "RET") 'notmuch-folder-show-search)
1620     (define-key map " " 'notmuch-folder-show-search)
1621     (define-key map "p" 'notmuch-folder-previous)
1622     (define-key map "n" 'notmuch-folder-next)
1623     map)
1624   "Keymap for \"notmuch folder\" buffers.")
1625
1626 (fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
1627
1628 (defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
1629   "List of searches for the notmuch folder view"
1630   :type '(alist :key-type (string) :value-type (string))
1631   :group 'notmuch)
1632
1633 (defun notmuch-folder-mode ()
1634   "Major mode for showing notmuch 'folders'.
1635
1636 This buffer contains a list of message counts returned by a
1637 customizable set of searches of your email archives. Each line in
1638 the buffer shows the name of a saved search and the resulting
1639 message count.
1640
1641 Pressing RET on any line opens a search window containing the
1642 results for the saved search on that line.
1643
1644 Here is an example of how the search list could be
1645 customized, (the following text would be placed in your ~/.emacs
1646 file):
1647
1648 (setq notmuch-folders '((\"inbox\" . \"tag:inbox\")
1649                         (\"unread\" . \"tag:inbox AND tag:unread\")
1650                         (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\")))
1651
1652 Of course, you can have any number of folders, each configured
1653 with any supported search terms (see \"notmuch help search-terms\").
1654
1655 Currently available key bindings:
1656
1657 \\{notmuch-folder-mode-map}"
1658   (interactive)
1659   (kill-all-local-variables)
1660   (use-local-map 'notmuch-folder-mode-map)
1661   (setq truncate-lines t)
1662   (hl-line-mode 1)
1663   (setq major-mode 'notmuch-folder-mode
1664         mode-name "notmuch-folder")
1665   (setq buffer-read-only t))
1666
1667 (defun notmuch-folder-next ()
1668   "Select the next folder in the list."
1669   (interactive)
1670   (forward-line 1)
1671   (if (eobp)
1672       (forward-line -1)))
1673
1674 (defun notmuch-folder-previous ()
1675   "Select the previous folder in the list."
1676   (interactive)
1677   (forward-line -1))
1678
1679 (defun notmuch-folder-first ()
1680   "Select the first folder in the list."
1681   (interactive)
1682   (goto-char (point-min)))
1683
1684 (defun notmuch-folder-last ()
1685   "Select the last folder in the list."
1686   (interactive)
1687   (goto-char (point-max))
1688   (forward-line -1))
1689
1690 (defun notmuch-folder-count (search)
1691   (car (process-lines notmuch-command "count" search)))
1692
1693 (setq notmuch-folder-show-empty t)
1694
1695 (defun notmuch-folder-show-empty-toggle ()
1696   "Toggle the listing of empty folders"
1697   (interactive)
1698   (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
1699   (notmuch-folder))
1700
1701 (defun notmuch-folder-add (folders)
1702   (if folders
1703       (let* ((name (car (car folders)))
1704             (inhibit-read-only t)
1705             (search (cdr (car folders)))
1706             (count (notmuch-folder-count search)))
1707         (if (or notmuch-folder-show-empty
1708                 (not (equal count "0")))
1709             (progn
1710               (insert name)
1711               (indent-to 16 1)
1712               (insert count)
1713               (insert "\n")
1714               )
1715           )
1716         (notmuch-folder-add (cdr folders)))))
1717
1718 (defun notmuch-folder-find-name ()
1719   (save-excursion
1720     (beginning-of-line)
1721     (let ((beg (point)))
1722       (re-search-forward "\\([ \t]*[^ \t]+\\)")
1723       (filter-buffer-substring (match-beginning 1) (match-end 1)))))
1724
1725 (defun notmuch-folder-show-search (&optional folder)
1726   "Show a search window for the search related to the specified folder."
1727   (interactive)
1728   (if (null folder)
1729       (setq folder (notmuch-folder-find-name)))
1730   (let ((search (assoc folder notmuch-folders)))
1731     (if search
1732         (notmuch-search (cdr search) notmuch-search-oldest-first))))
1733
1734 ;;;###autoload
1735 (defun notmuch-folder ()
1736   "Show the notmuch folder view and update the displayed counts."
1737   (interactive)
1738   (let ((buffer (get-buffer-create "*notmuch-folders*")))
1739     (switch-to-buffer buffer)
1740     (let ((inhibit-read-only t)
1741           (n (line-number-at-pos)))
1742       (erase-buffer)
1743       (notmuch-folder-mode)
1744       (notmuch-folder-add notmuch-folders)
1745       (goto-char (point-min))
1746       (goto-line n))))
1747
1748 (provide 'notmuch)