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

   1 ; notmuch.el --- run notmuch 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 (require 'cl)
  23 (require 'mm-view)
  24
  25 (defvar notmuch-show-mode-map
  26   (let ((map (make-sparse-keymap)))
  27     ; I don't actually want all of these toggle commands occupying
  28     ; keybindings. They steal valuable key-binding space, are hard
  29     ; to remember, and act globally rather than locally.
  30     ;
  31     ; Will be much preferable to switch to direct manipulation for
  32     ; toggling visibility of these components. Probably using
  33     ; overlays-at to query and manipulate the current overlay.
  34     (define-key map "a" 'notmuch-show-archive-thread)
  35     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
  36     (define-key map "b" 'notmuch-show-toggle-body-read-visible)
  37     (define-key map "c" 'notmuch-show-toggle-citations-visible)
  38     (define-key map "h" 'notmuch-show-toggle-headers-visible)
  39     (define-key map "m" 'message-mail)
  40     (define-key map "n" 'notmuch-show-next-message)
  41     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
  42     (define-key map "p" 'notmuch-show-previous-message)
  43     (define-key map (kbd "C-n") 'notmuch-show-next-line)
  44     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
  45     (define-key map "q" 'kill-this-buffer)
  46     (define-key map "r" 'notmuch-show-reply)
  47     (define-key map "s" 'notmuch-show-toggle-signatures-visible)
  48     (define-key map "v" 'notmuch-show-view-all-mime-parts)
  49     (define-key map "w" 'notmuch-show-view-raw-message)
  50     (define-key map "x" 'kill-this-buffer)
  51     (define-key map "+" 'notmuch-show-add-tag)
  52     (define-key map "-" 'notmuch-show-remove-tag)
  53     (define-key map (kbd "DEL") 'notmuch-show-rewind)
  54     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
  55     (define-key map "|" 'notmuch-show-pipe-message)
  56     (define-key map "?" 'describe-mode)
  57     map)
  58   "Keymap for \"notmuch show\" buffers.")
  59 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
  60
  61 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
  62   "Pattern to match a line that separates content from signature.
  63
  64 The regexp can (and should) include $ to match the end of the
  65 line, but should not include ^ to match the beginning of the
  66 line. This is because notmuch may have inserted additional space
  67 for indentation at the beginning of the line. But notmuch will
  68 move past the indentation when testing this pattern, (so that the
  69 pattern can still test against the entire line).")
  70
  71 (defvar notmuch-show-signature-lines-max 12
  72   "Maximum length of signature that will be hidden by default.")
  73
  74 (defvar notmuch-command "notmuch"
  75   "Command to run the notmuch binary.")
  76
  77 (set 'notmuch-show-message-begin-regexp    "\fmessage{")
  78 (set 'notmuch-show-message-end-regexp      "\fmessage}")
  79 (set 'notmuch-show-header-begin-regexp     "\fheader{")
  80 (set 'notmuch-show-header-end-regexp       "\fheader}")
  81 (set 'notmuch-show-body-begin-regexp       "\fbody{")
  82 (set 'notmuch-show-body-end-regexp         "\fbody}")
  83 (set 'notmuch-show-attachment-begin-regexp "\fattachment{")
  84 (set 'notmuch-show-attachment-end-regexp   "\fattachment}")
  85 (set 'notmuch-show-part-begin-regexp       "\fpart{")
  86 (set 'notmuch-show-part-end-regexp         "\fpart}")
  87 (set 'notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
  88
  89 (set 'notmuch-show-id-regexp "\\(id:[^ ]*\\)")
  90 (set 'notmuch-show-depth-regexp " depth:\\([0-9]*\\) ")
  91 (set 'notmuch-show-filename-regexp "filename:\\(.*\\)$")
  92 (set 'notmuch-show-tags-regexp "(\\([^)]*\\))$")
  93
  94 ; XXX: This should be a generic function in emacs somewhere, not here
  95 (defun point-invisible-p ()
  96   "Return whether the character at point is invisible.
  97
  98 Here visibility is determined by `buffer-invisibility-spec' and
  99 the invisible property of any overlays for point. It doesn't have
 100 anything to do with whether point is currently being displayed
 101 within the current window."
 102   (let ((prop (get-char-property (point) 'invisible)))
 103     (if (eq buffer-invisibility-spec t)
 104         prop
 105       (or (memq prop buffer-invisibility-spec)
 106           (assq prop buffer-invisibility-spec)))))
 107
 108 (defun notmuch-show-next-line ()
 109   "Like builtin `next-line' but ensuring we end on a visible character.
 110
 111 By advancing forward until reaching a visible character.
 112
 113 Unlike builtin `next-line' this version accepts no arguments."
 114   (interactive)
 115   (set 'this-command 'next-line)
 116   (call-interactively 'next-line)
 117   (while (point-invisible-p)
 118     (forward-char)))
 119
 120 (defun notmuch-show-previous-line ()
 121   "Like builtin `previous-line' but ensuring we end on a visible character.
 122
 123 By advancing forward until reaching a visible character.
 124
 125 Unlike builtin `next-line' this version accepts no arguments."
 126   (interactive)
 127   (set 'this-command 'previous-line)
 128   (call-interactively 'previous-line)
 129   (while (point-invisible-p)
 130     (forward-char)))
 131
 132 (defun notmuch-show-get-message-id ()
 133   (save-excursion
 134     (beginning-of-line)
 135     (if (not (looking-at notmuch-show-message-begin-regexp))
 136         (re-search-backward notmuch-show-message-begin-regexp))
 137     (re-search-forward notmuch-show-id-regexp)
 138     (buffer-substring (match-beginning 1) (match-end 1))))
 139
 140 (defun notmuch-show-get-filename ()
 141   (save-excursion
 142     (beginning-of-line)
 143     (if (not (looking-at notmuch-show-message-begin-regexp))
 144         (re-search-backward notmuch-show-message-begin-regexp))
 145     (re-search-forward notmuch-show-filename-regexp)
 146     (buffer-substring (match-beginning 1) (match-end 1))))
 147
 148 (defun notmuch-show-set-tags (tags)
 149   (save-excursion
 150     (beginning-of-line)
 151     (if (not (looking-at notmuch-show-message-begin-regexp))
 152         (re-search-backward notmuch-show-message-begin-regexp))
 153     (re-search-forward notmuch-show-tags-regexp)
 154     (let ((inhibit-read-only t)
 155           (beg (match-beginning 1))
 156           (end (match-end 1)))
 157       (delete-region beg end)
 158       (goto-char beg)
 159       (insert (mapconcat 'identity tags " ")))))
 160
 161 (defun notmuch-show-get-tags ()
 162   (save-excursion
 163     (beginning-of-line)
 164     (if (not (looking-at notmuch-show-message-begin-regexp))
 165         (re-search-backward notmuch-show-message-begin-regexp))
 166     (re-search-forward notmuch-show-tags-regexp)
 167     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
 168
 169 (defun notmuch-show-add-tag (&rest toadd)
 170   "Add a tag to the current message."
 171   (interactive "sTag to add: ")
 172   (apply 'notmuch-call-notmuch-process
 173          (append (cons "tag"
 174                        (mapcar (lambda (s) (concat "+" s)) toadd))
 175                  (cons (notmuch-show-get-message-id) nil)))
 176   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
 177
 178 (defun notmuch-show-remove-tag (&rest toremove)
 179   "Remove a tag from the current message."
 180   (interactive "sTag to remove: ")
 181   (let ((tags (notmuch-show-get-tags)))
 182     (if (intersection tags toremove :test 'string=)
 183         (progn
 184           (apply 'notmuch-call-notmuch-process
 185                  (append (cons "tag"
 186                                (mapcar (lambda (s) (concat "-" s)) toremove))
 187                          (cons (notmuch-show-get-message-id) nil)))
 188           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
 189
 190 (defun notmuch-show-archive-thread-maybe-mark-read (markread)
 191   (save-excursion
 192     (goto-char (point-min))
 193     (while (not (eobp))
 194       (if markread
 195           (notmuch-show-remove-tag "unread" "inbox")
 196         (notmuch-show-remove-tag "inbox"))
 197       (if (not (eobp))
 198           (forward-char))
 199       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
 200           (goto-char (point-max)))))
 201   (let ((parent-buffer notmuch-show-parent-buffer))
 202     (kill-this-buffer)
 203     (if parent-buffer
 204         (progn
 205           (switch-to-buffer parent-buffer)
 206           (forward-line)
 207           (notmuch-search-show-thread)))))
 208
 209 (defun notmuch-show-mark-read-then-archive-thread ()
 210   "Remove \"unread\" tag from each message, then archive and show next thread.
 211
 212 Archive each message currently shown by removing the \"unread\"
 213 and \"inbox\" tag from each. Then kill this buffer and show the
 214 next thread from the search from which this thread was originally
 215 shown.
 216
 217 Note: This command is safe from any race condition of new messages
 218 being delivered to the same thread. It does not archive the
 219 entire thread, but only the messages shown in the current
 220 buffer."
 221   (interactive)
 222   (notmuch-show-archive-thread-maybe-mark-read t))
 223
 224 (defun notmuch-show-archive-thread ()
 225   "Archive each message in thread, and show next thread from search.
 226
 227 Archive each message currently shown by removing the \"inbox\"
 228 tag from each. Then kill this buffer and show the next thread
 229 from the search from which this thread was originally shown.
 230
 231 Note: This command is safe from any race condition of new messages
 232 being delivered to the same thread. It does not archive the
 233 entire thread, but only the messages shown in the current
 234 buffer."
 235   (interactive)
 236   (notmuch-show-archive-thread-maybe-mark-read nil))
 237
 238 (defun notmuch-show-view-raw-message ()
 239   "View the raw email of the current message."
 240   (interactive)
 241   (view-file (notmuch-show-get-filename)))
 242
 243 (defun notmuch-show-view-all-mime-parts ()
 244   "Use external viewers (according to mailcap) to view all MIME-encoded parts."
 245   (interactive)
 246   (save-excursion
 247     (let ((filename (notmuch-show-get-filename)))
 248       (switch-to-buffer (generate-new-buffer (concat "*notmuch-mime-"
 249                                                      filename
 250                                                      "*")))
 251       (insert-file-contents filename nil nil nil t)
 252       (mm-display-parts (mm-dissect-buffer))
 253       (kill-this-buffer))))
 254
 255 (defun notmuch-reply (query-string)
 256   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
 257   (call-process notmuch-command nil t nil "reply" query-string)
 258   (goto-char (point-min))
 259   (if (re-search-forward "^$" nil t)
 260       (progn
 261         (insert "--text follows this line--")
 262         (forward-line)))
 263   (message-mode))
 264
 265 (defun notmuch-show-reply ()
 266   "Begin composing a reply to the current message in a new buffer."
 267   (interactive)
 268   (let ((message-id (notmuch-show-get-message-id)))
 269     (notmuch-reply message-id)))
 270
 271 (defun notmuch-show-pipe-message (command)
 272   "Pipe the contents of the current message to the given command.
 273
 274 The given command will be executed with the raw contents of the
 275 current email message as stdin. Anything printed by the command
 276 to stdout or stderr will appear in the *Messages* buffer."
 277   (interactive "sPipe message to command: ")
 278   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" (split-string (concat command " < " (notmuch-show-get-filename)))))
 279
 280 (defun notmuch-show-move-to-current-message-summary-line ()
 281   "Move to the beginning of the one-line summary of the current message.
 282
 283 This gives us a stable place to move to and work from since the
 284 summary line is always visible. This is important since moving to
 285 an invisible location is unreliable, (the main command loop moves
 286 point either forward or backward to the next visible character
 287 when a command ends with point on an invisible character).
 288
 289 Emits an error if point is not within a valid message, (that is
 290 not pattern of `notmuch-show-message-begin-regexp' could be found
 291 by searching backward)."
 292   (beginning-of-line)
 293   (if (not (looking-at notmuch-show-message-begin-regexp))
 294       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
 295           (forward-line 2)
 296         (error "Not within a valid message."))
 297     (forward-line 2)))
 298
 299 (defun notmuch-show-last-message-p ()
 300   "Predicate testing whether point is within the last message."
 301   (save-window-excursion
 302     (save-excursion
 303       (notmuch-show-move-to-current-message-summary-line)
 304       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
 305
 306 (defun notmuch-show-message-unread-p ()
 307   "Preficate testing whether current message is unread."
 308   (member "unread" (notmuch-show-get-tags)))
 309
 310 (defun notmuch-show-next-message ()
 311   "Advance to the beginning of the next message in the buffer.
 312
 313 Moves to the last visible character of the current message if
 314 already on the last message in the buffer."
 315   (interactive)
 316   (notmuch-show-move-to-current-message-summary-line)
 317   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 318       (notmuch-show-move-to-current-message-summary-line)
 319     (goto-char (- (point-max) 1))
 320     (while (point-invisible-p)
 321       (backward-char)))
 322   (recenter 0))
 323
 324 (defun notmuch-show-find-next-message ()
 325   "Returns the position of the next message in the buffer.
 326
 327 Or the position of the last visible character of the current
 328 message if already within the last message in the buffer."
 329   ; save-excursion doesn't save our window position
 330   ; save-window-excursion doesn't save point
 331   ; Looks like we have to use both.
 332   (save-excursion
 333     (save-window-excursion
 334       (notmuch-show-next-message)
 335       (point))))
 336
 337 (defun notmuch-show-next-unread-message ()
 338   "Advance to the beginning of the next unread message in the buffer.
 339
 340 Moves to the last visible character of the current message if
 341 there are no more unread messages past the current point."
 342   (notmuch-show-next-message)
 343   (while (and (not (notmuch-show-last-message-p))
 344               (not (notmuch-show-message-unread-p)))
 345     (notmuch-show-next-message))
 346   (if (not (notmuch-show-message-unread-p))
 347       (notmuch-show-next-message)))
 348
 349 (defun notmuch-show-next-open-message ()
 350   "Advance to the next message which is not hidden.
 351
 352 If read messages are currently hidden, advance to the next unread
 353 message. Otherwise, advance to the next message."
 354   (if (or (memq 'notmuch-show-body-read buffer-invisibility-spec)
 355           (assq 'notmuch-show-body-read buffer-invisibility-spec))
 356       (notmuch-show-next-unread-message)
 357     (notmuch-show-next-message)))
 358
 359 (defun notmuch-show-previous-message ()
 360   "Backup to the beginning of the previous message in the buffer.
 361
 362 If within a message rather than at the beginning of it, then
 363 simply move to the beginning of the current message."
 364   (interactive)
 365   (let ((start (point)))
 366     (notmuch-show-move-to-current-message-summary-line)
 367     (if (not (< (point) start))
 368         ; Go backward twice to skip the current message's marker
 369         (progn
 370           (re-search-backward notmuch-show-message-begin-regexp nil t)
 371           (re-search-backward notmuch-show-message-begin-regexp nil t)
 372           (notmuch-show-move-to-current-message-summary-line)
 373           ))
 374     (recenter 0)))
 375
 376 (defun notmuch-show-find-previous-message ()
 377   "Returns the position of the previous message in the buffer.
 378
 379 Or the position of the beginning of the current message if point
 380 is originally within the message rather than at the beginning of
 381 it."
 382   ; save-excursion doesn't save our window position
 383   ; save-window-excursion doesn't save point
 384   ; Looks like we have to use both.
 385   (save-excursion
 386     (save-window-excursion
 387       (notmuch-show-previous-message)
 388       (point))))
 389
 390 (defun notmuch-show-mark-read-then-next-open-message ()
 391   "Remove unread tag from current message, then advance to next unread message."
 392   (interactive)
 393   (notmuch-show-remove-tag "unread")
 394   (notmuch-show-next-open-message))
 395
 396 (defun notmuch-show-rewind ()
 397   "Do reverse scrolling compared to `notmuch-show-advance-marking-read-and-archiving'
 398
 399 Specifically, if the beginning of the previous email is fewer
 400 than `window-height' lines from the current point, move to it
 401 just like `notmuch-show-previous-message'.
 402
 403 Otherwise, just scroll down a screenful of the current message.
 404
 405 This command does not modify any message tags, (it does not undo
 406 any effects from previous calls to
 407 `notmuch-show-advance-marking-read-and-archiving'."
 408   (interactive)
 409   (let ((previous (notmuch-show-find-previous-message)))
 410     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
 411         (progn
 412           (condition-case nil
 413               (scroll-down nil)
 414             ((beginning-of-buffer) nil))
 415           (goto-char (window-start)))
 416       (notmuch-show-previous-message))))
 417
 418 (defun notmuch-show-advance-marking-read-and-archiving ()
 419   "Advance through buffer, marking read and archiving.
 420
 421 This command is intended to be one of the simplest ways to
 422 process a thread of email. It does the following:
 423
 424 If the current message in the thread is not yet fully visible,
 425 scroll by a near screenful to read more of the message.
 426
 427 Otherwise, (the end of the current message is already within the
 428 current window), remove the \"unread\" tag (if present) from the
 429 current message and advance to the next open message.
 430
 431 Finally, if there is no further message to advance to, and this
 432 last message is already read, then archive the entire current
 433 thread, (remove the \"inbox\" tag from each message). Also kill
 434 this buffer, and display the next thread from the search from
 435 which this thread was originally shown."
 436   (interactive)
 437   (let ((next (notmuch-show-find-next-message))
 438         (unread (notmuch-show-message-unread-p)))
 439     (if (> next (window-end))
 440         (scroll-up nil)
 441       (let ((last (notmuch-show-last-message-p)))
 442         (notmuch-show-mark-read-then-next-open-message)
 443         (if last
 444             (notmuch-show-archive-thread))))))
 445
 446 (defun notmuch-show-markup-citations-region (beg end depth)
 447   (goto-char beg)
 448   (beginning-of-line)
 449   (while (< (point) end)
 450     (let ((beg-sub (point-marker))
 451           (indent (make-string depth ? ))
 452           (citation "[[:space:]]*>"))
 453       (if (looking-at citation)
 454           (progn
 455             (while (looking-at citation)
 456               (forward-line))
 457             (let ((overlay (make-overlay beg-sub (point))))
 458               (overlay-put overlay 'invisible 'notmuch-show-citation)
 459               (overlay-put overlay 'before-string
 460                            (concat indent
 461                                    "[" (number-to-string (count-lines beg-sub (point)))
 462                                    "-line citation. Press 'c' to show.]\n")))))
 463       (move-to-column depth)
 464       (if (looking-at notmuch-show-signature-regexp)
 465           (let ((sig-lines (- (count-lines beg-sub end) 1)))
 466             (if (<= sig-lines notmuch-show-signature-lines-max)
 467                 (progn
 468                   (overlay-put (make-overlay beg-sub end)
 469                                'invisible 'notmuch-show-signature)
 470                   (overlay-put (make-overlay beg (- beg-sub 1))
 471                                'after-string
 472                                (concat "\n" indent
 473                                        "[" (number-to-string sig-lines)
 474                                        "-line signature. Press 's' to show.]"))
 475                   (goto-char end)))))
 476       (forward-line))))
 477
 478 (defun notmuch-show-markup-part (beg end depth)
 479   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 480       (progn
 481         (forward-line)
 482         (let ((beg (point-marker)))
 483           (re-search-forward notmuch-show-part-end-regexp)
 484           (let ((end (copy-marker (match-beginning 0))))
 485             (goto-char end)
 486             (if (not (bolp))
 487                 (insert "\n"))
 488             (indent-rigidly beg end depth)
 489             (notmuch-show-markup-citations-region beg end depth)
 490             ; Advance to the next part (if any) (so the outer loop can
 491             ; determine whether we've left the current message.
 492             (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 493                 (beginning-of-line)))))
 494     (goto-char end)))
 495
 496 (defun notmuch-show-markup-parts-region (beg end depth)
 497   (save-excursion
 498     (goto-char beg)
 499     (while (< (point) end)
 500       (notmuch-show-markup-part beg end depth))))
 501
 502 (defun notmuch-show-markup-body (depth)
 503   (re-search-forward notmuch-show-body-begin-regexp)
 504   (forward-line)
 505   (let ((beg (point-marker)))
 506     (re-search-forward notmuch-show-body-end-regexp)
 507     (let ((end (copy-marker (match-beginning 0))))
 508       (notmuch-show-markup-parts-region beg end depth)
 509       (if (not (notmuch-show-message-unread-p))
 510           (overlay-put (make-overlay beg end)
 511                        'invisible 'notmuch-show-body-read))
 512       (set-marker beg nil)
 513       (set-marker end nil)
 514       )))
 515
 516 (defun notmuch-show-markup-header (depth)
 517   (re-search-forward notmuch-show-header-begin-regexp)
 518   (forward-line)
 519   (let ((beg (point-marker)))
 520     (end-of-line)
 521     ; Inverse video for subject
 522     (overlay-put (make-overlay beg (point)) 'face '((cons :inverse-video t)))
 523     (forward-line 2)
 524     (let ((beg-hidden (point-marker)))
 525       (re-search-forward notmuch-show-header-end-regexp)
 526       (beginning-of-line)
 527       (let ((end (point-marker)))
 528         (indent-rigidly beg end depth)
 529         (overlay-put (make-overlay beg-hidden end)
 530                      'invisible 'notmuch-show-header)
 531         (set-marker beg nil)
 532         (set-marker beg-hidden nil)
 533         (set-marker end nil)
 534         ))))
 535
 536 (defun notmuch-show-markup-message ()
 537   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 538       (progn
 539         (re-search-forward notmuch-show-depth-regexp)
 540         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))
 541           (notmuch-show-markup-header depth)
 542           (notmuch-show-markup-body depth)))
 543     (goto-char (point-max))))
 544
 545 (defun notmuch-show-hide-markers ()
 546   (save-excursion
 547     (goto-char (point-min))
 548     (while (not (eobp))
 549       (if (re-search-forward notmuch-show-marker-regexp nil t)
 550           (progn
 551             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
 552                          'invisible 'notmuch-show-marker))
 553         (goto-char (point-max))))))
 554
 555 (defun notmuch-show-markup-messages ()
 556   (save-excursion
 557     (goto-char (point-min))
 558     (while (not (eobp))
 559       (notmuch-show-markup-message)))
 560   (notmuch-show-hide-markers))
 561
 562 (defun notmuch-show-toggle-citations-visible ()
 563   "Toggle visibility of citations"
 564   (interactive)
 565   (if notmuch-show-citations-visible
 566       (add-to-invisibility-spec 'notmuch-show-citation)
 567     (remove-from-invisibility-spec 'notmuch-show-citation))
 568   (set 'notmuch-show-citations-visible (not notmuch-show-citations-visible))
 569   ; Need to force the redisplay for some reason
 570   (force-window-update)
 571   (redisplay t))
 572
 573 (defun notmuch-show-toggle-signatures-visible ()
 574   "Toggle visibility of signatures"
 575   (interactive)
 576   (if notmuch-show-signatures-visible
 577       (add-to-invisibility-spec 'notmuch-show-signature)
 578     (remove-from-invisibility-spec 'notmuch-show-signature))
 579   (set 'notmuch-show-signatures-visible (not notmuch-show-signatures-visible))
 580   ; Need to force the redisplay for some reason
 581   (force-window-update)
 582   (redisplay t))
 583
 584 (defun notmuch-show-toggle-headers-visible ()
 585   "Toggle visibility of header fields"
 586   (interactive)
 587   (if notmuch-show-headers-visible
 588       (add-to-invisibility-spec 'notmuch-show-header)
 589     (remove-from-invisibility-spec 'notmuch-show-header))
 590   (set 'notmuch-show-headers-visible (not notmuch-show-headers-visible))
 591   ; Need to force the redisplay for some reason
 592   (force-window-update)
 593   (redisplay t))
 594
 595 (defun notmuch-show-toggle-body-read-visible ()
 596   "Toggle visibility of message bodies of read messages"
 597   (interactive)
 598   (if notmuch-show-body-read-visible
 599       (add-to-invisibility-spec 'notmuch-show-body-read)
 600     (remove-from-invisibility-spec 'notmuch-show-body-read))
 601   (set 'notmuch-show-body-read-visible (not notmuch-show-body-read-visible))
 602   ; Need to force the redisplay for some reason
 603   (force-window-update)
 604   (redisplay t))
 605
 606 ;;;###autoload
 607 (defun notmuch-show-mode ()
 608   "Major mode for viewing a thread with notmuch.
 609
 610 This buffer contains the results of the \"notmuch show\" command
 611 for displaying a single thread of email from your email archives.
 612
 613 By default, various components of email messages, (citations,
 614 signatures, already-read messages), are invisible to help you
 615 focus on the most important things, (new text from unread
 616 messages). See the various commands below for toggling the
 617 visibility of hidden components.
 618
 619 The `notmuch-show-next-message' and
 620 `notmuch-show-previous-message' commands, (bound to 'n' and 'p by
 621 default), allow you to navigate to the next and previous
 622 messages. Each time you navigate away from a message with
 623 `notmuch-show-next-message' the current message will have its
 624 \"unread\" tag removed.
 625
 626 You can add or remove tags from the current message with '+' and
 627 '-'.  You can also archive all messages in the current
 628 view, (remove the \"inbox\" tag from each), with
 629 `notmuch-show-archive-thread' (bound to 'a' by default).
 630
 631 \\{notmuch-show-mode-map}"
 632   (interactive)
 633   (kill-all-local-variables)
 634   (set (make-local-variable 'notmuch-show-headers-visible) t)
 635   (notmuch-show-toggle-headers-visible)
 636   (set (make-local-variable 'notmuch-show-body-read-visible) t)
 637   (notmuch-show-toggle-body-read-visible)
 638   (set (make-local-variable 'notmuch-show-citations-visible) t)
 639   (notmuch-show-toggle-citations-visible)
 640   (set (make-local-variable 'notmuch-show-signatures-visible) t)
 641   (notmuch-show-toggle-signatures-visible)
 642   (add-to-invisibility-spec 'notmuch-show-marker)
 643   (use-local-map notmuch-show-mode-map)
 644   (setq major-mode 'notmuch-show-mode
 645         mode-name "notmuch-show")
 646   (setq buffer-read-only t))
 647
 648 ;;;###autoload
 649
 650 (defgroup notmuch nil
 651   "Notmuch mail reader for Emacs."
 652   :group 'mail)
 653
 654 (defcustom notmuch-show-hook nil
 655   "List of functions to call when notmuch displays a message."
 656   :type 'hook
 657   :options '(goto-address)
 658   :group 'notmuch)
 659
 660 (defcustom notmuch-search-hook nil
 661   "List of functions to call when notmuch displays the search results."
 662   :type 'hook
 663   :options '(hl-line-mode)
 664   :group 'notmuch)
 665
 666 ; Make show mode a bit prettier, highlighting URLs and using word wrap
 667
 668 (defun notmuch-show-pretty-hook ()
 669   (goto-address-mode 1)
 670   (visual-line-mode))
 671
 672 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
 673 (add-hook 'notmuch-search-hook
 674           (lambda()
 675             (hl-line-mode 1) ))
 676
 677 (defun notmuch-show (thread-id &optional parent-buffer)
 678   "Run \"notmuch show\" with the given thread ID and display results.
 679
 680 The optional PARENT-BUFFER is the notmuch-search buffer from
 681 which this notmuch-show command was executed, (so that the next
 682 thread from that buffer can be show when done with this one)."
 683   (interactive "sNotmuch show: ")
 684   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
 685     (switch-to-buffer buffer)
 686     (notmuch-show-mode)
 687     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
 688     (let ((proc (get-buffer-process (current-buffer)))
 689           (inhibit-read-only t))
 690       (if proc
 691           (error "notmuch search process already running for query `%s'" query)
 692         )
 693       (erase-buffer)
 694       (goto-char (point-min))
 695       (save-excursion
 696         (call-process notmuch-command nil t nil "show" thread-id)
 697         (notmuch-show-markup-messages)
 698         )
 699       (run-hooks 'notmuch-show-hook)
 700       ; Move straight to the first unread message
 701       (if (not (notmuch-show-message-unread-p))
 702           (progn
 703             (notmuch-show-next-unread-message)
 704             ; But if there are no unread messages, go back to the
 705             ; beginning of the buffer, and open up the bodies of all
 706             ; read message.
 707             (if (not (notmuch-show-message-unread-p))
 708                 (progn
 709                   (goto-char (point-min))
 710                   (notmuch-show-toggle-body-read-visible)))))
 711       )))
 712
 713 (defvar notmuch-search-authors-width 40
 714   "Number of columns to use to display authors in a notmuch-search buffer.")
 715
 716 (defvar notmuch-search-mode-map
 717   (let ((map (make-sparse-keymap)))
 718     (define-key map "a" 'notmuch-search-archive-thread)
 719     (define-key map "b" 'notmuch-search-scroll-down)
 720     (define-key map "f" 'notmuch-search-filter)
 721     (define-key map "m" 'message-mail)
 722     (define-key map "n" 'next-line)
 723     (define-key map "o" 'notmuch-search-toggle-order)
 724     (define-key map "p" 'previous-line)
 725     (define-key map "q" 'kill-this-buffer)
 726     (define-key map "r" 'notmuch-search-reply-to-thread)
 727     (define-key map "s" 'notmuch-search)
 728     (define-key map "t" 'notmuch-search-filter-by-tag)
 729     (define-key map "x" 'kill-this-buffer)
 730     (define-key map (kbd "RET") 'notmuch-search-show-thread)
 731     (define-key map "+" 'notmuch-search-add-tag)
 732     (define-key map "-" 'notmuch-search-remove-tag)
 733     (define-key map "<" 'beginning-of-buffer)
 734     (define-key map ">" 'notmuch-search-goto-last-thread)
 735     (define-key map "=" 'notmuch-search-refresh-view)
 736     (define-key map "\M->" 'notmuch-search-goto-last-thread)
 737     (define-key map " " 'notmuch-search-scroll-up)
 738     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
 739     (define-key map "?" 'describe-mode)
 740     map)
 741   "Keymap for \"notmuch search\" buffers.")
 742 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
 743
 744 (defun notmuch-search-scroll-up ()
 745   "Scroll up, moving point to last message in thread if at end."
 746   (interactive)
 747   (condition-case nil
 748       (scroll-up nil)
 749     ((end-of-buffer) (notmuch-search-goto-last-thread))))
 750
 751 (defun notmuch-search-scroll-down ()
 752   "Scroll down, moving point to first message in thread if at beginning."
 753   (interactive)
 754   ; I don't know why scroll-down doesn't signal beginning-of-buffer
 755   ; the way that scroll-up signals end-of-buffer, but c'est la vie.
 756   ;
 757   ; So instead of trapping a signal we instead check whether the
 758   ; window begins on the first line of the buffer and if so, move
 759   ; directly to that position. (We have to count lines since the
 760   ; window-start position is not the same as point-min due to the
 761   ; invisible thread-ID characters on the first line.
 762   (if (equal (count-lines (point-min) (window-start)) 1)
 763       (goto-char (window-start))
 764     (scroll-down nil)))
 765
 766 (defun notmuch-search-goto-last-thread (&optional arg)
 767   "Move point to the last thread in the buffer."
 768   (interactive "^P")
 769   (end-of-buffer arg)
 770   (forward-line -1))
 771
 772 ;;;###autoload
 773 (defun notmuch-search-mode ()
 774   "Major mode for searching mail with notmuch.
 775
 776 This buffer contains the results of a \"notmuch search\" of your
 777 email archives. Each line in the buffer represents a single
 778 thread giving a relative date for the thread and a subject.
 779
 780 Pressing RET on any line displays that thread. The '+' and '-'
 781 keys can be used to add or remove tags from a thread. The 'a' key
 782 is a convenience key for archiving a thread (removing the
 783 \"inbox\" tag).
 784
 785 Other useful commands are `notmuch-search-filter' for filtering
 786 the current search based on an additional query string,
 787 `notmuch-search-filter-by-tag' for filtering to include only
 788 messages with a given tag, and `notmuch-search' to execute a new,
 789 global search.
 790
 791 \\{notmuch-search-mode-map}"
 792   (interactive)
 793   (kill-all-local-variables)
 794   (make-local-variable 'notmuch-search-query-string)
 795   (make-local-variable 'notmuch-search-oldest-first)
 796   (set (make-local-variable 'scroll-preserve-screen-position) t)
 797   (add-to-invisibility-spec 'notmuch-search)
 798   (use-local-map notmuch-search-mode-map)
 799   (setq truncate-lines t)
 800   (setq major-mode 'notmuch-search-mode
 801         mode-name "notmuch-search")
 802   (setq buffer-read-only t))
 803
 804 (defun notmuch-search-find-thread-id ()
 805   (save-excursion
 806     (beginning-of-line)
 807     (let ((beg (point)))
 808       (re-search-forward "thread:[a-fA-F0-9]*" nil t)
 809       (filter-buffer-substring beg (point)))))
 810
 811 (defun notmuch-search-markup-this-thread-id ()
 812   (beginning-of-line)
 813   (let ((beg (point)))
 814     (if (re-search-forward "thread:[a-fA-F0-9]*" nil t)
 815         (progn
 816           (forward-char)
 817           (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search)
 818           (re-search-forward ".*\\[[0-9]*/[0-9]*\\] \\([^;]*\\)\\(;\\)")
 819           (let* ((authors (buffer-substring (match-beginning 1) (match-end 1)))
 820                  (authors-length (length authors)))
 821             ;; Drop the semi-colon
 822             (replace-match "" t nil nil 2)
 823             (if (<= authors-length notmuch-search-authors-width)
 824                 (replace-match (concat authors (make-string
 825                                                 (- notmuch-search-authors-width
 826                                                    authors-length) ? )) t t nil 1)
 827               (replace-match (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...") t t nil 1)))))))
 828
 829 (defun notmuch-search-markup-thread-ids ()
 830   (save-excursion
 831     (goto-char (point-min))
 832     (while (not (eobp))
 833       (notmuch-search-markup-this-thread-id)
 834       (forward-line))))
 835
 836 (defun notmuch-search-show-thread ()
 837   (interactive)
 838   (let ((thread-id (notmuch-search-find-thread-id)))
 839     (if (> (length thread-id) 0)
 840         (notmuch-show thread-id (current-buffer))
 841       (error "End of search results"))))
 842
 843 (defun notmuch-search-reply-to-thread ()
 844   "Begin composing a reply to the entire current thread in a new buffer."
 845   (interactive)
 846   (let ((message-id (notmuch-search-find-thread-id)))
 847     (notmuch-reply message-id)))
 848
 849 (defun notmuch-call-notmuch-process (&rest args)
 850   "Synchronously invoke \"notmuch\" with the given list of arguments.
 851
 852 Output from the process will be presented to the user as an error
 853 and will also appear in a buffer named \"*Notmuch errors*\"."
 854   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
 855     (with-current-buffer error-buffer
 856         (erase-buffer))
 857     (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
 858         (point)
 859       (progn
 860         (with-current-buffer error-buffer
 861           (let ((beg (point-min))
 862                 (end (- (point-max) 1)))
 863             (error (buffer-substring beg end))
 864             ))))))
 865
 866 (defun notmuch-search-set-tags (tags)
 867   (save-excursion
 868     (end-of-line)
 869     (re-search-backward "(")
 870     (forward-char)
 871     (let ((beg (point))
 872           (inhibit-read-only t))
 873       (re-search-forward ")")
 874       (backward-char)
 875       (let ((end (point)))
 876         (delete-region beg end)
 877         (insert (mapconcat  'identity tags " "))))))
 878
 879 (defun notmuch-search-get-tags ()
 880   (save-excursion
 881     (end-of-line)
 882     (re-search-backward "(")
 883     (let ((beg (+ (point) 1)))
 884       (re-search-forward ")")
 885       (let ((end (- (point) 1)))
 886         (split-string (buffer-substring beg end))))))
 887
 888 (defun notmuch-search-add-tag (tag)
 889   (interactive "sTag to add: ")
 890   (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
 891   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
 892
 893 (defun notmuch-search-remove-tag (tag)
 894   (interactive "sTag to remove: ")
 895   (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
 896   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
 897
 898 (defun notmuch-search-archive-thread ()
 899   "Archive the current thread (remove its \"inbox\" tag).
 900
 901 This function advances point to the next line when finished."
 902   (interactive)
 903   (notmuch-search-remove-tag "inbox")
 904   (forward-line))
 905
 906 (defun notmuch-search (query &optional oldest-first)
 907   "Run \"notmuch search\" with the given query string and display results."
 908   (interactive "sNotmuch search: ")
 909   (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
 910     (switch-to-buffer buffer)
 911     (notmuch-search-mode)
 912     (set 'notmuch-search-query-string query)
 913     (set 'notmuch-search-oldest-first oldest-first)
 914     (let ((proc (get-buffer-process (current-buffer)))
 915           (inhibit-read-only t))
 916       (if proc
 917           (error "notmuch search process already running for query `%s'" query)
 918         )
 919       (erase-buffer)
 920       (goto-char (point-min))
 921       (save-excursion
 922         (if oldest-first
 923             (call-process notmuch-command nil t nil "search" "--sort=oldest-first" query)
 924           (call-process notmuch-command nil t nil "search" "--sort=newest-first" query))
 925         (notmuch-search-markup-thread-ids)
 926         ))
 927     (run-hooks 'notmuch-search-hook)))
 928
 929 (defun notmuch-search-refresh-view ()
 930   "Refresh the current view.
 931
 932 Kills the current buffer and runs a new search with the same
 933 query string as the current search. If the current thread is in
 934 the new search results, then point will be placed on the same
 935 thread. Otherwise, point will be moved to attempt to be in the
 936 same relative position within the new buffer."
 937   (interactive)
 938   (let ((here (point))
 939         (oldest-first notmuch-search-oldest-first)
 940         (thread (notmuch-search-find-thread-id))
 941         (query notmuch-search-query-string))
 942     (kill-this-buffer)
 943     (notmuch-search query oldest-first)
 944     (goto-char (point-min))
 945     (if (re-search-forward (concat "^" thread) nil t)
 946         (beginning-of-line)
 947       (goto-char here))))
 948
 949 (defun notmuch-search-toggle-order ()
 950   "Toggle the current search order.
 951
 952 By default, the \"inbox\" view created by `notmuch' is displayed
 953 in chronological order (oldest thread at the beginning of the
 954 buffer), while any global searches created by `notmuch-search'
 955 are displayed in reverse-chronological order (newest thread at
 956 the beginning of the buffer).
 957
 958 This command toggles the sort order for the current search.
 959
 960 Note that any filtered searches created by
 961 `notmuch-search-filter' retain the search order of the parent
 962 search."
 963   (interactive)
 964   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
 965   (notmuch-search-refresh-view))
 966
 967 (defun notmuch-search-filter (query)
 968   "Filter the current search results based on an additional query string.
 969
 970 Runs a new search matching only messages that match both the
 971 current search results AND the additional query string provided."
 972   (interactive "sFilter search: ")
 973   (notmuch-search (concat notmuch-search-query-string " and " query) notmuch-search-oldest-first))
 974
 975 (defun notmuch-search-filter-by-tag (tag)
 976   "Filter the current search results based on a single tag.
 977
 978 Runs a new search matching only messages that match both the
 979 current search results AND that are tagged with the given tag."
 980   (interactive "sFilter by tag: ")
 981   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 982
 983 (defun notmuch ()
 984   "Run notmuch to display all mail with tag of 'inbox'"
 985   (interactive)
 986   (notmuch-search "tag:inbox" t))
 987
 988 (setq mail-user-agent 'message-user-agent)
 989
 990 (provide 'notmuch)