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