config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

notmuch-show.el (104974B)


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