emacs: Increase consistency of library headers
[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 <https://www.gnu.org/licenses/>.
20 ;;
21 ;; Authors: Carl Worth <cworth@cworth.org>
22 ;;          David Edmondson <dme@dme.org>
23
24 ;;; Code:
25
26 (eval-when-compile
27   (require 'cl-lib)
28   (require 'pcase))
29
30 (require 'mm-view)
31 (require 'message)
32 (require 'mm-decode)
33 (require 'mailcap)
34 (require 'icalendar)
35 (require 'goto-addr)
36
37 (require 'notmuch-lib)
38 (require 'notmuch-tag)
39 (require 'notmuch-query)
40 (require 'notmuch-wash)
41 (require 'notmuch-mua)
42 (require 'notmuch-crypto)
43 (require 'notmuch-print)
44 (require 'notmuch-draft)
45
46 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
47 (declare-function notmuch-search-next-thread "notmuch" nil)
48 (declare-function notmuch-search-previous-thread "notmuch" nil)
49 (declare-function notmuch-search-show-thread "notmuch" nil)
50 (declare-function notmuch-foreach-mime-part "notmuch" (function mm-handle))
51 (declare-function notmuch-count-attachments "notmuch" (mm-handle))
52 (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
53 (declare-function notmuch-tree "notmuch-tree"
54                   (&optional query query-context target buffer-name
55                              open-target unthreaded))
56 (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
57 (declare-function notmuch-unthreaded
58                   (&optional query query-context target buffer-name open-target))
59 (declare-function notmuch-read-query "notmuch" (prompt))
60 (declare-function notmuch-draft-resume "notmuch-draft" (id))
61
62 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
63   "Headers that should be shown in a message, in this order.
64
65 For an open message, all of these headers will be made visible
66 according to `notmuch-message-headers-visible' or can be toggled
67 with `notmuch-show-toggle-visibility-headers'. For a closed message,
68 only the first header in the list will be visible."
69   :type '(repeat string)
70   :group 'notmuch-show)
71
72 (defcustom notmuch-message-headers-visible t
73   "Should the headers be visible by default?
74
75 If this value is non-nil, then all of the headers defined in
76 `notmuch-message-headers' will be visible by default in the display
77 of each message. Otherwise, these headers will be hidden and
78 `notmuch-show-toggle-visibility-headers' can be used to make them
79 visible for any given message."
80   :type 'boolean
81   :group 'notmuch-show)
82
83 (defcustom notmuch-show-relative-dates t
84   "Display relative dates in the message summary line."
85   :type 'boolean
86   :group 'notmuch-show)
87
88 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
89   "A list of functions called to decorate the headers listed in
90 `notmuch-message-headers'.")
91
92 (defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
93   "Functions called after populating a `notmuch-show' buffer."
94   :type 'hook
95   :options '(notmuch-show-turn-on-visual-line-mode)
96   :group 'notmuch-show
97   :group 'notmuch-hooks)
98
99 (defcustom notmuch-show-insert-text/plain-hook
100   '(notmuch-wash-wrap-long-lines
101     notmuch-wash-tidy-citations
102     notmuch-wash-elide-blank-lines
103     notmuch-wash-excerpt-citations)
104   "Functions used to improve the display of text/plain parts."
105   :type 'hook
106   :options '(notmuch-wash-convert-inline-patch-to-part
107              notmuch-wash-wrap-long-lines
108              notmuch-wash-tidy-citations
109              notmuch-wash-elide-blank-lines
110              notmuch-wash-excerpt-citations)
111   :group 'notmuch-show
112   :group 'notmuch-hooks)
113
114 (defcustom notmuch-show-max-text-part-size 100000
115   "Maximum size of a text part to be shown by default in characters.
116
117 Set to 0 to show the part regardless of size."
118   :type 'integer
119   :group 'notmuch-show)
120
121 ;; Mostly useful for debugging.
122 (defcustom notmuch-show-all-multipart/alternative-parts nil
123   "Should all parts of multipart/alternative parts be shown?"
124   :type 'boolean
125   :group 'notmuch-show)
126
127 (defcustom notmuch-show-indent-messages-width 1
128   "Width of message indentation in threads.
129
130 Messages are shown indented according to their depth in a thread.
131 This variable determines the width of this indentation measured
132 in number of blanks.  Defaults to `1', choose `0' to disable
133 indentation."
134   :type 'integer
135   :group 'notmuch-show)
136
137 (defcustom notmuch-show-indent-multipart nil
138   "Should the sub-parts of a multipart/* part be indented?"
139   ;; dme: Not sure which is a good default.
140   :type 'boolean
141   :group 'notmuch-show)
142
143 (defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part
144   "Default part header button action (on ENTER or mouse click)."
145   :group 'notmuch-show
146   :type '(choice (const :tag "Save part"
147                         notmuch-show-save-part)
148                  (const :tag "View part"
149                         notmuch-show-view-part)
150                  (const :tag "View interactively"
151                         notmuch-show-interactively-view-part)))
152
153 (defcustom notmuch-show-only-matching-messages nil
154   "Only matching messages are shown by default."
155   :type 'boolean
156   :group 'notmuch-show)
157
158 ;; By default, block all external images to prevent privacy leaks and
159 ;; potential attacks.
160 (defcustom notmuch-show-text/html-blocked-images "."
161   "Remote images that have URLs matching this regexp will be blocked."
162   :type '(choice (const nil) regexp)
163   :group 'notmuch-show)
164
165 (defvar notmuch-show-thread-id nil)
166 (make-variable-buffer-local 'notmuch-show-thread-id)
167
168 (defvar notmuch-show-parent-buffer nil)
169 (make-variable-buffer-local 'notmuch-show-parent-buffer)
170
171 (defvar notmuch-show-query-context nil)
172 (make-variable-buffer-local 'notmuch-show-query-context)
173
174 (defvar notmuch-show-process-crypto nil)
175 (make-variable-buffer-local 'notmuch-show-process-crypto)
176
177 (defvar notmuch-show-elide-non-matching-messages nil)
178 (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
179
180 (defvar notmuch-show-indent-content t)
181 (make-variable-buffer-local 'notmuch-show-indent-content)
182
183 (defvar notmuch-show-attachment-debug nil
184   "If t log stdout and stderr from attachment handlers.
185
186 When set to nil (the default) stdout and stderr from attachment
187 handlers is discarded. When set to t the stdout and stderr from
188 each attachment handler is logged in buffers with names beginning
189 \" *notmuch-part*\". This option requires emacs version at least
190 24.3 to work.")
191
192 (defcustom notmuch-show-stash-mlarchive-link-alist
193   '(("Gmane" . "https://mid.gmane.org/")
194     ("MARC" . "https://marc.info/?i=")
195     ("Mail Archive, The" . "https://mid.mail-archive.com/")
196     ("LKML" . "https://lkml.kernel.org/r/")
197     ;; FIXME: can these services be searched by `Message-Id' ?
198     ;; ("MarkMail" . "http://markmail.org/")
199     ;; ("Nabble" . "http://nabble.com/")
200     ;; ("opensubscriber" . "http://opensubscriber.com/")
201     )
202   "List of Mailing List Archives to use when stashing links.
203
204 This list is used for generating a Mailing List Archive reference
205 URI with the current message's Message-Id in
206 `notmuch-show-stash-mlarchive-link'.
207
208 If the cdr of the alist element is not a function, the cdr is
209 expected to contain a URI that is concatenated with the current
210 message's Message-Id to create a ML archive reference URI.
211
212 If the cdr is a function, the function is called with the
213 Message-Id as the argument, and the function is expected to
214 return the ML archive reference URI."
215   :type '(alist :key-type (string :tag "Name")
216                 :value-type (choice
217                              (string :tag "URL")
218                              (function :tag "Function returning the URL")))
219   :group 'notmuch-show)
220
221 (defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
222   "Default Mailing List Archive to use when stashing links.
223
224 This is used when `notmuch-show-stash-mlarchive-link' isn't
225 provided with an MLA argument nor `completing-read' input."
226   :type `(choice
227           ,@(mapcar
228              (lambda (mla)
229                (list 'const :tag (car mla) :value (car mla)))
230              notmuch-show-stash-mlarchive-link-alist))
231   :group 'notmuch-show)
232
233 (defcustom notmuch-show-mark-read-tags '("-unread")
234   "List of tag changes to apply to a message when it is marked as read.
235
236 Tags starting with \"+\" (or not starting with either \"+\" or
237 \"-\") in the list will be added, and tags starting with \"-\"
238 will be removed from the message being marked as read.
239
240 For example, if you wanted to remove an \"unread\" tag and add a
241 \"read\" tag (which would make little sense), you would set:
242     (\"-unread\" \"+read\")"
243   :type '(repeat string)
244   :group 'notmuch-show)
245
246 (defcustom notmuch-show-mark-read-function #'notmuch-show-seen-current-message
247   "Function to control which messages are marked read.
248
249 The function should take two arguments START and END which will
250 be the start and end of the visible portion of the buffer and
251 should mark the appropriate messages read by applying
252 `notmuch-show-mark-read'. This function will be called after
253 every user interaction with notmuch."
254   :type 'function
255   :group 'notmuch-show)
256
257 (defcustom notmuch-show-imenu-indent nil
258   "Should Imenu display messages indented.
259
260 By default, Imenu (see Info node `(emacs) Imenu') in a
261 notmuch-show buffer displays all messages straight.  This is
262 because the default Emacs frontend for Imenu makes it difficult
263 to select an Imenu entry with spaces in front.  Other imenu
264 frontends such as counsel-imenu does not have this limitation.
265 In these cases, Imenu entries can be indented to reflect the
266 position of the message in the thread."
267   :type 'boolean
268   :group 'notmuch-show)
269
270 (defmacro with-current-notmuch-show-message (&rest body)
271   "Evaluate body with current buffer set to the text of current message."
272   `(save-excursion
273      (let ((id (notmuch-show-get-message-id)))
274        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
275          (with-current-buffer buf
276            (let ((coding-system-for-read 'no-conversion))
277              (call-process notmuch-command nil t nil "show" "--format=raw" id))
278            ,@body)
279          (kill-buffer buf)))))
280
281 (defun notmuch-show-turn-on-visual-line-mode ()
282   "Enable Visual Line mode."
283   (visual-line-mode t))
284
285 ;; DEPRECATED in Notmuch 0.16 since we now have convenient part
286 ;; commands.  We'll keep the command around for a version or two in
287 ;; case people want to bind it themselves.
288 (defun notmuch-show-view-all-mime-parts ()
289   "Use external viewers to view all attachments from the current message."
290   (interactive)
291   (with-current-notmuch-show-message
292    ;; We override the mm-inline-media-tests to indicate which message
293    ;; parts are already sufficiently handled by the original
294    ;; presentation of the message in notmuch-show mode. These parts
295    ;; will be inserted directly into the temporary buffer of
296    ;; with-current-notmuch-show-message and silently discarded.
297    ;;
298    ;; Any MIME part not explicitly mentioned here will be handled by an
299    ;; external viewer as configured in the various mailcap files.
300    (let ((mm-inline-media-tests
301           '(("text/.*" ignore identity)
302             ("application/pgp-signature" ignore identity)
303             ("multipart/alternative" ignore identity)
304             ("multipart/mixed" ignore identity)
305             ("multipart/related" ignore identity))))
306      (mm-display-parts (mm-dissect-buffer)))))
307
308 (defun notmuch-show-save-attachments ()
309   "Save all attachments from the current message."
310   (interactive)
311   (with-current-notmuch-show-message
312    (let ((mm-handle (mm-dissect-buffer)))
313      (notmuch-save-attachments
314       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
315   (message "Done"))
316
317 (defun notmuch-show-with-message-as-text (fn)
318   "Apply FN to a text representation of the current message.
319
320 FN is called with one argument, the message properties. It should
321 operation on the contents of the current buffer."
322   ;; Remake the header to ensure that all information is available.
323   (let* ((to (notmuch-show-get-to))
324          (cc (notmuch-show-get-cc))
325          (from (notmuch-show-get-from))
326          (subject (notmuch-show-get-subject))
327          (date (notmuch-show-get-date))
328          (tags (notmuch-show-get-tags))
329          (depth (notmuch-show-get-depth))
330          (header (concat
331                   "Subject: " subject "\n"
332                   "To: " to "\n"
333                   (if (not (string= cc ""))
334                       (concat "Cc: " cc "\n")
335                     "")
336                   "From: " from "\n"
337                   "Date: " date "\n"
338                   (if tags
339                       (concat "Tags: "
340                               (mapconcat #'identity tags ", ") "\n")
341                     "")))
342          (all (buffer-substring (notmuch-show-message-top)
343                                 (notmuch-show-message-bottom)))
344
345          (props (notmuch-show-get-message-properties))
346          (indenting notmuch-show-indent-content))
347     (with-temp-buffer
348       (insert all)
349       (when indenting
350         (indent-rigidly (point-min)
351                         (point-max)
352                         (- (* notmuch-show-indent-messages-width depth))))
353       ;; Remove the original header.
354       (goto-char (point-min))
355       (re-search-forward "^$" (point-max) nil)
356       (delete-region (point-min) (point))
357       (insert header)
358       (funcall fn props))))
359
360 (defun notmuch-show-print-message ()
361   "Print the current message."
362   (interactive)
363   (notmuch-show-with-message-as-text 'notmuch-print-message))
364
365 (defun notmuch-show-fontify-header ()
366   (let ((face (cond
367                ((looking-at "[Tt]o:")
368                 'message-header-to)
369                ((looking-at "[Bb]?[Cc][Cc]:")
370                 'message-header-cc)
371                ((looking-at "[Ss]ubject:")
372                 'message-header-subject)
373                (t
374                 'message-header-other))))
375     (overlay-put (make-overlay (point) (re-search-forward ":"))
376                  'face 'message-header-name)
377     (overlay-put (make-overlay (point) (re-search-forward ".*$"))
378                  'face face)))
379
380 (defun notmuch-show-colour-headers ()
381   "Apply some colouring to the current headers."
382   (goto-char (point-min))
383   (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
384     (notmuch-show-fontify-header)
385     (forward-line)))
386
387 (defun notmuch-show-spaces-n (n)
388   "Return a string comprised of `n' spaces."
389   (make-string n ? ))
390
391 (defun notmuch-show-update-tags (tags)
392   "Update the displayed tags of the current message."
393   (save-excursion
394     (goto-char (notmuch-show-message-top))
395     (when (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
396       (let ((inhibit-read-only t))
397         (replace-match (concat "("
398                                (notmuch-tag-format-tags
399                                 tags
400                                 (notmuch-show-get-prop :orig-tags))
401                                ")"))))))
402
403 (defun notmuch-clean-address (address)
404   "Try to clean a single email ADDRESS for display. Return a cons
405 cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
406 parsing fails."
407   (condition-case nil
408       (let (p-name p-address)
409         ;; It would be convenient to use `mail-header-parse-address',
410         ;; but that expects un-decoded mailbox parts, whereas our
411         ;; mailbox parts are already decoded (and hence may contain
412         ;; UTF-8). Given that notmuch should handle most of the awkward
413         ;; cases, some simple string deconstruction should be sufficient
414         ;; here.
415         (cond
416          ;; "User <user@dom.ain>" style.
417          ((string-match "\\(.*\\) <\\(.*\\)>" address)
418           (setq p-name (match-string 1 address))
419           (setq p-address (match-string 2 address)))
420
421          ;; "<user@dom.ain>" style.
422          ((string-match "<\\(.*\\)>" address)
423           (setq p-address (match-string 1 address)))
424          ;; Everything else.
425          (t
426           (setq p-address address)))
427         (when p-name
428           ;; Remove elements of the mailbox part that are not relevant for
429           ;; display, even if they are required during transport:
430           ;;
431           ;; Backslashes.
432           (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
433           ;; Outer single and double quotes, which might be nested.
434           (cl-loop with start-of-loop
435                    do   (setq start-of-loop p-name)
436                    when (string-match "^\"\\(.*\\)\"$" p-name)
437                    do   (setq p-name (match-string 1 p-name))
438                    when (string-match "^'\\(.*\\)'$" p-name)
439                    do   (setq p-name (match-string 1 p-name))
440                    until (string= start-of-loop p-name)))
441         ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
442         ;; 'foo@bar.com'.
443         (when (string= p-name p-address)
444           (setq p-name nil))
445         (cons p-address p-name))
446     (error (cons address nil))))
447
448 (defun notmuch-show-clean-address (address)
449   "Try to clean a single email ADDRESS for display.
450 Return unchanged ADDRESS if parsing fails."
451   (let* ((clean-address (notmuch-clean-address address))
452          (p-address (car clean-address))
453          (p-name (cdr clean-address)))
454     ;; If no name, return just the address.
455     (if (not p-name)
456         p-address
457       ;; Otherwise format the name and address together.
458       (concat p-name " <" p-address ">"))))
459
460 (defun notmuch-show-insert-headerline (headers date tags depth)
461   "Insert a notmuch style headerline based on HEADERS for a
462 message at DEPTH in the current thread."
463   (let ((start (point))
464         (from (notmuch-sanitize
465                (notmuch-show-clean-address (plist-get headers :From)))))
466     (when (string-match "\\cR" from)
467       ;; If the From header has a right-to-left character add
468       ;; invisible U+200E LEFT-TO-RIGHT MARK character which forces
469       ;; the header paragraph as left-to-right text.
470       (insert (propertize (string ?\x200e) 'invisible t)))
471     (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
472             from
473             " ("
474             date
475             ") ("
476             (notmuch-tag-format-tags tags tags)
477             ")\n")
478     (overlay-put (make-overlay start (point))
479                  'face 'notmuch-message-summary-face)))
480
481 (defun notmuch-show-insert-header (header header-value)
482   "Insert a single header."
483   (insert header ": " (notmuch-sanitize header-value) "\n"))
484
485 (defun notmuch-show-insert-headers (headers)
486   "Insert the headers of the current message."
487   (let ((start (point)))
488     (mapc (lambda (header)
489             (let* ((header-symbol (intern (concat ":" header)))
490                    (header-value (plist-get headers header-symbol)))
491               (when (and header-value
492                          (not (string-equal "" header-value)))
493                 (notmuch-show-insert-header header header-value))))
494           notmuch-message-headers)
495     (save-excursion
496       (save-restriction
497         (narrow-to-region start (point-max))
498         (run-hooks 'notmuch-show-markup-headers-hook)))))
499
500 (define-button-type 'notmuch-show-part-button-type
501   'action 'notmuch-show-part-button-default
502   'follow-link t
503   'face 'message-mml
504   :supertype 'notmuch-button-type)
505
506 (defun notmuch-show-insert-part-header (nth content-type declared-type
507                                             &optional name comment)
508   (let ((base-label (concat (and name (concat name ": "))
509                             declared-type
510                             (and (not (string-equal declared-type content-type))
511                                  (concat " (as " content-type ")"))
512                             comment)))
513     (prog1 (insert-button
514             (concat "[ " base-label " ]")
515             :base-label base-label
516             :type 'notmuch-show-part-button-type
517             :notmuch-part-hidden nil)
518       (insert "\n"))))
519
520 (defun notmuch-show-toggle-part-invisibility (&optional button)
521   (interactive)
522   (let ((button (or button (button-at (point)))))
523     (when button
524       (let ((overlay (button-get button 'overlay))
525             (lazy-part (button-get button :notmuch-lazy-part)))
526         ;; We have a part to toggle if there is an overlay or if there
527         ;; is a lazy part.  If neither is present we cannot toggle the
528         ;; part so we just return nil.
529         (when (or overlay lazy-part)
530           (let* ((show (button-get button :notmuch-part-hidden))
531                  (new-start (button-start button))
532                  (button-label (button-get button :base-label))
533                  (old-point (point))
534                  (properties (text-properties-at (button-start button)))
535                  (inhibit-read-only t))
536             ;; Toggle the button itself.
537             (button-put button :notmuch-part-hidden (not show))
538             (goto-char new-start)
539             (insert "[ " button-label (if show " ]" " (hidden) ]"))
540             (set-text-properties new-start (point) properties)
541             (let ((old-end (button-end button)))
542               (move-overlay button new-start (point))
543               (delete-region (point) old-end))
544             (goto-char (min old-point (1- (button-end button))))
545             ;; Return nil if there is a lazy-part, it is empty, and we are
546             ;; trying to show it.  In all other cases return t.
547             (if lazy-part
548                 (when show
549                   (button-put button :notmuch-lazy-part nil)
550                   (notmuch-show-lazy-part lazy-part button))
551               ;; else there must be an overlay.
552               (overlay-put overlay 'invisible (not show))
553               t)))))))
554
555 ;; Part content ID handling
556
557 (defvar notmuch-show--cids nil
558   "Alist from raw content ID to (MSG PART).")
559 (make-variable-buffer-local 'notmuch-show--cids)
560
561 (defun notmuch-show--register-cids (msg part)
562   "Register content-IDs in PART and all of PART's sub-parts."
563   (let ((content-id (plist-get part :content-id)))
564     (when content-id
565       ;; Note that content-IDs are globally unique, except when they
566       ;; aren't: RFC 2046 section 5.1.4 permits children of a
567       ;; multipart/alternative to have the same content-ID, in which
568       ;; case the MUA is supposed to pick the best one it can render.
569       ;; We simply add the content-ID to the beginning of our alist;
570       ;; so if this happens, we'll take the last (and "best")
571       ;; alternative (even if we can't render it).
572       (push (list content-id msg part) notmuch-show--cids)))
573   ;; Recurse on sub-parts
574   (let ((ctype (notmuch-split-content-type
575                 (downcase (plist-get part :content-type)))))
576     (cond ((equal (car ctype) "multipart")
577            (mapc (apply-partially #'notmuch-show--register-cids msg)
578                  (plist-get part :content)))
579           ((equal ctype '("message" "rfc822"))
580            (notmuch-show--register-cids
581             msg
582             (car (plist-get (car (plist-get part :content)) :body)))))))
583
584 (defun notmuch-show--get-cid-content (cid)
585   "Return a list (CID-content content-type) or nil.
586
587 This will only find parts from messages that have been inserted
588 into the current buffer.  CID must be a raw content ID, without
589 enclosing angle brackets, a cid: prefix, or URL encoding.  This
590 will return nil if the CID is unknown or cannot be retrieved."
591   (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
592     (when descriptor
593       (let* ((msg (car descriptor))
594              (part (cadr descriptor))
595              ;; Request caching for this content, as some messages
596              ;; reference the same cid: part many times (hundreds!).
597              (content (notmuch-get-bodypart-binary
598                        msg part notmuch-show-process-crypto 'cache))
599              (content-type (plist-get part :content-type)))
600         (list content content-type)))))
601
602 (defun notmuch-show-setup-w3m ()
603   "Instruct w3m how to retrieve content from a \"related\" part of a message."
604   (interactive)
605   (when (and (boundp 'w3m-cid-retrieve-function-alist)
606              (not (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)))
607     (push (cons 'notmuch-show-mode #'notmuch-show--cid-w3m-retrieve)
608           w3m-cid-retrieve-function-alist))
609   (setq mm-html-inhibit-images nil))
610
611 (defvar w3m-current-buffer) ;; From `w3m.el'.
612 (defun notmuch-show--cid-w3m-retrieve (url &rest args)
613   ;; url includes the cid: prefix and is URL encoded (see RFC 2392).
614   (let* ((cid (url-unhex-string (substring url 4)))
615          (content-and-type
616           (with-current-buffer w3m-current-buffer
617             (notmuch-show--get-cid-content cid))))
618     (when content-and-type
619       (insert (car content-and-type))
620       (cadr content-and-type))))
621
622 ;; MIME part renderers
623
624 (defun notmuch-show-multipart/*-to-list (part)
625   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
626           (plist-get part :content)))
627
628 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
629   (let ((chosen-type (car (notmuch-multipart/alternative-choose
630                            msg (notmuch-show-multipart/*-to-list part))))
631         (inner-parts (plist-get part :content))
632         (start (point)))
633     ;; This inserts all parts of the chosen type rather than just one,
634     ;; but it's not clear that this is the wrong thing to do - which
635     ;; should be chosen if there are more than one that match?
636     (mapc (lambda (inner-part)
637             (let* ((inner-type (plist-get inner-part :content-type))
638                    (hide (not (or notmuch-show-all-multipart/alternative-parts
639                                   (string= chosen-type inner-type)))))
640               (notmuch-show-insert-bodypart msg inner-part depth hide)))
641           inner-parts)
642
643     (when notmuch-show-indent-multipart
644       (indent-rigidly start (point) 1)))
645   t)
646
647 (defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
648   (let ((inner-parts (plist-get part :content))
649         (start (point)))
650     ;; Render the primary part.  FIXME: Support RFC 2387 Start header.
651     (notmuch-show-insert-bodypart msg (car inner-parts) depth)
652     ;; Add hidden buttons for the rest
653     (mapc (lambda (inner-part)
654             (notmuch-show-insert-bodypart msg inner-part depth t))
655           (cdr inner-parts))
656     (when notmuch-show-indent-multipart
657       (indent-rigidly start (point) 1)))
658   t)
659
660 (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
661   (when button
662     (button-put button 'face 'notmuch-crypto-part-header))
663   ;; Insert a button detailing the signature status.
664   (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
665                                           (notmuch-show-get-header :From msg))
666   (let ((inner-parts (plist-get part :content))
667         (start (point)))
668     ;; Show all of the parts.
669     (mapc (lambda (inner-part)
670             (notmuch-show-insert-bodypart msg inner-part depth))
671           inner-parts)
672     (when notmuch-show-indent-multipart
673       (indent-rigidly start (point) 1)))
674   t)
675
676 (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
677   (when button
678     (button-put button 'face 'notmuch-crypto-part-header))
679   ;; Insert a button detailing the encryption status.
680   (notmuch-crypto-insert-encstatus-button (car (plist-get part :encstatus)))
681   ;; Insert a button detailing the signature status.
682   (notmuch-crypto-insert-sigstatus-button (car (plist-get part :sigstatus))
683                                           (notmuch-show-get-header :From msg))
684   (let ((inner-parts (plist-get part :content))
685         (start (point)))
686     ;; Show all of the parts.
687     (mapc (lambda (inner-part)
688             (notmuch-show-insert-bodypart msg inner-part depth))
689           inner-parts)
690     (when notmuch-show-indent-multipart
691       (indent-rigidly start (point) 1)))
692   t)
693
694 (defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button)
695   t)
696
697 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)
698   (let ((inner-parts (plist-get part :content))
699         (start (point)))
700     ;; Show all of the parts.
701     (mapc (lambda (inner-part)
702             (notmuch-show-insert-bodypart msg inner-part depth))
703           inner-parts)
704     (when notmuch-show-indent-multipart
705       (indent-rigidly start (point) 1)))
706   t)
707
708 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth button)
709   (let* ((message (car (plist-get part :content)))
710          (body (car (plist-get message :body)))
711          (start (point)))
712     ;; Override `notmuch-message-headers' to force `From' to be
713     ;; displayed.
714     (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
715       (notmuch-show-insert-headers (plist-get message :headers)))
716     ;; Blank line after headers to be compatible with the normal
717     ;; message display.
718     (insert "\n")
719     ;; Show the body
720     (notmuch-show-insert-bodypart msg body depth)
721     (when notmuch-show-indent-multipart
722       (indent-rigidly start (point) 1)))
723   t)
724
725 (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button)
726   ;; For backward compatibility we want to apply the text/plain hook
727   ;; to the whole of the part including the part button if there is
728   ;; one.
729   (let ((start (if button
730                    (button-start button)
731                  (point))))
732     (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto))
733     (save-excursion
734       (save-restriction
735         (narrow-to-region start (point-max))
736         (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
737   t)
738
739 (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button)
740   (insert (with-temp-buffer
741             (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto))
742             ;; notmuch-get-bodypart-text does no newline conversion.
743             ;; Replace CRLF with LF before icalendar can use it.
744             (goto-char (point-min))
745             (while (re-search-forward "\r\n" nil t)
746               (replace-match "\n" nil nil))
747             (let ((file (make-temp-file "notmuch-ical"))
748                   result)
749               (unwind-protect
750                   (progn
751                     (unless (icalendar-import-buffer file t)
752                       (error "Icalendar import error. %s"
753                              "See *icalendar-errors* for more information"))
754                     (set-buffer (get-file-buffer file))
755                     (setq result (buffer-substring (point-min) (point-max)))
756                     (set-buffer-modified-p nil)
757                     (kill-buffer (current-buffer)))
758                 (delete-file file))
759               result)))
760   t)
761
762 ;; For backwards compatibility.
763 (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
764   (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
765
766 (when (version< emacs-version "25.3")
767   ;; https://bugs.gnu.org/28350
768   ;;
769   ;; For newer emacs, we fall back to notmuch-show-insert-part-*/*
770   ;; (see notmuch-show-handlers-for)
771   (defun notmuch-show-insert-part-text/enriched
772       (msg part content-type nth depth button)
773     ;; By requiring enriched below, we ensure that the function
774     ;; enriched-decode-display-prop is defined before it will be
775     ;; shadowed by the letf below. Otherwise the version in
776     ;; enriched.el may be loaded a bit later and used instead (for
777     ;; the first time).
778     (require 'enriched)
779     (cl-letf (((symbol-function 'enriched-decode-display-prop)
780                (lambda (start end &optional param) (list start end))))
781       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
782
783 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
784   ;; If we can deduce a MIME type from the filename of the attachment,
785   ;; we return that.
786   (and (plist-get part :filename)
787        (let ((extension (file-name-extension (plist-get part :filename))))
788          (and extension
789               (progn
790                 (mailcap-parse-mimetypes)
791                 (let ((mime-type (mailcap-extension-to-mime extension)))
792                   (and mime-type
793                        (not (string-equal mime-type "application/octet-stream"))
794                        mime-type)))))))
795
796 (defun notmuch-show-insert-part-text/html (msg part content-type nth depth button)
797   (if (eq mm-text-html-renderer 'shr)
798       ;; It's easier to drive shr ourselves than to work around the
799       ;; goofy things `mm-shr' does (like irreversibly taking over
800       ;; content ID handling).
801       ;; FIXME: If we block an image, offer a button to load external
802       ;; images.
803       (let ((shr-blocked-images notmuch-show-text/html-blocked-images))
804         (notmuch-show--insert-part-text/html-shr msg part))
805     ;; Otherwise, let message-mode do the heavy lifting
806     ;;
807     ;; w3m sets up a keymap which "leaks" outside the invisible region
808     ;; and causes strange effects in notmuch. We set
809     ;; mm-inline-text-html-with-w3m-keymap to nil to tell w3m not to
810     ;; set a keymap (so the normal notmuch-show-mode-map remains).
811     (let ((mm-inline-text-html-with-w3m-keymap nil)
812           ;; FIXME: If we block an image, offer a button to load external
813           ;; images.
814           (gnus-blocked-images notmuch-show-text/html-blocked-images))
815       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
816
817 ;; These functions are used by notmuch-show--insert-part-text/html-shr
818 (declare-function libxml-parse-html-region "xml.c")
819 (declare-function shr-insert-document "shr")
820
821 (defun notmuch-show--insert-part-text/html-shr (msg part)
822   ;; Make sure shr is loaded before we start let-binding its globals
823   (require 'shr)
824   (let ((dom (let ((process-crypto notmuch-show-process-crypto))
825                (with-temp-buffer
826                  (insert (notmuch-get-bodypart-text msg part process-crypto))
827                  (libxml-parse-html-region (point-min) (point-max)))))
828         (shr-content-function
829          (lambda (url)
830            ;; shr strips the "cid:" part of URL, but doesn't
831            ;; URL-decode it (see RFC 2392).
832            (let ((cid (url-unhex-string url)))
833              (car (notmuch-show--get-cid-content cid))))))
834     (shr-insert-document dom)
835     t))
836
837 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)
838   ;; This handler _must_ succeed - it is the handler of last resort.
839   (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
840   t)
841
842 ;; Functions for determining how to handle MIME parts.
843
844 (defun notmuch-show-handlers-for (content-type)
845   "Return a list of content handlers for a part of type CONTENT-TYPE."
846   (let (result)
847     (mapc (lambda (func)
848             (when (functionp func)
849               (push func result)))
850           ;; Reverse order of prefrence.
851           (list (intern (concat "notmuch-show-insert-part-*/*"))
852                 (intern (concat
853                          "notmuch-show-insert-part-"
854                          (car (notmuch-split-content-type content-type))
855                          "/*"))
856                 (intern (concat "notmuch-show-insert-part-" content-type))))
857     result))
858
859 ;; \f
860
861 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
862   ;; Run the handlers until one of them succeeds.
863   (cl-loop for handler in (notmuch-show-handlers-for content-type)
864            until (condition-case err
865                      (funcall handler msg part content-type nth depth button)
866                    ;; Specifying `debug' here lets the debugger run if
867                    ;; `debug-on-error' is non-nil.
868                    ((debug error)
869                     (insert "!!! Bodypart handler `" (prin1-to-string handler)
870                             "' threw an error:\n"
871                             "!!! " (error-message-string err) "\n")
872                     nil))))
873
874 (defun notmuch-show-create-part-overlays (button beg end)
875   "Add an overlay to the part between BEG and END."
876   ;; If there is no button (i.e., the part is text/plain and the first
877   ;; part) or if the part has no content then we don't make the part
878   ;; toggleable.
879   (when (and button (/= beg end))
880     (button-put button 'overlay (make-overlay beg end))
881     ;; Return true if we created an overlay.
882     t))
883
884 (defun notmuch-show-record-part-information (part beg end)
885   "Store PART as a text property from BEG to END."
886   ;; Record part information.  Since we already inserted subparts,
887   ;; don't override existing :notmuch-part properties.
888   (notmuch-map-text-property beg end :notmuch-part
889                              (lambda (v) (or v part)))
890   ;; Make :notmuch-part front sticky and rear non-sticky so it stays
891   ;; applied to the beginning of each line when we indent the
892   ;; message.  Since we're operating on arbitrary renderer output,
893   ;; watch out for sticky specs of t, which means all properties are
894   ;; front-sticky/rear-nonsticky.
895   (notmuch-map-text-property beg end 'front-sticky
896                              (lambda (v)
897                                (if (listp v)
898                                    (cl-pushnew :notmuch-part v)
899                                  v)))
900   (notmuch-map-text-property beg end 'rear-nonsticky
901                              (lambda (v)
902                                (if (listp v)
903                                    (cl-pushnew :notmuch-part v)
904                                  v))))
905
906 (defun notmuch-show-lazy-part (part-args button)
907   ;; Insert the lazy part after the button for the part. We would just
908   ;; move to the start of the new line following the button and insert
909   ;; the part but that point might have text properties (eg colours
910   ;; from a message header etc) so instead we start from the last
911   ;; character of the button by adding a newline and finish by
912   ;; removing the extra newline from the end of the part.
913   (save-excursion
914     (goto-char (button-end button))
915     (insert "\n")
916     (let* ((inhibit-read-only t)
917            ;; We need to use markers for the start and end of the part
918            ;; because the part insertion functions do not guarantee
919            ;; to leave point at the end of the part.
920            (part-beg (copy-marker (point) nil))
921            (part-end (copy-marker (point) t))
922            ;; We have to save the depth as we can't find the depth
923            ;; when narrowed.
924            (depth (notmuch-show-get-depth)))
925       (save-restriction
926         (narrow-to-region part-beg part-end)
927         (delete-region part-beg part-end)
928         (apply #'notmuch-show-insert-bodypart-internal part-args)
929         (indent-rigidly part-beg
930                         part-end
931                         (* notmuch-show-indent-messages-width depth)))
932       (goto-char part-end)
933       (delete-char 1)
934       (notmuch-show-record-part-information (cadr part-args)
935                                             (button-start button)
936                                             part-end)
937       ;; Create the overlay. If the lazy-part turned out to be empty/not
938       ;; showable this returns nil.
939       (notmuch-show-create-part-overlays button part-beg part-end))))
940
941 (defun notmuch-show-mime-type (part)
942   "Return the correct mime-type to use for PART."
943   (let ((content-type (downcase (plist-get part :content-type))))
944     (or (and (string= content-type "application/octet-stream")
945              (notmuch-show-get-mime-type-of-application/octet-stream part))
946         (and (string= content-type "inline patch")
947              "text/x-diff")
948         content-type)))
949
950 ;; The following variable can be overridden by let bindings.
951 (defvar notmuch-show-insert-header-p-function 'notmuch-show-insert-header-p
952   "Specify which function decides which part headers get inserted.
953
954 The function should take two parameters, PART and HIDE, and
955 should return non-NIL if a header button should be inserted for
956 this part.")
957
958 (defun notmuch-show-insert-header-p (part hide)
959   ;; Show all part buttons except for the first part if it is text/plain.
960   (let ((mime-type (notmuch-show-mime-type part)))
961     (not (and (string= mime-type "text/plain")
962               (<= (plist-get part :id) 1)))))
963
964 (defun notmuch-show-reply-insert-header-p-never (part hide)
965   nil)
966
967 (defun notmuch-show-reply-insert-header-p-trimmed (part hide)
968   (let ((mime-type (notmuch-show-mime-type part)))
969     (and (not (notmuch-match-content-type mime-type "multipart/*"))
970          (not hide))))
971
972 (defun notmuch-show-reply-insert-header-p-minimal (part hide)
973   (let ((mime-type (notmuch-show-mime-type part)))
974     (and (notmuch-match-content-type mime-type "text/*")
975          (not hide))))
976
977 (defun notmuch-show-insert-bodypart (msg part depth &optional hide)
978   "Insert the body part PART at depth DEPTH in the current thread.
979
980 HIDE determines whether to show or hide the part and the button
981 as follows: If HIDE is nil, show the part and the button. If HIDE
982 is t, hide the part initially and show the button."
983   (let* ((content-type (downcase (plist-get part :content-type)))
984          (mime-type (notmuch-show-mime-type part))
985          (nth (plist-get part :id))
986          (long (and (notmuch-match-content-type mime-type "text/*")
987                     (> notmuch-show-max-text-part-size 0)
988                     (> (length (plist-get part :content))
989                        notmuch-show-max-text-part-size)))
990          (beg (point))
991          ;; This default header-p function omits the part button for
992          ;; the first (or only) part if this is text/plain.
993          (button (and (funcall notmuch-show-insert-header-p-function part hide)
994                       (notmuch-show-insert-part-header
995                        nth mime-type content-type
996                        (plist-get part :filename))))
997          ;; Hide the part initially if HIDE is t, or if it is too long
998          ;; and we have a button to allow toggling.
999          (show-part (not (or (equal hide t)
1000                              (and long button))))
1001          (content-beg (point)))
1002     ;; Store the computed mime-type for later use (e.g. by attachment handlers).
1003     (plist-put part :computed-type mime-type)
1004     (if show-part
1005         (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
1006       (when button
1007         (button-put button :notmuch-lazy-part
1008                     (list msg part mime-type nth depth button))))
1009     ;; Some of the body part handlers leave point somewhere up in the
1010     ;; part, so we make sure that we're down at the end.
1011     (goto-char (point-max))
1012     ;; Ensure that the part ends with a carriage return.
1013     (unless (bolp)
1014       (insert "\n"))
1015     ;; We do not create the overlay for hidden (lazy) parts until
1016     ;; they are inserted.
1017     (if show-part
1018         (notmuch-show-create-part-overlays button content-beg (point))
1019       (save-excursion
1020         (notmuch-show-toggle-part-invisibility button)))
1021     (notmuch-show-record-part-information part beg (point))))
1022
1023 (defun notmuch-show-insert-body (msg body depth)
1024   "Insert the body BODY at depth DEPTH in the current thread."
1025   ;; Register all content IDs for this message.  According to RFC
1026   ;; 2392, content IDs are *global*, but it's okay if an MUA treats
1027   ;; them as only global within a message.
1028   (notmuch-show--register-cids msg (car body))
1029   (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
1030
1031 (defun notmuch-show-make-symbol (type)
1032   (make-symbol (concat "notmuch-show-" type)))
1033
1034 (defun notmuch-show-strip-re (string)
1035   (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
1036
1037 (defvar notmuch-show-previous-subject "")
1038 (make-variable-buffer-local 'notmuch-show-previous-subject)
1039
1040 (defun notmuch-show-insert-msg (msg depth)
1041   "Insert the message MSG at depth DEPTH in the current thread."
1042   (let* ((headers (plist-get msg :headers))
1043          ;; Indentation causes the buffer offset of the start/end
1044          ;; points to move, so we must use markers.
1045          message-start message-end
1046          content-start content-end
1047          headers-start headers-end
1048          (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
1049     (setq message-start (point-marker))
1050     (notmuch-show-insert-headerline headers
1051                                     (or (and notmuch-show-relative-dates
1052                                              (plist-get msg :date_relative))
1053                                         (plist-get headers :Date))
1054                                     (plist-get msg :tags) depth)
1055     (setq content-start (point-marker))
1056     ;; Set `headers-start' to point after the 'Subject:' header to be
1057     ;; compatible with the existing implementation. This just sets it
1058     ;; to after the first header.
1059     (notmuch-show-insert-headers headers)
1060     (save-excursion
1061       (goto-char content-start)
1062       ;; If the subject of this message is the same as that of the
1063       ;; previous message, don't display it when this message is
1064       ;; collapsed.
1065       (unless (string= notmuch-show-previous-subject bare-subject)
1066         (forward-line 1))
1067       (setq headers-start (point-marker)))
1068     (setq headers-end (point-marker))
1069     (setq notmuch-show-previous-subject bare-subject)
1070     ;; A blank line between the headers and the body.
1071     (insert "\n")
1072     (notmuch-show-insert-body msg (plist-get msg :body)
1073                               (if notmuch-show-indent-content depth 0))
1074     ;; Ensure that the body ends with a newline.
1075     (unless (bolp)
1076       (insert "\n"))
1077     (setq content-end (point-marker))
1078     ;; Indent according to the depth in the thread.
1079     (when notmuch-show-indent-content
1080       (indent-rigidly content-start
1081                       content-end
1082                       (* notmuch-show-indent-messages-width depth)))
1083     (setq message-end (point-max-marker))
1084     ;; Save the extents of this message over the whole text of the
1085     ;; message.
1086     (put-text-property message-start message-end
1087                        :notmuch-message-extent
1088                        (cons message-start message-end))
1089     ;; Create overlays used to control visibility
1090     (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
1091     (plist-put msg :message-overlay (make-overlay headers-start content-end))
1092     (plist-put msg :depth depth)
1093     ;; Save the properties for this message. Currently this saves the
1094     ;; entire message (augmented it with other stuff), which seems
1095     ;; like overkill. We might save a reduced subset (for example, not
1096     ;; the content).
1097     (notmuch-show-set-message-properties msg)
1098     ;; Set header visibility.
1099     (notmuch-show-headers-visible msg notmuch-message-headers-visible)
1100     ;; Message visibility depends on whether it matched the search
1101     ;; criteria.
1102     (notmuch-show-message-visible msg (and (plist-get msg :match)
1103                                            (not (plist-get msg :excluded))))))
1104
1105 (defun notmuch-show-toggle-process-crypto ()
1106   "Toggle the processing of cryptographic MIME parts."
1107   (interactive)
1108   (setq notmuch-show-process-crypto (not notmuch-show-process-crypto))
1109   (message (if notmuch-show-process-crypto
1110                "Processing cryptographic MIME parts."
1111              "Not processing cryptographic MIME parts."))
1112   (notmuch-show-refresh-view))
1113
1114 (defun notmuch-show-toggle-elide-non-matching ()
1115   "Toggle the display of non-matching messages."
1116   (interactive)
1117   (setq notmuch-show-elide-non-matching-messages
1118         (not notmuch-show-elide-non-matching-messages))
1119   (message (if notmuch-show-elide-non-matching-messages
1120                "Showing matching messages only."
1121              "Showing all messages."))
1122   (notmuch-show-refresh-view))
1123
1124 (defun notmuch-show-toggle-thread-indentation ()
1125   "Toggle the indentation of threads."
1126   (interactive)
1127   (setq notmuch-show-indent-content (not notmuch-show-indent-content))
1128   (message (if notmuch-show-indent-content
1129                "Content is indented."
1130              "Content is not indented."))
1131   (notmuch-show-refresh-view))
1132
1133 (defun notmuch-show-insert-tree (tree depth)
1134   "Insert the message tree TREE at depth DEPTH in the current thread."
1135   (let ((msg (car tree))
1136         (replies (cadr tree)))
1137     ;; We test whether there is a message or just some replies.
1138     (when msg
1139       (notmuch-show-insert-msg msg depth))
1140     (notmuch-show-insert-thread replies (1+ depth))))
1141
1142 (defun notmuch-show-insert-thread (thread depth)
1143   "Insert the thread THREAD at depth DEPTH in the current forest."
1144   (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
1145
1146 (defun notmuch-show-insert-forest (forest)
1147   "Insert the forest of threads FOREST."
1148   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
1149
1150 (defvar notmuch-id-regexp
1151   (concat
1152    ;; Match the id: prefix only if it begins a word (to disallow, for
1153    ;; example, matching cid:).
1154    "\\<id:\\("
1155    ;; If the term starts with a ", then parse Xapian's quoted boolean
1156    ;; term syntax, which allows for anything as long as embedded
1157    ;; double quotes escaped by doubling them.  We also disallow
1158    ;; newlines (which Xapian allows) to prevent runaway terms.
1159    "\"\\([^\"\n]\\|\"\"\\)*\""
1160    ;; Otherwise, parse Xapian's unquoted syntax, which goes up to the
1161    ;; next space or ).  We disallow [.,;] as the last character
1162    ;; because these are probably part of the surrounding text, and not
1163    ;; part of the id.  This doesn't match single character ids; meh.
1164    "\\|[^\"[:space:])][^[:space:])]*[^])[:space:].,:;?!]"
1165    "\\)")
1166   "The regexp used to match id: links in messages.")
1167
1168 (defvar notmuch-mid-regexp
1169   ;; goto-address-url-regexp matched cid: links, which have the same
1170   ;; grammar as the message ID part of a mid: link.  Construct the
1171   ;; regexp using the same technique as goto-address-url-regexp.
1172   (concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
1173   "The regexp used to match mid: links in messages.
1174
1175 See RFC 2392.")
1176
1177 (defun notmuch-show-buttonise-links (start end)
1178   "Buttonise URLs and mail addresses between START and END.
1179
1180 This also turns id:\"<message id>\"-parts and mid: links into
1181 buttons for a corresponding notmuch search."
1182   (goto-address-fontify-region start end)
1183   (save-excursion
1184     (let (links
1185           (beg-line (progn (goto-char start) (line-beginning-position)))
1186           (end-line (progn (goto-char end) (line-end-position))))
1187       (goto-char beg-line)
1188       (while (re-search-forward notmuch-id-regexp end-line t)
1189         (push (list (match-beginning 0) (match-end 0)
1190                     (match-string-no-properties 0)) links))
1191       (goto-char beg-line)
1192       (while (re-search-forward notmuch-mid-regexp end-line t)
1193         (let* ((mid-cid (match-string-no-properties 1))
1194                (mid (save-match-data
1195                       (string-match "^[^/]*" mid-cid)
1196                       (url-unhex-string (match-string 0 mid-cid)))))
1197           (push (list (match-beginning 0) (match-end 0)
1198                       (notmuch-id-to-query mid)) links)))
1199       (pcase-dolist (`(,beg ,end ,link) links)
1200         ;; Remove the overlay created by goto-address-mode
1201         (remove-overlays beg end 'goto-address t)
1202         (make-text-button beg end
1203                           :type 'notmuch-button-type
1204                           'action `(lambda (arg)
1205                                      (notmuch-show ,link current-prefix-arg))
1206                           'follow-link t
1207                           'help-echo "Mouse-1, RET: search for this message"
1208                           'face goto-address-mail-face)))))
1209
1210 ;;;###autoload
1211 (defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
1212   "Run \"notmuch show\" with the given thread ID and display results.
1213
1214 ELIDE-TOGGLE, if non-nil, inverts the default elide behavior.
1215
1216 The optional PARENT-BUFFER is the notmuch-search buffer from
1217 which this notmuch-show command was executed, (so that the
1218 next thread from that buffer can be show when done with this
1219 one).
1220
1221 The optional QUERY-CONTEXT is a notmuch search term. Only
1222 messages from the thread matching this search term are shown if
1223 non-nil.
1224
1225 The optional BUFFER-NAME provides the name of the buffer in
1226 which the message thread is shown. If it is nil (which occurs
1227 when the command is called interactively) the argument to the
1228 function is used.
1229
1230 Returns the buffer containing the messages, or NIL if no messages
1231 matched."
1232   (interactive "sNotmuch show: \nP")
1233   (let ((buffer-name (generate-new-buffer-name
1234                       (or buffer-name
1235                           (concat "*notmuch-" thread-id "*"))))
1236         ;; We override mm-inline-override-types to stop application/*
1237         ;; parts from being displayed unless the user has customized
1238         ;; it themselves.
1239         (mm-inline-override-types
1240          (if (equal mm-inline-override-types
1241                     (eval (car (get 'mm-inline-override-types 'standard-value))))
1242              (cons "application/*" mm-inline-override-types)
1243            mm-inline-override-types)))
1244     (switch-to-buffer (get-buffer-create buffer-name))
1245     ;; No need to track undo information for this buffer.
1246     (setq buffer-undo-list t)
1247     (notmuch-show-mode)
1248     ;; Set various buffer local variables to their appropriate initial
1249     ;; state. Do this after enabling `notmuch-show-mode' so that they
1250     ;; aren't wiped out.
1251     (setq notmuch-show-thread-id thread-id)
1252     (setq notmuch-show-parent-buffer parent-buffer)
1253     (setq notmuch-show-query-context
1254           (if (or (string= query-context "")
1255                   (string= query-context "*"))
1256               nil
1257             query-context))
1258     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
1259     ;; If `elide-toggle', invert the default value.
1260     (setq notmuch-show-elide-non-matching-messages
1261           (if elide-toggle
1262               (not notmuch-show-only-matching-messages)
1263             notmuch-show-only-matching-messages))
1264     (add-hook 'post-command-hook #'notmuch-show-command-hook nil t)
1265     (jit-lock-register #'notmuch-show-buttonise-links)
1266     (notmuch-tag-clear-cache)
1267     (let ((inhibit-read-only t))
1268       (if (notmuch-show--build-buffer)
1269           ;; Messages were inserted into the buffer.
1270           (current-buffer)
1271         ;; No messages were inserted - presumably none matched the
1272         ;; query.
1273         (kill-buffer (current-buffer))
1274         (ding)
1275         (message "No messages matched the query!")
1276         nil))))
1277
1278 (defun notmuch-show--build-queries (thread context)
1279   "Return a list of queries to try for this search.
1280
1281 THREAD and CONTEXT are both strings, though CONTEXT may be nil.
1282 When CONTEXT is not nil, the first query is the conjunction of it
1283 and THREAD.  The next query is THREAD alone, and serves as a
1284 fallback if the prior matches no messages."
1285   (let (queries)
1286     (push (list thread) queries)
1287     (when context
1288       (push (list thread "and (" context ")") queries))
1289     queries))
1290
1291 (defun notmuch-show--build-buffer (&optional state)
1292   "Display messages matching the current buffer context.
1293
1294 Apply the previously saved STATE if supplied, otherwise show the
1295 first relevant message.
1296
1297 If no messages match the query return NIL."
1298   (let* ((cli-args (cons "--exclude=false"
1299                          (and notmuch-show-elide-non-matching-messages
1300                               (list "--entire-thread=false"))))
1301          (queries (notmuch-show--build-queries
1302                    notmuch-show-thread-id notmuch-show-query-context))
1303          (forest nil)
1304          ;; Must be reset every time we are going to start inserting
1305          ;; messages into the buffer.
1306          (notmuch-show-previous-subject ""))
1307     ;; Use results from the first query that returns some.
1308     (while (and (not forest) queries)
1309       (setq forest (notmuch-query-get-threads
1310                     (append cli-args (list "'") (car queries) (list "'"))))
1311       (setq queries (cdr queries)))
1312     (when forest
1313       (notmuch-show-insert-forest forest)
1314       ;; Store the original tags for each message so that we can
1315       ;; display changes.
1316       (notmuch-show-mapc
1317        (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
1318       ;; Set the header line to the subject of the first message.
1319       (setq header-line-format
1320             (replace-regexp-in-string "%" "%%"
1321                                       (notmuch-sanitize
1322                                        (notmuch-show-strip-re
1323                                         (notmuch-show-get-subject)))))
1324       (run-hooks 'notmuch-show-hook)
1325       (if state
1326           (notmuch-show-apply-state state)
1327         ;; With no state to apply, just go to the first message.
1328         (notmuch-show-goto-first-wanted-message)))
1329     ;; Report back to the caller whether any messages matched.
1330     forest))
1331
1332 (defun notmuch-show-capture-state ()
1333   "Capture the state of the current buffer.
1334
1335 This includes:
1336  - the list of open messages,
1337  - the combination of current message id with/for each visible window."
1338   (let* ((win-list (get-buffer-window-list (current-buffer) nil t))
1339          (win-id-combo (mapcar (lambda (win)
1340                                  (with-selected-window win
1341                                    (list win (notmuch-show-get-message-id))))
1342                                win-list)))
1343     (list win-id-combo (notmuch-show-get-message-ids-for-open-messages))))
1344
1345 (defun notmuch-show-get-query ()
1346   "Return the current query in this show buffer."
1347   (if notmuch-show-query-context
1348       (concat notmuch-show-thread-id
1349               " and ("
1350               notmuch-show-query-context
1351               ")")
1352     notmuch-show-thread-id))
1353
1354 (defun notmuch-show-goto-message (msg-id)
1355   "Go to message with msg-id."
1356   (goto-char (point-min))
1357   (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
1358                    return t
1359                    until (not (notmuch-show-goto-message-next)))
1360     (goto-char (point-min))
1361     (message "Message-id not found."))
1362   (notmuch-show-message-adjust))
1363
1364 (defun notmuch-show-apply-state (state)
1365   "Apply STATE to the current buffer.
1366
1367 This includes:
1368  - opening the messages previously opened,
1369  - closing all other messages,
1370  - moving to the correct current message in every displayed window."
1371   (let ((win-msg-alist (car state))
1372         (open (cadr state)))
1373     ;; Open those that were open.
1374     (goto-char (point-min))
1375     (cl-loop do (notmuch-show-message-visible
1376                  (notmuch-show-get-message-properties)
1377                  (member (notmuch-show-get-message-id) open))
1378              until (not (notmuch-show-goto-message-next)))
1379     (dolist (win-msg-pair win-msg-alist)
1380       (with-selected-window (car win-msg-pair)
1381         ;; Go to the previously open message in this window
1382         (notmuch-show-goto-message (cadr win-msg-pair))))))
1383
1384 (defun notmuch-show-refresh-view (&optional reset-state)
1385   "Refresh the current view.
1386
1387 Refreshes the current view, observing changes in display
1388 preferences. If invoked with a prefix argument (or RESET-STATE is
1389 non-nil) then the state of the buffer (open/closed messages) is
1390 reset based on the original query."
1391   (interactive "P")
1392   (let ((inhibit-read-only t)
1393         (state (unless reset-state
1394                  (notmuch-show-capture-state))))
1395     ;; `erase-buffer' does not seem to remove overlays, which can lead
1396     ;; to weird effects such as remaining images, so remove them
1397     ;; manually.
1398     (remove-overlays)
1399     (erase-buffer)
1400     (unless (notmuch-show--build-buffer state)
1401       ;; No messages were inserted.
1402       (kill-buffer (current-buffer))
1403       (ding)
1404       (message "Refreshing the buffer resulted in no messages!"))))
1405
1406 (defvar notmuch-show-stash-map
1407   (let ((map (make-sparse-keymap)))
1408     (define-key map "c" 'notmuch-show-stash-cc)
1409     (define-key map "d" 'notmuch-show-stash-date)
1410     (define-key map "F" 'notmuch-show-stash-filename)
1411     (define-key map "f" 'notmuch-show-stash-from)
1412     (define-key map "i" 'notmuch-show-stash-message-id)
1413     (define-key map "I" 'notmuch-show-stash-message-id-stripped)
1414     (define-key map "s" 'notmuch-show-stash-subject)
1415     (define-key map "T" 'notmuch-show-stash-tags)
1416     (define-key map "t" 'notmuch-show-stash-to)
1417     (define-key map "l" 'notmuch-show-stash-mlarchive-link)
1418     (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
1419     (define-key map "G" 'notmuch-show-stash-git-send-email)
1420     (define-key map "?" 'notmuch-subkeymap-help)
1421     map)
1422   "Submap for stash commands.")
1423 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
1424
1425 (defvar notmuch-show-part-map
1426   (let ((map (make-sparse-keymap)))
1427     (define-key map "s" 'notmuch-show-save-part)
1428     (define-key map "v" 'notmuch-show-view-part)
1429     (define-key map "o" 'notmuch-show-interactively-view-part)
1430     (define-key map "|" 'notmuch-show-pipe-part)
1431     (define-key map "m" 'notmuch-show-choose-mime-of-part)
1432     (define-key map "?" 'notmuch-subkeymap-help)
1433     map)
1434   "Submap for part commands.")
1435 (fset 'notmuch-show-part-map notmuch-show-part-map)
1436
1437 (defvar notmuch-show-mode-map
1438   (let ((map (make-sparse-keymap)))
1439     (set-keymap-parent map notmuch-common-keymap)
1440     (define-key map "Z" 'notmuch-tree-from-show-current-query)
1441     (define-key map "U" 'notmuch-unthreaded-from-show-current-query)
1442     (define-key map (kbd "<C-tab>") 'widget-backward)
1443     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
1444     (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
1445     (define-key map (kbd "TAB") 'notmuch-show-next-button)
1446     (define-key map "f" 'notmuch-show-forward-message)
1447     (define-key map "F" 'notmuch-show-forward-open-messages)
1448     (define-key map "b" 'notmuch-show-resend-message)
1449     (define-key map "l" 'notmuch-show-filter-thread)
1450     (define-key map "r" 'notmuch-show-reply-sender)
1451     (define-key map "R" 'notmuch-show-reply)
1452     (define-key map "|" 'notmuch-show-pipe-message)
1453     (define-key map "w" 'notmuch-show-save-attachments)
1454     (define-key map "V" 'notmuch-show-view-raw-message)
1455     (define-key map "e" 'notmuch-show-resume-message)
1456     (define-key map "c" 'notmuch-show-stash-map)
1457     (define-key map "h" 'notmuch-show-toggle-visibility-headers)
1458     (define-key map "k" 'notmuch-tag-jump)
1459     (define-key map "*" 'notmuch-show-tag-all)
1460     (define-key map "-" 'notmuch-show-remove-tag)
1461     (define-key map "+" 'notmuch-show-add-tag)
1462     (define-key map "X" 'notmuch-show-archive-thread-then-exit)
1463     (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)
1464     (define-key map "A" 'notmuch-show-archive-thread-then-next)
1465     (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)
1466     (define-key map "N" 'notmuch-show-next-message)
1467     (define-key map "P" 'notmuch-show-previous-message)
1468     (define-key map "n" 'notmuch-show-next-open-message)
1469     (define-key map "p" 'notmuch-show-previous-open-message)
1470     (define-key map (kbd "M-n") 'notmuch-show-next-thread-show)
1471     (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show)
1472     (define-key map (kbd "DEL") 'notmuch-show-rewind)
1473     (define-key map " " 'notmuch-show-advance-and-archive)
1474     (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
1475     (define-key map (kbd "RET") 'notmuch-show-toggle-message)
1476     (define-key map "#" 'notmuch-show-print-message)
1477     (define-key map "!" 'notmuch-show-toggle-elide-non-matching)
1478     (define-key map "$" 'notmuch-show-toggle-process-crypto)
1479     (define-key map "<" 'notmuch-show-toggle-thread-indentation)
1480     (define-key map "t" 'toggle-truncate-lines)
1481     (define-key map "." 'notmuch-show-part-map)
1482     (define-key map "B" 'notmuch-show-browse-urls)
1483     map)
1484   "Keymap for \"notmuch show\" buffers.")
1485 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
1486
1487 (define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"
1488   "Major mode for viewing a thread with notmuch.
1489
1490 This buffer contains the results of the \"notmuch show\" command
1491 for displaying a single thread of email from your email archives.
1492
1493 By default, various components of email messages, (citations,
1494 signatures, already-read messages), are hidden. You can make
1495 these parts visible by clicking with the mouse button or by
1496 pressing RET after positioning the cursor on a hidden part, (for
1497 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
1498
1499 Reading the thread sequentially is well-supported by pressing
1500 \\[notmuch-show-advance-and-archive]. This will scroll the current message (if necessary), advance
1501 to the next message, or advance to the next thread (if already on
1502 the last message of a thread).
1503
1504 Other commands are available to read or manipulate the thread
1505 more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages
1506 without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread
1507 without scrolling through with \\[notmuch-show-advance-and-archive]).
1508
1509 You can add or remove arbitrary tags from the current message with
1510 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
1511
1512 All currently available key bindings:
1513
1514 \\{notmuch-show-mode-map}"
1515   (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
1516   (setq buffer-read-only t)
1517   (setq truncate-lines t)
1518   (setq imenu-prev-index-position-function
1519         #'notmuch-show-imenu-prev-index-position-function)
1520   (setq imenu-extract-index-name-function
1521         #'notmuch-show-imenu-extract-index-name-function))
1522
1523 (defun notmuch-tree-from-show-current-query ()
1524   "Call notmuch tree with the current query."
1525   (interactive)
1526   (notmuch-tree notmuch-show-thread-id
1527                 notmuch-show-query-context
1528                 (notmuch-show-get-message-id)))
1529
1530 (defun notmuch-unthreaded-from-show-current-query ()
1531   "Call notmuch unthreaded with the current query."
1532   (interactive)
1533   (notmuch-unthreaded notmuch-show-thread-id
1534                       notmuch-show-query-context
1535                       (notmuch-show-get-message-id)))
1536
1537 (defun notmuch-show-move-to-message-top ()
1538   (goto-char (notmuch-show-message-top)))
1539
1540 (defun notmuch-show-move-to-message-bottom ()
1541   (goto-char (notmuch-show-message-bottom)))
1542
1543 (defun notmuch-show-message-adjust ()
1544   (recenter 0))
1545
1546 ;; Movement related functions.
1547
1548 ;; There's some strangeness here where a text property applied to a
1549 ;; region a->b is not found when point is at b. We walk backwards
1550 ;; until finding the property.
1551 (defun notmuch-show-message-extent ()
1552   "Return a cons cell containing the start and end buffer offset
1553 of the current message."
1554   (let (r)
1555     (save-excursion
1556       (while (not (setq r (get-text-property (point) :notmuch-message-extent)))
1557         (backward-char)))
1558     r))
1559
1560 (defun notmuch-show-message-top ()
1561   (car (notmuch-show-message-extent)))
1562
1563 (defun notmuch-show-message-bottom ()
1564   (cdr (notmuch-show-message-extent)))
1565
1566 (defun notmuch-show-goto-message-next ()
1567   (let ((start (point)))
1568     (notmuch-show-move-to-message-bottom)
1569     (if (not (eobp))
1570         t
1571       (goto-char start)
1572       nil)))
1573
1574 (defun notmuch-show-goto-message-previous ()
1575   (notmuch-show-move-to-message-top)
1576   (if (bobp)
1577       nil
1578     (backward-char)
1579     (notmuch-show-move-to-message-top)
1580     t))
1581
1582 (defun notmuch-show-mapc (function)
1583   "Iterate through all messages in the current thread with
1584 `notmuch-show-goto-message-next' and call FUNCTION for side
1585 effects."
1586   (save-excursion
1587     (goto-char (point-min))
1588     (cl-loop do (funcall function)
1589              while (notmuch-show-goto-message-next))))
1590
1591 ;; Functions relating to the visibility of messages and their
1592 ;; components.
1593
1594 (defun notmuch-show-message-visible (props visible-p)
1595   (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
1596   (notmuch-show-set-prop :message-visible visible-p props))
1597
1598 (defun notmuch-show-headers-visible (props visible-p)
1599   (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
1600   (notmuch-show-set-prop :headers-visible visible-p props))
1601
1602 ;; Functions for setting and getting attributes of the current
1603 ;; message.
1604
1605 (defun notmuch-show-set-message-properties (props)
1606   (save-excursion
1607     (notmuch-show-move-to-message-top)
1608     (put-text-property (point) (+ (point) 1)
1609                        :notmuch-message-properties props)))
1610
1611 (defun notmuch-show-get-message-properties ()
1612   "Return the properties of the current message as a plist.
1613
1614 Some useful entries are:
1615 :headers - Property list containing the headers :Date, :Subject, :From, etc.
1616 :body - Body of the message
1617 :tags - Tags for this message"
1618   (save-excursion
1619     (notmuch-show-move-to-message-top)
1620     (get-text-property (point) :notmuch-message-properties)))
1621
1622 (defun notmuch-show-get-part-properties ()
1623   "Return the properties of the innermost part containing point.
1624
1625 This is the part property list retrieved from the CLI.  Signals
1626 an error if there is no part containing point."
1627   (or (get-text-property (point) :notmuch-part)
1628       (error "No message part here")))
1629
1630 (defun notmuch-show-set-prop (prop val &optional props)
1631   (let ((inhibit-read-only t)
1632         (props (or props
1633                    (notmuch-show-get-message-properties))))
1634     (plist-put props prop val)
1635     (notmuch-show-set-message-properties props)))
1636
1637 (defun notmuch-show-get-prop (prop &optional props)
1638   "Get property PROP from current message in show or tree mode.
1639
1640 It gets property PROP from PROPS or, if PROPS is nil, the current
1641 message in either tree or show. This means that several utility
1642 functions in notmuch-show can be used directly by notmuch-tree as
1643 they just need the correct message properties."
1644   (let ((props (or props
1645                    (cond ((eq major-mode 'notmuch-show-mode)
1646                           (notmuch-show-get-message-properties))
1647                          ((eq major-mode 'notmuch-tree-mode)
1648                           (notmuch-tree-get-message-properties))
1649                          (t nil)))))
1650     (plist-get props prop)))
1651
1652 (defun notmuch-show-get-message-id (&optional bare)
1653   "Return an id: query for the Message-Id of the current message.
1654
1655 If optional argument BARE is non-nil, return
1656 the Message-Id without id: prefix and escaping."
1657   (if bare
1658       (notmuch-show-get-prop :id)
1659     (notmuch-id-to-query (notmuch-show-get-prop :id))))
1660
1661 (defun notmuch-show-get-messages-ids ()
1662   "Return all id: queries of messages in the current thread."
1663   (let ((message-ids))
1664     (notmuch-show-mapc
1665      (lambda () (push (notmuch-show-get-message-id) message-ids)))
1666     message-ids))
1667
1668 (defun notmuch-show-get-messages-ids-search ()
1669   "Return a search string for all message ids of messages in the
1670 current thread."
1671   (mapconcat 'identity (notmuch-show-get-messages-ids) " or "))
1672
1673 ;; dme: Would it make sense to use a macro for many of these?
1674
1675 ;; XXX TODO figure out what to do about multiple filenames
1676 (defun notmuch-show-get-filename ()
1677   "Return the filename of the current message."
1678   (car (notmuch-show-get-prop :filename)))
1679
1680 (defun notmuch-show-get-header (header &optional props)
1681   "Return the named header of the current message, if any."
1682   (plist-get (notmuch-show-get-prop :headers props) header))
1683
1684 (defun notmuch-show-get-cc ()
1685   (notmuch-show-get-header :Cc))
1686
1687 (defun notmuch-show-get-date ()
1688   (notmuch-show-get-header :Date))
1689
1690 (defun notmuch-show-get-timestamp ()
1691   (notmuch-show-get-prop :timestamp))
1692
1693 (defun notmuch-show-get-from ()
1694   (notmuch-show-get-header :From))
1695
1696 (defun notmuch-show-get-subject ()
1697   (notmuch-show-get-header :Subject))
1698
1699 (defun notmuch-show-get-to ()
1700   (notmuch-show-get-header :To))
1701
1702 (defun notmuch-show-get-depth ()
1703   (notmuch-show-get-prop :depth))
1704
1705 (defun notmuch-show-set-tags (tags)
1706   "Set the tags of the current message."
1707   (notmuch-show-set-prop :tags tags)
1708   (notmuch-show-update-tags tags))
1709
1710 (defun notmuch-show-get-tags ()
1711   "Return the tags of the current message."
1712   (notmuch-show-get-prop :tags))
1713
1714 (defun notmuch-show-message-visible-p ()
1715   "Is the current message visible?"
1716   (notmuch-show-get-prop :message-visible))
1717
1718 (defun notmuch-show-headers-visible-p ()
1719   "Are the headers of the current message visible?"
1720   (notmuch-show-get-prop :headers-visible))
1721
1722 (put 'notmuch-show-mark-read 'notmuch-prefix-doc
1723      "Mark the current message as unread.")
1724 (defun notmuch-show-mark-read (&optional unread)
1725   "Mark the current message as read.
1726
1727 Mark the current message as read by applying the tag changes in
1728 `notmuch-show-mark-read-tags' to it (remove the \"unread\" tag by
1729 default). If a prefix argument is given, the message will be
1730 marked as unread, i.e. the tag changes in
1731 `notmuch-show-mark-read-tags' will be reversed."
1732   (interactive "P")
1733   (when notmuch-show-mark-read-tags
1734     (apply 'notmuch-show-tag-message
1735            (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
1736
1737 (defun notmuch-show-seen-current-message (start end)
1738   "Mark the current message read if it is open.
1739
1740 We only mark it read once: if it is changed back then that is a
1741 user decision and we should not override it."
1742   (when (and (notmuch-show-message-visible-p)
1743              (not (notmuch-show-get-prop :seen)))
1744     (notmuch-show-mark-read)
1745     (notmuch-show-set-prop :seen t)))
1746
1747 (defvar notmuch-show--seen-has-errored nil)
1748 (make-variable-buffer-local 'notmuch-show--seen-has-errored)
1749
1750 (defun notmuch-show-command-hook ()
1751   (when (eq major-mode 'notmuch-show-mode)
1752     ;; We need to redisplay to get window-start and window-end correct.
1753     (redisplay)
1754     (save-excursion
1755       (condition-case err
1756           (funcall notmuch-show-mark-read-function (window-start) (window-end))
1757         ((debug error)
1758          (unless notmuch-show--seen-has-errored
1759            (setq notmuch-show--seen-has-errored 't)
1760            (setq header-line-format
1761                  (concat header-line-format
1762                          (propertize
1763                           "  [some mark read tag changes may have failed]"
1764                           'face font-lock-warning-face)))))))))
1765
1766 (defun notmuch-show-filter-thread (query)
1767   "Filter or LIMIT the current thread based on a new query string.
1768
1769 Reshows the current thread with matches defined by the new query-string."
1770   (interactive (list (notmuch-read-query "Filter thread: ")))
1771   (let ((msg-id (notmuch-show-get-message-id)))
1772     (setq notmuch-show-query-context (if (string= query "") nil query))
1773     (notmuch-show-refresh-view t)
1774     (notmuch-show-goto-message msg-id)))
1775
1776 ;; Functions for getting attributes of several messages in the current
1777 ;; thread.
1778
1779 (defun notmuch-show-get-message-ids-for-open-messages ()
1780   "Return a list of all id: queries for open messages in the current thread."
1781   (save-excursion
1782     (let (message-ids done)
1783       (goto-char (point-min))
1784       (while (not done)
1785         (when (notmuch-show-message-visible-p)
1786           (setq message-ids
1787                 (append message-ids (list (notmuch-show-get-message-id)))))
1788         (setq done (not (notmuch-show-goto-message-next))))
1789       message-ids)))
1790
1791 ;; Commands typically bound to keys.
1792
1793 (defun notmuch-show-advance ()
1794   "Advance through thread.
1795
1796 If the current message in the thread is not yet fully visible,
1797 scroll by a near screenful to read more of the message.
1798
1799 Otherwise, (the end of the current message is already within the
1800 current window), advance to the next open message."
1801   (interactive)
1802   (let* ((end-of-this-message (notmuch-show-message-bottom))
1803          (visible-end-of-this-message (1- end-of-this-message))
1804          (ret nil))
1805     (while (invisible-p visible-end-of-this-message)
1806       (setq visible-end-of-this-message
1807             (max (point-min)
1808                  (1- (previous-single-char-property-change
1809                       visible-end-of-this-message 'invisible)))))
1810     (cond
1811      ;; Ideally we would test `end-of-this-message' against the result
1812      ;; of `window-end', but that doesn't account for the fact that
1813      ;; the end of the message might be hidden.
1814      ((and visible-end-of-this-message
1815            (> visible-end-of-this-message (window-end)))
1816       ;; The bottom of this message is not visible - scroll.
1817       (scroll-up nil))
1818      ((not (= end-of-this-message (point-max)))
1819       ;; This is not the last message - move to the next visible one.
1820       (notmuch-show-next-open-message))
1821      ((not (= (point) (point-max)))
1822       ;; This is the last message, but the cursor is not at the end of
1823       ;; the buffer. Move it there.
1824       (goto-char (point-max)))
1825      (t
1826       ;; This is the last message - change the return value
1827       (setq ret t)))
1828     ret))
1829
1830 (defun notmuch-show-advance-and-archive ()
1831   "Advance through thread and archive.
1832
1833 This command is intended to be one of the simplest ways to
1834 process a thread of email. It works exactly like
1835 notmuch-show-advance, in that it scrolls through messages in a
1836 show buffer, except that when it gets to the end of the buffer it
1837 archives the entire current thread, (apply changes in
1838 `notmuch-archive-tags'), kills the buffer, and displays the next
1839 thread from the search from which this thread was originally
1840 shown."
1841   (interactive)
1842   (when (notmuch-show-advance)
1843     (notmuch-show-archive-thread-then-next)))
1844
1845 (defun notmuch-show-rewind ()
1846   "Backup through the thread (reverse scrolling compared to \
1847 \\[notmuch-show-advance-and-archive]).
1848
1849 Specifically, if the beginning of the previous email is fewer
1850 than `window-height' lines from the current point, move to it
1851 just like `notmuch-show-previous-message'.
1852
1853 Otherwise, just scroll down a screenful of the current message.
1854
1855 This command does not modify any message tags, (it does not undo
1856 any effects from previous calls to
1857 `notmuch-show-advance-and-archive'."
1858   (interactive)
1859   (let ((start-of-message (notmuch-show-message-top))
1860         (start-of-window (window-start)))
1861     (cond
1862      ;; Either this message is properly aligned with the start of the
1863      ;; window or the start of this message is not visible on the
1864      ;; screen - scroll.
1865      ((or (= start-of-message start-of-window)
1866           (< start-of-message start-of-window))
1867       (scroll-down)
1868       ;; If a small number of lines from the previous message are
1869       ;; visible, realign so that the top of the current message is at
1870       ;; the top of the screen.
1871       (when (<= (count-screen-lines (window-start) start-of-message)
1872                 next-screen-context-lines)
1873         (goto-char (notmuch-show-message-top))
1874         (notmuch-show-message-adjust))
1875       ;; Move to the top left of the window.
1876       (goto-char (window-start)))
1877      (t
1878       ;; Move to the previous message.
1879       (notmuch-show-previous-message)))))
1880
1881 (put 'notmuch-show-reply 'notmuch-prefix-doc "... and prompt for sender")
1882 (defun notmuch-show-reply (&optional prompt-for-sender)
1883   "Reply to the sender and all recipients of the current message."
1884   (interactive "P")
1885   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t))
1886
1887 (put 'notmuch-show-reply-sender 'notmuch-prefix-doc "... and prompt for sender")
1888 (defun notmuch-show-reply-sender (&optional prompt-for-sender)
1889   "Reply to the sender of the current message."
1890   (interactive "P")
1891   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil))
1892
1893 (put 'notmuch-show-forward-message 'notmuch-prefix-doc
1894      "... and prompt for sender")
1895 (defun notmuch-show-forward-message (&optional prompt-for-sender)
1896   "Forward the current message."
1897   (interactive "P")
1898   (notmuch-mua-new-forward-messages (list (notmuch-show-get-message-id))
1899                                     prompt-for-sender))
1900
1901 (put 'notmuch-show-forward-open-messages 'notmuch-prefix-doc
1902      "... and prompt for sender")
1903 (defun notmuch-show-forward-open-messages (&optional prompt-for-sender)
1904   "Forward the currently open messages."
1905   (interactive "P")
1906   (let ((open-messages (notmuch-show-get-message-ids-for-open-messages)))
1907     (unless open-messages
1908       (error "No open messages to forward."))
1909     (notmuch-mua-new-forward-messages open-messages prompt-for-sender)))
1910
1911 (defun notmuch-show-resend-message (addresses)
1912   "Resend the current message."
1913   (interactive (list (notmuch-address-from-minibuffer "Resend to: ")))
1914   (when (y-or-n-p (concat "Confirm resend to " addresses " "))
1915     (notmuch-show-view-raw-message)
1916     (message-resend addresses)
1917     (notmuch-bury-or-kill-this-buffer)))
1918
1919 (defun notmuch-show-next-message (&optional pop-at-end)
1920   "Show the next message.
1921
1922 If a prefix argument is given and this is the last message in the
1923 thread, navigate to the next thread in the parent search buffer."
1924   (interactive "P")
1925   (if (notmuch-show-goto-message-next)
1926       (notmuch-show-message-adjust)
1927     (if pop-at-end
1928         (notmuch-show-next-thread)
1929       (goto-char (point-max)))))
1930
1931 (defun notmuch-show-previous-message ()
1932   "Show the previous message or the start of the current message."
1933   (interactive)
1934   (if (= (point) (notmuch-show-message-top))
1935       (notmuch-show-goto-message-previous)
1936     (notmuch-show-move-to-message-top))
1937   (notmuch-show-message-adjust))
1938
1939 (defun notmuch-show-next-open-message (&optional pop-at-end)
1940   "Show the next open message.
1941
1942 If a prefix argument is given and this is the last open message
1943 in the thread, navigate to the next thread in the parent search
1944 buffer. Return t if there was a next open message in the thread
1945 to show, nil otherwise."
1946   (interactive "P")
1947   (let (r)
1948     (while (and (setq r (notmuch-show-goto-message-next))
1949                 (not (notmuch-show-message-visible-p))))
1950     (if r
1951         (notmuch-show-message-adjust)
1952       (if pop-at-end
1953           (notmuch-show-next-thread)
1954         (goto-char (point-max))))
1955     r))
1956
1957 (defun notmuch-show-next-matching-message ()
1958   "Show the next matching message."
1959   (interactive)
1960   (let (r)
1961     (while (and (setq r (notmuch-show-goto-message-next))
1962                 (not (notmuch-show-get-prop :match))))
1963     (if r
1964         (notmuch-show-message-adjust)
1965       (goto-char (point-max)))))
1966
1967 (defun notmuch-show-open-if-matched ()
1968   "Open a message if it is matched (whether or not excluded)."
1969   (let ((props (notmuch-show-get-message-properties)))
1970     (notmuch-show-message-visible props (plist-get props :match))))
1971
1972 (defun notmuch-show-goto-first-wanted-message ()
1973   "Move to the first open message and mark it read."
1974   (goto-char (point-min))
1975   (unless (notmuch-show-message-visible-p)
1976     (notmuch-show-next-open-message))
1977   (when (eobp)
1978     ;; There are no matched non-excluded messages so open all matched
1979     ;; (necessarily excluded) messages and go to the first.
1980     (notmuch-show-mapc 'notmuch-show-open-if-matched)
1981     (force-window-update)
1982     (goto-char (point-min))
1983     (unless (notmuch-show-message-visible-p)
1984       (notmuch-show-next-open-message))))
1985
1986 (defun notmuch-show-previous-open-message ()
1987   "Show the previous open message."
1988   (interactive)
1989   (while (and (if (= (point) (notmuch-show-message-top))
1990                   (notmuch-show-goto-message-previous)
1991                 (notmuch-show-move-to-message-top))
1992               (not (notmuch-show-message-visible-p))))
1993   (notmuch-show-message-adjust))
1994
1995 (defun notmuch-show-view-raw-message ()
1996   "View the original source of the current message."
1997   (interactive)
1998   (let* ((id (notmuch-show-get-message-id))
1999          (buf (get-buffer-create (concat "*notmuch-raw-" id "*")))
2000          (inhibit-read-only t))
2001     (switch-to-buffer buf)
2002     (erase-buffer)
2003     (let ((coding-system-for-read 'no-conversion))
2004       (call-process notmuch-command nil t nil "show" "--format=raw" id))
2005     (goto-char (point-min))
2006     (set-buffer-modified-p nil)
2007     (setq buffer-read-only t)
2008     (view-buffer buf 'kill-buffer-if-not-modified)))
2009
2010 (defun notmuch-show-resume-message ()
2011   "Resume EDITING the current draft message."
2012   (interactive)
2013   (notmuch-draft-resume (notmuch-show-get-message-id)))
2014
2015 (put 'notmuch-show-pipe-message 'notmuch-doc
2016      "Pipe the contents of the current message to a command.")
2017 (put 'notmuch-show-pipe-message 'notmuch-prefix-doc
2018      "Pipe the thread as an mbox to a command.")
2019 (defun notmuch-show-pipe-message (entire-thread command)
2020   "Pipe the contents of the current message (or thread) to COMMAND.
2021
2022 COMMAND will be executed with the raw contents of the current
2023 email message as stdin. Anything printed by the command to stdout
2024 or stderr will appear in the *notmuch-pipe* buffer.
2025
2026 If ENTIRE-THREAD is non-nil (or when invoked with a prefix
2027 argument), COMMAND will receive all open messages in the current
2028 thread (formatted as an mbox) rather than only the current
2029 message."
2030   (interactive (let ((query-string (if current-prefix-arg
2031                                        "Pipe all open messages to command: "
2032                                      "Pipe message to command: ")))
2033                  (list current-prefix-arg (read-string query-string))))
2034   (let (shell-command)
2035     (if entire-thread
2036         (setq shell-command
2037               (concat notmuch-command " show --format=mbox --exclude=false "
2038                       (shell-quote-argument
2039                        (mapconcat 'identity
2040                                   (notmuch-show-get-message-ids-for-open-messages)
2041                                   " OR "))
2042                       " | " command))
2043       (setq shell-command
2044             (concat notmuch-command " show --format=raw "
2045                     (shell-quote-argument (notmuch-show-get-message-id))
2046                     " | " command)))
2047     (let ((cwd default-directory)
2048           (buf (get-buffer-create (concat "*notmuch-pipe*"))))
2049       (with-current-buffer buf
2050         (setq buffer-read-only nil)
2051         (erase-buffer)
2052         ;; Use the originating buffer's working directory instead of
2053         ;; that of the pipe buffer.
2054         (cd cwd)
2055         (let ((exit-code (call-process-shell-command shell-command nil buf)))
2056           (goto-char (point-max))
2057           (set-buffer-modified-p nil)
2058           (setq buffer-read-only t)
2059           (unless (zerop exit-code)
2060             (switch-to-buffer-other-window buf)
2061             (message (format "Command '%s' exited abnormally with code %d"
2062                              shell-command exit-code))))))))
2063
2064 (defun notmuch-show-tag-message (&rest tag-changes)
2065   "Change tags for the current message.
2066
2067 TAG-CHANGES is a list of tag operations for `notmuch-tag'."
2068   (let* ((current-tags (notmuch-show-get-tags))
2069          (new-tags (notmuch-update-tags current-tags tag-changes)))
2070     (unless (equal current-tags new-tags)
2071       (notmuch-tag (notmuch-show-get-message-id) tag-changes)
2072       (notmuch-show-set-tags new-tags))))
2073
2074 (defun notmuch-show-tag (tag-changes)
2075   "Change tags for the current message.
2076
2077 See `notmuch-tag' for information on the format of TAG-CHANGES."
2078   (interactive (list (notmuch-read-tag-changes (notmuch-show-get-tags)
2079                                                "Tag message")))
2080   (notmuch-tag (notmuch-show-get-message-id) tag-changes)
2081   (let* ((current-tags (notmuch-show-get-tags))
2082          (new-tags (notmuch-update-tags current-tags tag-changes)))
2083     (unless (equal current-tags new-tags)
2084       (notmuch-show-set-tags new-tags))))
2085
2086 (defun notmuch-show-tag-all (tag-changes)
2087   "Change tags for all messages in the current show buffer.
2088
2089 See `notmuch-tag' for information on the format of TAG-CHANGES."
2090   (interactive
2091    (list (let (tags)
2092            (notmuch-show-mapc
2093             (lambda () (setq tags (append (notmuch-show-get-tags) tags))))
2094            (notmuch-read-tag-changes tags "Tag thread"))))
2095   (notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)
2096   (notmuch-show-mapc
2097    (lambda ()
2098      (let* ((current-tags (notmuch-show-get-tags))
2099             (new-tags (notmuch-update-tags current-tags tag-changes)))
2100        (unless (equal current-tags new-tags)
2101          (notmuch-show-set-tags new-tags))))))
2102
2103 (defun notmuch-show-add-tag (tag-changes)
2104   "Change tags for the current message (defaulting to add).
2105
2106 Same as `notmuch-show-tag' but sets initial input to '+'."
2107   (interactive
2108    (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "+")))
2109   (notmuch-show-tag tag-changes))
2110
2111 (defun notmuch-show-remove-tag (tag-changes)
2112   "Change tags for the current message (defaulting to remove).
2113
2114 Same as `notmuch-show-tag' but sets initial input to '-'."
2115   (interactive
2116    (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "-")))
2117   (notmuch-show-tag tag-changes))
2118
2119 (defun notmuch-show-toggle-visibility-headers ()
2120   "Toggle the visibility of the current message headers."
2121   (interactive)
2122   (let ((props (notmuch-show-get-message-properties)))
2123     (notmuch-show-headers-visible
2124      props
2125      (not (plist-get props :headers-visible))))
2126   (force-window-update))
2127
2128 (defun notmuch-show-toggle-message ()
2129   "Toggle the visibility of the current message."
2130   (interactive)
2131   (let ((props (notmuch-show-get-message-properties)))
2132     (notmuch-show-message-visible
2133      props
2134      (not (plist-get props :message-visible))))
2135   (force-window-update))
2136
2137 (put 'notmuch-show-open-or-close-all 'notmuch-doc "Show all messages.")
2138 (put 'notmuch-show-open-or-close-all 'notmuch-prefix-doc "Hide all messages.")
2139 (defun notmuch-show-open-or-close-all ()
2140   "Set the visibility all of the messages in the current thread.
2141
2142 By default make all of the messages visible. With a prefix
2143 argument, hide all of the messages."
2144   (interactive)
2145   (save-excursion
2146     (goto-char (point-min))
2147     (cl-loop do (notmuch-show-message-visible
2148                  (notmuch-show-get-message-properties)
2149                  (not current-prefix-arg))
2150              until (not (notmuch-show-goto-message-next))))
2151   (force-window-update))
2152
2153 (defun notmuch-show-next-button ()
2154   "Advance point to the next button in the buffer."
2155   (interactive)
2156   (forward-button 1))
2157
2158 (defun notmuch-show-previous-button ()
2159   "Move point back to the previous button in the buffer."
2160   (interactive)
2161   (backward-button 1))
2162
2163 (defun notmuch-show-next-thread (&optional show previous)
2164   "Move to the next item in the search results, if any.
2165
2166 If SHOW is non-nil, open the next item in a show
2167 buffer. Otherwise just highlight the next item in the search
2168 buffer. If PREVIOUS is non-nil, move to the previous item in the
2169 search results instead."
2170   (interactive "P")
2171   (let ((parent-buffer notmuch-show-parent-buffer))
2172     (notmuch-bury-or-kill-this-buffer)
2173     (when (buffer-live-p parent-buffer)
2174       (switch-to-buffer parent-buffer)
2175       (and (if previous
2176                (notmuch-search-previous-thread)
2177              (notmuch-search-next-thread))
2178            show
2179            (notmuch-search-show-thread)))))
2180
2181 (defun notmuch-show-next-thread-show ()
2182   "Show the next thread in the search results, if any."
2183   (interactive)
2184   (notmuch-show-next-thread t))
2185
2186 (defun notmuch-show-previous-thread-show ()
2187   "Show the previous thread in the search results, if any."
2188   (interactive)
2189   (notmuch-show-next-thread t t))
2190
2191 (put 'notmuch-show-archive-thread 'notmuch-prefix-doc
2192      "Un-archive each message in thread.")
2193 (defun notmuch-show-archive-thread (&optional unarchive)
2194   "Archive each message in thread.
2195
2196 Archive each message currently shown by applying the tag changes
2197 in `notmuch-archive-tags' to each. If a prefix argument is given,
2198 the messages will be \"unarchived\", i.e. the tag changes in
2199 `notmuch-archive-tags' will be reversed.
2200
2201 Note: This command is safe from any race condition of new messages
2202 being delivered to the same thread. It does not archive the
2203 entire thread, but only the messages shown in the current
2204 buffer."
2205   (interactive "P")
2206   (when notmuch-archive-tags
2207     (notmuch-show-tag-all
2208      (notmuch-tag-change-list notmuch-archive-tags unarchive))))
2209
2210 (defun notmuch-show-archive-thread-then-next ()
2211   "Archive all messages in the current buffer, then show next thread from search."
2212   (interactive)
2213   (notmuch-show-archive-thread)
2214   (notmuch-show-next-thread t))
2215
2216 (defun notmuch-show-archive-thread-then-exit ()
2217   "Archive all messages in the current buffer, then exit back to search results."
2218   (interactive)
2219   (notmuch-show-archive-thread)
2220   (notmuch-show-next-thread))
2221
2222 (put 'notmuch-show-archive-message 'notmuch-prefix-doc
2223      "Un-archive the current message.")
2224 (defun notmuch-show-archive-message (&optional unarchive)
2225   "Archive the current message.
2226
2227 Archive the current message by applying the tag changes in
2228 `notmuch-archive-tags' to it. If a prefix argument is given, the
2229 message will be \"unarchived\", i.e. the tag changes in
2230 `notmuch-archive-tags' will be reversed."
2231   (interactive "P")
2232   (when notmuch-archive-tags
2233     (apply 'notmuch-show-tag-message
2234            (notmuch-tag-change-list notmuch-archive-tags unarchive))))
2235
2236 (defun notmuch-show-archive-message-then-next-or-exit ()
2237   "Archive current message, then show next open message in current thread.
2238
2239 If at the last open message in the current thread, then exit back
2240 to search results."
2241   (interactive)
2242   (notmuch-show-archive-message)
2243   (notmuch-show-next-open-message t))
2244
2245 (defun notmuch-show-archive-message-then-next-or-next-thread ()
2246   "Archive current message, then show next open message in current or next thread.
2247
2248 If at the last open message in the current thread, then show next
2249 thread from search."
2250   (interactive)
2251   (notmuch-show-archive-message)
2252   (unless (notmuch-show-next-open-message)
2253     (notmuch-show-next-thread t)))
2254
2255 (defun notmuch-show-stash-cc ()
2256   "Copy CC field of current message to kill-ring."
2257   (interactive)
2258   (notmuch-common-do-stash (notmuch-show-get-cc)))
2259
2260 (put 'notmuch-show-stash-date 'notmuch-prefix-doc
2261      "Copy timestamp of current message to kill-ring.")
2262 (defun notmuch-show-stash-date (&optional stash-timestamp)
2263   "Copy date of current message to kill-ring.
2264
2265 If invoked with a prefix argument, copy timestamp of current
2266 message to kill-ring."
2267   (interactive "P")
2268   (if stash-timestamp
2269       (notmuch-common-do-stash (format "%d" (notmuch-show-get-timestamp)))
2270     (notmuch-common-do-stash (notmuch-show-get-date))))
2271
2272 (defun notmuch-show-stash-filename ()
2273   "Copy filename of current message to kill-ring."
2274   (interactive)
2275   (notmuch-common-do-stash (notmuch-show-get-filename)))
2276
2277 (defun notmuch-show-stash-from ()
2278   "Copy From address of current message to kill-ring."
2279   (interactive)
2280   (notmuch-common-do-stash (notmuch-show-get-from)))
2281
2282 (put 'notmuch-show-stash-message-id 'notmuch-prefix-doc
2283      "Copy thread: query matching current thread to kill-ring.")
2284 (defun notmuch-show-stash-message-id (&optional stash-thread-id)
2285   "Copy id: query matching the current message to kill-ring.
2286
2287 If invoked with a prefix argument (or STASH-THREAD-ID is
2288 non-nil), copy thread: query matching the current thread to
2289 kill-ring."
2290   (interactive "P")
2291   (if stash-thread-id
2292       (notmuch-common-do-stash notmuch-show-thread-id)
2293     (notmuch-common-do-stash (notmuch-show-get-message-id))))
2294
2295 (defun notmuch-show-stash-message-id-stripped ()
2296   "Copy message ID of current message (sans `id:' prefix) to kill-ring."
2297   (interactive)
2298   (notmuch-common-do-stash (notmuch-show-get-message-id t)))
2299
2300 (defun notmuch-show-stash-subject ()
2301   "Copy Subject field of current message to kill-ring."
2302   (interactive)
2303   (notmuch-common-do-stash (notmuch-show-get-subject)))
2304
2305 (defun notmuch-show-stash-tags ()
2306   "Copy tags of current message to kill-ring as a comma separated list."
2307   (interactive)
2308   (notmuch-common-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
2309
2310 (defun notmuch-show-stash-to ()
2311   "Copy To address of current message to kill-ring."
2312   (interactive)
2313   (notmuch-common-do-stash (notmuch-show-get-to)))
2314
2315 (defun notmuch-show-stash-mlarchive-link (&optional mla)
2316   "Copy an ML Archive URI for the current message to the kill-ring.
2317
2318 This presumes that the message is available at the selected Mailing List Archive.
2319
2320 If optional argument MLA is non-nil, use the provided key instead of prompting
2321 the user (see `notmuch-show-stash-mlarchive-link-alist')."
2322   (interactive)
2323   (let ((url (cdr (assoc
2324                    (or mla
2325                        (let ((completion-ignore-case t))
2326                          (completing-read
2327                           "Mailing List Archive: "
2328                           notmuch-show-stash-mlarchive-link-alist
2329                           nil t nil nil
2330                           notmuch-show-stash-mlarchive-link-default)))
2331                    notmuch-show-stash-mlarchive-link-alist))))
2332     (notmuch-common-do-stash
2333      (if (functionp url)
2334          (funcall url (notmuch-show-get-message-id t))
2335        (concat url (notmuch-show-get-message-id t))))))
2336
2337 (defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
2338   "Copy an ML Archive URI for the current message to the kill-ring and visit it.
2339
2340 This presumes that the message is available at the selected Mailing List Archive.
2341
2342 If optional argument MLA is non-nil, use the provided key instead of prompting
2343 the user (see `notmuch-show-stash-mlarchive-link-alist')."
2344   (interactive)
2345   (notmuch-show-stash-mlarchive-link mla)
2346   (browse-url (current-kill 0 t)))
2347
2348 (defun notmuch-show-stash-git-helper (addresses prefix)
2349   "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string."
2350   (mapconcat (lambda (x)
2351                (concat prefix "\""
2352                        ;; escape double-quotes
2353                        (replace-regexp-in-string
2354                         "\"" "\\\\\""
2355                         ;; trim leading and trailing spaces
2356                         (replace-regexp-in-string
2357                          "\\(^ *\\| *$\\)" ""
2358                          x)) "\""))
2359              addresses " "))
2360
2361 (put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc
2362      "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.")
2363
2364 (defun notmuch-show-stash-git-send-email (&optional no-in-reply-to)
2365   "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line.
2366
2367 If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil),
2368 omit --in-reply-to=<Message-Id>."
2369   (interactive "P")
2370   (notmuch-common-do-stash
2371    (mapconcat 'identity
2372               (remove ""
2373                       (list
2374                        (notmuch-show-stash-git-helper
2375                         (message-tokenize-header (notmuch-show-get-from)) "--to=")
2376                        (notmuch-show-stash-git-helper
2377                         (message-tokenize-header (notmuch-show-get-to)) "--to=")
2378                        (notmuch-show-stash-git-helper
2379                         (message-tokenize-header (notmuch-show-get-cc)) "--cc=")
2380                        (unless no-in-reply-to
2381                          (notmuch-show-stash-git-helper
2382                           (list (notmuch-show-get-message-id t)) "--in-reply-to="))))
2383               " ")))
2384
2385 ;; Interactive part functions and their helpers
2386
2387 (defun notmuch-show-generate-part-buffer (msg part)
2388   "Return a temporary buffer containing the specified part's content."
2389   (let ((buf (generate-new-buffer " *notmuch-part*"))
2390         (process-crypto notmuch-show-process-crypto))
2391     (with-current-buffer buf
2392       ;; This is always used in the content of mm handles, which
2393       ;; expect undecoded, binary part content.
2394       (insert (notmuch-get-bodypart-binary msg part process-crypto)))
2395     buf))
2396
2397 (defun notmuch-show-current-part-handle (&optional mime-type)
2398   "Return an mm-handle for the part containing point.
2399
2400 This creates a temporary buffer for the part's content; the
2401 caller is responsible for killing this buffer as appropriate.  If
2402 MIME-TYPE is given then set the handle's mime-type to MIME-TYPE."
2403   (let* ((msg (notmuch-show-get-message-properties))
2404          (part (notmuch-show-get-part-properties))
2405          (buf (notmuch-show-generate-part-buffer msg part))
2406          (computed-type (or mime-type (plist-get part :computed-type)))
2407          (filename (plist-get part :filename))
2408          (disposition (and filename `(attachment (filename . ,filename)))))
2409     (mm-make-handle buf (list computed-type) nil nil disposition)))
2410
2411 (defun notmuch-show-apply-to-current-part-handle (fn &optional mime-type)
2412   "Apply FN to an mm-handle for the part containing point.
2413
2414 This ensures that the temporary buffer created for the mm-handle
2415 is destroyed when FN returns. If MIME-TYPE is given then force
2416 part to be treated as if it had that mime-type."
2417   (let ((handle (notmuch-show-current-part-handle mime-type)))
2418     ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
2419     ;; call it from a temp-buffer, unless
2420     ;; notmuch-show-attachment-debug is non-nil in which case we put
2421     ;; it in " *notmuch-part*".
2422     (unwind-protect
2423         (if notmuch-show-attachment-debug
2424             (with-current-buffer (generate-new-buffer " *notmuch-part*")
2425               (funcall fn handle))
2426           (with-temp-buffer
2427             (funcall fn handle)))
2428       (kill-buffer (mm-handle-buffer handle)))))
2429
2430 (defun notmuch-show-part-button-default (&optional button)
2431   (interactive)
2432   (let ((button (or button (button-at (point)))))
2433     ;; Try to toggle the part, if that fails then call the default
2434     ;; action. The toggle fails if the part has no emacs renderable
2435     ;; content.
2436     (unless (notmuch-show-toggle-part-invisibility button)
2437       (call-interactively notmuch-show-part-button-default-action))))
2438
2439 (defun notmuch-show-save-part ()
2440   "Save the MIME part containing point to a file."
2441   (interactive)
2442   (notmuch-show-apply-to-current-part-handle #'mm-save-part))
2443
2444 (defun notmuch-show-view-part ()
2445   "View the MIME part containing point in an external viewer."
2446   (interactive)
2447   ;; Set mm-inlined-types to nil to force an external viewer
2448   (let ((mm-inlined-types nil))
2449     (notmuch-show-apply-to-current-part-handle #'mm-display-part)))
2450
2451 (defun notmuch-show-interactively-view-part ()
2452   "View the MIME part containing point, prompting for a viewer."
2453   (interactive)
2454   (notmuch-show-apply-to-current-part-handle #'mm-interactively-view-part))
2455
2456 (defun notmuch-show-pipe-part ()
2457   "Pipe the MIME part containing point to an external command."
2458   (interactive)
2459   (notmuch-show-apply-to-current-part-handle #'mm-pipe-part))
2460
2461 (defun notmuch-show--mm-display-part (handle)
2462   "Use mm-display-part to display HANDLE in a new buffer.
2463
2464 If the part is displayed in an external application then close
2465 the new buffer."
2466   (let ((buf (get-buffer-create (generate-new-buffer-name
2467                                  (concat " *notmuch-internal-part*")))))
2468     (switch-to-buffer buf)
2469     (if (eq (mm-display-part handle) 'external)
2470         (kill-buffer buf)
2471       (goto-char (point-min))
2472       (set-buffer-modified-p nil)
2473       (view-buffer buf 'kill-buffer-if-not-modified))))
2474
2475 (defun notmuch-show-choose-mime-of-part (mime-type)
2476   "Choose the mime type to use for displaying part."
2477   (interactive
2478    (list (completing-read "Mime type to use (default text/plain): "
2479                           (mailcap-mime-types) nil nil nil nil "text/plain")))
2480   (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part
2481                                              mime-type))
2482
2483 (defun notmuch-show-imenu-prev-index-position-function ()
2484   "Move point to previous message in notmuch-show buffer.
2485 This function is used as a value for
2486 `imenu-prev-index-position-function'."
2487   (if (bobp)
2488       nil
2489     (notmuch-show-previous-message)
2490     t))
2491
2492 (defun notmuch-show-imenu-extract-index-name-function ()
2493   "Return imenu name for line at point.
2494 This function is used as a value for
2495 `imenu-extract-index-name-function'.  Point should be at the
2496 beginning of the line."
2497   (back-to-indentation)
2498   (buffer-substring-no-properties (if notmuch-show-imenu-indent
2499                                       (line-beginning-position)
2500                                     (point))
2501                                   (line-end-position)))
2502
2503 (defmacro notmuch-show--with-currently-shown-message (&rest body)
2504   "Evaluate BODY with display restricted to the currently shown
2505 message."
2506   `(save-excursion
2507      (save-restriction
2508        (let ((extent (notmuch-show-message-extent)))
2509          (narrow-to-region (car extent) (cdr extent))
2510          ,@body))))
2511
2512 (defun notmuch-show--gather-urls ()
2513   "Gather any URLs in the current message."
2514   (notmuch-show--with-currently-shown-message
2515    (let (urls)
2516      (goto-char (point-min))
2517      (while (re-search-forward goto-address-url-regexp (point-max) t)
2518        (push (match-string-no-properties 0) urls))
2519      (reverse urls))))
2520
2521 (defun notmuch-show-browse-urls (&optional kill)
2522   "Offer to browse any URLs in the current message.
2523 With a prefix argument, copy the URL to the kill ring rather than
2524 browsing."
2525   (interactive "P")
2526   (let ((urls (notmuch-show--gather-urls))
2527         (prompt (if kill "Copy URL to kill ring: " "Browse URL: "))
2528         (fn (if kill #'kill-new #'browse-url)))
2529     (if urls
2530         (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
2531       (message "No URLs found."))))
2532
2533 (provide 'notmuch-show)
2534
2535 ;;; notmuch-show.el ends here