emacs: Show cleaner `From:' addresses in the summary line.
[notmuch] / emacs / notmuch-show.el
1 ;; notmuch-show.el --- displaying notmuch forests.
2 ;;
3 ;; Copyright © Carl Worth
4 ;; Copyright © David Edmondson
5 ;;
6 ;; This file is part of Notmuch.
7 ;;
8 ;; Notmuch is free software: you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12 ;;
13 ;; Notmuch is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 ;; General Public License for more details.
17 ;;
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
20 ;;
21 ;; Authors: Carl Worth <cworth@cworth.org>
22 ;;          David Edmondson <dme@dme.org>
23
24 (eval-when-compile (require 'cl))
25 (require 'mm-view)
26 (require 'message)
27 (require 'mm-decode)
28 (require 'mailcap)
29 (require 'icalendar)
30
31 (require 'notmuch-lib)
32 (require 'notmuch-query)
33 (require 'notmuch-wash)
34 (require 'notmuch-mua)
35
36 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
37 (declare-function notmuch-fontify-headers "notmuch" nil)
38 (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
39 (declare-function notmuch-search-show-thread "notmuch" nil)
40
41 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
42   "Headers that should be shown in a message, in this order.
43
44 For an open message, all of these headers will be made visible
45 according to `notmuch-message-headers-visible' or can be toggled
46 with `notmuch-show-toggle-headers'. For a closed message, only
47 the first header in the list will be visible."
48   :group 'notmuch
49   :type '(repeat string))
50
51 (defcustom notmuch-message-headers-visible t
52   "Should the headers be visible by default?
53
54 If this value is non-nil, then all of the headers defined in
55 `notmuch-message-headers' will be visible by default in the display
56 of each message. Otherwise, these headers will be hidden and
57 `notmuch-show-toggle-headers' can be used to make the visible for
58 any given message."
59   :group 'notmuch
60   :type 'boolean)
61
62 (defcustom notmuch-show-relative-dates t
63   "Display relative dates in the message summary line."
64   :group 'notmuch
65   :type 'boolean)
66
67 (defcustom notmuch-show-elide-same-subject nil
68   "Do not show the subject of a collapsed message if it is the
69 same as that of the previous message."
70   :group 'notmuch
71   :type 'boolean)
72
73 (defcustom notmuch-show-always-show-subject t
74   "Should a collapsed message show the `Subject:' line?"
75   :group 'notmuch
76   :type 'boolean)
77
78 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
79   "A list of functions called to decorate the headers listed in
80 `notmuch-message-headers'.")
81
82 (defcustom notmuch-show-hook nil
83   "Functions called after populating a `notmuch-show' buffer."
84   :group 'notmuch
85   :type 'hook)
86
87 (defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
88   "Functions used to improve the display of text/plain parts."
89   :group 'notmuch
90   :type 'hook
91   :options '(notmuch-wash-convert-inline-patch-to-part
92              notmuch-wash-wrap-long-lines
93              notmuch-wash-tidy-citations
94              notmuch-wash-elide-blank-lines
95              notmuch-wash-excerpt-citations))
96
97 ;; Mostly useful for debugging.
98 (defcustom notmuch-show-all-multipart/alternative-parts nil
99   "Should all parts of multipart/alternative parts be shown?"
100   :group 'notmuch
101   :type 'boolean)
102
103 (defcustom notmuch-show-indent-multipart nil
104   "Should the sub-parts of a multipart/* part be indented?"
105   ;; dme: Not sure which is a good default.
106   :group 'notmuch
107   :type 'boolean)
108
109 (defmacro with-current-notmuch-show-message (&rest body)
110   "Evaluate body with current buffer set to the text of current message"
111   `(save-excursion
112      (let ((id (notmuch-show-get-message-id)))
113        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
114          (with-current-buffer buf
115             (call-process notmuch-command nil t nil "show" "--format=raw" id)
116            ,@body)
117          (kill-buffer buf)))))
118
119 (defun notmuch-show-view-all-mime-parts ()
120   "Use external viewers to view all attachments from the current message."
121   (interactive)
122   (with-current-notmuch-show-message
123    ; We ovverride the mm-inline-media-tests to indicate which message
124    ; parts are already sufficiently handled by the original
125    ; presentation of the message in notmuch-show mode. These parts
126    ; will be inserted directly into the temporary buffer of
127    ; with-current-notmuch-show-message and silently discarded.
128    ;
129    ; Any MIME part not explicitly mentioned here will be handled by an
130    ; external viewer as configured in the various mailcap files.
131    (let ((mm-inline-media-tests '(
132                                   ("text/.*" ignore identity)
133                                   ("application/pgp-signature" ignore identity)
134                                   ("multipart/alternative" ignore identity)
135                                   ("multipart/mixed" ignore identity)
136                                   ("multipart/related" ignore identity)
137                                  )))
138      (mm-display-parts (mm-dissect-buffer)))))
139
140 (defun notmuch-foreach-mime-part (function mm-handle)
141   (cond ((stringp (car mm-handle))
142          (dolist (part (cdr mm-handle))
143            (notmuch-foreach-mime-part function part)))
144         ((bufferp (car mm-handle))
145          (funcall function mm-handle))
146         (t (dolist (part mm-handle)
147              (notmuch-foreach-mime-part function part)))))
148
149 (defun notmuch-count-attachments (mm-handle)
150   (let ((count 0))
151     (notmuch-foreach-mime-part
152      (lambda (p)
153        (let ((disposition (mm-handle-disposition p)))
154          (and (listp disposition)
155               (or (equal (car disposition) "attachment")
156                   (and (equal (car disposition) "inline")
157                        (assq 'filename disposition)))
158               (incf count))))
159      mm-handle)
160     count))
161
162 (defun notmuch-save-attachments (mm-handle &optional queryp)
163   (notmuch-foreach-mime-part
164    (lambda (p)
165      (let ((disposition (mm-handle-disposition p)))
166        (and (listp disposition)
167             (or (equal (car disposition) "attachment")
168                 (and (equal (car disposition) "inline")
169                      (assq 'filename disposition)))
170             (or (not queryp)
171                 (y-or-n-p
172                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
173             (mm-save-part p))))
174    mm-handle))
175
176 (defun notmuch-show-save-attachments ()
177   "Save all attachments from the current message."
178   (interactive)
179   (with-current-notmuch-show-message
180    (let ((mm-handle (mm-dissect-buffer)))
181      (notmuch-save-attachments
182       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
183   (message "Done"))
184
185 (defun notmuch-show-fontify-header ()
186   (let ((face (cond
187                ((looking-at "[Tt]o:")
188                 'message-header-to)
189                ((looking-at "[Bb]?[Cc][Cc]:")
190                 'message-header-cc)
191                ((looking-at "[Ss]ubject:")
192                 'message-header-subject)
193                ((looking-at "[Ff]rom:")
194                 'message-header-from)
195                (t
196                 'message-header-other))))
197
198     (overlay-put (make-overlay (point) (re-search-forward ":"))
199                  'face 'message-header-name)
200     (overlay-put (make-overlay (point) (re-search-forward ".*$"))
201                  'face face)))
202
203 (defun notmuch-show-colour-headers ()
204   "Apply some colouring to the current headers."
205   (goto-char (point-min))
206   (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
207     (notmuch-show-fontify-header)
208     (forward-line)))
209
210 (defun notmuch-show-spaces-n (n)
211   "Return a string comprised of `n' spaces."
212   (make-string n ? ))
213
214 (defun notmuch-show-update-tags (tags)
215   "Update the displayed tags of the current message."
216   (save-excursion
217     (goto-char (notmuch-show-message-top))
218     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
219         (let ((inhibit-read-only t))
220           (replace-match (concat "("
221                                  (propertize (mapconcat 'identity tags " ")
222                                              'face 'notmuch-tag-face)
223                                  ")"))))))
224
225 (defun notmuch-show-clean-address (address)
226   "Clean a single email address for display."
227   (let* ((parsed (mail-header-parse-address address))
228          (address (car parsed))
229          (name (cdr parsed)))
230     ;; Remove double quotes. They might be required during transport,
231     ;; but we don't need to see them.
232     (when name
233       (setq name (replace-regexp-in-string "\"" "" name)))
234     ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
235     ;; 'foo@bar.com'.
236     (when (string= name address)
237       (setq name nil))
238
239     (if (not name)
240         address
241       (concat name " <" address ">"))))
242
243 (defun notmuch-show-insert-headerline (headers date tags depth)
244   "Insert a notmuch style headerline based on HEADERS for a
245 message at DEPTH in the current thread."
246   (let ((start (point)))
247     (insert (notmuch-show-spaces-n depth)
248             (notmuch-show-clean-address (plist-get headers :From))
249             " ("
250             date
251             ") ("
252             (propertize (mapconcat 'identity tags " ")
253                         'face 'notmuch-tag-face)
254             ")\n")
255     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
256
257 (defun notmuch-show-insert-header (header header-value)
258   "Insert a single header."
259   (insert header ": " header-value "\n"))
260
261 (defun notmuch-show-insert-headers (headers)
262   "Insert the headers of the current message."
263   (let ((start (point)))
264     (mapc '(lambda (header)
265              (let* ((header-symbol (intern (concat ":" header)))
266                     (header-value (plist-get headers header-symbol)))
267                (if (and header-value
268                         (not (string-equal "" header-value)))
269                    (notmuch-show-insert-header header header-value))))
270           notmuch-message-headers)
271     (save-excursion
272       (save-restriction
273         (narrow-to-region start (point-max))
274         (run-hooks 'notmuch-show-markup-headers-hook)))))
275
276 (define-button-type 'notmuch-show-part-button-type
277   'action 'notmuch-show-part-button-action
278   'follow-link t
279   'face 'message-mml)
280
281 (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
282   (insert-button
283    (concat "[ "
284            (if name (concat name ": ") "")
285            declared-type
286            (if (not (string-equal declared-type content-type))
287                (concat " (as " content-type ")")
288              "")
289            (or comment "")
290            " ]\n")
291    :type 'notmuch-show-part-button-type
292    :notmuch-part nth
293    :notmuch-filename name))
294
295 ;; Functions handling particular MIME parts.
296
297 (defun notmuch-show-save-part (message-id nth &optional filename)
298   (with-temp-buffer
299     ;; Always acquires the part via `notmuch part', even if it is
300     ;; available in the JSON output.
301     (insert (notmuch-show-get-bodypart-internal message-id nth))
302     (let ((file (read-file-name
303                  "Filename to save as: "
304                  (or mailcap-download-directory "~/")
305                  nil nil
306                  filename))
307           (require-final-newline nil)
308           (coding-system-for-write 'no-conversion))
309       (write-region (point-min) (point-max) file))))
310
311 (defun notmuch-show-mm-display-part-inline (msg part content-type content)
312   "Use the mm-decode/mm-view functions to display a part in the
313 current buffer, if possible."
314   (let ((display-buffer (current-buffer)))
315     (with-temp-buffer
316       (insert content)
317       (let ((handle (mm-make-handle (current-buffer) (list content-type))))
318         (set-buffer display-buffer)
319         (if (and (mm-inlinable-p handle)
320                  (mm-inlined-p handle))
321             (progn
322               (mm-display-part handle)
323               t)
324           nil)))))
325
326 (defvar notmuch-show-multipart/alternative-discouraged
327   '(
328     ;; Avoid HTML parts.
329     "text/html"
330     ;; multipart/related usually contain a text/html part and some associated graphics.
331     "multipart/related"
332     ))
333
334 (defun notmuch-show-multipart/*-to-list (part)
335   (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
336           (plist-get part :content)))
337
338 (defun notmuch-show-multipart/alternative-choose (types)
339   ;; Based on `mm-preferred-alternative-precedence'.
340   (let ((seq types))
341     (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
342       (dolist (elem (copy-sequence seq))
343         (when (string-match pref elem)
344           (setq seq (nconc (delete elem seq) (list elem))))))
345     seq))
346
347 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
348   (notmuch-show-insert-part-header nth declared-type content-type nil)
349   (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
350         (inner-parts (plist-get part :content))
351         (start (point)))
352     ;; This inserts all parts of the chosen type rather than just one,
353     ;; but it's not clear that this is the wrong thing to do - which
354     ;; should be chosen if there are more than one that match?
355     (mapc (lambda (inner-part)
356             (let ((inner-type (plist-get inner-part :content-type)))
357               (if (or notmuch-show-all-multipart/alternative-parts
358                       (string= chosen-type inner-type))
359                   (notmuch-show-insert-bodypart msg inner-part depth)
360                 (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
361           inner-parts)
362
363     (when notmuch-show-indent-multipart
364       (indent-rigidly start (point) 1)))
365   t)
366
367 (defun notmuch-show-setup-w3m ()
368   "Instruct w3m how to retrieve content from a \"related\" part of a message."
369   (interactive)
370   (if (boundp 'w3m-cid-retrieve-function-alist)
371     (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
372       (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
373             w3m-cid-retrieve-function-alist)))
374   (setq mm-inline-text-html-with-images t))
375
376 (defvar w3m-current-buffer) ;; From `w3m.el'.
377 (defvar notmuch-show-w3m-cid-store nil)
378 (make-variable-buffer-local 'notmuch-show-w3m-cid-store)
379
380 (defun notmuch-show-w3m-cid-store-internal (content-id
381                                             message-id
382                                             part-number
383                                             content-type
384                                             content)
385   (push (list content-id
386               message-id
387               part-number
388               content-type
389               content)
390         notmuch-show-w3m-cid-store))
391
392 (defun notmuch-show-w3m-cid-store (msg part)
393   (let ((content-id (plist-get part :content-id)))
394     (when content-id
395       (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
396                                            (plist-get msg :id)
397                                            (plist-get part :id)
398                                            (plist-get part :content-type)
399                                            nil))))
400
401 (defun notmuch-show-w3m-cid-retrieve (url &rest args)
402   (let ((matching-part (with-current-buffer w3m-current-buffer
403                          (assoc url notmuch-show-w3m-cid-store))))
404     (if matching-part
405         (let ((message-id (nth 1 matching-part))
406               (part-number (nth 2 matching-part))
407               (content-type (nth 3 matching-part))
408               (content (nth 4 matching-part)))
409           ;; If we don't already have the content, get it and cache
410           ;; it, as some messages reference the same cid: part many
411           ;; times (hundreds!), which results in many calls to
412           ;; `notmuch part'.
413           (unless content
414             (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
415                                                               part-number))
416             (with-current-buffer w3m-current-buffer
417               (notmuch-show-w3m-cid-store-internal url
418                                                    message-id
419                                                    part-number
420                                                    content-type
421                                                    content)))
422           (insert content)
423           content-type)
424       nil)))
425
426 (defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
427   (notmuch-show-insert-part-header nth declared-type content-type nil)
428   (let ((inner-parts (plist-get part :content))
429         (start (point)))
430
431     ;; We assume that the first part is text/html and the remainder
432     ;; things that it references.
433
434     ;; Stash the non-primary parts.
435     (mapc (lambda (part)
436             (notmuch-show-w3m-cid-store msg part))
437           (cdr inner-parts))
438
439     ;; Render the primary part.
440     (notmuch-show-insert-bodypart msg (car inner-parts) depth)
441
442     (when notmuch-show-indent-multipart
443       (indent-rigidly start (point) 1)))
444   t)
445
446 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
447   (notmuch-show-insert-part-header nth declared-type content-type nil)
448   (let ((inner-parts (plist-get part :content))
449         (start (point)))
450     ;; Show all of the parts.
451     (mapc (lambda (inner-part)
452             (notmuch-show-insert-bodypart msg inner-part depth))
453           inner-parts)
454
455     (when notmuch-show-indent-multipart
456       (indent-rigidly start (point) 1)))
457   t)
458
459 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
460   (let* ((message-part (plist-get part :content))
461          (inner-parts (plist-get message-part :content)))
462     (notmuch-show-insert-part-header nth declared-type content-type nil)
463     ;; Override `notmuch-message-headers' to force `From' to be
464     ;; displayed.
465     (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
466       (notmuch-show-insert-headers (plist-get part :headers)))
467     ;; Blank line after headers to be compatible with the normal
468     ;; message display.
469     (insert "\n")
470
471     ;; Show all of the parts.
472     (mapc (lambda (inner-part)
473             (notmuch-show-insert-bodypart msg inner-part depth))
474           inner-parts))
475   t)
476
477 (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
478   (let ((start (point)))
479     ;; If this text/plain part is not the first part in the message,
480     ;; insert a header to make this clear.
481     (if (> nth 1)
482         (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
483     (insert (notmuch-show-get-bodypart-content msg part nth))
484     (save-excursion
485       (save-restriction
486         (narrow-to-region start (point-max))
487         (run-hook-with-args 'notmuch-show-insert-text/plain-hook depth))))
488   t)
489
490 (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
491   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
492   (insert (with-temp-buffer
493             (insert (notmuch-show-get-bodypart-content msg part nth))
494             (goto-char (point-min))
495             (let ((file (make-temp-file "notmuch-ical"))
496                   result)
497               (icalendar--convert-ical-to-diary
498                (icalendar--read-element nil nil)
499                file t)
500               (set-buffer (get-file-buffer file))
501               (setq result (buffer-substring (point-min) (point-max)))
502               (set-buffer-modified-p nil)
503               (kill-buffer (current-buffer))
504               (delete-file file)
505               result)))
506   t)
507
508 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
509   ;; If we can deduce a MIME type from the filename of the attachment,
510   ;; do so and pass it on to the handler for that type.
511   (if (plist-get part :filename)
512       (let ((extension (file-name-extension (plist-get part :filename)))
513             mime-type)
514         (if extension
515             (progn
516               (mailcap-parse-mimetypes)
517               (setq mime-type (mailcap-extension-to-mime extension))
518               (if (and mime-type
519                        (not (string-equal mime-type "application/octet-stream")))
520                   (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
521                 nil))
522           nil))))
523
524 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
525   ;; This handler _must_ succeed - it is the handler of last resort.
526   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
527   (let ((content (notmuch-show-get-bodypart-content msg part nth)))
528     (if content
529         (notmuch-show-mm-display-part-inline msg part content-type content)))
530   t)
531
532 ;; Functions for determining how to handle MIME parts.
533
534 (defun notmuch-show-split-content-type (content-type)
535   (split-string content-type "/"))
536
537 (defun notmuch-show-handlers-for (content-type)
538   "Return a list of content handlers for a part of type CONTENT-TYPE."
539   (let (result)
540     (mapc (lambda (func)
541             (if (functionp func)
542                 (push func result)))
543           ;; Reverse order of prefrence.
544           (list (intern (concat "notmuch-show-insert-part-*/*"))
545                 (intern (concat
546                          "notmuch-show-insert-part-"
547                          (car (notmuch-show-split-content-type content-type))
548                          "/*"))
549                 (intern (concat "notmuch-show-insert-part-" content-type))))
550     result))
551
552 ;; Helper for parts which are generally not included in the default
553 ;; JSON output.
554
555 (defun notmuch-show-get-bodypart-internal (message-id part-number)
556   (with-temp-buffer
557     (let ((coding-system-for-read 'no-conversion))
558       (call-process notmuch-command nil t nil
559                     "part" (format "--part=%s" part-number) message-id)
560       (buffer-string))))
561
562 (defun notmuch-show-get-bodypart-content (msg part nth)
563   (or (plist-get part :content)
564       (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
565
566 ;; \f
567
568 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
569   (let ((handlers (notmuch-show-handlers-for content-type)))
570     ;; Run the content handlers until one of them returns a non-nil
571     ;; value.
572     (while (and handlers
573                 (not (funcall (car handlers) msg part content-type nth depth declared-type)))
574       (setq handlers (cdr handlers))))
575   t)
576
577 (defun notmuch-show-insert-bodypart (msg part depth)
578   "Insert the body part PART at depth DEPTH in the current thread."
579   (let ((content-type (downcase (plist-get part :content-type)))
580         (nth (plist-get part :id)))
581     (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
582   ;; Some of the body part handlers leave point somewhere up in the
583   ;; part, so we make sure that we're down at the end.
584   (goto-char (point-max))
585   ;; Ensure that the part ends with a carriage return.
586   (if (not (bolp))
587       (insert "\n")))
588
589 (defun notmuch-show-insert-body (msg body depth)
590   "Insert the body BODY at depth DEPTH in the current thread."
591   (mapc '(lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
592
593 (defun notmuch-show-make-symbol (type)
594   (make-symbol (concat "notmuch-show-" type)))
595
596 (defun notmuch-show-strip-re (string)
597   (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
598
599 (defvar notmuch-show-previous-subject "")
600 (make-variable-buffer-local 'notmuch-show-previous-subject)
601
602 (defun notmuch-show-insert-msg (msg depth)
603   "Insert the message MSG at depth DEPTH in the current thread."
604   (let* ((headers (plist-get msg :headers))
605          ;; Indentation causes the buffer offset of the start/end
606          ;; points to move, so we must use markers.
607          message-start message-end
608          content-start content-end
609          headers-start headers-end
610          body-start body-end
611          (headers-invis-spec (notmuch-show-make-symbol "header"))
612          (message-invis-spec (notmuch-show-make-symbol "message"))
613          (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
614
615     ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
616     ;; removing items from `buffer-invisibility-spec' (which is what
617     ;; `notmuch-show-headers-visible' and
618     ;; `notmuch-show-message-visible' do) is a no-op and has no
619     ;; effect. This caused threads with only matching messages to have
620     ;; those messages hidden initially because
621     ;; `buffer-invisibility-spec' stayed `t'.
622     ;;
623     ;; This needs to be set here (rather than just above the call to
624     ;; `notmuch-show-headers-visible') because some of the part
625     ;; rendering or body washing functions
626     ;; (e.g. `notmuch-wash-text/plain-citations') manipulate
627     ;; `buffer-invisibility-spec').
628     (when (eq buffer-invisibility-spec t)
629       (setq buffer-invisibility-spec nil))
630
631     (setq message-start (point-marker))
632
633     (notmuch-show-insert-headerline headers
634                                     (or (if notmuch-show-relative-dates
635                                             (plist-get msg :date_relative)
636                                           nil)
637                                         (plist-get headers :Date))
638                                     (plist-get msg :tags) depth)
639
640     (setq content-start (point-marker))
641
642     ;; Set `headers-start' to point after the 'Subject:' header to be
643     ;; compatible with the existing implementation. This just sets it
644     ;; to after the first header.
645     (notmuch-show-insert-headers headers)
646     ;; Headers should include a blank line (backwards compatibility).
647     (insert "\n")
648     (save-excursion
649       (goto-char content-start)
650       ;; If the subject of this message is the same as that of the
651       ;; previous message, don't display it when this message is
652       ;; collapsed.
653       (when (and notmuch-show-elide-same-subject
654                  (not (string= notmuch-show-previous-subject
655                                bare-subject)))
656         (forward-line 1))
657       (setq headers-start (point-marker)))
658     (setq headers-end (point-marker))
659
660     (setq notmuch-show-previous-subject bare-subject)
661
662     (setq body-start (point-marker))
663     (notmuch-show-insert-body msg (plist-get msg :body) depth)
664     ;; Ensure that the body ends with a newline.
665     (if (not (bolp))
666         (insert "\n"))
667     (setq body-end (point-marker))
668     (setq content-end (point-marker))
669
670     ;; Indent according to the depth in the thread.
671     (indent-rigidly content-start content-end depth)
672
673     (setq message-end (point-max-marker))
674
675     ;; Save the extents of this message over the whole text of the
676     ;; message.
677     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
678
679     (plist-put msg :headers-invis-spec headers-invis-spec)
680     (overlay-put (make-overlay headers-start headers-end) 'invisible headers-invis-spec)
681
682     (plist-put msg :message-invis-spec message-invis-spec)
683     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
684
685     ;; Save the properties for this message. Currently this saves the
686     ;; entire message (augmented it with other stuff), which seems
687     ;; like overkill. We might save a reduced subset (for example, not
688     ;; the content).
689     (notmuch-show-set-message-properties msg)
690
691     ;; Set header visibility.
692     (notmuch-show-headers-visible msg notmuch-message-headers-visible)
693
694     ;; Message visibility depends on whether it matched the search
695     ;; criteria.
696     (notmuch-show-message-visible msg (plist-get msg :match))))
697
698 (defun notmuch-show-insert-tree (tree depth)
699   "Insert the message tree TREE at depth DEPTH in the current thread."
700   (let ((msg (car tree))
701         (replies (cadr tree)))
702     (notmuch-show-insert-msg msg depth)
703     (notmuch-show-insert-thread replies (1+ depth))))
704
705 (defun notmuch-show-insert-thread (thread depth)
706   "Insert the thread THREAD at depth DEPTH in the current forest."
707   (mapc '(lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
708
709 (defun notmuch-show-insert-forest (forest)
710   "Insert the forest of threads FOREST."
711   (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
712
713 (defvar notmuch-show-parent-buffer nil)
714
715 ;;;###autoload
716 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
717   "Run \"notmuch show\" with the given thread ID and display results.
718
719 The optional PARENT-BUFFER is the notmuch-search buffer from
720 which this notmuch-show command was executed, (so that the
721 next thread from that buffer can be show when done with this
722 one).
723
724 The optional QUERY-CONTEXT is a notmuch search term. Only
725 messages from the thread matching this search term are shown if
726 non-nil.
727
728 The optional BUFFER-NAME provides the neame of the buffer in
729 which the message thread is shown. If it is nil (which occurs
730 when the command is called interactively) the argument to the
731 function is used. "
732   (interactive "sNotmuch show: ")
733   (let ((buffer (get-buffer-create (generate-new-buffer-name
734                                     (or buffer-name
735                                         (concat "*notmuch-" thread-id "*")))))
736         (inhibit-read-only t))
737     (switch-to-buffer buffer)
738     (notmuch-show-mode)
739     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
740     (erase-buffer)
741     (goto-char (point-min))
742     (save-excursion
743       (let* ((basic-args (list thread-id))
744              (args (if query-context
745                        (append (list "\'") basic-args (list "and (" query-context ")\'"))
746                      (append (list "\'") basic-args (list "\'")))))
747         (notmuch-show-insert-forest (notmuch-query-get-threads args))
748         ;; If the query context reduced the results to nothing, run
749         ;; the basic query.
750         (when (and (eq (buffer-size) 0)
751                    query-context)
752           (notmuch-show-insert-forest
753            (notmuch-query-get-threads basic-args))))
754
755       ;; Enable buttonisation of URLs and email addresses in the
756       ;; buffer.
757       (goto-address-mode t)
758       ;; Act on visual lines rather than logical lines.
759       (visual-line-mode t)
760
761       (run-hooks 'notmuch-show-hook))
762
763     ;; Move straight to the first open message
764     (if (not (notmuch-show-message-visible-p))
765         (notmuch-show-next-open-message))
766
767     ;; Set the header line to the subject of the first open message.
768     (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
769
770     (notmuch-show-mark-read)))
771
772 (defvar notmuch-show-stash-map
773   (let ((map (make-sparse-keymap)))
774     (define-key map "c" 'notmuch-show-stash-cc)
775     (define-key map "d" 'notmuch-show-stash-date)
776     (define-key map "F" 'notmuch-show-stash-filename)
777     (define-key map "f" 'notmuch-show-stash-from)
778     (define-key map "i" 'notmuch-show-stash-message-id)
779     (define-key map "s" 'notmuch-show-stash-subject)
780     (define-key map "T" 'notmuch-show-stash-tags)
781     (define-key map "t" 'notmuch-show-stash-to)
782     map)
783   "Submap for stash commands")
784 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
785
786 (defvar notmuch-show-mode-map
787       (let ((map (make-sparse-keymap)))
788         (define-key map "?" 'notmuch-help)
789         (define-key map "q" 'notmuch-kill-this-buffer)
790         (define-key map (kbd "<C-tab>") 'widget-backward)
791         (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
792         (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
793         (define-key map (kbd "TAB") 'notmuch-show-next-button)
794         (define-key map "s" 'notmuch-search)
795         (define-key map "m" 'notmuch-mua-mail)
796         (define-key map "f" 'notmuch-show-forward-message)
797         (define-key map "r" 'notmuch-show-reply)
798         (define-key map "|" 'notmuch-show-pipe-message)
799         (define-key map "w" 'notmuch-show-save-attachments)
800         (define-key map "V" 'notmuch-show-view-raw-message)
801         (define-key map "v" 'notmuch-show-view-all-mime-parts)
802         (define-key map "c" 'notmuch-show-stash-map)
803         (define-key map "h" 'notmuch-show-toggle-headers)
804         (define-key map "-" 'notmuch-show-remove-tag)
805         (define-key map "+" 'notmuch-show-add-tag)
806         (define-key map "x" 'notmuch-show-archive-thread-then-exit)
807         (define-key map "a" 'notmuch-show-archive-thread)
808         (define-key map "N" 'notmuch-show-next-message)
809         (define-key map "P" 'notmuch-show-previous-message)
810         (define-key map "n" 'notmuch-show-next-open-message)
811         (define-key map "p" 'notmuch-show-previous-open-message)
812         (define-key map (kbd "DEL") 'notmuch-show-rewind)
813         (define-key map " " 'notmuch-show-advance-and-archive)
814         (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
815         (define-key map (kbd "RET") 'notmuch-show-toggle-message)
816         map)
817       "Keymap for \"notmuch show\" buffers.")
818 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
819
820 (defun notmuch-show-mode ()
821   "Major mode for viewing a thread with notmuch.
822
823 This buffer contains the results of the \"notmuch show\" command
824 for displaying a single thread of email from your email archives.
825
826 By default, various components of email messages, (citations,
827 signatures, already-read messages), are hidden. You can make
828 these parts visible by clicking with the mouse button or by
829 pressing RET after positioning the cursor on a hidden part, (for
830 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
831
832 Reading the thread sequentially is well-supported by pressing
833 \\[notmuch-show-advance-and-archive]. This will scroll the current message (if necessary), advance
834 to the next message, or advance to the next thread (if already on
835 the last message of a thread).
836
837 Other commands are available to read or manipulate the thread
838 more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages
839 without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread
840 without scrolling through with \\[notmuch-show-advance-and-archive]).
841
842 You can add or remove arbitary tags from the current message with
843 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
844
845 All currently available key bindings:
846
847 \\{notmuch-show-mode-map}"
848   (interactive)
849   (kill-all-local-variables)
850   (use-local-map notmuch-show-mode-map)
851   (setq major-mode 'notmuch-show-mode
852         mode-name "notmuch-show")
853   (setq buffer-read-only t))
854
855 (defun notmuch-show-move-to-message-top ()
856   (goto-char (notmuch-show-message-top)))
857
858 (defun notmuch-show-move-to-message-bottom ()
859   (goto-char (notmuch-show-message-bottom)))
860
861 (defun notmuch-show-message-adjust ()
862   (recenter 0))
863
864 ;; Movement related functions.
865
866 ;; There's some strangeness here where a text property applied to a
867 ;; region a->b is not found when point is at b. We walk backwards
868 ;; until finding the property.
869 (defun notmuch-show-message-extent ()
870   (let (r)
871     (save-excursion
872       (while (not (setq r (get-text-property (point) :notmuch-message-extent)))
873         (backward-char)))
874     r))
875
876 (defun notmuch-show-message-top ()
877   (car (notmuch-show-message-extent)))
878
879 (defun notmuch-show-message-bottom ()
880   (cdr (notmuch-show-message-extent)))
881
882 (defun notmuch-show-goto-message-next ()
883   (let ((start (point)))
884     (notmuch-show-move-to-message-bottom)
885     (if (not (eobp))
886         t
887       (goto-char start)
888       nil)))
889
890 (defun notmuch-show-goto-message-previous ()
891   (notmuch-show-move-to-message-top)
892   (if (bobp)
893       nil
894     (backward-char)
895     (notmuch-show-move-to-message-top)
896     t))
897
898 (defun notmuch-show-move-past-invisible-forward ()
899   (while (point-invisible-p)
900     (forward-char)))
901
902 (defun notmuch-show-move-past-invisible-backward ()
903   (while (point-invisible-p)
904     (backward-char)))
905
906 ;; Functions relating to the visibility of messages and their
907 ;; components.
908
909 (defun notmuch-show-element-visible (props visible-p spec-property)
910   (let ((spec (plist-get props spec-property)))
911     (if visible-p
912         (remove-from-invisibility-spec spec)
913       (add-to-invisibility-spec spec))))
914
915 (defun notmuch-show-message-visible (props visible-p)
916   (if visible-p
917       ;; When making the message visible, the headers may or not be
918       ;; visible. So we check that property separately.
919       (let ((headers-visible (plist-get props :headers-visible)))
920         (notmuch-show-element-visible props headers-visible :headers-invis-spec)
921         (notmuch-show-element-visible props t :message-invis-spec))
922     (notmuch-show-element-visible props nil :headers-invis-spec)
923     (notmuch-show-element-visible props nil :message-invis-spec))
924
925   (notmuch-show-set-prop :message-visible visible-p props))
926
927 (defun notmuch-show-headers-visible (props visible-p)
928   (if (plist-get props :message-visible)
929       (notmuch-show-element-visible props visible-p :headers-invis-spec))
930   (notmuch-show-set-prop :headers-visible visible-p props))
931
932 ;; Functions for setting and getting attributes of the current
933 ;; message.
934
935 (defun notmuch-show-set-message-properties (props)
936   (save-excursion
937     (notmuch-show-move-to-message-top)
938     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
939
940 (defun notmuch-show-get-message-properties ()
941   (save-excursion
942     (notmuch-show-move-to-message-top)
943     (get-text-property (point) :notmuch-message-properties)))
944
945 (defun notmuch-show-set-prop (prop val &optional props)
946   (let ((inhibit-read-only t)
947         (props (or props
948                    (notmuch-show-get-message-properties))))
949     (plist-put props prop val)
950     (notmuch-show-set-message-properties props)))
951
952 (defun notmuch-show-get-prop (prop &optional props)
953   (let ((props (or props
954                    (notmuch-show-get-message-properties))))
955     (plist-get props prop)))
956
957 (defun notmuch-show-get-message-id ()
958   "Return the message id of the current message."
959   (concat "id:\"" (notmuch-show-get-prop :id) "\""))
960
961 ;; dme: Would it make sense to use a macro for many of these?
962
963 (defun notmuch-show-get-filename ()
964   "Return the filename of the current message."
965   (notmuch-show-get-prop :filename))
966
967 (defun notmuch-show-get-header (header)
968   "Return the named header of the current message, if any."
969   (plist-get (notmuch-show-get-prop :headers) header))
970
971 (defun notmuch-show-get-cc ()
972   (notmuch-show-get-header :Cc))
973
974 (defun notmuch-show-get-date ()
975   (notmuch-show-get-header :Date))
976
977 (defun notmuch-show-get-from ()
978   (notmuch-show-get-header :From))
979
980 (defun notmuch-show-get-subject ()
981   (notmuch-show-get-header :Subject))
982
983 (defun notmuch-show-get-to ()
984   (notmuch-show-get-header :To))
985
986 (defun notmuch-show-set-tags (tags)
987   "Set the tags of the current message."
988   (notmuch-show-set-prop :tags tags)
989   (notmuch-show-update-tags tags))
990
991 (defun notmuch-show-get-tags ()
992   "Return the tags of the current message."
993   (notmuch-show-get-prop :tags))
994
995 (defun notmuch-show-message-visible-p ()
996   "Is the current message visible?"
997   (notmuch-show-get-prop :message-visible))
998
999 (defun notmuch-show-headers-visible-p ()
1000   "Are the headers of the current message visible?"
1001   (notmuch-show-get-prop :headers-visible))
1002
1003 (defun notmuch-show-mark-read ()
1004   "Mark the current message as read."
1005   (notmuch-show-remove-tag "unread"))
1006
1007 ;; Functions for getting attributes of several messages in the current
1008 ;; thread.
1009
1010 (defun notmuch-show-get-message-ids-for-open-messages ()
1011   "Return a list of all message IDs for open messages in the current thread."
1012   (save-excursion
1013     (let (message-ids done)
1014       (goto-char (point-min))
1015       (while (not done)
1016         (if (notmuch-show-message-visible-p)
1017             (setq message-ids (append message-ids (list (notmuch-show-get-message-id)))))
1018         (setq done (not (notmuch-show-goto-message-next)))
1019         )
1020       message-ids
1021       )))
1022
1023 ;; Commands typically bound to keys.
1024
1025 (defun notmuch-show-advance-and-archive ()
1026   "Advance through thread and archive.
1027
1028 This command is intended to be one of the simplest ways to
1029 process a thread of email. It does the following:
1030
1031 If the current message in the thread is not yet fully visible,
1032 scroll by a near screenful to read more of the message.
1033
1034 Otherwise, (the end of the current message is already within the
1035 current window), advance to the next open message.
1036
1037 Finally, if there is no further message to advance to, and this
1038 last message is already read, then archive the entire current
1039 thread, (remove the \"inbox\" tag from each message). Also kill
1040 this buffer, and display the next thread from the search from
1041 which this thread was originally shown."
1042   (interactive)
1043   (let ((end-of-this-message (notmuch-show-message-bottom)))
1044     (cond
1045      ;; Ideally we would test `end-of-this-message' against the result
1046      ;; of `window-end', but that doesn't account for the fact that
1047      ;; the end of the message might be hidden, so we have to actually
1048      ;; go to the end, walk back over invisible text and then see if
1049      ;; point is visible.
1050      ((save-excursion
1051         (goto-char (- end-of-this-message 1))
1052         (notmuch-show-move-past-invisible-backward)
1053         (> (point) (window-end)))
1054       ;; The bottom of this message is not visible - scroll.
1055       (scroll-up nil))
1056
1057      ((not (= end-of-this-message (point-max)))
1058       ;; This is not the last message - move to the next visible one.
1059       (notmuch-show-next-open-message))
1060
1061      (t
1062       ;; This is the last message - archive the thread.
1063       (notmuch-show-archive-thread)))))
1064
1065 (defun notmuch-show-rewind ()
1066   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
1067
1068 Specifically, if the beginning of the previous email is fewer
1069 than `window-height' lines from the current point, move to it
1070 just like `notmuch-show-previous-message'.
1071
1072 Otherwise, just scroll down a screenful of the current message.
1073
1074 This command does not modify any message tags, (it does not undo
1075 any effects from previous calls to
1076 `notmuch-show-advance-and-archive'."
1077   (interactive)
1078   (let ((start-of-message (notmuch-show-message-top))
1079         (start-of-window (window-start)))
1080     (cond
1081       ;; Either this message is properly aligned with the start of the
1082       ;; window or the start of this message is not visible on the
1083       ;; screen - scroll.
1084      ((or (= start-of-message start-of-window)
1085           (< start-of-message start-of-window))
1086       (scroll-down)
1087       ;; If a small number of lines from the previous message are
1088       ;; visible, realign so that the top of the current message is at
1089       ;; the top of the screen.
1090       (if (<= (count-screen-lines (window-start) start-of-message)
1091               next-screen-context-lines)
1092           (progn
1093             (goto-char (notmuch-show-message-top))
1094             (notmuch-show-message-adjust)))
1095       ;; Move to the top left of the window.
1096       (goto-char (window-start)))
1097      (t
1098       ;; Move to the previous message.
1099       (notmuch-show-previous-message)))))
1100
1101 (defun notmuch-show-reply ()
1102   "Reply to the current message."
1103   (interactive)
1104   (notmuch-mua-reply (notmuch-show-get-message-id)))
1105
1106 (defun notmuch-show-forward-message ()
1107   "Forward the current message."
1108   (interactive)
1109   (with-current-notmuch-show-message
1110    (notmuch-mua-forward-message)))
1111
1112 (defun notmuch-show-next-message ()
1113   "Show the next message."
1114   (interactive)
1115   (if (notmuch-show-goto-message-next)
1116       (progn
1117         (notmuch-show-mark-read)
1118         (notmuch-show-message-adjust))
1119     (goto-char (point-max))))
1120
1121 (defun notmuch-show-previous-message ()
1122   "Show the previous message."
1123   (interactive)
1124   (notmuch-show-goto-message-previous)
1125   (notmuch-show-mark-read)
1126   (notmuch-show-message-adjust))
1127
1128 (defun notmuch-show-next-open-message ()
1129   "Show the next message."
1130   (interactive)
1131   (let (r)
1132     (while (and (setq r (notmuch-show-goto-message-next))
1133                 (not (notmuch-show-message-visible-p))))
1134     (if r
1135         (progn
1136           (notmuch-show-mark-read)
1137           (notmuch-show-message-adjust))
1138       (goto-char (point-max)))))
1139
1140 (defun notmuch-show-previous-open-message ()
1141   "Show the previous message."
1142   (interactive)
1143   (while (and (notmuch-show-goto-message-previous)
1144               (not (notmuch-show-message-visible-p))))
1145   (notmuch-show-mark-read)
1146   (notmuch-show-message-adjust))
1147
1148 (defun notmuch-show-view-raw-message ()
1149   "View the file holding the current message."
1150   (interactive)
1151   (let* ((id (notmuch-show-get-message-id))
1152          (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
1153     (call-process notmuch-command nil buf nil "show" "--format=raw" id)
1154     (switch-to-buffer buf)
1155     (goto-char (point-min))
1156     (set-buffer-modified-p nil)
1157     (view-buffer buf 'kill-buffer-if-not-modified)))
1158
1159 (defun notmuch-show-pipe-message (entire-thread command)
1160   "Pipe the contents of the current message (or thread) to the given command.
1161
1162 The given command will be executed with the raw contents of the
1163 current email message as stdin. Anything printed by the command
1164 to stdout or stderr will appear in the *notmuch-pipe* buffer.
1165
1166 When invoked with a prefix argument, the command will receive all
1167 open messages in the current thread (formatted as an mbox) rather
1168 than only the current message."
1169   (interactive "P\nsPipe message to command: ")
1170   (let (shell-command)
1171     (if entire-thread
1172         (setq shell-command 
1173               (concat notmuch-command " show --format=mbox "
1174                       (shell-quote-argument
1175                        (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
1176                       " | " command))
1177       (setq shell-command
1178             (concat notmuch-command " show --format=raw "
1179                     (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
1180     (let ((buf (get-buffer-create (concat "*notmuch-pipe*"))))
1181       (with-current-buffer buf
1182         (setq buffer-read-only nil)
1183         (erase-buffer)
1184         (let ((exit-code (call-process-shell-command shell-command nil buf)))
1185           (goto-char (point-max))
1186           (set-buffer-modified-p nil)
1187           (setq buffer-read-only t)
1188           (unless (zerop exit-code)
1189             (switch-to-buffer-other-window buf)
1190             (message (format "Command '%s' exited abnormally with code %d"
1191                              shell-command exit-code))))))))
1192
1193 (defun notmuch-show-add-tags-worker (current-tags add-tags)
1194   "Add to `current-tags' with any tags from `add-tags' not
1195 currently present and return the result."
1196   (let ((result-tags (copy-sequence current-tags)))
1197     (mapc (lambda (add-tag)
1198             (unless (member add-tag current-tags)
1199               (setq result-tags (push add-tag result-tags))))
1200             add-tags)
1201     (sort result-tags 'string<)))
1202
1203 (defun notmuch-show-del-tags-worker (current-tags del-tags)
1204   "Remove any tags in `del-tags' from `current-tags' and return
1205 the result."
1206   (let ((result-tags (copy-sequence current-tags)))
1207     (mapc (lambda (del-tag)
1208             (setq result-tags (delete del-tag result-tags)))
1209           del-tags)
1210     result-tags))
1211
1212 (defun notmuch-show-add-tag (&rest toadd)
1213   "Add a tag to the current message."
1214   (interactive
1215    (list (notmuch-select-tag-with-completion "Tag to add: ")))
1216
1217   (let* ((current-tags (notmuch-show-get-tags))
1218          (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
1219
1220     (unless (equal current-tags new-tags)
1221       (apply 'notmuch-call-notmuch-process
1222              (append (cons "tag"
1223                            (mapcar (lambda (s) (concat "+" s)) toadd))
1224                      (cons (notmuch-show-get-message-id) nil)))
1225       (notmuch-show-set-tags new-tags))))
1226
1227 (defun notmuch-show-remove-tag (&rest toremove)
1228   "Remove a tag from the current message."
1229   (interactive
1230    (list (notmuch-select-tag-with-completion
1231           "Tag to remove: " (notmuch-show-get-message-id))))
1232
1233   (let* ((current-tags (notmuch-show-get-tags))
1234          (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
1235
1236     (unless (equal current-tags new-tags)
1237       (apply 'notmuch-call-notmuch-process
1238              (append (cons "tag"
1239                            (mapcar (lambda (s) (concat "-" s)) toremove))
1240                      (cons (notmuch-show-get-message-id) nil)))
1241       (notmuch-show-set-tags new-tags))))
1242
1243 (defun notmuch-show-toggle-headers ()
1244   "Toggle the visibility of the current message headers."
1245   (interactive)
1246   (let ((props (notmuch-show-get-message-properties)))
1247     (notmuch-show-headers-visible
1248      props
1249      (not (plist-get props :headers-visible))))
1250   (force-window-update))
1251
1252 (defun notmuch-show-toggle-message ()
1253   "Toggle the visibility of the current message."
1254   (interactive)
1255   (let ((props (notmuch-show-get-message-properties)))
1256     (notmuch-show-message-visible
1257      props
1258      (not (plist-get props :message-visible))))
1259   (force-window-update))
1260
1261 (defun notmuch-show-open-or-close-all ()
1262   "Set the visibility all of the messages in the current thread.
1263 By default make all of the messages visible. With a prefix
1264 argument, hide all of the messages."
1265   (interactive)
1266   (save-excursion
1267     (goto-char (point-min))
1268     (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
1269                                            (not current-prefix-arg))
1270           until (not (notmuch-show-goto-message-next))))
1271   (force-window-update))
1272
1273 (defun notmuch-show-next-button ()
1274   "Advance point to the next button in the buffer."
1275   (interactive)
1276   (forward-button 1))
1277
1278 (defun notmuch-show-previous-button ()
1279   "Move point back to the previous button in the buffer."
1280   (interactive)
1281   (backward-button 1))
1282
1283 (defun notmuch-show-archive-thread-internal (show-next)
1284   ;; Remove the tag from the current set of messages.
1285   (goto-char (point-min))
1286   (loop do (notmuch-show-remove-tag "inbox")
1287         until (not (notmuch-show-goto-message-next)))
1288   ;; Move to the next item in the search results, if any.
1289   (let ((parent-buffer notmuch-show-parent-buffer))
1290     (notmuch-kill-this-buffer)
1291     (if parent-buffer
1292         (progn
1293           (switch-to-buffer parent-buffer)
1294           (forward-line)
1295           (if show-next
1296               (notmuch-search-show-thread))))))
1297
1298 (defun notmuch-show-archive-thread ()
1299   "Archive each message in thread, then show next thread from search.
1300
1301 Archive each message currently shown by removing the \"inbox\"
1302 tag from each. Then kill this buffer and show the next thread
1303 from the search from which this thread was originally shown.
1304
1305 Note: This command is safe from any race condition of new messages
1306 being delivered to the same thread. It does not archive the
1307 entire thread, but only the messages shown in the current
1308 buffer."
1309   (interactive)
1310   (notmuch-show-archive-thread-internal t))
1311
1312 (defun notmuch-show-archive-thread-then-exit ()
1313   "Archive each message in thread, then exit back to search results."
1314   (interactive)
1315   (notmuch-show-archive-thread-internal nil))
1316
1317 (defun notmuch-show-stash-cc ()
1318   "Copy CC field of current message to kill-ring."
1319   (interactive)
1320   (notmuch-common-do-stash (notmuch-show-get-cc)))
1321
1322 (defun notmuch-show-stash-date ()
1323   "Copy date of current message to kill-ring."
1324   (interactive)
1325   (notmuch-common-do-stash (notmuch-show-get-date)))
1326
1327 (defun notmuch-show-stash-filename ()
1328   "Copy filename of current message to kill-ring."
1329   (interactive)
1330   (notmuch-common-do-stash (notmuch-show-get-filename)))
1331
1332 (defun notmuch-show-stash-from ()
1333   "Copy From address of current message to kill-ring."
1334   (interactive)
1335   (notmuch-common-do-stash (notmuch-show-get-from)))
1336
1337 (defun notmuch-show-stash-message-id ()
1338   "Copy message ID of current message to kill-ring."
1339   (interactive)
1340   (notmuch-common-do-stash (notmuch-show-get-message-id)))
1341
1342 (defun notmuch-show-stash-subject ()
1343   "Copy Subject field of current message to kill-ring."
1344   (interactive)
1345   (notmuch-common-do-stash (notmuch-show-get-subject)))
1346
1347 (defun notmuch-show-stash-tags ()
1348   "Copy tags of current message to kill-ring as a comma separated list."
1349   (interactive)
1350   (notmuch-common-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
1351
1352 (defun notmuch-show-stash-to ()
1353   "Copy To address of current message to kill-ring."
1354   (interactive)
1355   (notmuch-common-do-stash (notmuch-show-get-to)))
1356
1357 ;; Commands typically bound to buttons.
1358
1359 (defun notmuch-show-part-button-action (button)
1360   (let ((nth (button-get button :notmuch-part)))
1361     (if nth
1362         (notmuch-show-save-part (notmuch-show-get-message-id) nth
1363                                 (button-get button :notmuch-filename))
1364       (message "Not a valid part (is it a fake part?)."))))
1365
1366 ;;
1367
1368 (provide 'notmuch-show)