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