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