Merge branch 'debian' into rebuild
[notmuch] / emacs / notmuch-show.el
1 ;; notmuch-show.el --- display notmuch messages 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 part of an emacs-based interface to the notmuch mail system.
23
24 (require 'cl)
25 (require 'mm-view)
26 (require 'message)
27
28 (require 'notmuch-lib)
29
30 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
31 (declare-function notmuch-count-attachments "notmuch" (mm-handle))
32 (declare-function notmuch-reply "notmuch" (query-string))
33 (declare-function notmuch-fontify-headers "notmuch" nil)
34 (declare-function notmuch-toggle-invisible-action "notmuch" (cite-button))
35 (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
36 (declare-function notmuch-search-show-thread "notmuch" nil)
37 (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
38
39 (defvar notmuch-show-stash-map
40   (let ((map (make-sparse-keymap)))
41     (define-key map "c" 'notmuch-show-stash-cc)
42     (define-key map "d" 'notmuch-show-stash-date)
43     (define-key map "F" 'notmuch-show-stash-filename)
44     (define-key map "f" 'notmuch-show-stash-from)
45     (define-key map "i" 'notmuch-show-stash-message-id)
46     (define-key map "s" 'notmuch-show-stash-subject)
47     (define-key map "T" 'notmuch-show-stash-tags)
48     (define-key map "t" 'notmuch-show-stash-to)
49     map)
50   "Submap for stash commands"
51   )
52
53 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
54
55 (defvar notmuch-show-mode-map
56   (let ((map (make-sparse-keymap)))
57     (define-key map "?" 'notmuch-help)
58     (define-key map "q" 'kill-this-buffer)
59     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
60     (define-key map (kbd "C-n") 'notmuch-show-next-line)
61     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
62     (define-key map (kbd "TAB") 'notmuch-show-next-button)
63     (define-key map "s" 'notmuch-search)
64     (define-key map "m" 'message-mail)
65     (define-key map "f" 'notmuch-show-forward-current)
66     (define-key map "r" 'notmuch-show-reply)
67     (define-key map "|" 'notmuch-show-pipe-message)
68     (define-key map "w" 'notmuch-show-save-attachments)
69     (define-key map "V" 'notmuch-show-view-raw-message)
70     (define-key map "v" 'notmuch-show-view-all-mime-parts)
71     (define-key map "c" 'notmuch-show-stash-map)
72     (define-key map "b" 'notmuch-show-toggle-current-body)
73     (define-key map "h" 'notmuch-show-toggle-current-header)
74     (define-key map "-" 'notmuch-show-remove-tag)
75     (define-key map "+" 'notmuch-show-add-tag)
76     (define-key map "x" 'notmuch-show-archive-thread-then-exit)
77     (define-key map "a" 'notmuch-show-archive-thread)
78     (define-key map "P" 'notmuch-show-previous-message)
79     (define-key map "N" 'notmuch-show-next-message)
80     (define-key map "p" 'notmuch-show-previous-open-message)
81     (define-key map "n" 'notmuch-show-next-open-message)
82     (define-key map (kbd "DEL") 'notmuch-show-rewind)
83     (define-key map " " 'notmuch-show-advance-and-archive)
84     map)
85   "Keymap for \"notmuch show\" buffers.")
86 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
87
88 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
89   "Pattern to match a line that separates content from signature.
90
91 The regexp can (and should) include $ to match the end of the
92 line, but should not include ^ to match the beginning of the
93 line. This is because notmuch may have inserted additional space
94 for indentation at the beginning of the line. But notmuch will
95 move past the indentation when testing this pattern, (so that the
96 pattern can still test against the entire line).")
97
98 (defvar notmuch-show-signature-button-format
99   "[ %d-line signature. Click/Enter to toggle visibility. ]"
100   "String used to construct button text for hidden signatures
101
102 Can use up to one integer format parameter, i.e. %d")
103
104 (defvar notmuch-show-citation-button-format
105   "[ %d more citation lines. Click/Enter to toggle visibility. ]"
106   "String used to construct button text for hidden citations.
107
108 Can use up to one integer format parameter, i.e. %d")
109
110 (defvar notmuch-show-signature-lines-max 12
111   "Maximum length of signature that will be hidden by default.")
112
113 (defvar notmuch-show-citation-lines-prefix 4
114   "Always show at least this many lines of a citation.
115
116 If there is one more line, show that, otherwise collapse
117 remaining lines into a button.")
118
119 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
120 (defvar notmuch-show-message-end-regexp      "\fmessage}")
121 (defvar notmuch-show-header-begin-regexp     "\fheader{")
122 (defvar notmuch-show-header-end-regexp       "\fheader}")
123 (defvar notmuch-show-body-begin-regexp       "\fbody{")
124 (defvar notmuch-show-body-end-regexp         "\fbody}")
125 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
126 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
127 (defvar notmuch-show-part-begin-regexp       "\fpart{")
128 (defvar notmuch-show-part-end-regexp         "\fpart}")
129 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
130
131 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
132 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
133 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
134 (defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
135
136 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
137
138 (defvar notmuch-show-parent-buffer nil)
139 (defvar notmuch-show-body-read-visible nil)
140 (defvar notmuch-show-citations-visible nil)
141 (defvar notmuch-show-signatures-visible nil)
142 (defvar notmuch-show-headers-visible nil)
143
144 (defun notmuch-show-next-line ()
145   "Like builtin `next-line' but ensuring we end on a visible character.
146
147 By advancing forward until reaching a visible character.
148
149 Unlike builtin `next-line' this version accepts no arguments."
150   (interactive)
151   (set 'this-command 'next-line)
152   (call-interactively 'next-line)
153   (while (point-invisible-p)
154     (forward-char)))
155
156 (defun notmuch-show-previous-line ()
157   "Like builtin `previous-line' but ensuring we end on a visible character.
158
159 By advancing forward until reaching a visible character.
160
161 Unlike builtin `previous-line' this version accepts no arguments."
162   (interactive)
163   (set 'this-command 'previous-line)
164   (call-interactively 'previous-line)
165   (while (point-invisible-p)
166     (forward-char)))
167
168 (defun notmuch-show-get-message-id ()
169   (save-excursion
170     (beginning-of-line)
171     (if (not (looking-at notmuch-show-message-begin-regexp))
172         (re-search-backward notmuch-show-message-begin-regexp))
173     (re-search-forward notmuch-show-id-regexp)
174     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
175
176 (defun notmuch-show-get-filename ()
177   (save-excursion
178     (beginning-of-line)
179     (if (not (looking-at notmuch-show-message-begin-regexp))
180         (re-search-backward notmuch-show-message-begin-regexp))
181     (re-search-forward notmuch-show-filename-regexp)
182     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
183
184 (defun notmuch-show-set-tags (tags)
185   (save-excursion
186     (beginning-of-line)
187     (if (not (looking-at notmuch-show-message-begin-regexp))
188         (re-search-backward notmuch-show-message-begin-regexp))
189     (re-search-forward notmuch-show-tags-regexp)
190     (let ((inhibit-read-only t)
191           (beg (match-beginning 1))
192           (end (match-end 1)))
193       (delete-region beg end)
194       (goto-char beg)
195       (insert (mapconcat 'identity tags " ")))))
196
197 (defun notmuch-show-get-tags ()
198   (save-excursion
199     (beginning-of-line)
200     (if (not (looking-at notmuch-show-message-begin-regexp))
201         (re-search-backward notmuch-show-message-begin-regexp))
202     (re-search-forward notmuch-show-tags-regexp)
203     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
204
205 (defun notmuch-show-get-bcc ()
206   "Return BCC address(es) of current message"
207   (notmuch-show-get-header-field 'bcc))
208
209 (defun notmuch-show-get-cc ()
210   "Return CC address(es) of current message"
211   (notmuch-show-get-header-field 'cc))
212
213 (defun notmuch-show-get-date ()
214   "Return Date of current message"
215   (notmuch-show-get-header-field 'date))
216
217 (defun notmuch-show-get-from ()
218   "Return From address of current message"
219   (notmuch-show-get-header-field 'from))
220
221 (defun notmuch-show-get-subject ()
222   "Return Subject of current message"
223   (notmuch-show-get-header-field 'subject))
224
225 (defun notmuch-show-get-to ()
226   "Return To address(es) of current message"
227   (notmuch-show-get-header-field 'to))
228
229 (defun notmuch-show-get-header-field (name)
230   "Retrieve the header field NAME from the current message.
231 NAME should be a symbol, in lower case, as returned by
232 mail-header-extract-no-properties"
233   (let* ((result (assoc name (notmuch-show-get-header)))
234         (val (and result (cdr result))))
235     val))
236
237 (defun notmuch-show-get-header ()
238   "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
239 where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
240 pseudoheader summary"
241   (require 'mailheader)
242   (save-excursion
243     (beginning-of-line)
244     (if (not (looking-at notmuch-show-message-begin-regexp))
245         (re-search-backward notmuch-show-message-begin-regexp))
246     (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
247     (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
248           (beg (point)))
249       (re-search-forward notmuch-show-header-end-regexp)
250       (let ((text (buffer-substring beg (match-beginning 0))))
251         (with-temp-buffer
252           (insert text)
253           (goto-char (point-min))
254           (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
255             (delete-region (match-beginning 1) (match-end 1))
256             (forward-line)
257             )
258           (goto-char (point-min))
259           (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
260
261 (defun notmuch-show-add-tag (&rest toadd)
262   "Add a tag to the current message."
263   (interactive
264    (list (notmuch-select-tag-with-completion "Tag to add: ")))
265   (apply 'notmuch-call-notmuch-process
266          (append (cons "tag"
267                        (mapcar (lambda (s) (concat "+" s)) toadd))
268                  (cons (notmuch-show-get-message-id) nil)))
269   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
270
271 (defun notmuch-show-remove-tag (&rest toremove)
272   "Remove a tag from the current message."
273   (interactive
274    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
275   (let ((tags (notmuch-show-get-tags)))
276     (if (intersection tags toremove :test 'string=)
277         (progn
278           (apply 'notmuch-call-notmuch-process
279                  (append (cons "tag"
280                                (mapcar (lambda (s) (concat "-" s)) toremove))
281                          (cons (notmuch-show-get-message-id) nil)))
282           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
283
284 (defun notmuch-show-archive-thread ()
285   "Archive each message in thread, then show next thread from search.
286
287 Archive each message currently shown by removing the \"inbox\"
288 tag from each. Then kill this buffer and show the next thread
289 from the search from which this thread was originally shown.
290
291 Note: This command is safe from any race condition of new messages
292 being delivered to the same thread. It does not archive the
293 entire thread, but only the messages shown in the current
294 buffer."
295   (interactive)
296   (save-excursion
297     (goto-char (point-min))
298     (while (not (eobp))
299       (notmuch-show-remove-tag "inbox")
300       (if (not (eobp))
301           (forward-char))
302       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
303           (goto-char (point-max)))))
304   (let ((parent-buffer notmuch-show-parent-buffer))
305     (kill-this-buffer)
306     (if parent-buffer
307         (progn
308           (switch-to-buffer parent-buffer)
309           (forward-line)
310           (notmuch-search-show-thread)))))
311
312 (defun notmuch-show-archive-thread-then-exit ()
313   "Archive each message in thread, then exit back to search results."
314   (interactive)
315   (notmuch-show-archive-thread)
316   (kill-this-buffer))
317
318 (defun notmuch-show-view-raw-message ()
319   "View the raw email of the current message."
320   (interactive)
321   (view-file (notmuch-show-get-filename)))
322
323 (defmacro with-current-notmuch-show-message (&rest body)
324   "Evaluate body with current buffer set to the text of current message"
325   `(save-excursion
326      (let ((filename (notmuch-show-get-filename)))
327        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
328          (with-current-buffer buf
329            (insert-file-contents filename nil nil nil t)
330            ,@body)
331          (kill-buffer buf)))))
332
333 (defun notmuch-show-view-all-mime-parts ()
334   "Use external viewers to view all attachments from the current message."
335   (interactive)
336   (with-current-notmuch-show-message
337    ; We ovverride the mm-inline-media-tests to indicate which message
338    ; parts are already sufficiently handled by the original
339    ; presentation of the message in notmuch-show mode. These parts
340    ; will be inserted directly into the temporary buffer of
341    ; with-current-notmuch-show-message and silently discarded.
342    ;
343    ; Any MIME part not explicitly mentioned here will be handled by an
344    ; external viewer as configured in the various mailcap files.
345    (let ((mm-inline-media-tests '(
346                                   ("text/.*" ignore identity)
347                                   ("application/pgp-signature" ignore identity)
348                                   ("multipart/alternative" ignore identity)
349                                   ("multipart/mixed" ignore identity)
350                                   ("multipart/related" ignore identity)
351                                  )))
352      (mm-display-parts (mm-dissect-buffer)))))
353
354 (defun notmuch-show-save-attachments ()
355   "Save all attachments from the current message."
356   (interactive)
357   (with-current-notmuch-show-message
358    (let ((mm-handle (mm-dissect-buffer)))
359      (notmuch-save-attachments
360       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
361   (message "Done"))
362
363 (defun notmuch-show-reply ()
364   "Begin composing a reply to the current message in a new buffer."
365   (interactive)
366   (let ((message-id (notmuch-show-get-message-id)))
367     (notmuch-reply message-id)))
368
369 (defun notmuch-show-forward-current ()
370   "Forward the current message."
371   (interactive)
372   (with-current-notmuch-show-message
373    (message-forward)))
374
375 (defun notmuch-show-pipe-message (command)
376   "Pipe the contents of the current message to the given command.
377
378 The given command will be executed with the raw contents of the
379 current email message as stdin. Anything printed by the command
380 to stdout or stderr will appear in the *Messages* buffer."
381   (interactive "sPipe message to command: ")
382   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
383          (list command " < " (shell-quote-argument (notmuch-show-get-filename)))))
384
385 (defun notmuch-show-move-to-current-message-summary-line ()
386   "Move to the beginning of the one-line summary of the current message.
387
388 This gives us a stable place to move to and work from since the
389 summary line is always visible. This is important since moving to
390 an invisible location is unreliable, (the main command loop moves
391 point either forward or backward to the next visible character
392 when a command ends with point on an invisible character).
393
394 Emits an error if point is not within a valid message, (that is
395 no pattern of `notmuch-show-message-begin-regexp' could be found
396 by searching backward)."
397   (beginning-of-line)
398   (if (not (looking-at notmuch-show-message-begin-regexp))
399       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
400           (forward-line 2)
401         (error "Not within a valid message."))
402     (forward-line 2)))
403
404 (defun notmuch-show-last-message-p ()
405   "Predicate testing whether point is within the last message."
406   (save-window-excursion
407     (save-excursion
408       (notmuch-show-move-to-current-message-summary-line)
409       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
410
411 (defun notmuch-show-message-unread-p ()
412   "Predicate testing whether current message is unread."
413   (member "unread" (notmuch-show-get-tags)))
414
415 (defun notmuch-show-message-open-p ()
416   "Predicate testing whether current message is open (body is visible)."
417   (let ((btn (previous-button (point) t)))
418     (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type))
419       (setq btn (previous-button (button-start btn))))
420     (not (invisible-p (button-get btn 'invisibility-spec)))))
421
422 (defun notmuch-show-next-message-without-marking-read ()
423   "Advance to the beginning of the next message in the buffer.
424
425 Moves to the last visible character of the current message if
426 already on the last message in the buffer.
427
428 Returns nil if already on the last message in the buffer."
429   (notmuch-show-move-to-current-message-summary-line)
430   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
431       (progn
432         (notmuch-show-move-to-current-message-summary-line)
433         (recenter 0)
434         t)
435     (goto-char (- (point-max) 1))
436     (while (point-invisible-p)
437       (backward-char))
438     (recenter 0)
439     nil))
440
441 (defun notmuch-show-next-message ()
442   "Advance to the next message (whether open or closed)
443 and remove the unread tag from that message.
444
445 Moves to the last visible character of the current message if
446 already on the last message in the buffer.
447
448 Returns nil if already on the last message in the buffer."
449   (interactive)
450   (notmuch-show-next-message-without-marking-read)
451   (notmuch-show-mark-read))
452
453 (defun notmuch-show-find-next-message ()
454   "Returns the position of the next message in the buffer.
455
456 Or the position of the last visible character of the current
457 message if already within the last message in the buffer."
458   ; save-excursion doesn't save our window position
459   ; save-window-excursion doesn't save point
460   ; Looks like we have to use both.
461   (save-excursion
462     (save-window-excursion
463       (notmuch-show-next-message-without-marking-read)
464       (point))))
465
466 (defun notmuch-show-next-unread-message ()
467   "Advance to the next unread message.
468
469 Moves to the last visible character of the current message if
470 there are no more unread messages past the current point."
471   (notmuch-show-next-message-without-marking-read)
472   (while (and (not (notmuch-show-last-message-p))
473               (not (notmuch-show-message-unread-p)))
474     (notmuch-show-next-message-without-marking-read))
475   (if (not (notmuch-show-message-unread-p))
476       (notmuch-show-next-message-without-marking-read))
477   (notmuch-show-mark-read))
478
479 (defun notmuch-show-next-open-message ()
480   "Advance to the next open message (that is, body is visible).
481
482 Moves to the last visible character of the final message in the buffer
483 if there are no more open messages."
484   (interactive)
485   (while (and (notmuch-show-next-message-without-marking-read)
486               (not (notmuch-show-message-open-p))))
487   (notmuch-show-mark-read))
488
489 (defun notmuch-show-previous-message-without-marking-read ()
490   "Backup to the beginning of the previous message in the buffer.
491
492 If within a message rather than at the beginning of it, then
493 simply move to the beginning of the current message.
494
495 Returns nil if already on the first message in the buffer."
496   (let ((start (point)))
497     (notmuch-show-move-to-current-message-summary-line)
498     (if (not (< (point) start))
499         ; Go backward twice to skip the current message's marker
500         (progn
501           (re-search-backward notmuch-show-message-begin-regexp nil t)
502           (re-search-backward notmuch-show-message-begin-regexp nil t)
503           (notmuch-show-move-to-current-message-summary-line)
504           (recenter 0)
505           (if (= (point) start)
506               nil
507             t))
508       (recenter 0)
509       nil)))
510
511 (defun notmuch-show-previous-message ()
512   "Backup to the previous message (whether open or closed)
513 and remove the unread tag from that message.
514
515 If within a message rather than at the beginning of it, then
516 simply move to the beginning of the current message."
517   (interactive)
518   (notmuch-show-previous-message-without-marking-read)
519   (notmuch-show-mark-read))
520
521 (defun notmuch-show-find-previous-message ()
522   "Returns the position of the previous message in the buffer.
523
524 Or the position of the beginning of the current message if point
525 is originally within the message rather than at the beginning of
526 it."
527   ; save-excursion doesn't save our window position
528   ; save-window-excursion doesn't save point
529   ; Looks like we have to use both.
530   (save-excursion
531     (save-window-excursion
532       (notmuch-show-previous-message-without-marking-read)
533       (point))))
534
535 (defun notmuch-show-previous-open-message ()
536   "Backup to previous open message (that is, body is visible).
537
538 Moves to the first message in the buffer if there are no previous
539 open messages."
540   (interactive)
541   (while (and (notmuch-show-previous-message-without-marking-read)
542               (not (notmuch-show-message-open-p))))
543   (notmuch-show-mark-read))
544
545 (defun notmuch-show-rewind ()
546   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
547
548 Specifically, if the beginning of the previous email is fewer
549 than `window-height' lines from the current point, move to it
550 just like `notmuch-show-previous-message'.
551
552 Otherwise, just scroll down a screenful of the current message.
553
554 This command does not modify any message tags, (it does not undo
555 any effects from previous calls to
556 `notmuch-show-advance-and-archive'."
557   (interactive)
558   (let ((previous (notmuch-show-find-previous-message)))
559     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
560         (progn
561           (condition-case nil
562               (scroll-down nil)
563             ((beginning-of-buffer) nil))
564           (goto-char (window-start))
565           ; Because count-lines counts invivisible lines, we may have
566           ; scrolled to far. If so., notice this and fix it up.
567           (if (< (point) previous)
568               (progn
569                 (goto-char previous)
570                 (recenter 0))))
571       (notmuch-show-previous-message))))
572
573 (defun notmuch-show-advance-and-archive ()
574   "Advance through thread and archive.
575
576 This command is intended to be one of the simplest ways to
577 process a thread of email. It does the following:
578
579 If the current message in the thread is not yet fully visible,
580 scroll by a near screenful to read more of the message.
581
582 Otherwise, (the end of the current message is already within the
583 current window), advance to the next open message.
584
585 Finally, if there is no further message to advance to, and this
586 last message is already read, then archive the entire current
587 thread, (remove the \"inbox\" tag from each message). Also kill
588 this buffer, and display the next thread from the search from
589 which this thread was originally shown."
590   (interactive)
591   (let ((next (notmuch-show-find-next-message))
592         (unread (notmuch-show-message-unread-p)))
593     (if (> next (window-end))
594         (scroll-up nil)
595       (let ((last (notmuch-show-last-message-p)))
596         (notmuch-show-next-open-message)
597         (if last
598             (notmuch-show-archive-thread))))))
599
600 (defun notmuch-show-next-button ()
601   "Advance point to the next button in the buffer."
602   (interactive)
603   (forward-button 1))
604
605 (defun notmuch-show-previous-button ()
606   "Move point back to the previous button in the buffer."
607   (interactive)
608   (backward-button 1))
609
610 (defun notmuch-show-toggle-current-body ()
611   "Toggle the display of the current message body."
612   (interactive)
613   (save-excursion
614     (notmuch-show-move-to-current-message-summary-line)
615     (unless (button-at (point))
616       (notmuch-show-next-button))
617     (push-button))
618   )
619
620 (defun notmuch-show-toggle-current-header ()
621   "Toggle the display of the current message header."
622   (interactive)
623   (save-excursion
624     (notmuch-show-move-to-current-message-summary-line)
625     (forward-line)
626     (unless (button-at (point))
627       (notmuch-show-next-button))
628     (push-button))
629   )
630
631 (defun notmuch-show-citation-regexp (depth)
632   "Build a regexp for matching citations at a given DEPTH (indent)"
633   (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth)))
634     (concat "\\(?:^" line-regexp
635             "\\(?:[[:space:]]*\n" line-regexp
636             "\\)?\\)+")))
637
638 (defun notmuch-show-region-to-button (beg end type prefix button-text)
639   "Auxilary function to do the actual making of overlays and buttons
640
641 BEG and END are buffer locations. TYPE should a string, either
642 \"citation\" or \"signature\". PREFIX is some arbitrary text to
643 insert before the button, probably for indentation.  BUTTON-TEXT
644 is what to put on the button."
645
646 ;; This uses some slightly tricky conversions between strings and
647 ;; symbols because of the way the button code works. Note that
648 ;; replacing intern-soft with make-symbol will cause this to fail,
649 ;; since the newly created symbol has no plist.
650
651   (let ((overlay (make-overlay beg end))
652         (invis-spec (make-symbol (concat "notmuch-" type "-region")))
653         (button-type (intern-soft (concat "notmuch-button-"
654                                           type "-toggle-type"))))
655     (add-to-invisibility-spec invis-spec)
656     (overlay-put overlay 'invisible invis-spec)
657     (goto-char (1+ end))
658     (save-excursion
659       (goto-char (1- beg))
660       (insert prefix)
661       (insert-button button-text
662                      'invisibility-spec invis-spec
663                      :type button-type)
664       )))
665
666 (defun notmuch-show-markup-citations-region (beg end depth)
667   "Markup citations, and up to one signature in the given region"
668   ;; it would be nice if the untabify was not required, but
669   ;; that would require notmuch to indent with spaces.
670   (untabify beg end)
671   (let ((citation-regexp (notmuch-show-citation-regexp depth))
672         (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
673                                   notmuch-show-signature-regexp))
674         (indent (concat "\n" (make-string depth ? ))))
675     (goto-char beg)
676     (beginning-of-line)
677     (while (and (< (point) end)
678                 (re-search-forward citation-regexp end t))
679       (let* ((cite-start (match-beginning 0))
680              (cite-end  (match-end 0))
681              (cite-lines (count-lines cite-start cite-end)))
682         (when (> cite-lines (1+ notmuch-show-citation-lines-prefix))
683           (goto-char cite-start)
684           (forward-line notmuch-show-citation-lines-prefix)
685           (notmuch-show-region-to-button
686            (point) cite-end
687            "citation"
688            indent
689            (format notmuch-show-citation-button-format
690                    (- cite-lines notmuch-show-citation-lines-prefix))
691            ))))
692     (if (and (< (point) end)
693              (re-search-forward signature-regexp end t))
694         (let* ((sig-start (match-beginning 0))
695                (sig-end (match-end 0))
696                (sig-lines (1- (count-lines sig-start end))))
697           (if (<= sig-lines notmuch-show-signature-lines-max)
698               (notmuch-show-region-to-button
699                sig-start
700                end
701                "signature"
702                indent
703                (format notmuch-show-signature-button-format sig-lines)
704                ))))))
705
706 (defun notmuch-show-markup-part (beg end depth)
707   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
708       (progn
709         (let (mime-message mime-type)
710           (save-excursion
711             (re-search-forward notmuch-show-contentype-regexp end t)
712             (setq mime-type (car (split-string (buffer-substring
713                                                 (match-beginning 1) (match-end 1))))))
714
715           (if (equal mime-type "text/html")
716               (let ((filename (notmuch-show-get-filename)))
717                 (with-temp-buffer
718                   (insert-file-contents filename nil nil nil t)
719                   (setq mime-message (mm-dissect-buffer)))))
720           (forward-line)
721           (let ((beg (point-marker)))
722             (re-search-forward notmuch-show-part-end-regexp)
723             (let ((end (copy-marker (match-beginning 0))))
724               (goto-char end)
725               (if (not (bolp))
726                   (insert "\n"))
727               (indent-rigidly beg end depth)
728               (if (not (eq mime-message nil))
729                   (save-excursion
730                     (goto-char beg)
731                     (forward-line -1)
732                     (let ((handle-type (mm-handle-type mime-message))
733                           mime-type)
734                       (if (sequencep (car handle-type))
735                           (setq mime-type (car handle-type))
736                         (setq mime-type (car (car (cdr handle-type))))
737                         )
738                       (if (equal mime-type "text/html")
739                           (mm-display-part mime-message))))
740                 )
741               (notmuch-show-markup-citations-region beg end depth)
742               ; Advance to the next part (if any) (so the outer loop can
743               ; determine whether we've left the current message.
744               (if (re-search-forward notmuch-show-part-begin-regexp nil t)
745                   (beginning-of-line)))))
746         (goto-char end))
747     (goto-char end)))
748
749 (defun notmuch-show-markup-parts-region (beg end depth)
750   (save-excursion
751     (goto-char beg)
752     (while (< (point) end)
753       (notmuch-show-markup-part beg end depth))))
754
755 (defun notmuch-show-markup-body (depth match btn)
756   "Markup a message body, (indenting, buttonizing citations,
757 etc.), and hiding the body itself if the message does not match
758 the current search.
759
760 DEPTH specifies the depth at which this message appears in the
761 tree of the current thread, (the top-level messages have depth 0
762 and each reply increases depth by 1). MATCH indicates whether
763 this message is regarded as matching the current search. BTN is
764 the button which is used to toggle the visibility of this
765 message.
766
767 When this function is called, point must be within the message, but
768 before the delimiter marking the beginning of the body."
769   (re-search-forward notmuch-show-body-begin-regexp)
770   (forward-line)
771   (let ((beg (point-marker)))
772     (re-search-forward notmuch-show-body-end-regexp)
773     (let ((end (copy-marker (match-beginning 0))))
774       (notmuch-show-markup-parts-region beg end depth)
775       (let ((invis-spec (make-symbol "notmuch-show-body-read")))
776         (overlay-put (make-overlay beg end)
777                      'invisible invis-spec)
778         (button-put btn 'invisibility-spec invis-spec)
779         (if (not match)
780             (add-to-invisibility-spec invis-spec)))
781       (set-marker beg nil)
782       (set-marker end nil)
783       )))
784
785 (defun notmuch-show-markup-header (message-begin depth)
786   "Buttonize and decorate faces in a message header.
787
788 MESSAGE-BEGIN is the position of the absolute first character in
789 the message (including all delimiters that will end up being
790 invisible etc.). This is to allow a button to reliably extend to
791 the beginning of the message even if point is positioned at an
792 invisible character (such as the beginning of the buffer).
793
794 DEPTH specifies the depth at which this message appears in the
795 tree of the current thread, (the top-level messages have depth 0
796 and each reply increases depth by 1)."
797   (re-search-forward notmuch-show-header-begin-regexp)
798   (forward-line)
799   (let ((beg (point-marker))
800         (summary-end (copy-marker (line-beginning-position 2)))
801         (subject-end (copy-marker (line-end-position 2)))
802         (invis-spec (make-symbol "notmuch-show-header"))
803         (btn nil))
804     (re-search-forward notmuch-show-header-end-regexp)
805     (beginning-of-line)
806     (let ((end (point-marker)))
807       (indent-rigidly beg end depth)
808       (goto-char beg)
809       (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type))
810       (forward-line)
811       (add-to-invisibility-spec invis-spec)
812       (overlay-put (make-overlay subject-end end)
813                    'invisible invis-spec)
814       (make-button (line-beginning-position) subject-end
815                    'invisibility-spec invis-spec
816                    :type 'notmuch-button-headers-toggle-type)
817       (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:")
818         (beginning-of-line)
819         (notmuch-fontify-headers)
820         (forward-line)
821         )
822       (goto-char end)
823       (insert "\n")
824       (set-marker beg nil)
825       (set-marker summary-end nil)
826       (set-marker subject-end nil)
827       (set-marker end nil)
828       )
829   btn))
830
831 (defun notmuch-show-markup-message ()
832   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
833       (let ((message-begin (match-beginning 0)))
834         (re-search-forward notmuch-show-depth-match-regexp)
835         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
836               (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2))))
837               (btn nil))
838           (setq btn (notmuch-show-markup-header message-begin depth))
839           (notmuch-show-markup-body depth match btn)))
840     (goto-char (point-max))))
841
842 (defun notmuch-show-hide-markers ()
843   (save-excursion
844     (goto-char (point-min))
845     (while (not (eobp))
846       (if (re-search-forward notmuch-show-marker-regexp nil t)
847           (progn
848             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
849                          'invisible 'notmuch-show-marker))
850         (goto-char (point-max))))))
851
852 (defun notmuch-show-markup-messages ()
853   (save-excursion
854     (goto-char (point-min))
855     (while (not (eobp))
856       (notmuch-show-markup-message)))
857   (notmuch-show-hide-markers))
858
859 ;;;###autoload
860 (defun notmuch-show-mode ()
861   "Major mode for viewing a thread with notmuch.
862
863 This buffer contains the results of the \"notmuch show\" command
864 for displaying a single thread of email from your email archives.
865
866 By default, various components of email messages, (citations,
867 signatures, already-read messages), are hidden. You can make
868 these parts visible by clicking with the mouse button or by
869 pressing RET after positioning the cursor on a hidden part, (for
870 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
871
872 Reading the thread sequentially is well-supported by pressing
873 \\[notmuch-show-advance-and-archive]. This will
874 scroll the current message (if necessary), advance to the next
875 message, or advance to the next thread (if already on the last
876 message of a thread).
877
878 Other commands are available to read or manipulate the thread more
879 selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without
880 removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without
881 scrolling through with \\[notmuch-show-advance-and-archive]).
882
883 You can add or remove arbitary tags from the current message with
884 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
885
886 All currently available key bindings:
887
888 \\{notmuch-show-mode-map}"
889   (interactive)
890   (kill-all-local-variables)
891   (add-to-invisibility-spec 'notmuch-show-marker)
892   (use-local-map notmuch-show-mode-map)
893   (setq major-mode 'notmuch-show-mode
894         mode-name "notmuch-show")
895   (setq buffer-read-only t))
896
897 (defcustom notmuch-show-hook nil
898   "List of functions to call when notmuch displays a message."
899   :type 'hook
900   :options '(goto-address)
901   :group 'notmuch)
902
903 (defun notmuch-show-do-stash (text)
904     (kill-new text)
905     (message (concat "Saved: " text)))
906
907 (defun notmuch-show-stash-cc ()
908   "Copy CC field of current message to kill-ring."
909   (interactive)
910   (notmuch-show-do-stash (notmuch-show-get-cc)))
911
912 (defun notmuch-show-stash-date ()
913   "Copy date of current message to kill-ring."
914   (interactive)
915   (notmuch-show-do-stash (notmuch-show-get-date)))
916
917 (defun notmuch-show-stash-filename ()
918   "Copy filename of current message to kill-ring."
919   (interactive)
920   (notmuch-show-do-stash (notmuch-show-get-filename)))
921
922 (defun notmuch-show-stash-from ()
923   "Copy From address of current message to kill-ring."
924   (interactive)
925   (notmuch-show-do-stash (notmuch-show-get-from)))
926
927 (defun notmuch-show-stash-message-id ()
928   "Copy message ID of current message to kill-ring."
929   (interactive)
930   (notmuch-show-do-stash (notmuch-show-get-message-id)))
931
932 (defun notmuch-show-stash-subject ()
933   "Copy Subject field of current message to kill-ring."
934   (interactive)
935   (notmuch-show-do-stash (notmuch-show-get-subject)))
936
937 (defun notmuch-show-stash-tags ()
938   "Copy tags of current message to kill-ring as a comma separated list."
939   (interactive)
940   (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
941
942 (defun notmuch-show-stash-to ()
943   "Copy To address of current message to kill-ring."
944   (interactive)
945   (notmuch-show-do-stash (notmuch-show-get-to)))
946
947 ; Make show mode a bit prettier, highlighting URLs and using word wrap
948
949 (defun notmuch-show-mark-read ()
950   (notmuch-show-remove-tag "unread"))
951
952 (defun notmuch-show-pretty-hook ()
953   (goto-address-mode 1)
954   (visual-line-mode))
955
956 (add-hook 'notmuch-show-hook 'notmuch-show-mark-read)
957 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
958 (add-hook 'notmuch-search-hook
959           (lambda()
960             (hl-line-mode 1) ))
961
962 (defun notmuch-show (thread-id &optional parent-buffer query-context)
963   "Run \"notmuch show\" with the given thread ID and display results.
964
965 The optional PARENT-BUFFER is the notmuch-search buffer from
966 which this notmuch-show command was executed, (so that the next
967 thread from that buffer can be show when done with this one).
968
969 The optional QUERY-CONTEXT is a notmuch search term. Only messages from the thread
970 matching this search term are shown if non-nil. "
971   (interactive "sNotmuch show: ")
972   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
973     (switch-to-buffer buffer)
974     (notmuch-show-mode)
975     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
976     (let ((proc (get-buffer-process (current-buffer)))
977           (inhibit-read-only t))
978       (if proc
979           (error "notmuch search process already running for query `%s'" thread-id)
980         )
981       (erase-buffer)
982       (goto-char (point-min))
983       (save-excursion
984         (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id))
985                 (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args)))
986           (apply 'call-process args)
987           (when (and (eq (buffer-size) 0) query-context)
988             (apply 'call-process basic-args)))
989         (notmuch-show-markup-messages)
990         )
991       (run-hooks 'notmuch-show-hook)
992       ; Move straight to the first open message
993       (if (not (notmuch-show-message-open-p))
994           (notmuch-show-next-open-message))
995       )))
996
997 (provide 'notmuch-show)