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