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