git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-show.el

   1 ;; notmuch-show.el --- displaying notmuch forests.
   2 ;;
   3 ;; Copyright © Carl Worth
   4 ;; Copyright © David Edmondson
   5 ;;
   6 ;; This file is part of Notmuch.
   7 ;;
   8 ;; Notmuch is free software: you can redistribute it and/or modify it
   9 ;; under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12 ;;
  13 ;; Notmuch is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
  20 ;;
  21 ;; Authors: Carl Worth <cworth@cworth.org>
  22 ;;          David Edmondson <dme@dme.org>
  23
  24 (eval-when-compile (require 'cl))
  25 (require 'mm-view)
  26 (require 'message)
  27 (require 'mm-decode)
  28 (require 'mailcap)
  29 (require 'icalendar)
  30 (require 'goto-addr)
  31
  32 (require 'notmuch-lib)
  33 (require 'notmuch-tag)
  34 (require 'notmuch-query)
  35 (require 'notmuch-wash)
  36 (require 'notmuch-mua)
  37 (require 'notmuch-crypto)
  38 (require 'notmuch-print)
  39
  40 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
  41 (declare-function notmuch-search-next-thread "notmuch" nil)
  42 (declare-function notmuch-search-show-thread "notmuch" nil)
  43
  44 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
  45   "Headers that should be shown in a message, in this order.
  46
  47 For an open message, all of these headers will be made visible
  48 according to `notmuch-message-headers-visible' or can be toggled
  49 with `notmuch-show-toggle-visibility-headers'. For a closed message,
  50 only the first header in the list will be visible."
  51   :type '(repeat string)
  52   :group 'notmuch-show)
  53
  54 (defcustom notmuch-message-headers-visible t
  55   "Should the headers be visible by default?
  56
  57 If this value is non-nil, then all of the headers defined in
  58 `notmuch-message-headers' will be visible by default in the display
  59 of each message. Otherwise, these headers will be hidden and
  60 `notmuch-show-toggle-visibility-headers' can be used to make them
  61 visible for any given message."
  62   :type 'boolean
  63   :group 'notmuch-show)
  64
  65 (defcustom notmuch-show-relative-dates t
  66   "Display relative dates in the message summary line."
  67   :type 'boolean
  68   :group 'notmuch-show)
  69
  70 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
  71   "A list of functions called to decorate the headers listed in
  72 `notmuch-message-headers'.")
  73
  74 (defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
  75   "Functions called after populating a `notmuch-show' buffer."
  76   :type 'hook
  77   :options '(notmuch-show-turn-on-visual-line-mode)
  78   :group 'notmuch-show
  79   :group 'notmuch-hooks)
  80
  81 (defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
  82                                                  notmuch-wash-tidy-citations
  83                                                  notmuch-wash-elide-blank-lines
  84                                                  notmuch-wash-excerpt-citations)
  85   "Functions used to improve the display of text/plain parts."
  86   :type 'hook
  87   :options '(notmuch-wash-convert-inline-patch-to-part
  88              notmuch-wash-wrap-long-lines
  89              notmuch-wash-tidy-citations
  90              notmuch-wash-elide-blank-lines
  91              notmuch-wash-excerpt-citations)
  92   :group 'notmuch-show
  93   :group 'notmuch-hooks)
  94
  95 ;; Mostly useful for debugging.
  96 (defcustom notmuch-show-all-multipart/alternative-parts nil
  97   "Should all parts of multipart/alternative parts be shown?"
  98   :type 'boolean
  99   :group 'notmuch-show)
 100
 101 (defcustom notmuch-show-indent-messages-width 1
 102   "Width of message indentation in threads.
 103
 104 Messages are shown indented according to their depth in a thread.
 105 This variable determines the width of this indentation measured
 106 in number of blanks.  Defaults to `1', choose `0' to disable
 107 indentation."
 108   :type 'integer
 109   :group 'notmuch-show)
 110
 111 (defcustom notmuch-show-indent-multipart nil
 112   "Should the sub-parts of a multipart/* part be indented?"
 113   ;; dme: Not sure which is a good default.
 114   :type 'boolean
 115   :group 'notmuch-show)
 116
 117 (defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part
 118   "Default part header button action (on ENTER or mouse click)."
 119   :group 'notmuch-show
 120   :type '(choice (const :tag "Save part"
 121                         notmuch-show-save-part)
 122                  (const :tag "View part"
 123                         notmuch-show-view-part)
 124                  (const :tag "View interactively"
 125                         notmuch-show-interactively-view-part)))
 126
 127 (defcustom notmuch-show-only-matching-messages nil
 128   "Only matching messages are shown by default."
 129   :type 'boolean
 130   :group 'notmuch-show)
 131
 132 (defvar notmuch-show-thread-id nil)
 133 (make-variable-buffer-local 'notmuch-show-thread-id)
 134 (put 'notmuch-show-thread-id 'permanent-local t)
 135
 136 (defvar notmuch-show-parent-buffer nil)
 137 (make-variable-buffer-local 'notmuch-show-parent-buffer)
 138 (put 'notmuch-show-parent-buffer 'permanent-local t)
 139
 140 (defvar notmuch-show-query-context nil)
 141 (make-variable-buffer-local 'notmuch-show-query-context)
 142 (put 'notmuch-show-query-context 'permanent-local t)
 143
 144 (defvar notmuch-show-process-crypto nil)
 145 (make-variable-buffer-local 'notmuch-show-process-crypto)
 146 (put 'notmuch-show-process-crypto 'permanent-local t)
 147
 148 (defvar notmuch-show-elide-non-matching-messages nil)
 149 (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
 150 (put 'notmuch-show-elide-non-matching-messages 'permanent-local t)
 151
 152 (defvar notmuch-show-indent-content t)
 153 (make-variable-buffer-local 'notmuch-show-indent-content)
 154 (put 'notmuch-show-indent-content 'permanent-local t)
 155
 156 (defcustom notmuch-show-stash-mlarchive-link-alist
 157   '(("Gmane" . "http://mid.gmane.org/")
 158     ("MARC" . "http://marc.info/?i=")
 159     ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
 160     ;; FIXME: can these services be searched by `Message-Id' ?
 161     ;; ("MarkMail" . "http://markmail.org/")
 162     ;; ("Nabble" . "http://nabble.com/")
 163     ;; ("opensubscriber" . "http://opensubscriber.com/")
 164     )
 165   "List of Mailing List Archives to use when stashing links.
 166
 167 These URIs are concatenated with the current message's
 168 Message-Id in `notmuch-show-stash-mlarchive-link'."
 169   :type '(alist :key-type (string :tag "Name")
 170                 :value-type (string :tag "URL"))
 171   :group 'notmuch-show)
 172
 173 (defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
 174   "Default Mailing List Archive to use when stashing links.
 175
 176 This is used when `notmuch-show-stash-mlarchive-link' isn't
 177 provided with an MLA argument nor `completing-read' input."
 178   :type `(choice
 179           ,@(mapcar
 180              (lambda (mla)
 181                (list 'const :tag (car mla) :value (car mla)))
 182              notmuch-show-stash-mlarchive-link-alist))
 183   :group 'notmuch-show)
 184
 185 (defcustom notmuch-show-mark-read-tags '("-unread")
 186   "List of tag changes to apply to a message when it is marked as read.
 187
 188 Tags starting with \"+\" (or not starting with either \"+\" or
 189 \"-\") in the list will be added, and tags starting with \"-\"
 190 will be removed from the message being marked as read.
 191
 192 For example, if you wanted to remove an \"unread\" tag and add a
 193 \"read\" tag (which would make little sense), you would set:
 194     (\"-unread\" \"+read\")"
 195   :type '(repeat string)
 196   :group 'notmuch-show)
 197
 198
 199 (defmacro with-current-notmuch-show-message (&rest body)
 200   "Evaluate body with current buffer set to the text of current message"
 201   `(save-excursion
 202      (let ((id (notmuch-show-get-message-id)))
 203        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
 204          (with-current-buffer buf
 205            (let ((coding-system-for-read 'no-conversion))
 206              (call-process notmuch-command nil t nil "show" "--format=raw" id)
 207              ,@body)
 208            (kill-buffer buf))))))
 209
 210 (defun notmuch-show-turn-on-visual-line-mode ()
 211   "Enable Visual Line mode."
 212   (visual-line-mode t))
 213
 214 (defun notmuch-show-view-all-mime-parts ()
 215   "Use external viewers to view all attachments from the current message."
 216   (interactive)
 217   (with-current-notmuch-show-message
 218    ;; We override the mm-inline-media-tests to indicate which message
 219    ;; parts are already sufficiently handled by the original
 220    ;; presentation of the message in notmuch-show mode. These parts
 221    ;; will be inserted directly into the temporary buffer of
 222    ;; with-current-notmuch-show-message and silently discarded.
 223    ;;
 224    ;; Any MIME part not explicitly mentioned here will be handled by an
 225    ;; external viewer as configured in the various mailcap files.
 226    (let ((mm-inline-media-tests '(
 227                                   ("text/.*" ignore identity)
 228                                   ("application/pgp-signature" ignore identity)
 229                                   ("multipart/alternative" ignore identity)
 230                                   ("multipart/mixed" ignore identity)
 231                                   ("multipart/related" ignore identity)
 232                                  )))
 233      (mm-display-parts (mm-dissect-buffer)))))
 234
 235 (defun notmuch-foreach-mime-part (function mm-handle)
 236   (cond ((stringp (car mm-handle))
 237          (dolist (part (cdr mm-handle))
 238            (notmuch-foreach-mime-part function part)))
 239         ((bufferp (car mm-handle))
 240          (funcall function mm-handle))
 241         (t (dolist (part mm-handle)
 242              (notmuch-foreach-mime-part function part)))))
 243
 244 (defun notmuch-count-attachments (mm-handle)
 245   (let ((count 0))
 246     (notmuch-foreach-mime-part
 247      (lambda (p)
 248        (let ((disposition (mm-handle-disposition p)))
 249          (and (listp disposition)
 250               (or (equal (car disposition) "attachment")
 251                   (and (equal (car disposition) "inline")
 252                        (assq 'filename disposition)))
 253               (incf count))))
 254      mm-handle)
 255     count))
 256
 257 (defun notmuch-save-attachments (mm-handle &optional queryp)
 258   (notmuch-foreach-mime-part
 259    (lambda (p)
 260      (let ((disposition (mm-handle-disposition p)))
 261        (and (listp disposition)
 262             (or (equal (car disposition) "attachment")
 263                 (and (equal (car disposition) "inline")
 264                      (assq 'filename disposition)))
 265             (or (not queryp)
 266                 (y-or-n-p
 267                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
 268             (mm-save-part p))))
 269    mm-handle))
 270
 271 (defun notmuch-show-save-attachments ()
 272   "Save all attachments from the current message."
 273   (interactive)
 274   (with-current-notmuch-show-message
 275    (let ((mm-handle (mm-dissect-buffer)))
 276      (notmuch-save-attachments
 277       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
 278   (message "Done"))
 279
 280 (defun notmuch-show-with-message-as-text (fn)
 281   "Apply FN to a text representation of the current message.
 282
 283 FN is called with one argument, the message properties. It should
 284 operation on the contents of the current buffer."
 285
 286   ;; Remake the header to ensure that all information is available.
 287   (let* ((to (notmuch-show-get-to))
 288          (cc (notmuch-show-get-cc))
 289          (from (notmuch-show-get-from))
 290          (subject (notmuch-show-get-subject))
 291          (date (notmuch-show-get-date))
 292          (tags (notmuch-show-get-tags))
 293          (depth (notmuch-show-get-depth))
 294
 295          (header (concat
 296                   "Subject: " subject "\n"
 297                   "To: " to "\n"
 298                   (if (not (string= cc ""))
 299                       (concat "Cc: " cc "\n")
 300                     "")
 301                   "From: " from "\n"
 302                   "Date: " date "\n"
 303                   (if tags
 304                       (concat "Tags: "
 305                               (mapconcat #'identity tags ", ") "\n")
 306                     "")))
 307          (all (buffer-substring (notmuch-show-message-top)
 308                                 (notmuch-show-message-bottom)))
 309
 310          (props (notmuch-show-get-message-properties))
 311          (indenting notmuch-show-indent-content))
 312     (with-temp-buffer
 313       (insert all)
 314       (if indenting
 315           (indent-rigidly (point-min) (point-max) (- depth)))
 316       ;; Remove the original header.
 317       (goto-char (point-min))
 318       (re-search-forward "^$" (point-max) nil)
 319       (delete-region (point-min) (point))
 320       (insert header)
 321       (funcall fn props))))
 322
 323 (defun notmuch-show-print-message ()
 324   "Print the current message."
 325   (interactive)
 326   (notmuch-show-with-message-as-text 'notmuch-print-message))
 327
 328 (defun notmuch-show-fontify-header ()
 329   (let ((face (cond
 330                ((looking-at "[Tt]o:")
 331                 'message-header-to)
 332                ((looking-at "[Bb]?[Cc][Cc]:")
 333                 'message-header-cc)
 334                ((looking-at "[Ss]ubject:")
 335                 'message-header-subject)
 336                ((looking-at "[Ff]rom:")
 337                 'message-header-from)
 338                (t
 339                 'message-header-other))))
 340
 341     (overlay-put (make-overlay (point) (re-search-forward ":"))
 342                  'face 'message-header-name)
 343     (overlay-put (make-overlay (point) (re-search-forward ".*$"))
 344                  'face face)))
 345
 346 (defun notmuch-show-colour-headers ()
 347   "Apply some colouring to the current headers."
 348   (goto-char (point-min))
 349   (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
 350     (notmuch-show-fontify-header)
 351     (forward-line)))
 352
 353 (defun notmuch-show-spaces-n (n)
 354   "Return a string comprised of `n' spaces."
 355   (make-string n ? ))
 356
 357 (defun notmuch-show-update-tags (tags)
 358   "Update the displayed tags of the current message."
 359   (save-excursion
 360     (goto-char (notmuch-show-message-top))
 361     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
 362         (let ((inhibit-read-only t))
 363           (replace-match (concat "("
 364                                  (notmuch-tag-format-tags tags)
 365                                  ")"))))))
 366
 367 (defun notmuch-clean-address (address)
 368   "Try to clean a single email ADDRESS for display. Return a cons
 369 cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
 370 parsing fails."
 371   (condition-case nil
 372     (let (p-name p-address)
 373       ;; It would be convenient to use `mail-header-parse-address',
 374       ;; but that expects un-decoded mailbox parts, whereas our
 375       ;; mailbox parts are already decoded (and hence may contain
 376       ;; UTF-8). Given that notmuch should handle most of the awkward
 377       ;; cases, some simple string deconstruction should be sufficient
 378       ;; here.
 379       (cond
 380        ;; "User <user@dom.ain>" style.
 381        ((string-match "\\(.*\\) <\\(.*\\)>" address)
 382         (setq p-name (match-string 1 address)
 383               p-address (match-string 2 address)))
 384
 385        ;; "<user@dom.ain>" style.
 386        ((string-match "<\\(.*\\)>" address)
 387         (setq p-address (match-string 1 address)))
 388
 389        ;; Everything else.
 390        (t
 391         (setq p-address address)))
 392
 393       (when p-name
 394         ;; Remove elements of the mailbox part that are not relevant for
 395         ;; display, even if they are required during transport:
 396         ;;
 397         ;; Backslashes.
 398         (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
 399
 400         ;; Outer single and double quotes, which might be nested.
 401         (loop
 402          with start-of-loop
 403          do (setq start-of-loop p-name)
 404
 405          when (string-match "^\"\\(.*\\)\"$" p-name)
 406          do (setq p-name (match-string 1 p-name))
 407
 408          when (string-match "^'\\(.*\\)'$" p-name)
 409          do (setq p-name (match-string 1 p-name))
 410
 411          until (string= start-of-loop p-name)))
 412
 413       ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
 414       ;; 'foo@bar.com'.
 415       (when (string= p-name p-address)
 416         (setq p-name nil))
 417
 418       (cons p-address p-name))
 419     (error (cons address nil))))
 420
 421 (defun notmuch-show-clean-address (address)
 422   "Try to clean a single email ADDRESS for display.  Return
 423 unchanged ADDRESS if parsing fails."
 424   (let* ((clean-address (notmuch-clean-address address))
 425          (p-address (car clean-address))
 426          (p-name (cdr clean-address)))
 427     ;; If no name, return just the address.
 428     (if (not p-name)
 429         p-address
 430       ;; Otherwise format the name and address together.
 431       (concat p-name " <" p-address ">"))))
 432
 433 (defun notmuch-show-insert-headerline (headers date tags depth)
 434   "Insert a notmuch style headerline based on HEADERS for a
 435 message at DEPTH in the current thread."
 436   (let ((start (point)))
 437     (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
 438             (notmuch-show-clean-address (plist-get headers :From))
 439             " ("
 440             date
 441             ") ("
 442             (notmuch-tag-format-tags tags)
 443             ")\n")
 444     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
 445
 446 (defun notmuch-show-insert-header (header header-value)
 447   "Insert a single header."
 448   (insert header ": " header-value "\n"))
 449
 450 (defun notmuch-show-insert-headers (headers)
 451   "Insert the headers of the current message."
 452   (let ((start (point)))
 453     (mapc (lambda (header)
 454             (let* ((header-symbol (intern (concat ":" header)))
 455                    (header-value (plist-get headers header-symbol)))
 456               (if (and header-value
 457                        (not (string-equal "" header-value)))
 458                   (notmuch-show-insert-header header header-value))))
 459           notmuch-message-headers)
 460     (save-excursion
 461       (save-restriction
 462         (narrow-to-region start (point-max))
 463         (run-hooks 'notmuch-show-markup-headers-hook)))))
 464
 465 (define-button-type 'notmuch-show-part-button-type
 466   'action 'notmuch-show-part-button-default
 467   'keymap 'notmuch-show-part-button-map
 468   'follow-link t
 469   'face 'message-mml
 470   :supertype 'notmuch-button-type)
 471
 472 (defvar notmuch-show-part-button-map
 473   (let ((map (make-sparse-keymap)))
 474     (set-keymap-parent map button-map)
 475     (define-key map "s" 'notmuch-show-part-button-save)
 476     (define-key map "v" 'notmuch-show-part-button-view)
 477     (define-key map "o" 'notmuch-show-part-button-interactively-view)
 478     (define-key map "|" 'notmuch-show-part-button-pipe)
 479     map)
 480   "Submap for button commands")
 481 (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
 482
 483 (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
 484   (let ((button)
 485         (base-label (concat (when name (concat name ": "))
 486                             declared-type
 487                             (unless (string-equal declared-type content-type)
 488                               (concat " (as " content-type ")"))
 489                             comment)))
 490
 491     (setq button
 492           (insert-button
 493            (concat "[ " base-label " ]")
 494            :base-label base-label
 495            :type 'notmuch-show-part-button-type
 496            :notmuch-part nth
 497            :notmuch-filename name
 498            :notmuch-content-type content-type))
 499     (insert "\n")
 500     ;; return button
 501     button))
 502
 503 ;; Functions handling particular MIME parts.
 504
 505 (defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
 506   (declare (indent 2))
 507   (let ((process-crypto (make-symbol "process-crypto")))
 508     `(let ((,process-crypto notmuch-show-process-crypto))
 509        (with-temp-buffer
 510          (setq notmuch-show-process-crypto ,process-crypto)
 511          ;; Always acquires the part via `notmuch part', even if it is
 512          ;; available in the JSON output.
 513          (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))
 514          ,@body))))
 515
 516 (defun notmuch-show-save-part (message-id nth &optional filename content-type)
 517   (notmuch-with-temp-part-buffer message-id nth
 518     (let ((file (read-file-name
 519                  "Filename to save as: "
 520                  (or mailcap-download-directory "~/")
 521                  nil nil
 522                  filename)))
 523       ;; Don't re-compress .gz & al.  Arguably we should make
 524       ;; `file-name-handler-alist' nil, but that would chop
 525       ;; ange-ftp, which is reasonable to use here.
 526       (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t))))
 527
 528 (defun notmuch-show-view-part (message-id nth &optional filename content-type )
 529   (notmuch-with-temp-part-buffer message-id nth
 530     ;; set mm-inlined-types to nil to force an external viewer
 531     (let ((handle (mm-make-handle (current-buffer) (list content-type)))
 532           (mm-inlined-types nil))
 533       ;; We override mm-save-part as notmuch-show-save-part is better
 534       ;; since it offers the filename. We need to lexically bind
 535       ;; everything we need for notmuch-show-save-part to prevent
 536       ;; potential dynamic shadowing.
 537       (lexical-let ((message-id message-id)
 538                     (nth nth)
 539                     (filename filename)
 540                     (content-type content-type))
 541         (flet ((mm-save-part (&rest args) (notmuch-show-save-part
 542                                            message-id nth filename content-type)))
 543           (mm-display-part handle))))))
 544
 545 (defun notmuch-show-interactively-view-part (message-id nth &optional filename content-type)
 546   (notmuch-with-temp-part-buffer message-id nth
 547     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
 548       (mm-interactively-view-part handle))))
 549
 550 (defun notmuch-show-pipe-part (message-id nth &optional filename content-type)
 551   (notmuch-with-temp-part-buffer message-id nth
 552     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
 553       (mm-pipe-part handle))))
 554
 555 ;; This is taken from notmuch-wash: maybe it should be unified?
 556 (defun notmuch-show-toggle-part-invisibility (&optional button)
 557   (interactive)
 558   (let* ((button (or button (button-at (point))))
 559          (overlay (button-get button 'overlay)))
 560     (when overlay
 561       (let* ((show (overlay-get overlay 'invisible))
 562              (new-start (button-start button))
 563              (button-label (button-get button :base-label))
 564              (old-point (point))
 565              (inhibit-read-only t))
 566         (overlay-put overlay 'invisible (not show))
 567         (goto-char new-start)
 568         (insert "[ " button-label (if show " ]" " (hidden) ]"))
 569         (let ((old-end (button-end button)))
 570           (move-overlay button new-start (point))
 571           (delete-region (point) old-end))
 572         (goto-char (min old-point (1- (button-end button))))))))
 573
 574 (defun notmuch-show-multipart/*-to-list (part)
 575   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
 576           (plist-get part :content)))
 577
 578 (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
 579   (notmuch-show-insert-part-header nth declared-type content-type nil)
 580   (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
 581         (inner-parts (plist-get part :content))
 582         (start (point)))
 583     ;; This inserts all parts of the chosen type rather than just one,
 584     ;; but it's not clear that this is the wrong thing to do - which
 585     ;; should be chosen if there are more than one that match?
 586     (mapc (lambda (inner-part)
 587             (let* ((inner-type (plist-get inner-part :content-type))
 588                   (hide (not (or notmuch-show-all-multipart/alternative-parts
 589                            (string= chosen-type inner-type)))))
 590               (notmuch-show-insert-bodypart msg inner-part depth hide)))
 591           inner-parts)
 592
 593     (when notmuch-show-indent-multipart
 594       (indent-rigidly start (point) 1)))
 595   t)
 596
 597 (defun notmuch-show-setup-w3m ()
 598   "Instruct w3m how to retrieve content from a \"related\" part of a message."
 599   (interactive)
 600   (if (boundp 'w3m-cid-retrieve-function-alist)
 601     (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
 602       (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
 603             w3m-cid-retrieve-function-alist)))
 604   (setq mm-inline-text-html-with-images t))
 605
 606 (defvar w3m-current-buffer) ;; From `w3m.el'.
 607 (defvar notmuch-show-w3m-cid-store nil)
 608 (make-variable-buffer-local 'notmuch-show-w3m-cid-store)
 609
 610 (defun notmuch-show-w3m-cid-store-internal (content-id
 611                                             message-id
 612                                             part-number
 613                                             content-type
 614                                             content)
 615   (push (list content-id
 616               message-id
 617               part-number
 618               content-type
 619               content)
 620         notmuch-show-w3m-cid-store))
 621
 622 (defun notmuch-show-w3m-cid-store (msg part)
 623   (let ((content-id (plist-get part :content-id)))
 624     (when content-id
 625       (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
 626                                            (plist-get msg :id)
 627                                            (plist-get part :id)
 628                                            (plist-get part :content-type)
 629                                            nil))))
 630
 631 (defun notmuch-show-w3m-cid-retrieve (url &rest args)
 632   (let ((matching-part (with-current-buffer w3m-current-buffer
 633                          (assoc url notmuch-show-w3m-cid-store))))
 634     (if matching-part
 635         (let ((message-id (nth 1 matching-part))
 636               (part-number (nth 2 matching-part))
 637               (content-type (nth 3 matching-part))
 638               (content (nth 4 matching-part)))
 639           ;; If we don't already have the content, get it and cache
 640           ;; it, as some messages reference the same cid: part many
 641           ;; times (hundreds!), which results in many calls to
 642           ;; `notmuch part'.
 643           (unless content
 644             (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
 645                                                               part-number notmuch-show-process-crypto))
 646             (with-current-buffer w3m-current-buffer
 647               (notmuch-show-w3m-cid-store-internal url
 648                                                    message-id
 649                                                    part-number
 650                                                    content-type
 651                                                    content)))
 652           (insert content)
 653           content-type)
 654       nil)))
 655
 656 (defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
 657   (notmuch-show-insert-part-header nth declared-type content-type nil)
 658   (let ((inner-parts (plist-get part :content))
 659         (start (point)))
 660
 661     ;; We assume that the first part is text/html and the remainder
 662     ;; things that it references.
 663
 664     ;; Stash the non-primary parts.
 665     (mapc (lambda (part)
 666             (notmuch-show-w3m-cid-store msg part))
 667           (cdr inner-parts))
 668
 669     ;; Render the primary part.
 670     (notmuch-show-insert-bodypart msg (car inner-parts) depth)
 671
 672     (when notmuch-show-indent-multipart
 673       (indent-rigidly start (point) 1)))
 674   t)
 675
 676 (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
 677   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
 678     (button-put button 'face 'notmuch-crypto-part-header)
 679     ;; add signature status button if sigstatus provided
 680     (if (plist-member part :sigstatus)
 681         (let* ((from (notmuch-show-get-header :From msg))
 682                (sigstatus (car (plist-get part :sigstatus))))
 683           (notmuch-crypto-insert-sigstatus-button sigstatus from))
 684       ;; if we're not adding sigstatus, tell the user how they can get it
 685       (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
 686
 687   (let ((inner-parts (plist-get part :content))
 688         (start (point)))
 689     ;; Show all of the parts.
 690     (mapc (lambda (inner-part)
 691             (notmuch-show-insert-bodypart msg inner-part depth))
 692           inner-parts)
 693
 694     (when notmuch-show-indent-multipart
 695       (indent-rigidly start (point) 1)))
 696   t)
 697
 698 (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
 699   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
 700     (button-put button 'face 'notmuch-crypto-part-header)
 701     ;; add encryption status button if encstatus specified
 702     (if (plist-member part :encstatus)
 703         (let ((encstatus (car (plist-get part :encstatus))))
 704           (notmuch-crypto-insert-encstatus-button encstatus)
 705           ;; add signature status button if sigstatus specified
 706           (if (plist-member part :sigstatus)
 707               (let* ((from (notmuch-show-get-header :From msg))
 708                      (sigstatus (car (plist-get part :sigstatus))))
 709                 (notmuch-crypto-insert-sigstatus-button sigstatus from))))
 710       ;; if we're not adding encstatus, tell the user how they can get it
 711       (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
 712
 713   (let ((inner-parts (plist-get part :content))
 714         (start (point)))
 715     ;; Show all of the parts.
 716     (mapc (lambda (inner-part)
 717             (notmuch-show-insert-bodypart msg inner-part depth))
 718           inner-parts)
 719
 720     (when notmuch-show-indent-multipart
 721       (indent-rigidly start (point) 1)))
 722   t)
 723
 724 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
 725   (notmuch-show-insert-part-header nth declared-type content-type nil)
 726   (let ((inner-parts (plist-get part :content))
 727         (start (point)))
 728     ;; Show all of the parts.
 729     (mapc (lambda (inner-part)
 730             (notmuch-show-insert-bodypart msg inner-part depth))
 731           inner-parts)
 732
 733     (when notmuch-show-indent-multipart
 734       (indent-rigidly start (point) 1)))
 735   t)
 736
 737 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
 738   (notmuch-show-insert-part-header nth declared-type content-type nil)
 739   (let* ((message (car (plist-get part :content)))
 740          (body (car (plist-get message :body)))
 741          (start (point)))
 742
 743     ;; Override `notmuch-message-headers' to force `From' to be
 744     ;; displayed.
 745     (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
 746       (notmuch-show-insert-headers (plist-get message :headers)))
 747
 748     ;; Blank line after headers to be compatible with the normal
 749     ;; message display.
 750     (insert "\n")
 751
 752     ;; Show the body
 753     (notmuch-show-insert-bodypart msg body depth)
 754
 755     (when notmuch-show-indent-multipart
 756       (indent-rigidly start (point) 1)))
 757   t)
 758
 759 (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
 760   (let ((start (point)))
 761     ;; If this text/plain part is not the first part in the message,
 762     ;; insert a header to make this clear.
 763     (if (> nth 1)
 764         (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
 765     (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 766     (save-excursion
 767       (save-restriction
 768         (narrow-to-region start (point-max))
 769         (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
 770   t)
 771
 772 (defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
 773   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
 774   (insert (with-temp-buffer
 775             (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
 776             ;; notmuch-get-bodypart-content provides "raw", non-converted
 777             ;; data. Replace CRLF with LF before icalendar can use it.
 778             (goto-char (point-min))
 779             (while (re-search-forward "\r\n" nil t)
 780               (replace-match "\n" nil nil))
 781             (let ((file (make-temp-file "notmuch-ical"))
 782                   result)
 783               (unwind-protect
 784                   (progn
 785                     (unless (icalendar-import-buffer file t)
 786                       (error "Icalendar import error. See *icalendar-errors* for more information"))
 787                     (set-buffer (get-file-buffer file))
 788                     (setq result (buffer-substring (point-min) (point-max)))
 789                     (set-buffer-modified-p nil)
 790                     (kill-buffer (current-buffer)))
 791                 (delete-file file))
 792               result)))
 793   t)
 794
 795 ;; For backwards compatibility.
 796 (defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
 797   (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
 798
 799 (defun notmuch-show-insert-part-application/octet-stream (msg part content-type nth depth declared-type)
 800   ;; If we can deduce a MIME type from the filename of the attachment,
 801   ;; do so and pass it on to the handler for that type.
 802   (if (plist-get part :filename)
 803       (let ((extension (file-name-extension (plist-get part :filename)))
 804             mime-type)
 805         (if extension
 806             (progn
 807               (mailcap-parse-mimetypes)
 808               (setq mime-type (mailcap-extension-to-mime extension))
 809               (if (and mime-type
 810                        (not (string-equal mime-type "application/octet-stream")))
 811                   (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
 812                 nil))
 813           nil))))
 814
 815 ;; Handler for wash generated inline patch fake parts.
 816 (defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
 817   (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch"))
 818
 819 (defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type)
 820   ;; text/html handler to work around bugs in renderers and our
 821   ;; invisibile parts code. In particular w3m sets up a keymap which
 822   ;; "leaks" outside the invisible region and causes strange effects
 823   ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
 824   ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
 825   ;; remains).
 826   (let ((mm-inline-text-html-with-w3m-keymap nil))
 827     (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)))
 828
 829 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
 830   ;; This handler _must_ succeed - it is the handler of last resort.
 831   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
 832   (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
 833   t)
 834
 835 ;; Functions for determining how to handle MIME parts.
 836
 837 (defun notmuch-show-handlers-for (content-type)
 838   "Return a list of content handlers for a part of type CONTENT-TYPE."
 839   (let (result)
 840     (mapc (lambda (func)
 841             (if (functionp func)
 842                 (push func result)))
 843           ;; Reverse order of prefrence.
 844           (list (intern (concat "notmuch-show-insert-part-*/*"))
 845                 (intern (concat
 846                          "notmuch-show-insert-part-"
 847                          (car (notmuch-split-content-type content-type))
 848                          "/*"))
 849                 (intern (concat "notmuch-show-insert-part-" content-type))))
 850     result))
 851
 852 ;; \f
 853
 854 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
 855   (let ((handlers (notmuch-show-handlers-for content-type)))
 856     ;; Run the content handlers until one of them returns a non-nil
 857     ;; value.
 858     (while (and handlers
 859                 (not (condition-case err
 860                          (funcall (car handlers) msg part content-type nth depth declared-type)
 861                        (error (progn
 862                                 (insert "!!! Bodypart insert error: ")
 863                                 (insert (error-message-string err))
 864                                 (insert " !!!\n") nil)))))
 865       (setq handlers (cdr handlers))))
 866   t)
 867
 868 (defun notmuch-show-create-part-overlays (msg beg end hide)
 869   "Add an overlay to the part between BEG and END"
 870   (let* ((button (button-at beg))
 871          (part-beg (and button (1+ (button-end button)))))
 872
 873     ;; If the part contains no text we do not make it toggleable. We
 874     ;; also need to check that the button is a genuine part button not
 875     ;; a notmuch-wash button.
 876     (when (and button (/= part-beg end) (button-get button :base-label))
 877       (button-put button 'overlay (make-overlay part-beg end))
 878       ;; We toggle the button for hidden parts as that gets the
 879       ;; button label right.
 880       (save-excursion
 881         (when hide
 882           (notmuch-show-toggle-part-invisibility button))))))
 883
 884 (defun notmuch-show-insert-bodypart (msg part depth &optional hide)
 885   "Insert the body part PART at depth DEPTH in the current thread.
 886
 887 If HIDE is non-nil then initially hide this part."
 888   (let ((content-type (downcase (plist-get part :content-type)))
 889         (nth (plist-get part :id))
 890         (beg (point)))
 891
 892     (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
 893     ;; Some of the body part handlers leave point somewhere up in the
 894     ;; part, so we make sure that we're down at the end.
 895     (goto-char (point-max))
 896     ;; Ensure that the part ends with a carriage return.
 897     (unless (bolp)
 898       (insert "\n"))
 899     (notmuch-show-create-part-overlays msg beg (point) hide)))
 900
 901 (defun notmuch-show-insert-body (msg body depth)
 902   "Insert the body BODY at depth DEPTH in the current thread."
 903   (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
 904
 905 (defun notmuch-show-make-symbol (type)
 906   (make-symbol (concat "notmuch-show-" type)))
 907
 908 (defun notmuch-show-strip-re (string)
 909   (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
 910
 911 (defvar notmuch-show-previous-subject "")
 912 (make-variable-buffer-local 'notmuch-show-previous-subject)
 913
 914 (defun notmuch-show-insert-msg (msg depth)
 915   "Insert the message MSG at depth DEPTH in the current thread."
 916   (let* ((headers (plist-get msg :headers))
 917          ;; Indentation causes the buffer offset of the start/end
 918          ;; points to move, so we must use markers.
 919          message-start message-end
 920          content-start content-end
 921          headers-start headers-end
 922          (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
 923
 924     (setq message-start (point-marker))
 925
 926     (notmuch-show-insert-headerline headers
 927                                     (or (if notmuch-show-relative-dates
 928                                             (plist-get msg :date_relative)
 929                                           nil)
 930                                         (plist-get headers :Date))
 931                                     (plist-get msg :tags) depth)
 932
 933     (setq content-start (point-marker))
 934
 935     ;; Set `headers-start' to point after the 'Subject:' header to be
 936     ;; compatible with the existing implementation. This just sets it
 937     ;; to after the first header.
 938     (notmuch-show-insert-headers headers)
 939     (save-excursion
 940       (goto-char content-start)
 941       ;; If the subject of this message is the same as that of the
 942       ;; previous message, don't display it when this message is
 943       ;; collapsed.
 944       (when (not (string= notmuch-show-previous-subject
 945                           bare-subject))
 946         (forward-line 1))
 947       (setq headers-start (point-marker)))
 948     (setq headers-end (point-marker))
 949
 950     (setq notmuch-show-previous-subject bare-subject)
 951
 952     ;; A blank line between the headers and the body.
 953     (insert "\n")
 954     (notmuch-show-insert-body msg (plist-get msg :body)
 955                               (if notmuch-show-indent-content depth 0))
 956     ;; Ensure that the body ends with a newline.
 957     (unless (bolp)
 958       (insert "\n"))
 959     (setq content-end (point-marker))
 960
 961     ;; Indent according to the depth in the thread.
 962     (if notmuch-show-indent-content
 963         (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)))
 964
 965     (setq message-end (point-max-marker))
 966
 967     ;; Save the extents of this message over the whole text of the
 968     ;; message.
 969     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 970
 971     ;; Create overlays used to control visibility
 972     (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
 973     (plist-put msg :message-overlay (make-overlay headers-start content-end))
 974
 975     (plist-put msg :depth depth)
 976
 977     ;; Save the properties for this message. Currently this saves the
 978     ;; entire message (augmented it with other stuff), which seems
 979     ;; like overkill. We might save a reduced subset (for example, not
 980     ;; the content).
 981     (notmuch-show-set-message-properties msg)
 982
 983     ;; Set header visibility.
 984     (notmuch-show-headers-visible msg notmuch-message-headers-visible)
 985
 986     ;; Message visibility depends on whether it matched the search
 987     ;; criteria.
 988     (notmuch-show-message-visible msg (and (plist-get msg :match)
 989                                            (not (plist-get msg :excluded))))))
 990
 991 (defun notmuch-show-toggle-process-crypto ()
 992   "Toggle the processing of cryptographic MIME parts."
 993   (interactive)
 994   (setq notmuch-show-process-crypto (not notmuch-show-process-crypto))
 995   (message (if notmuch-show-process-crypto
 996                "Processing cryptographic MIME parts."
 997              "Not processing cryptographic MIME parts."))
 998   (notmuch-show-refresh-view))
 999
1000 (defun notmuch-show-toggle-elide-non-matching ()
1001   "Toggle the display of non-matching messages."
1002   (interactive)
1003   (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages))
1004   (message (if notmuch-show-elide-non-matching-messages
1005                "Showing matching messages only."
1006              "Showing all messages."))
1007   (notmuch-show-refresh-view))
1008
1009 (defun notmuch-show-toggle-thread-indentation ()
1010   "Toggle the indentation of threads."
1011   (interactive)
1012   (setq notmuch-show-indent-content (not notmuch-show-indent-content))
1013   (message (if notmuch-show-indent-content
1014                "Content is indented."
1015              "Content is not indented."))
1016   (notmuch-show-refresh-view))
1017
1018 (defun notmuch-show-insert-tree (tree depth)
1019   "Insert the message tree TREE at depth DEPTH in the current thread."
1020   (let ((msg (car tree))
1021         (replies (cadr tree)))
1022     ;; We test whether there is a message or just some replies.
1023     (when msg
1024       (notmuch-show-insert-msg msg depth))
1025     (notmuch-show-insert-thread replies (1+ depth))))
1026
1027 (defun notmuch-show-insert-thread (thread depth)
1028   "Insert the thread THREAD at depth DEPTH in the current forest."
1029   (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
1030
1031 (defun notmuch-show-insert-forest (forest)
1032   "Insert the forest of threads FOREST."
1033   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
1034
1035 (defvar notmuch-id-regexp
1036   (concat
1037    ;; Match the id: prefix only if it begins a word (to disallow, for
1038    ;; example, matching cid:).
1039    "\\<id:\\("
1040    ;; If the term starts with a ", then parse Xapian's quoted boolean
1041    ;; term syntax, which allows for anything as long as embedded
1042    ;; double quotes escaped by doubling them.  We also disallow
1043    ;; newlines (which Xapian allows) to prevent runaway terms.
1044    "\"\\([^\"\n]\\|\"\"\\)*\""
1045    ;; Otherwise, parse Xapian's unquoted syntax, which goes up to the
1046    ;; next space or ).  We disallow [.,;] as the last character
1047    ;; because these are probably part of the surrounding text, and not
1048    ;; part of the id.  This doesn't match single character ids; meh.
1049    "\\|[^\"[:space:])][^[:space:])]*[^])[:space:].,:;?!]"
1050    "\\)")
1051   "The regexp used to match id: links in messages.")
1052
1053 (defvar notmuch-mid-regexp
1054   ;; goto-address-url-regexp matched cid: links, which have the same
1055   ;; grammar as the message ID part of a mid: link.  Construct the
1056   ;; regexp using the same technique as goto-address-url-regexp.
1057   (concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
1058   "The regexp used to match mid: links in messages.
1059
1060 See RFC 2392.")
1061
1062 (defun notmuch-show-buttonise-links (start end)
1063   "Buttonise URLs and mail addresses between START and END.
1064
1065 This also turns id:\"<message id>\"-parts and mid: links into
1066 buttons for a corresponding notmuch search."
1067   (goto-address-fontify-region start end)
1068   (save-excursion
1069     (let (links)
1070       (goto-char start)
1071       (while (re-search-forward notmuch-id-regexp end t)
1072         (push (list (match-beginning 0) (match-end 0)
1073                     (match-string-no-properties 0)) links))
1074       (goto-char start)
1075       (while (re-search-forward notmuch-mid-regexp end t)
1076         (let* ((mid-cid (match-string-no-properties 1))
1077                (mid (save-match-data
1078                       (string-match "^[^/]*" mid-cid)
1079                       (url-unhex-string (match-string 0 mid-cid)))))
1080           (push (list (match-beginning 0) (match-end 0)
1081                       (notmuch-id-to-query mid)) links)))
1082       (dolist (link links)
1083         ;; Remove the overlay created by goto-address-mode
1084         (remove-overlays (first link) (second link) 'goto-address t)
1085         (make-text-button (first link) (second link)
1086                           :type 'notmuch-button-type
1087                           'action `(lambda (arg)
1088                                      (notmuch-show ,(third link)))
1089                           'follow-link t
1090                           'help-echo "Mouse-1, RET: search for this message"
1091                           'face goto-address-mail-face)))))
1092
1093 ;;;###autoload
1094 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
1095   "Run \"notmuch show\" with the given thread ID and display results.
1096
1097 The optional PARENT-BUFFER is the notmuch-search buffer from
1098 which this notmuch-show command was executed, (so that the
1099 next thread from that buffer can be show when done with this
1100 one).
1101
1102 The optional QUERY-CONTEXT is a notmuch search term. Only
1103 messages from the thread matching this search term are shown if
1104 non-nil.
1105
1106 The optional BUFFER-NAME provides the name of the buffer in
1107 which the message thread is shown. If it is nil (which occurs
1108 when the command is called interactively) the argument to the
1109 function is used."
1110   (interactive "sNotmuch show: ")
1111   (let ((buffer-name (generate-new-buffer-name
1112                       (or buffer-name
1113                           (concat "*notmuch-" thread-id "*")))))
1114     (switch-to-buffer (get-buffer-create buffer-name))
1115     ;; Set the default value for `notmuch-show-process-crypto' in this
1116     ;; buffer.
1117     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
1118     ;; Set the default value for
1119     ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
1120     ;; there is a prefix argument, invert the default.
1121     (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
1122     (if current-prefix-arg
1123         (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
1124
1125     (setq notmuch-show-thread-id thread-id
1126           notmuch-show-parent-buffer parent-buffer
1127           notmuch-show-query-context query-context)
1128     (notmuch-show-build-buffer)
1129     (notmuch-show-goto-first-wanted-message)
1130     (current-buffer)))
1131
1132 (defun notmuch-show-build-buffer ()
1133   (let ((inhibit-read-only t))
1134
1135     (notmuch-show-mode)
1136     ;; Don't track undo information for this buffer
1137     (set 'buffer-undo-list t)
1138
1139     (erase-buffer)
1140     (goto-char (point-min))
1141     (save-excursion
1142       (let* ((basic-args (list notmuch-show-thread-id))
1143              (args (if notmuch-show-query-context
1144                        (append (list "\'") basic-args
1145                                (list "and (" notmuch-show-query-context ")\'"))
1146                      (append (list "\'") basic-args (list "\'"))))
1147              (cli-args (cons "--exclude=false"
1148                              (when notmuch-show-elide-non-matching-messages
1149                                (list "--entire-thread=false")))))
1150
1151         (notmuch-show-insert-forest (notmuch-query-get-threads (append cli-args args)))
1152         ;; If the query context reduced the results to nothing, run
1153         ;; the basic query.
1154         (when (and (eq (buffer-size) 0)
1155                    notmuch-show-query-context)
1156           (notmuch-show-insert-forest
1157            (notmuch-query-get-threads (append cli-args basic-args)))))
1158
1159       (jit-lock-register #'notmuch-show-buttonise-links)
1160
1161       ;; Set the header line to the subject of the first message.
1162       (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
1163
1164       (run-hooks 'notmuch-show-hook))))
1165
1166 (defun notmuch-show-capture-state ()
1167   "Capture the state of the current buffer.
1168
1169 This includes:
1170  - the list of open messages,
1171  - the current message."
1172   (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages)))
1173
1174 (defun notmuch-show-apply-state (state)
1175   "Apply STATE to the current buffer.
1176
1177 This includes:
1178  - opening the messages previously opened,
1179  - closing all other messages,
1180  - moving to the correct current message."
1181   (let ((current (car state))
1182         (open (cadr state)))
1183
1184     ;; Open those that were open.
1185     (goto-char (point-min))
1186     (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
1187                                            (member (notmuch-show-get-message-id) open))
1188           until (not (notmuch-show-goto-message-next)))
1189
1190     ;; Go to the previously open message.
1191     (goto-char (point-min))
1192     (unless (loop if (string= current (notmuch-show-get-message-id))
1193                   return t
1194                   until (not (notmuch-show-goto-message-next)))
1195       (goto-char (point-min))
1196       (message "Previously current message not found."))
1197     (notmuch-show-message-adjust)))
1198
1199 (defun notmuch-show-refresh-view (&optional reset-state)
1200   "Refresh the current view.
1201
1202 Refreshes the current view, observing changes in display
1203 preferences. If invoked with a prefix argument (or RESET-STATE is
1204 non-nil) then the state of the buffer (open/closed messages) is
1205 reset based on the original query."
1206   (interactive "P")
1207   (let ((inhibit-read-only t)
1208         (state (unless reset-state
1209                  (notmuch-show-capture-state))))
1210     ;; erase-buffer does not seem to remove overlays, which can lead
1211     ;; to weird effects such as remaining images, so remove them
1212     ;; manually.
1213     (remove-overlays)
1214     (erase-buffer)
1215     (notmuch-show-build-buffer)
1216     (if state
1217         (notmuch-show-apply-state state)
1218       ;; We're resetting state, so navigate to the first open message
1219       ;; and mark it read, just like opening a new show buffer.
1220       (notmuch-show-goto-first-wanted-message))))
1221
1222 (defvar notmuch-show-stash-map
1223   (let ((map (make-sparse-keymap)))
1224     (define-key map "c" 'notmuch-show-stash-cc)
1225     (define-key map "d" 'notmuch-show-stash-date)
1226     (define-key map "F" 'notmuch-show-stash-filename)
1227     (define-key map "f" 'notmuch-show-stash-from)
1228     (define-key map "i" 'notmuch-show-stash-message-id)
1229     (define-key map "I" 'notmuch-show-stash-message-id-stripped)
1230     (define-key map "s" 'notmuch-show-stash-subject)
1231     (define-key map "T" 'notmuch-show-stash-tags)
1232     (define-key map "t" 'notmuch-show-stash-to)
1233     (define-key map "l" 'notmuch-show-stash-mlarchive-link)
1234     (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
1235     map)
1236   "Submap for stash commands")
1237 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
1238
1239 (defvar notmuch-show-mode-map
1240       (let ((map (make-sparse-keymap)))
1241         (define-key map "?" 'notmuch-help)
1242         (define-key map "q" 'notmuch-kill-this-buffer)
1243         (define-key map (kbd "<C-tab>") 'widget-backward)
1244         (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
1245         (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
1246         (define-key map (kbd "TAB") 'notmuch-show-next-button)
1247         (define-key map "s" 'notmuch-search)
1248         (define-key map "m" 'notmuch-mua-new-mail)
1249         (define-key map "f" 'notmuch-show-forward-message)
1250         (define-key map "r" 'notmuch-show-reply-sender)
1251         (define-key map "R" 'notmuch-show-reply)
1252         (define-key map "|" 'notmuch-show-pipe-message)
1253         (define-key map "w" 'notmuch-show-save-attachments)
1254         (define-key map "V" 'notmuch-show-view-raw-message)
1255         (define-key map "v" 'notmuch-show-view-all-mime-parts)
1256         (define-key map "c" 'notmuch-show-stash-map)
1257         (define-key map "=" 'notmuch-show-refresh-view)
1258         (define-key map "h" 'notmuch-show-toggle-visibility-headers)
1259         (define-key map "*" 'notmuch-show-tag-all)
1260         (define-key map "-" 'notmuch-show-remove-tag)
1261         (define-key map "+" 'notmuch-show-add-tag)
1262         (define-key map "X" 'notmuch-show-archive-thread-then-exit)
1263         (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)
1264         (define-key map "A" 'notmuch-show-archive-thread-then-next)
1265         (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)
1266         (define-key map "N" 'notmuch-show-next-message)
1267         (define-key map "P" 'notmuch-show-previous-message)
1268         (define-key map "n" 'notmuch-show-next-open-message)
1269         (define-key map "p" 'notmuch-show-previous-open-message)
1270         (define-key map (kbd "DEL") 'notmuch-show-rewind)
1271         (define-key map " " 'notmuch-show-advance-and-archive)
1272         (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
1273         (define-key map (kbd "RET") 'notmuch-show-toggle-message)
1274         (define-key map "#" 'notmuch-show-print-message)
1275         (define-key map "!" 'notmuch-show-toggle-elide-non-matching)
1276         (define-key map "$" 'notmuch-show-toggle-process-crypto)
1277         (define-key map "<" 'notmuch-show-toggle-thread-indentation)
1278         (define-key map "t" 'toggle-truncate-lines)
1279         map)
1280       "Keymap for \"notmuch show\" buffers.")
1281 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
1282
1283 (defun notmuch-show-mode ()
1284   "Major mode for viewing a thread with notmuch.
1285
1286 This buffer contains the results of the \"notmuch show\" command
1287 for displaying a single thread of email from your email archives.
1288
1289 By default, various components of email messages, (citations,
1290 signatures, already-read messages), are hidden. You can make
1291 these parts visible by clicking with the mouse button or by
1292 pressing RET after positioning the cursor on a hidden part, (for
1293 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
1294
1295 Reading the thread sequentially is well-supported by pressing
1296 \\[notmuch-show-advance-and-archive]. This will scroll the current message (if necessary), advance
1297 to the next message, or advance to the next thread (if already on
1298 the last message of a thread).
1299
1300 Other commands are available to read or manipulate the thread
1301 more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages
1302 without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread
1303 without scrolling through with \\[notmuch-show-advance-and-archive]).
1304
1305 You can add or remove arbitrary tags from the current message with
1306 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
1307
1308 All currently available key bindings:
1309
1310 \\{notmuch-show-mode-map}"
1311   (interactive)
1312   (kill-all-local-variables)
1313   (use-local-map notmuch-show-mode-map)
1314   (setq major-mode 'notmuch-show-mode
1315         mode-name "notmuch-show")
1316   (setq buffer-read-only t
1317         truncate-lines t))
1318
1319 (defun notmuch-show-move-to-message-top ()
1320   (goto-char (notmuch-show-message-top)))
1321
1322 (defun notmuch-show-move-to-message-bottom ()
1323   (goto-char (notmuch-show-message-bottom)))
1324
1325 (defun notmuch-show-message-adjust ()
1326   (recenter 0))
1327
1328 ;; Movement related functions.
1329
1330 ;; There's some strangeness here where a text property applied to a
1331 ;; region a->b is not found when point is at b. We walk backwards
1332 ;; until finding the property.
1333 (defun notmuch-show-message-extent ()
1334   (let (r)
1335     (save-excursion
1336       (while (not (setq r (get-text-property (point) :notmuch-message-extent)))
1337         (backward-char)))
1338     r))
1339
1340 (defun notmuch-show-message-top ()
1341   (car (notmuch-show-message-extent)))
1342
1343 (defun notmuch-show-message-bottom ()
1344   (cdr (notmuch-show-message-extent)))
1345
1346 (defun notmuch-show-goto-message-next ()
1347   (let ((start (point)))
1348     (notmuch-show-move-to-message-bottom)
1349     (if (not (eobp))
1350         t
1351       (goto-char start)
1352       nil)))
1353
1354 (defun notmuch-show-goto-message-previous ()
1355   (notmuch-show-move-to-message-top)
1356   (if (bobp)
1357       nil
1358     (backward-char)
1359     (notmuch-show-move-to-message-top)
1360     t))
1361
1362 (defun notmuch-show-mapc (function)
1363   "Iterate through all messages in the current thread with
1364 `notmuch-show-goto-message-next' and call FUNCTION for side
1365 effects."
1366   (save-excursion
1367     (goto-char (point-min))
1368     (loop do (funcall function)
1369           while (notmuch-show-goto-message-next))))
1370
1371 ;; Functions relating to the visibility of messages and their
1372 ;; components.
1373
1374 (defun notmuch-show-message-visible (props visible-p)
1375   (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
1376   (notmuch-show-set-prop :message-visible visible-p props))
1377
1378 (defun notmuch-show-headers-visible (props visible-p)
1379   (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
1380   (notmuch-show-set-prop :headers-visible visible-p props))
1381
1382 ;; Functions for setting and getting attributes of the current
1383 ;; message.
1384
1385 (defun notmuch-show-set-message-properties (props)
1386   (save-excursion
1387     (notmuch-show-move-to-message-top)
1388     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
1389
1390 (defun notmuch-show-get-message-properties ()
1391   "Return the properties of the current message as a plist.
1392
1393 Some useful entries are:
1394 :headers - Property list containing the headers :Date, :Subject, :From, etc.
1395 :body - Body of the message
1396 :tags - Tags for this message"
1397   (save-excursion
1398     (notmuch-show-move-to-message-top)
1399     (get-text-property (point) :notmuch-message-properties)))
1400
1401 (defun notmuch-show-set-prop (prop val &optional props)
1402   (let ((inhibit-read-only t)
1403         (props (or props
1404                    (notmuch-show-get-message-properties))))
1405     (plist-put props prop val)
1406     (notmuch-show-set-message-properties props)))
1407
1408 (defun notmuch-show-get-prop (prop &optional props)
1409   (let ((props (or props
1410                    (notmuch-show-get-message-properties))))
1411     (plist-get props prop)))
1412
1413 (defun notmuch-show-get-message-id (&optional bare)
1414   "Return an id: query for the Message-Id of the current message.
1415
1416 If optional argument BARE is non-nil, return
1417 the Message-Id without id: prefix and escaping."
1418   (if bare
1419       (notmuch-show-get-prop :id)
1420     (notmuch-id-to-query (notmuch-show-get-prop :id))))
1421
1422 (defun notmuch-show-get-messages-ids ()
1423   "Return all id: queries of messages in the current thread."
1424   (let ((message-ids))
1425     (notmuch-show-mapc
1426      (lambda () (push (notmuch-show-get-message-id) message-ids)))
1427     message-ids))
1428
1429 (defun notmuch-show-get-messages-ids-search ()
1430   "Return a search string for all message ids of messages in the
1431 current thread."
1432   (mapconcat 'identity (notmuch-show-get-messages-ids) " or "))
1433
1434 ;; dme: Would it make sense to use a macro for many of these?
1435
1436 (defun notmuch-show-get-filename ()
1437   "Return the filename of the current message."
1438   (notmuch-show-get-prop :filename))
1439
1440 (defun notmuch-show-get-header (header &optional props)
1441   "Return the named header of the current message, if any."
1442   (plist-get (notmuch-show-get-prop :headers props) header))
1443
1444 (defun notmuch-show-get-cc ()
1445   (notmuch-show-get-header :Cc))
1446
1447 (defun notmuch-show-get-date ()
1448   (notmuch-show-get-header :Date))
1449
1450 (defun notmuch-show-get-from ()
1451   (notmuch-show-get-header :From))
1452
1453 (defun notmuch-show-get-subject ()
1454   (notmuch-show-get-header :Subject))
1455
1456 (defun notmuch-show-get-to ()
1457   (notmuch-show-get-header :To))
1458
1459 (defun notmuch-show-get-depth ()
1460   (notmuch-show-get-prop :depth))
1461
1462 (defun notmuch-show-set-tags (tags)
1463   "Set the tags of the current message."
1464   (notmuch-show-set-prop :tags tags)
1465   (notmuch-show-update-tags tags))
1466
1467 (defun notmuch-show-get-tags ()
1468   "Return the tags of the current message."
1469   (notmuch-show-get-prop :tags))
1470
1471 (defun notmuch-show-message-visible-p ()
1472   "Is the current message visible?"
1473   (notmuch-show-get-prop :message-visible))
1474
1475 (defun notmuch-show-headers-visible-p ()
1476   "Are the headers of the current message visible?"
1477   (notmuch-show-get-prop :headers-visible))
1478
1479 (defun notmuch-show-mark-read (&optional unread)
1480   "Mark the current message as read.
1481
1482 Mark the current message as read by applying the tag changes in
1483 `notmuch-show-mark-read-tags' to it (remove the \"unread\" tag by
1484 default). If a prefix argument is given, the message will be
1485 marked as unread, i.e. the tag changes in
1486 `notmuch-show-mark-read-tags' will be reversed."
1487   (interactive "P")
1488   (when notmuch-show-mark-read-tags
1489     (apply 'notmuch-show-tag-message
1490            (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
1491
1492 ;; Functions for getting attributes of several messages in the current
1493 ;; thread.
1494
1495 (defun notmuch-show-get-message-ids-for-open-messages ()
1496   "Return a list of all id: queries for open messages in the current thread."
1497   (save-excursion
1498     (let (message-ids done)
1499       (goto-char (point-min))
1500       (while (not done)
1501         (if (notmuch-show-message-visible-p)
1502             (setq message-ids (append message-ids (list (notmuch-show-get-message-id)))))
1503         (setq done (not (notmuch-show-goto-message-next)))
1504         )
1505       message-ids
1506       )))
1507
1508 ;; Commands typically bound to keys.
1509
1510 (defun notmuch-show-advance ()
1511   "Advance through thread.
1512
1513 If the current message in the thread is not yet fully visible,
1514 scroll by a near screenful to read more of the message.
1515
1516 Otherwise, (the end of the current message is already within the
1517 current window), advance to the next open message."
1518   (interactive)
1519   (let* ((end-of-this-message (notmuch-show-message-bottom))
1520          (visible-end-of-this-message (1- end-of-this-message))
1521          (ret nil))
1522     (while (invisible-p visible-end-of-this-message)
1523       (setq visible-end-of-this-message
1524             (max (point-min)
1525                  (1- (previous-single-char-property-change
1526                       visible-end-of-this-message 'invisible)))))
1527     (cond
1528      ;; Ideally we would test `end-of-this-message' against the result
1529      ;; of `window-end', but that doesn't account for the fact that
1530      ;; the end of the message might be hidden.
1531      ((and visible-end-of-this-message
1532            (> visible-end-of-this-message (window-end)))
1533       ;; The bottom of this message is not visible - scroll.
1534       (scroll-up nil))
1535
1536      ((not (= end-of-this-message (point-max)))
1537       ;; This is not the last message - move to the next visible one.
1538       (notmuch-show-next-open-message))
1539
1540      ((not (= (point) (point-max)))
1541       ;; This is the last message, but the cursor is not at the end of
1542       ;; the buffer. Move it there.
1543       (goto-char (point-max)))
1544
1545      (t
1546       ;; This is the last message - change the return value
1547       (setq ret t)))
1548     ret))
1549
1550 (defun notmuch-show-advance-and-archive ()
1551   "Advance through thread and archive.
1552
1553 This command is intended to be one of the simplest ways to
1554 process a thread of email. It works exactly like
1555 notmuch-show-advance, in that it scrolls through messages in a
1556 show buffer, except that when it gets to the end of the buffer it
1557 archives the entire current thread, (remove the \"inbox\" tag
1558 from each message), kills the buffer, and displays the next
1559 thread from the search from which this thread was originally
1560 shown."
1561   (interactive)
1562   (if (notmuch-show-advance)
1563       (notmuch-show-archive-thread-then-next)))
1564
1565 (defun notmuch-show-rewind ()
1566   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
1567
1568 Specifically, if the beginning of the previous email is fewer
1569 than `window-height' lines from the current point, move to it
1570 just like `notmuch-show-previous-message'.
1571
1572 Otherwise, just scroll down a screenful of the current message.
1573
1574 This command does not modify any message tags, (it does not undo
1575 any effects from previous calls to
1576 `notmuch-show-advance-and-archive'."
1577   (interactive)
1578   (let ((start-of-message (notmuch-show-message-top))
1579         (start-of-window (window-start)))
1580     (cond
1581       ;; Either this message is properly aligned with the start of the
1582       ;; window or the start of this message is not visible on the
1583       ;; screen - scroll.
1584      ((or (= start-of-message start-of-window)
1585           (< start-of-message start-of-window))
1586       (scroll-down)
1587       ;; If a small number of lines from the previous message are
1588       ;; visible, realign so that the top of the current message is at
1589       ;; the top of the screen.
1590       (when (<= (count-screen-lines (window-start) start-of-message)
1591                 next-screen-context-lines)
1592         (goto-char (notmuch-show-message-top))
1593         (notmuch-show-message-adjust))
1594       ;; Move to the top left of the window.
1595       (goto-char (window-start)))
1596      (t
1597       ;; Move to the previous message.
1598       (notmuch-show-previous-message)))))
1599
1600 (defun notmuch-show-reply (&optional prompt-for-sender)
1601   "Reply to the sender and all recipients of the current message."
1602   (interactive "P")
1603   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t))
1604
1605 (defun notmuch-show-reply-sender (&optional prompt-for-sender)
1606   "Reply to the sender of the current message."
1607   (interactive "P")
1608   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil))
1609
1610 (defun notmuch-show-forward-message (&optional prompt-for-sender)
1611   "Forward the current message."
1612   (interactive "P")
1613   (with-current-notmuch-show-message
1614    (notmuch-mua-new-forward-message prompt-for-sender)))
1615
1616 (defun notmuch-show-next-message (&optional pop-at-end)
1617   "Show the next message.
1618
1619 If a prefix argument is given and this is the last message in the
1620 thread, navigate to the next thread in the parent search buffer."
1621   (interactive "P")
1622   (if (notmuch-show-goto-message-next)
1623       (progn
1624         (notmuch-show-mark-read)
1625         (notmuch-show-message-adjust))
1626     (if pop-at-end
1627         (notmuch-show-next-thread)
1628       (goto-char (point-max)))))
1629
1630 (defun notmuch-show-previous-message ()
1631   "Show the previous message or the start of the current message."
1632   (interactive)
1633   (if (= (point) (notmuch-show-message-top))
1634       (notmuch-show-goto-message-previous)
1635     (notmuch-show-move-to-message-top))
1636   (notmuch-show-mark-read)
1637   (notmuch-show-message-adjust))
1638
1639 (defun notmuch-show-next-open-message (&optional pop-at-end)
1640   "Show the next open message.
1641
1642 If a prefix argument is given and this is the last open message
1643 in the thread, navigate to the next thread in the parent search
1644 buffer. Return t if there was a next open message in the thread
1645 to show, nil otherwise."
1646   (interactive "P")
1647   (let (r)
1648     (while (and (setq r (notmuch-show-goto-message-next))
1649                 (not (notmuch-show-message-visible-p))))
1650     (if r
1651         (progn
1652           (notmuch-show-mark-read)
1653           (notmuch-show-message-adjust))
1654       (if pop-at-end
1655           (notmuch-show-next-thread)
1656         (goto-char (point-max))))
1657     r))
1658
1659 (defun notmuch-show-next-matching-message ()
1660   "Show the next matching message."
1661   (interactive)
1662   (let (r)
1663     (while (and (setq r (notmuch-show-goto-message-next))
1664                 (not (notmuch-show-get-prop :match))))
1665     (if r
1666         (progn
1667           (notmuch-show-mark-read)
1668           (notmuch-show-message-adjust))
1669       (goto-char (point-max)))))
1670
1671 (defun notmuch-show-open-if-matched ()
1672   "Open a message if it is matched (whether or not excluded)."
1673   (let ((props (notmuch-show-get-message-properties)))
1674     (notmuch-show-message-visible props (plist-get props :match))))
1675
1676 (defun notmuch-show-goto-first-wanted-message ()
1677   "Move to the first open message and mark it read"
1678   (goto-char (point-min))
1679   (if (notmuch-show-message-visible-p)
1680       (notmuch-show-mark-read)
1681     (notmuch-show-next-open-message))
1682   (when (eobp)
1683     ;; There are no matched non-excluded messages so open all matched
1684     ;; (necessarily excluded) messages and go to the first.
1685     (notmuch-show-mapc 'notmuch-show-open-if-matched)
1686     (force-window-update)
1687     (goto-char (point-min))
1688     (if (notmuch-show-message-visible-p)
1689         (notmuch-show-mark-read)
1690       (notmuch-show-next-open-message))))
1691
1692 (defun notmuch-show-previous-open-message ()
1693   "Show the previous open message."
1694   (interactive)
1695   (while (and (if (= (point) (notmuch-show-message-top))
1696                   (notmuch-show-goto-message-previous)
1697                 (notmuch-show-move-to-message-top))
1698               (not (notmuch-show-message-visible-p))))
1699   (notmuch-show-mark-read)
1700   (notmuch-show-message-adjust))
1701
1702 (defun notmuch-show-view-raw-message ()
1703   "View the file holding the current message."
1704   (interactive)
1705   (let* ((id (notmuch-show-get-message-id))
1706          (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
1707     (call-process notmuch-command nil buf nil "show" "--format=raw" id)
1708     (switch-to-buffer buf)
1709     (goto-char (point-min))
1710     (set-buffer-modified-p nil)
1711     (view-buffer buf 'kill-buffer-if-not-modified)))
1712
1713 (defun notmuch-show-pipe-message (entire-thread command)
1714   "Pipe the contents of the current message (or thread) to the given command.
1715
1716 The given command will be executed with the raw contents of the
1717 current email message as stdin. Anything printed by the command
1718 to stdout or stderr will appear in the *notmuch-pipe* buffer.
1719
1720 When invoked with a prefix argument, the command will receive all
1721 open messages in the current thread (formatted as an mbox) rather
1722 than only the current message."
1723   (interactive "P\nsPipe message to command: ")
1724   (let (shell-command)
1725     (if entire-thread
1726         (setq shell-command
1727               (concat notmuch-command " show --format=mbox --exclude=false "
1728                       (shell-quote-argument
1729                        (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
1730                       " | " command))
1731       (setq shell-command
1732             (concat notmuch-command " show --format=raw "
1733                     (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
1734     (let ((buf (get-buffer-create (concat "*notmuch-pipe*"))))
1735       (with-current-buffer buf
1736         (setq buffer-read-only nil)
1737         (erase-buffer)
1738         (let ((exit-code (call-process-shell-command shell-command nil buf)))
1739           (goto-char (point-max))
1740           (set-buffer-modified-p nil)
1741           (setq buffer-read-only t)
1742           (unless (zerop exit-code)
1743             (switch-to-buffer-other-window buf)
1744             (message (format "Command '%s' exited abnormally with code %d"
1745                              shell-command exit-code))))))))
1746
1747 (defun notmuch-show-tag-message (&rest tag-changes)
1748   "Change tags for the current message.
1749
1750 TAG-CHANGES is a list of tag operations for `notmuch-tag'."
1751   (let* ((current-tags (notmuch-show-get-tags))
1752          (new-tags (notmuch-update-tags current-tags tag-changes)))
1753     (unless (equal current-tags new-tags)
1754       (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes)
1755       (notmuch-show-set-tags new-tags))))
1756
1757 (defun notmuch-show-tag (&optional tag-changes)
1758   "Change tags for the current message.
1759
1760 See `notmuch-tag' for information on the format of TAG-CHANGES."
1761   (interactive)
1762   (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-message-id) tag-changes))
1763   (let* ((current-tags (notmuch-show-get-tags))
1764          (new-tags (notmuch-update-tags current-tags tag-changes)))
1765     (unless (equal current-tags new-tags)
1766       (notmuch-show-set-tags new-tags))))
1767
1768 (defun notmuch-show-tag-all (&optional tag-changes)
1769   "Change tags for all messages in the current show buffer.
1770
1771 See `notmuch-tag' for information on the format of TAG-CHANGES."
1772   (interactive)
1773   (setq tag-changes (funcall 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes))
1774   (notmuch-show-mapc
1775    (lambda ()
1776      (let* ((current-tags (notmuch-show-get-tags))
1777             (new-tags (notmuch-update-tags current-tags tag-changes)))
1778        (unless (equal current-tags new-tags)
1779          (notmuch-show-set-tags new-tags))))))
1780
1781 (defun notmuch-show-add-tag ()
1782   "Same as `notmuch-show-tag' but sets initial input to '+'."
1783   (interactive)
1784   (notmuch-show-tag "+"))
1785
1786 (defun notmuch-show-remove-tag ()
1787   "Same as `notmuch-show-tag' but sets initial input to '-'."
1788   (interactive)
1789   (notmuch-show-tag "-"))
1790
1791 (defun notmuch-show-toggle-visibility-headers ()
1792   "Toggle the visibility of the current message headers."
1793   (interactive)
1794   (let ((props (notmuch-show-get-message-properties)))
1795     (notmuch-show-headers-visible
1796      props
1797      (not (plist-get props :headers-visible))))
1798   (force-window-update))
1799
1800 (defun notmuch-show-toggle-message ()
1801   "Toggle the visibility of the current message."
1802   (interactive)
1803   (let ((props (notmuch-show-get-message-properties)))
1804     (notmuch-show-message-visible
1805      props
1806      (not (plist-get props :message-visible))))
1807   (force-window-update))
1808
1809 (defun notmuch-show-open-or-close-all ()
1810   "Set the visibility all of the messages in the current thread.
1811 By default make all of the messages visible. With a prefix
1812 argument, hide all of the messages."
1813   (interactive)
1814   (save-excursion
1815     (goto-char (point-min))
1816     (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
1817                                            (not current-prefix-arg))
1818           until (not (notmuch-show-goto-message-next))))
1819   (force-window-update))
1820
1821 (defun notmuch-show-next-button ()
1822   "Advance point to the next button in the buffer."
1823   (interactive)
1824   (forward-button 1))
1825
1826 (defun notmuch-show-previous-button ()
1827   "Move point back to the previous button in the buffer."
1828   (interactive)
1829   (backward-button 1))
1830
1831 (defun notmuch-show-next-thread (&optional show-next)
1832   "Move to the next item in the search results, if any."
1833   (interactive "P")
1834   (let ((parent-buffer notmuch-show-parent-buffer))
1835     (notmuch-kill-this-buffer)
1836     (when (buffer-live-p parent-buffer)
1837       (switch-to-buffer parent-buffer)
1838       (notmuch-search-next-thread)
1839       (if show-next
1840           (notmuch-search-show-thread)))))
1841
1842 (defun notmuch-show-archive-thread (&optional unarchive)
1843   "Archive each message in thread.
1844
1845 Archive each message currently shown by applying the tag changes
1846 in `notmuch-archive-tags' to each (remove the \"inbox\" tag by
1847 default). If a prefix argument is given, the messages will be
1848 \"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
1849 will be reversed.
1850
1851 Note: This command is safe from any race condition of new messages
1852 being delivered to the same thread. It does not archive the
1853 entire thread, but only the messages shown in the current
1854 buffer."
1855   (interactive "P")
1856   (when notmuch-archive-tags
1857     (notmuch-show-tag-all
1858      (notmuch-tag-change-list notmuch-archive-tags unarchive))))
1859
1860 (defun notmuch-show-archive-thread-then-next ()
1861   "Archive all messages in the current buffer, then show next thread from search."
1862   (interactive)
1863   (notmuch-show-archive-thread)
1864   (notmuch-show-next-thread t))
1865
1866 (defun notmuch-show-archive-thread-then-exit ()
1867   "Archive all messages in the current buffer, then exit back to search results."
1868   (interactive)
1869   (notmuch-show-archive-thread)
1870   (notmuch-show-next-thread))
1871
1872 (defun notmuch-show-archive-message (&optional unarchive)
1873   "Archive the current message.
1874
1875 Archive the current message by applying the tag changes in
1876 `notmuch-archive-tags' to it (remove the \"inbox\" tag by
1877 default). If a prefix argument is given, the message will be
1878 \"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
1879 will be reversed."
1880   (interactive "P")
1881   (when notmuch-archive-tags
1882     (apply 'notmuch-show-tag-message
1883            (notmuch-tag-change-list notmuch-archive-tags unarchive))))
1884
1885 (defun notmuch-show-archive-message-then-next-or-exit ()
1886   "Archive the current message, then show the next open message in the current thread.
1887
1888 If at the last open message in the current thread, then exit back
1889 to search results."
1890   (interactive)
1891   (notmuch-show-archive-message)
1892   (notmuch-show-next-open-message t))
1893
1894 (defun notmuch-show-archive-message-then-next-or-next-thread ()
1895   "Archive the current message, then show the next open message in the current thread.
1896
1897 If at the last open message in the current thread, then show next
1898 thread from search."
1899   (interactive)
1900   (notmuch-show-archive-message)
1901   (unless (notmuch-show-next-open-message)
1902     (notmuch-show-next-thread t)))
1903
1904 (defun notmuch-show-stash-cc ()
1905   "Copy CC field of current message to kill-ring."
1906   (interactive)
1907   (notmuch-common-do-stash (notmuch-show-get-cc)))
1908
1909 (defun notmuch-show-stash-date ()
1910   "Copy date of current message to kill-ring."
1911   (interactive)
1912   (notmuch-common-do-stash (notmuch-show-get-date)))
1913
1914 (defun notmuch-show-stash-filename ()
1915   "Copy filename of current message to kill-ring."
1916   (interactive)
1917   (notmuch-common-do-stash (notmuch-show-get-filename)))
1918
1919 (defun notmuch-show-stash-from ()
1920   "Copy From address of current message to kill-ring."
1921   (interactive)
1922   (notmuch-common-do-stash (notmuch-show-get-from)))
1923
1924 (defun notmuch-show-stash-message-id (&optional stash-thread-id)
1925   "Copy id: query matching the current message to kill-ring.
1926
1927 If invoked with a prefix argument (or STASH-THREAD-ID is
1928 non-nil), copy thread: query matching the current thread to
1929 kill-ring."
1930   (interactive "P")
1931   (if stash-thread-id
1932       (notmuch-common-do-stash notmuch-show-thread-id)
1933     (notmuch-common-do-stash (notmuch-show-get-message-id))))
1934
1935 (defun notmuch-show-stash-message-id-stripped ()
1936   "Copy message ID of current message (sans `id:' prefix) to kill-ring."
1937   (interactive)
1938   (notmuch-common-do-stash (notmuch-show-get-message-id t)))
1939
1940 (defun notmuch-show-stash-subject ()
1941   "Copy Subject field of current message to kill-ring."
1942   (interactive)
1943   (notmuch-common-do-stash (notmuch-show-get-subject)))
1944
1945 (defun notmuch-show-stash-tags ()
1946   "Copy tags of current message to kill-ring as a comma separated list."
1947   (interactive)
1948   (notmuch-common-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
1949
1950 (defun notmuch-show-stash-to ()
1951   "Copy To address of current message to kill-ring."
1952   (interactive)
1953   (notmuch-common-do-stash (notmuch-show-get-to)))
1954
1955 (defun notmuch-show-stash-mlarchive-link (&optional mla)
1956   "Copy an ML Archive URI for the current message to the kill-ring.
1957
1958 This presumes that the message is available at the selected Mailing List Archive.
1959
1960 If optional argument MLA is non-nil, use the provided key instead of prompting
1961 the user (see `notmuch-show-stash-mlarchive-link-alist')."
1962   (interactive)
1963   (notmuch-common-do-stash
1964    (concat (cdr (assoc
1965                  (or mla
1966                      (let ((completion-ignore-case t))
1967                        (completing-read
1968                         "Mailing List Archive: "
1969                         notmuch-show-stash-mlarchive-link-alist
1970                         nil t nil nil notmuch-show-stash-mlarchive-link-default)))
1971                  notmuch-show-stash-mlarchive-link-alist))
1972            (notmuch-show-get-message-id t))))
1973
1974 (defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
1975   "Copy an ML Archive URI for the current message to the kill-ring and visit it.
1976
1977 This presumes that the message is available at the selected Mailing List Archive.
1978
1979 If optional argument MLA is non-nil, use the provided key instead of prompting
1980 the user (see `notmuch-show-stash-mlarchive-link-alist')."
1981   (interactive)
1982   (notmuch-show-stash-mlarchive-link mla)
1983   (browse-url (current-kill 0 t)))
1984
1985 ;; Commands typically bound to buttons.
1986
1987 (defun notmuch-show-part-button-default (&optional button)
1988   (interactive)
1989   (let ((button (or button (button-at (point)))))
1990     (if (button-get button 'overlay)
1991         (notmuch-show-toggle-part-invisibility button)
1992       (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))))
1993
1994 (defun notmuch-show-part-button-save (&optional button)
1995   (interactive)
1996   (notmuch-show-part-button-internal button #'notmuch-show-save-part))
1997
1998 (defun notmuch-show-part-button-view (&optional button)
1999   (interactive)
2000   (notmuch-show-part-button-internal button #'notmuch-show-view-part))
2001
2002 (defun notmuch-show-part-button-interactively-view (&optional button)
2003   (interactive)
2004   (notmuch-show-part-button-internal button #'notmuch-show-interactively-view-part))
2005
2006 (defun notmuch-show-part-button-pipe (&optional button)
2007   (interactive)
2008   (notmuch-show-part-button-internal button #'notmuch-show-pipe-part))
2009
2010 (defun notmuch-show-part-button-internal (button handler)
2011   (let ((button (or button (button-at (point)))))
2012     (if button
2013         (let ((nth (button-get button :notmuch-part)))
2014           (if nth
2015               (funcall handler (notmuch-show-get-message-id) nth
2016                        (button-get button :notmuch-filename)
2017                        (button-get button :notmuch-content-type)))))))
2018
2019 ;;
2020
2021 (provide 'notmuch-show)