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

   1 ;; notmuch-show.el --- display notmuch messages within emacs
   2 ;;
   3 ;; Copyright © Carl Worth
   4 ;;
   5 ;; This file is part of Notmuch.
   6 ;;
   7 ;; Notmuch is free software: you can redistribute it and/or modify it
   8 ;; under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11 ;;
  12 ;; Notmuch is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
  19 ;;
  20 ;; Authors: Carl Worth <cworth@cworth.org>
  21
  22 ;; This is an part of an emacs-based interface to the notmuch mail system.
  23
  24 (require 'cl)
  25 (require 'mm-view)
  26 (require 'message)
  27
  28 (require 'notmuch-lib)
  29
  30 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
  31 (declare-function notmuch-count-attachments "notmuch" (mm-handle))
  32 (declare-function notmuch-reply "notmuch" (query-string))
  33 (declare-function notmuch-fontify-headers "notmuch" nil)
  34 (declare-function notmuch-toggle-invisible-action "notmuch" (cite-button))
  35 (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
  36 (declare-function notmuch-search-show-thread "notmuch" nil)
  37 (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
  38
  39 (defvar notmuch-show-stash-map
  40   (let ((map (make-sparse-keymap)))
  41     (define-key map "c" 'notmuch-show-stash-cc)
  42     (define-key map "d" 'notmuch-show-stash-date)
  43     (define-key map "F" 'notmuch-show-stash-filename)
  44     (define-key map "f" 'notmuch-show-stash-from)
  45     (define-key map "i" 'notmuch-show-stash-message-id)
  46     (define-key map "s" 'notmuch-show-stash-subject)
  47     (define-key map "T" 'notmuch-show-stash-tags)
  48     (define-key map "t" 'notmuch-show-stash-to)
  49     map)
  50   "Submap for stash commands"
  51   )
  52
  53 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
  54
  55 (defvar notmuch-show-mode-map
  56   (let ((map (make-sparse-keymap)))
  57     (define-key map "?" 'notmuch-help)
  58     (define-key map "q" 'kill-this-buffer)
  59     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
  60     (define-key map (kbd "C-n") 'notmuch-show-next-line)
  61     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
  62     (define-key map (kbd "TAB") 'notmuch-show-next-button)
  63     (define-key map "s" 'notmuch-search)
  64     (define-key map "m" 'message-mail)
  65     (define-key map "f" 'notmuch-show-forward-current)
  66     (define-key map "r" 'notmuch-show-reply)
  67     (define-key map "|" 'notmuch-show-pipe-message)
  68     (define-key map "w" 'notmuch-show-save-attachments)
  69     (define-key map "V" 'notmuch-show-view-raw-message)
  70     (define-key map "v" 'notmuch-show-view-all-mime-parts)
  71     (define-key map "c" 'notmuch-show-stash-map)
  72     (define-key map "b" 'notmuch-show-toggle-current-body)
  73     (define-key map "h" 'notmuch-show-toggle-current-header)
  74     (define-key map "-" 'notmuch-show-remove-tag)
  75     (define-key map "+" 'notmuch-show-add-tag)
  76     (define-key map "x" 'notmuch-show-archive-thread-then-exit)
  77     (define-key map "a" 'notmuch-show-archive-thread)
  78     (define-key map "P" 'notmuch-show-previous-message)
  79     (define-key map "N" 'notmuch-show-next-message)
  80     (define-key map "p" 'notmuch-show-previous-open-message)
  81     (define-key map "n" 'notmuch-show-next-open-message)
  82     (define-key map (kbd "DEL") 'notmuch-show-rewind)
  83     (define-key map " " 'notmuch-show-advance-and-archive)
  84     map)
  85   "Keymap for \"notmuch show\" buffers.")
  86 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
  87
  88 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
  89   "Pattern to match a line that separates content from signature.
  90
  91 The regexp can (and should) include $ to match the end of the
  92 line, but should not include ^ to match the beginning of the
  93 line. This is because notmuch may have inserted additional space
  94 for indentation at the beginning of the line. But notmuch will
  95 move past the indentation when testing this pattern, (so that the
  96 pattern can still test against the entire line).")
  97
  98 (defvar notmuch-show-signature-button-format
  99   "[ %d-line signature. Click/Enter to toggle visibility. ]"
 100   "String used to construct button text for hidden signatures
 101
 102 Can use up to one integer format parameter, i.e. %d")
 103
 104 (defvar notmuch-show-citation-button-format
 105   "[ %d more citation lines. Click/Enter to toggle visibility. ]"
 106   "String used to construct button text for hidden citations.
 107
 108 Can use up to one integer format parameter, i.e. %d")
 109
 110 (defvar notmuch-show-signature-lines-max 12
 111   "Maximum length of signature that will be hidden by default.")
 112
 113 (defvar notmuch-show-citation-lines-prefix 4
 114   "Always show at least this many lines of a citation.
 115
 116 If there is one more line, show that, otherwise collapse
 117 remaining lines into a button.")
 118
 119 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
 120 (defvar notmuch-show-message-end-regexp      "\fmessage}")
 121 (defvar notmuch-show-header-begin-regexp     "\fheader{")
 122 (defvar notmuch-show-header-end-regexp       "\fheader}")
 123 (defvar notmuch-show-body-begin-regexp       "\fbody{")
 124 (defvar notmuch-show-body-end-regexp         "\fbody}")
 125 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
 126 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
 127 (defvar notmuch-show-part-begin-regexp       "\fpart{")
 128 (defvar notmuch-show-part-end-regexp         "\fpart}")
 129 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
 130
 131 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
 132 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
 133 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
 134 (defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
 135
 136 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
 137
 138 (defvar notmuch-show-parent-buffer nil)
 139 (defvar notmuch-show-body-read-visible nil)
 140 (defvar notmuch-show-citations-visible nil)
 141 (defvar notmuch-show-signatures-visible nil)
 142 (defvar notmuch-show-headers-visible nil)
 143
 144 (defun notmuch-show-next-line ()
 145   "Like builtin `next-line' but ensuring we end on a visible character.
 146
 147 By advancing forward until reaching a visible character.
 148
 149 Unlike builtin `next-line' this version accepts no arguments."
 150   (interactive)
 151   (set 'this-command 'next-line)
 152   (call-interactively 'next-line)
 153   (while (point-invisible-p)
 154     (forward-char)))
 155
 156 (defun notmuch-show-previous-line ()
 157   "Like builtin `previous-line' but ensuring we end on a visible character.
 158
 159 By advancing forward until reaching a visible character.
 160
 161 Unlike builtin `previous-line' this version accepts no arguments."
 162   (interactive)
 163   (set 'this-command 'previous-line)
 164   (call-interactively 'previous-line)
 165   (while (point-invisible-p)
 166     (forward-char)))
 167
 168 (defun notmuch-show-get-message-id ()
 169   (save-excursion
 170     (beginning-of-line)
 171     (if (not (looking-at notmuch-show-message-begin-regexp))
 172         (re-search-backward notmuch-show-message-begin-regexp))
 173     (re-search-forward notmuch-show-id-regexp)
 174     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 175
 176 (defun notmuch-show-get-filename ()
 177   (save-excursion
 178     (beginning-of-line)
 179     (if (not (looking-at notmuch-show-message-begin-regexp))
 180         (re-search-backward notmuch-show-message-begin-regexp))
 181     (re-search-forward notmuch-show-filename-regexp)
 182     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 183
 184 (defun notmuch-show-set-tags (tags)
 185   (save-excursion
 186     (beginning-of-line)
 187     (if (not (looking-at notmuch-show-message-begin-regexp))
 188         (re-search-backward notmuch-show-message-begin-regexp))
 189     (re-search-forward notmuch-show-tags-regexp)
 190     (let ((inhibit-read-only t)
 191           (beg (match-beginning 1))
 192           (end (match-end 1)))
 193       (delete-region beg end)
 194       (goto-char beg)
 195       (insert (mapconcat 'identity tags " ")))))
 196
 197 (defun notmuch-show-get-tags ()
 198   (save-excursion
 199     (beginning-of-line)
 200     (if (not (looking-at notmuch-show-message-begin-regexp))
 201         (re-search-backward notmuch-show-message-begin-regexp))
 202     (re-search-forward notmuch-show-tags-regexp)
 203     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
 204
 205 (defun notmuch-show-get-bcc ()
 206   "Return BCC address(es) of current message"
 207   (notmuch-show-get-header-field 'bcc))
 208
 209 (defun notmuch-show-get-cc ()
 210   "Return CC address(es) of current message"
 211   (notmuch-show-get-header-field 'cc))
 212
 213 (defun notmuch-show-get-date ()
 214   "Return Date of current message"
 215   (notmuch-show-get-header-field 'date))
 216
 217 (defun notmuch-show-get-from ()
 218   "Return From address of current message"
 219   (notmuch-show-get-header-field 'from))
 220
 221 (defun notmuch-show-get-subject ()
 222   "Return Subject of current message"
 223   (notmuch-show-get-header-field 'subject))
 224
 225 (defun notmuch-show-get-to ()
 226   "Return To address(es) of current message"
 227   (notmuch-show-get-header-field 'to))
 228
 229 (defun notmuch-show-get-header-field (name)
 230   "Retrieve the header field NAME from the current message.
 231 NAME should be a symbol, in lower case, as returned by
 232 mail-header-extract-no-properties"
 233   (let* ((result (assoc name (notmuch-show-get-header)))
 234         (val (and result (cdr result))))
 235     val))
 236
 237 (defun notmuch-show-get-header ()
 238   "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
 239 where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
 240 pseudoheader summary"
 241   (require 'mailheader)
 242   (save-excursion
 243     (beginning-of-line)
 244     (if (not (looking-at notmuch-show-message-begin-regexp))
 245         (re-search-backward notmuch-show-message-begin-regexp))
 246     (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
 247     (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
 248           (beg (point)))
 249       (re-search-forward notmuch-show-header-end-regexp)
 250       (let ((text (buffer-substring beg (match-beginning 0))))
 251         (with-temp-buffer
 252           (insert text)
 253           (goto-char (point-min))
 254           (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
 255             (delete-region (match-beginning 1) (match-end 1))
 256             (forward-line)
 257             )
 258           (goto-char (point-min))
 259           (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
 260
 261 (defun notmuch-show-add-tag (&rest toadd)
 262   "Add a tag to the current message."
 263   (interactive
 264    (list (notmuch-select-tag-with-completion "Tag to add: ")))
 265   (apply 'notmuch-call-notmuch-process
 266          (append (cons "tag"
 267                        (mapcar (lambda (s) (concat "+" s)) toadd))
 268                  (cons (notmuch-show-get-message-id) nil)))
 269   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
 270
 271 (defun notmuch-show-remove-tag (&rest toremove)
 272   "Remove a tag from the current message."
 273   (interactive
 274    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
 275   (let ((tags (notmuch-show-get-tags)))
 276     (if (intersection tags toremove :test 'string=)
 277         (progn
 278           (apply 'notmuch-call-notmuch-process
 279                  (append (cons "tag"
 280                                (mapcar (lambda (s) (concat "-" s)) toremove))
 281                          (cons (notmuch-show-get-message-id) nil)))
 282           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
 283
 284 (defun notmuch-show-archive-thread ()
 285   "Archive each message in thread, then show next thread from search.
 286
 287 Archive each message currently shown by removing the \"inbox\"
 288 tag from each. Then kill this buffer and show the next thread
 289 from the search from which this thread was originally shown.
 290
 291 Note: This command is safe from any race condition of new messages
 292 being delivered to the same thread. It does not archive the
 293 entire thread, but only the messages shown in the current
 294 buffer."
 295   (interactive)
 296   (save-excursion
 297     (goto-char (point-min))
 298     (while (not (eobp))
 299       (notmuch-show-remove-tag "inbox")
 300       (if (not (eobp))
 301           (forward-char))
 302       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
 303           (goto-char (point-max)))))
 304   (let ((parent-buffer notmuch-show-parent-buffer))
 305     (kill-this-buffer)
 306     (if parent-buffer
 307         (progn
 308           (switch-to-buffer parent-buffer)
 309           (forward-line)
 310           (notmuch-search-show-thread)))))
 311
 312 (defun notmuch-show-archive-thread-then-exit ()
 313   "Archive each message in thread, then exit back to search results."
 314   (interactive)
 315   (notmuch-show-archive-thread)
 316   (kill-this-buffer))
 317
 318 (defun notmuch-show-view-raw-message ()
 319   "View the raw email of the current message."
 320   (interactive)
 321   (view-file (notmuch-show-get-filename)))
 322
 323 (defmacro with-current-notmuch-show-message (&rest body)
 324   "Evaluate body with current buffer set to the text of current message"
 325   `(save-excursion
 326      (let ((filename (notmuch-show-get-filename)))
 327        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
 328          (with-current-buffer buf
 329            (insert-file-contents filename nil nil nil t)
 330            ,@body)
 331          (kill-buffer buf)))))
 332
 333 (defun notmuch-show-view-all-mime-parts ()
 334   "Use external viewers to view all attachments from the current message."
 335   (interactive)
 336   (with-current-notmuch-show-message
 337    ; We ovverride the mm-inline-media-tests to indicate which message
 338    ; parts are already sufficiently handled by the original
 339    ; presentation of the message in notmuch-show mode. These parts
 340    ; will be inserted directly into the temporary buffer of
 341    ; with-current-notmuch-show-message and silently discarded.
 342    ;
 343    ; Any MIME part not explicitly mentioned here will be handled by an
 344    ; external viewer as configured in the various mailcap files.
 345    (let ((mm-inline-media-tests '(
 346                                   ("text/.*" ignore identity)
 347                                   ("application/pgp-signature" ignore identity)
 348                                   ("multipart/alternative" ignore identity)
 349                                   ("multipart/mixed" ignore identity)
 350                                   ("multipart/related" ignore identity)
 351                                  )))
 352      (mm-display-parts (mm-dissect-buffer)))))
 353
 354 (defun notmuch-show-save-attachments ()
 355   "Save all attachments from the current message."
 356   (interactive)
 357   (with-current-notmuch-show-message
 358    (let ((mm-handle (mm-dissect-buffer)))
 359      (notmuch-save-attachments
 360       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
 361   (message "Done"))
 362
 363 (defun notmuch-show-reply ()
 364   "Begin composing a reply to the current message in a new buffer."
 365   (interactive)
 366   (let ((message-id (notmuch-show-get-message-id)))
 367     (notmuch-reply message-id)))
 368
 369 (defun notmuch-show-forward-current ()
 370   "Forward the current message."
 371   (interactive)
 372   (with-current-notmuch-show-message
 373    (message-forward)))
 374
 375 (defun notmuch-show-pipe-message (command)
 376   "Pipe the contents of the current message to the given command.
 377
 378 The given command will be executed with the raw contents of the
 379 current email message as stdin. Anything printed by the command
 380 to stdout or stderr will appear in the *Messages* buffer."
 381   (interactive "sPipe message to command: ")
 382   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
 383          (list command " < " (shell-quote-argument (notmuch-show-get-filename)))))
 384
 385 (defun notmuch-show-move-to-current-message-summary-line ()
 386   "Move to the beginning of the one-line summary of the current message.
 387
 388 This gives us a stable place to move to and work from since the
 389 summary line is always visible. This is important since moving to
 390 an invisible location is unreliable, (the main command loop moves
 391 point either forward or backward to the next visible character
 392 when a command ends with point on an invisible character).
 393
 394 Emits an error if point is not within a valid message, (that is
 395 no pattern of `notmuch-show-message-begin-regexp' could be found
 396 by searching backward)."
 397   (beginning-of-line)
 398   (if (not (looking-at notmuch-show-message-begin-regexp))
 399       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
 400           (forward-line 2)
 401         (error "Not within a valid message."))
 402     (forward-line 2)))
 403
 404 (defun notmuch-show-last-message-p ()
 405   "Predicate testing whether point is within the last message."
 406   (save-window-excursion
 407     (save-excursion
 408       (notmuch-show-move-to-current-message-summary-line)
 409       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
 410
 411 (defun notmuch-show-message-unread-p ()
 412   "Predicate testing whether current message is unread."
 413   (member "unread" (notmuch-show-get-tags)))
 414
 415 (defun notmuch-show-message-open-p ()
 416   "Predicate testing whether current message is open (body is visible)."
 417   (let ((btn (previous-button (point) t)))
 418     (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type))
 419       (setq btn (previous-button (button-start btn))))
 420     (not (invisible-p (button-get btn 'invisibility-spec)))))
 421
 422 (defun notmuch-show-next-message-without-marking-read ()
 423   "Advance to the beginning of the next message in the buffer.
 424
 425 Moves to the last visible character of the current message if
 426 already on the last message in the buffer.
 427
 428 Returns nil if already on the last message in the buffer."
 429   (notmuch-show-move-to-current-message-summary-line)
 430   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 431       (progn
 432         (notmuch-show-move-to-current-message-summary-line)
 433         (recenter 0)
 434         t)
 435     (goto-char (- (point-max) 1))
 436     (while (point-invisible-p)
 437       (backward-char))
 438     (recenter 0)
 439     nil))
 440
 441 (defun notmuch-show-next-message ()
 442   "Advance to the next message (whether open or closed)
 443 and remove the unread tag from that message.
 444
 445 Moves to the last visible character of the current message if
 446 already on the last message in the buffer.
 447
 448 Returns nil if already on the last message in the buffer."
 449   (interactive)
 450   (notmuch-show-next-message-without-marking-read)
 451   (notmuch-show-mark-read))
 452
 453 (defun notmuch-show-find-next-message ()
 454   "Returns the position of the next message in the buffer.
 455
 456 Or the position of the last visible character of the current
 457 message if already within the last message in the buffer."
 458   ; save-excursion doesn't save our window position
 459   ; save-window-excursion doesn't save point
 460   ; Looks like we have to use both.
 461   (save-excursion
 462     (save-window-excursion
 463       (notmuch-show-next-message-without-marking-read)
 464       (point))))
 465
 466 (defun notmuch-show-next-unread-message ()
 467   "Advance to the next unread message.
 468
 469 Moves to the last visible character of the current message if
 470 there are no more unread messages past the current point."
 471   (notmuch-show-next-message-without-marking-read)
 472   (while (and (not (notmuch-show-last-message-p))
 473               (not (notmuch-show-message-unread-p)))
 474     (notmuch-show-next-message-without-marking-read))
 475   (if (not (notmuch-show-message-unread-p))
 476       (notmuch-show-next-message-without-marking-read))
 477   (notmuch-show-mark-read))
 478
 479 (defun notmuch-show-next-open-message ()
 480   "Advance to the next open message (that is, body is visible).
 481
 482 Moves to the last visible character of the final message in the buffer
 483 if there are no more open messages."
 484   (interactive)
 485   (while (and (notmuch-show-next-message-without-marking-read)
 486               (not (notmuch-show-message-open-p))))
 487   (notmuch-show-mark-read))
 488
 489 (defun notmuch-show-previous-message-without-marking-read ()
 490   "Backup to the beginning of the previous message in the buffer.
 491
 492 If within a message rather than at the beginning of it, then
 493 simply move to the beginning of the current message.
 494
 495 Returns nil if already on the first message in the buffer."
 496   (let ((start (point)))
 497     (notmuch-show-move-to-current-message-summary-line)
 498     (if (not (< (point) start))
 499         ; Go backward twice to skip the current message's marker
 500         (progn
 501           (re-search-backward notmuch-show-message-begin-regexp nil t)
 502           (re-search-backward notmuch-show-message-begin-regexp nil t)
 503           (notmuch-show-move-to-current-message-summary-line)
 504           (recenter 0)
 505           (if (= (point) start)
 506               nil
 507             t))
 508       (recenter 0)
 509       nil)))
 510
 511 (defun notmuch-show-previous-message ()
 512   "Backup to the previous message (whether open or closed)
 513 and remove the unread tag from that message.
 514
 515 If within a message rather than at the beginning of it, then
 516 simply move to the beginning of the current message."
 517   (interactive)
 518   (notmuch-show-previous-message-without-marking-read)
 519   (notmuch-show-mark-read))
 520
 521 (defun notmuch-show-find-previous-message ()
 522   "Returns the position of the previous message in the buffer.
 523
 524 Or the position of the beginning of the current message if point
 525 is originally within the message rather than at the beginning of
 526 it."
 527   ; save-excursion doesn't save our window position
 528   ; save-window-excursion doesn't save point
 529   ; Looks like we have to use both.
 530   (save-excursion
 531     (save-window-excursion
 532       (notmuch-show-previous-message-without-marking-read)
 533       (point))))
 534
 535 (defun notmuch-show-previous-open-message ()
 536   "Backup to previous open message (that is, body is visible).
 537
 538 Moves to the first message in the buffer if there are no previous
 539 open messages."
 540   (interactive)
 541   (while (and (notmuch-show-previous-message-without-marking-read)
 542               (not (notmuch-show-message-open-p))))
 543   (notmuch-show-mark-read))
 544
 545 (defun notmuch-show-rewind ()
 546   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
 547
 548 Specifically, if the beginning of the previous email is fewer
 549 than `window-height' lines from the current point, move to it
 550 just like `notmuch-show-previous-message'.
 551
 552 Otherwise, just scroll down a screenful of the current message.
 553
 554 This command does not modify any message tags, (it does not undo
 555 any effects from previous calls to
 556 `notmuch-show-advance-and-archive'."
 557   (interactive)
 558   (let ((previous (notmuch-show-find-previous-message)))
 559     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
 560         (progn
 561           (condition-case nil
 562               (scroll-down nil)
 563             ((beginning-of-buffer) nil))
 564           (goto-char (window-start))
 565           ; Because count-lines counts invivisible lines, we may have
 566           ; scrolled to far. If so., notice this and fix it up.
 567           (if (< (point) previous)
 568               (progn
 569                 (goto-char previous)
 570                 (recenter 0))))
 571       (notmuch-show-previous-message))))
 572
 573 (defun notmuch-show-advance-and-archive ()
 574   "Advance through thread and archive.
 575
 576 This command is intended to be one of the simplest ways to
 577 process a thread of email. It does the following:
 578
 579 If the current message in the thread is not yet fully visible,
 580 scroll by a near screenful to read more of the message.
 581
 582 Otherwise, (the end of the current message is already within the
 583 current window), advance to the next open message.
 584
 585 Finally, if there is no further message to advance to, and this
 586 last message is already read, then archive the entire current
 587 thread, (remove the \"inbox\" tag from each message). Also kill
 588 this buffer, and display the next thread from the search from
 589 which this thread was originally shown."
 590   (interactive)
 591   (let ((next (notmuch-show-find-next-message))
 592         (unread (notmuch-show-message-unread-p)))
 593     (if (> next (window-end))
 594         (scroll-up nil)
 595       (let ((last (notmuch-show-last-message-p)))
 596         (notmuch-show-next-open-message)
 597         (if last
 598             (notmuch-show-archive-thread))))))
 599
 600 (defun notmuch-show-next-button ()
 601   "Advance point to the next button in the buffer."
 602   (interactive)
 603   (forward-button 1))
 604
 605 (defun notmuch-show-previous-button ()
 606   "Move point back to the previous button in the buffer."
 607   (interactive)
 608   (backward-button 1))
 609
 610 (defun notmuch-show-toggle-current-body ()
 611   "Toggle the display of the current message body."
 612   (interactive)
 613   (save-excursion
 614     (notmuch-show-move-to-current-message-summary-line)
 615     (unless (button-at (point))
 616       (notmuch-show-next-button))
 617     (push-button))
 618   )
 619
 620 (defun notmuch-show-toggle-current-header ()
 621   "Toggle the display of the current message header."
 622   (interactive)
 623   (save-excursion
 624     (notmuch-show-move-to-current-message-summary-line)
 625     (forward-line)
 626     (unless (button-at (point))
 627       (notmuch-show-next-button))
 628     (push-button))
 629   )
 630
 631 (defun notmuch-show-citation-regexp (depth)
 632   "Build a regexp for matching citations at a given DEPTH (indent)"
 633   (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth)))
 634     (concat "\\(?:^" line-regexp
 635             "\\(?:[[:space:]]*\n" line-regexp
 636             "\\)?\\)+")))
 637
 638 (defun notmuch-show-region-to-button (beg end type prefix button-text)
 639   "Auxilary function to do the actual making of overlays and buttons
 640
 641 BEG and END are buffer locations. TYPE should a string, either
 642 \"citation\" or \"signature\". PREFIX is some arbitrary text to
 643 insert before the button, probably for indentation.  BUTTON-TEXT
 644 is what to put on the button."
 645
 646 ;; This uses some slightly tricky conversions between strings and
 647 ;; symbols because of the way the button code works. Note that
 648 ;; replacing intern-soft with make-symbol will cause this to fail,
 649 ;; since the newly created symbol has no plist.
 650
 651   (let ((overlay (make-overlay beg end))
 652         (invis-spec (make-symbol (concat "notmuch-" type "-region")))
 653         (button-type (intern-soft (concat "notmuch-button-"
 654                                           type "-toggle-type"))))
 655     (add-to-invisibility-spec invis-spec)
 656     (overlay-put overlay 'invisible invis-spec)
 657     (goto-char (1+ end))
 658     (save-excursion
 659       (goto-char (1- beg))
 660       (insert prefix)
 661       (insert-button button-text
 662                      'invisibility-spec invis-spec
 663                      :type button-type)
 664       )))
 665
 666 (defun notmuch-show-markup-citations-region (beg end depth)
 667   "Markup citations, and up to one signature in the given region"
 668   ;; it would be nice if the untabify was not required, but
 669   ;; that would require notmuch to indent with spaces.
 670   (untabify beg end)
 671   (let ((citation-regexp (notmuch-show-citation-regexp depth))
 672         (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
 673                                   notmuch-show-signature-regexp))
 674         (indent (concat "\n" (make-string depth ? ))))
 675     (goto-char beg)
 676     (beginning-of-line)
 677     (while (and (< (point) end)
 678                 (re-search-forward citation-regexp end t))
 679       (let* ((cite-start (match-beginning 0))
 680              (cite-end  (match-end 0))
 681              (cite-lines (count-lines cite-start cite-end)))
 682         (when (> cite-lines (1+ notmuch-show-citation-lines-prefix))
 683           (goto-char cite-start)
 684           (forward-line notmuch-show-citation-lines-prefix)
 685           (notmuch-show-region-to-button
 686            (point) cite-end
 687            "citation"
 688            indent
 689            (format notmuch-show-citation-button-format
 690                    (- cite-lines notmuch-show-citation-lines-prefix))
 691            ))))
 692     (if (and (< (point) end)
 693              (re-search-forward signature-regexp end t))
 694         (let* ((sig-start (match-beginning 0))
 695                (sig-end (match-end 0))
 696                (sig-lines (1- (count-lines sig-start end))))
 697           (if (<= sig-lines notmuch-show-signature-lines-max)
 698               (notmuch-show-region-to-button
 699                sig-start
 700                end
 701                "signature"
 702                indent
 703                (format notmuch-show-signature-button-format sig-lines)
 704                ))))))
 705
 706 (defun notmuch-show-markup-part (beg end depth)
 707   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 708       (progn
 709         (let (mime-message mime-type)
 710           (save-excursion
 711             (re-search-forward notmuch-show-contentype-regexp end t)
 712             (setq mime-type (car (split-string (buffer-substring
 713                                                 (match-beginning 1) (match-end 1))))))
 714
 715           (if (equal mime-type "text/html")
 716               (let ((filename (notmuch-show-get-filename)))
 717                 (with-temp-buffer
 718                   (insert-file-contents filename nil nil nil t)
 719                   (setq mime-message (mm-dissect-buffer)))))
 720           (forward-line)
 721           (let ((beg (point-marker)))
 722             (re-search-forward notmuch-show-part-end-regexp)
 723             (let ((end (copy-marker (match-beginning 0))))
 724               (goto-char end)
 725               (if (not (bolp))
 726                   (insert "\n"))
 727               (indent-rigidly beg end depth)
 728               (if (not (eq mime-message nil))
 729                   (save-excursion
 730                     (goto-char beg)
 731                     (forward-line -1)
 732                     (let ((handle-type (mm-handle-type mime-message))
 733                           mime-type)
 734                       (if (sequencep (car handle-type))
 735                           (setq mime-type (car handle-type))
 736                         (setq mime-type (car (car (cdr handle-type))))
 737                         )
 738                       (if (equal mime-type "text/html")
 739                           (mm-display-part mime-message))))
 740                 )
 741               (notmuch-show-markup-citations-region beg end depth)
 742               ; Advance to the next part (if any) (so the outer loop can
 743               ; determine whether we've left the current message.
 744               (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 745                   (beginning-of-line)))))
 746         (goto-char end))
 747     (goto-char end)))
 748
 749 (defun notmuch-show-markup-parts-region (beg end depth)
 750   (save-excursion
 751     (goto-char beg)
 752     (while (< (point) end)
 753       (notmuch-show-markup-part beg end depth))))
 754
 755 (defun notmuch-show-markup-body (depth match btn)
 756   "Markup a message body, (indenting, buttonizing citations,
 757 etc.), and hiding the body itself if the message does not match
 758 the current search.
 759
 760 DEPTH specifies the depth at which this message appears in the
 761 tree of the current thread, (the top-level messages have depth 0
 762 and each reply increases depth by 1). MATCH indicates whether
 763 this message is regarded as matching the current search. BTN is
 764 the button which is used to toggle the visibility of this
 765 message.
 766
 767 When this function is called, point must be within the message, but
 768 before the delimiter marking the beginning of the body."
 769   (re-search-forward notmuch-show-body-begin-regexp)
 770   (forward-line)
 771   (let ((beg (point-marker)))
 772     (re-search-forward notmuch-show-body-end-regexp)
 773     (let ((end (copy-marker (match-beginning 0))))
 774       (notmuch-show-markup-parts-region beg end depth)
 775       (let ((invis-spec (make-symbol "notmuch-show-body-read")))
 776         (overlay-put (make-overlay beg end)
 777                      'invisible invis-spec)
 778         (button-put btn 'invisibility-spec invis-spec)
 779         (if (not match)
 780             (add-to-invisibility-spec invis-spec)))
 781       (set-marker beg nil)
 782       (set-marker end nil)
 783       )))
 784
 785 (defun notmuch-show-markup-header (message-begin depth)
 786   "Buttonize and decorate faces in a message header.
 787
 788 MESSAGE-BEGIN is the position of the absolute first character in
 789 the message (including all delimiters that will end up being
 790 invisible etc.). This is to allow a button to reliably extend to
 791 the beginning of the message even if point is positioned at an
 792 invisible character (such as the beginning of the buffer).
 793
 794 DEPTH specifies the depth at which this message appears in the
 795 tree of the current thread, (the top-level messages have depth 0
 796 and each reply increases depth by 1)."
 797   (re-search-forward notmuch-show-header-begin-regexp)
 798   (forward-line)
 799   (let ((beg (point-marker))
 800         (summary-end (copy-marker (line-beginning-position 2)))
 801         (subject-end (copy-marker (line-end-position 2)))
 802         (invis-spec (make-symbol "notmuch-show-header"))
 803         (btn nil))
 804     (re-search-forward notmuch-show-header-end-regexp)
 805     (beginning-of-line)
 806     (let ((end (point-marker)))
 807       (indent-rigidly beg end depth)
 808       (goto-char beg)
 809       (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type))
 810       (forward-line)
 811       (add-to-invisibility-spec invis-spec)
 812       (overlay-put (make-overlay subject-end end)
 813                    'invisible invis-spec)
 814       (make-button (line-beginning-position) subject-end
 815                    'invisibility-spec invis-spec
 816                    :type 'notmuch-button-headers-toggle-type)
 817       (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:")
 818         (beginning-of-line)
 819         (notmuch-fontify-headers)
 820         (forward-line)
 821         )
 822       (goto-char end)
 823       (insert "\n")
 824       (set-marker beg nil)
 825       (set-marker summary-end nil)
 826       (set-marker subject-end nil)
 827       (set-marker end nil)
 828       )
 829   btn))
 830
 831 (defun notmuch-show-markup-message ()
 832   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 833       (let ((message-begin (match-beginning 0)))
 834         (re-search-forward notmuch-show-depth-match-regexp)
 835         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
 836               (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2))))
 837               (btn nil))
 838           (setq btn (notmuch-show-markup-header message-begin depth))
 839           (notmuch-show-markup-body depth match btn)))
 840     (goto-char (point-max))))
 841
 842 (defun notmuch-show-hide-markers ()
 843   (save-excursion
 844     (goto-char (point-min))
 845     (while (not (eobp))
 846       (if (re-search-forward notmuch-show-marker-regexp nil t)
 847           (progn
 848             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
 849                          'invisible 'notmuch-show-marker))
 850         (goto-char (point-max))))))
 851
 852 (defun notmuch-show-markup-messages ()
 853   (save-excursion
 854     (goto-char (point-min))
 855     (while (not (eobp))
 856       (notmuch-show-markup-message)))
 857   (notmuch-show-hide-markers))
 858
 859 ;;;###autoload
 860 (defun notmuch-show-mode ()
 861   "Major mode for viewing a thread with notmuch.
 862
 863 This buffer contains the results of the \"notmuch show\" command
 864 for displaying a single thread of email from your email archives.
 865
 866 By default, various components of email messages, (citations,
 867 signatures, already-read messages), are hidden. You can make
 868 these parts visible by clicking with the mouse button or by
 869 pressing RET after positioning the cursor on a hidden part, (for
 870 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
 871
 872 Reading the thread sequentially is well-supported by pressing
 873 \\[notmuch-show-advance-and-archive]. This will
 874 scroll the current message (if necessary), advance to the next
 875 message, or advance to the next thread (if already on the last
 876 message of a thread).
 877
 878 Other commands are available to read or manipulate the thread more
 879 selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without
 880 removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without
 881 scrolling through with \\[notmuch-show-advance-and-archive]).
 882
 883 You can add or remove arbitary tags from the current message with
 884 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
 885
 886 All currently available key bindings:
 887
 888 \\{notmuch-show-mode-map}"
 889   (interactive)
 890   (kill-all-local-variables)
 891   (add-to-invisibility-spec 'notmuch-show-marker)
 892   (use-local-map notmuch-show-mode-map)
 893   (setq major-mode 'notmuch-show-mode
 894         mode-name "notmuch-show")
 895   (setq buffer-read-only t))
 896
 897 (defcustom notmuch-show-hook nil
 898   "List of functions to call when notmuch displays a message."
 899   :type 'hook
 900   :options '(goto-address)
 901   :group 'notmuch)
 902
 903 (defun notmuch-show-do-stash (text)
 904     (kill-new text)
 905     (message (concat "Saved: " text)))
 906
 907 (defun notmuch-show-stash-cc ()
 908   "Copy CC field of current message to kill-ring."
 909   (interactive)
 910   (notmuch-show-do-stash (notmuch-show-get-cc)))
 911
 912 (defun notmuch-show-stash-date ()
 913   "Copy date of current message to kill-ring."
 914   (interactive)
 915   (notmuch-show-do-stash (notmuch-show-get-date)))
 916
 917 (defun notmuch-show-stash-filename ()
 918   "Copy filename of current message to kill-ring."
 919   (interactive)
 920   (notmuch-show-do-stash (notmuch-show-get-filename)))
 921
 922 (defun notmuch-show-stash-from ()
 923   "Copy From address of current message to kill-ring."
 924   (interactive)
 925   (notmuch-show-do-stash (notmuch-show-get-from)))
 926
 927 (defun notmuch-show-stash-message-id ()
 928   "Copy message ID of current message to kill-ring."
 929   (interactive)
 930   (notmuch-show-do-stash (notmuch-show-get-message-id)))
 931
 932 (defun notmuch-show-stash-subject ()
 933   "Copy Subject field of current message to kill-ring."
 934   (interactive)
 935   (notmuch-show-do-stash (notmuch-show-get-subject)))
 936
 937 (defun notmuch-show-stash-tags ()
 938   "Copy tags of current message to kill-ring as a comma separated list."
 939   (interactive)
 940   (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
 941
 942 (defun notmuch-show-stash-to ()
 943   "Copy To address of current message to kill-ring."
 944   (interactive)
 945   (notmuch-show-do-stash (notmuch-show-get-to)))
 946
 947 ; Make show mode a bit prettier, highlighting URLs and using word wrap
 948
 949 (defun notmuch-show-mark-read ()
 950   (notmuch-show-remove-tag "unread"))
 951
 952 (defun notmuch-show-pretty-hook ()
 953   (goto-address-mode 1)
 954   (visual-line-mode))
 955
 956 (add-hook 'notmuch-show-hook 'notmuch-show-mark-read)
 957 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
 958 (add-hook 'notmuch-search-hook
 959           (lambda()
 960             (hl-line-mode 1) ))
 961
 962 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
 963   "Run \"notmuch show\" with the given thread ID and display results.
 964
 965 The optional PARENT-BUFFER is the notmuch-search buffer from
 966 which this notmuch-show command was executed, (so that the next
 967 thread from that buffer can be show when done with this one).
 968
 969 The optional QUERY-CONTEXT is a notmuch search term. Only
 970 messages from the thread matching this search term are shown if
 971 non-nil.
 972
 973 The optional BUFFER-NAME provides the name of the buffer in which
 974 the message thread is shown. If it is nil (which occurs when the
 975 command is called interactively) the argument to the function is
 976 used."
 977   (interactive "sNotmuch show: ")
 978   (when (null buffer-name)
 979     (setq buffer-name (concat "*notmuch-" thread-id "*")))
 980   (let* ((thread-buffer-name (generate-new-buffer-name buffer-name))
 981          (buffer (get-buffer-create thread-buffer-name)))
 982     (switch-to-buffer buffer)
 983     (notmuch-show-mode)
 984     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
 985     (let ((proc (get-buffer-process (current-buffer)))
 986           (inhibit-read-only t))
 987       (if proc
 988           (error "notmuch search process already running for query `%s'" thread-id)
 989         )
 990       (erase-buffer)
 991       (goto-char (point-min))
 992       (save-excursion
 993         (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id))
 994                 (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args)))
 995           (apply 'call-process args)
 996           (when (and (eq (buffer-size) 0) query-context)
 997             (apply 'call-process basic-args)))
 998         (notmuch-show-markup-messages)
 999         )
1000       (run-hooks 'notmuch-show-hook)
1001       ; Move straight to the first open message
1002       (if (not (notmuch-show-message-open-p))
1003           (notmuch-show-next-open-message))
1004       )))
1005
1006 (provide 'notmuch-show)