git.cworth.org Git - obsolete/notmuch-old/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 ; This is an emacs-based interface to the notmuch mail system.
  23 ;
  24 ; You will first need to have the notmuch program installed and have a
  25 ; notmuch database built in order to use this. See
  26 ; http://notmuchmail.org for details.
  27 ;
  28 ; To install this software, copy it to a directory that is on the
  29 ; `load-path' variable within emacs (a good candidate is
  30 ; /usr/local/share/emacs/site-lisp). If you are viewing this from the
  31 ; notmuch source distribution then you can simply run:
  32 ;
  33 ;       sudo make install-emacs
  34 ;
  35 ; to install it.
  36 ;
  37 ; Then, to actually run it, add:
  38 ;
  39 ;       (require 'notmuch)
  40 ;
  41 ; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
  42 ; or run:
  43 ;
  44 ;       emacs -f notmuch
  45 ;
  46 ; Have fun, and let us know if you have any comment, questions, or
  47 ; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
  48 ; required, but is available from http://notmuchmail.org).
  49
  50 (require 'cl)
  51 (require 'mm-view)
  52 (require 'message)
  53
  54 (defvar notmuch-show-stash-map
  55   (let ((map (make-sparse-keymap)))
  56     (define-key map "c" 'notmuch-show-stash-cc)
  57     (define-key map "d" 'notmuch-show-stash-date)
  58     (define-key map "F" 'notmuch-show-stash-filename)
  59     (define-key map "f" 'notmuch-show-stash-from)
  60     (define-key map "i" 'notmuch-show-stash-message-id)
  61     (define-key map "s" 'notmuch-show-stash-subject)
  62     (define-key map "T" 'notmuch-show-stash-tags)
  63     (define-key map "t" 'notmuch-show-stash-to)
  64     map)
  65   "Submap for stash commands"
  66   )
  67
  68 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
  69
  70 (defvar notmuch-show-mode-map
  71   (let ((map (make-sparse-keymap)))
  72     (define-key map "?" 'notmuch-help)
  73     (define-key map "q" 'kill-this-buffer)
  74     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
  75     (define-key map (kbd "C-n") 'notmuch-show-next-line)
  76     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
  77     (define-key map (kbd "TAB") 'notmuch-show-next-button)
  78     (define-key map "s" 'notmuch-search)
  79     (define-key map "m" 'message-mail)
  80     (define-key map "f" 'notmuch-show-forward-current)
  81     (define-key map "r" 'notmuch-show-reply)
  82     (define-key map "|" 'notmuch-show-pipe-message)
  83     (define-key map "w" 'notmuch-show-save-attachments)
  84     (define-key map "V" 'notmuch-show-view-raw-message)
  85     (define-key map "v" 'notmuch-show-view-all-mime-parts)
  86     (define-key map "c" 'notmuch-show-stash-map)
  87     (define-key map "b" 'notmuch-show-toggle-current-body)
  88     (define-key map "h" 'notmuch-show-toggle-current-header)
  89     (define-key map "-" 'notmuch-show-remove-tag)
  90     (define-key map "+" 'notmuch-show-add-tag)
  91     (define-key map "X" 'notmuch-show-mark-read-then-archive-then-exit)
  92     (define-key map "x" 'notmuch-show-archive-thread-then-exit)
  93     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
  94     (define-key map "a" 'notmuch-show-archive-thread)
  95     (define-key map "p" 'notmuch-show-previous-message)
  96     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
  97     (define-key map "n" 'notmuch-show-next-message)
  98     (define-key map (kbd "DEL") 'notmuch-show-rewind)
  99     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
 100     map)
 101   "Keymap for \"notmuch show\" buffers.")
 102 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
 103
 104 (defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$"
 105   "Pattern to match a line that separates content from signature.
 106
 107 The regexp can (and should) include $ to match the end of the
 108 line, but should not include ^ to match the beginning of the
 109 line. This is because notmuch may have inserted additional space
 110 for indentation at the beginning of the line. But notmuch will
 111 move past the indentation when testing this pattern, (so that the
 112 pattern can still test against the entire line).")
 113
 114 (defvar notmuch-show-signature-button-format
 115   "[ %d-line signature. Click/Enter to toggle visibility. ]"
 116   "String used to construct button text for hidden signatures
 117
 118 Can use up to one integer format parameter, i.e. %d")
 119
 120 (defvar notmuch-show-citation-button-format
 121   "[ %d more citation lines. Click/Enter to toggle visibility. ]"
 122   "String used to construct button text for hidden citations.
 123
 124 Can use up to one integer format parameter, i.e. %d")
 125
 126 (defvar notmuch-show-signature-lines-max 12
 127   "Maximum length of signature that will be hidden by default.")
 128
 129 (defvar notmuch-show-citation-lines-prefix 4
 130   "Always show at least this many lines of a citation.
 131
 132 If there is one more line, show that, otherwise collapse
 133 remaining lines into a button.")
 134
 135 (defvar notmuch-command "notmuch"
 136   "Command to run the notmuch binary.")
 137
 138 (defvar notmuch-show-message-begin-regexp    "\fmessage{")
 139 (defvar notmuch-show-message-end-regexp      "\fmessage}")
 140 (defvar notmuch-show-header-begin-regexp     "\fheader{")
 141 (defvar notmuch-show-header-end-regexp       "\fheader}")
 142 (defvar notmuch-show-body-begin-regexp       "\fbody{")
 143 (defvar notmuch-show-body-end-regexp         "\fbody}")
 144 (defvar notmuch-show-attachment-begin-regexp "\fattachment{")
 145 (defvar notmuch-show-attachment-end-regexp   "\fattachment}")
 146 (defvar notmuch-show-part-begin-regexp       "\fpart{")
 147 (defvar notmuch-show-part-end-regexp         "\fpart}")
 148 (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$")
 149
 150 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
 151 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
 152 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
 153 (defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
 154
 155 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
 156
 157 (defvar notmuch-show-parent-buffer nil)
 158 (defvar notmuch-show-body-read-visible nil)
 159 (defvar notmuch-show-citations-visible nil)
 160 (defvar notmuch-show-signatures-visible nil)
 161 (defvar notmuch-show-headers-visible nil)
 162
 163 ; XXX: This should be a generic function in emacs somewhere, not here
 164 (defun point-invisible-p ()
 165   "Return whether the character at point is invisible.
 166
 167 Here visibility is determined by `buffer-invisibility-spec' and
 168 the invisible property of any overlays for point. It doesn't have
 169 anything to do with whether point is currently being displayed
 170 within the current window."
 171   (let ((prop (get-char-property (point) 'invisible)))
 172     (if (eq buffer-invisibility-spec t)
 173         prop
 174       (or (memq prop buffer-invisibility-spec)
 175           (assq prop buffer-invisibility-spec)))))
 176
 177 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
 178   (let ((tag-list
 179          (with-output-to-string
 180            (with-current-buffer standard-output
 181              (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
 182     (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
 183
 184 (defun notmuch-show-next-line ()
 185   "Like builtin `next-line' but ensuring we end on a visible character.
 186
 187 By advancing forward until reaching a visible character.
 188
 189 Unlike builtin `next-line' this version accepts no arguments."
 190   (interactive)
 191   (set 'this-command 'next-line)
 192   (call-interactively 'next-line)
 193   (while (point-invisible-p)
 194     (forward-char)))
 195
 196 (defun notmuch-show-previous-line ()
 197   "Like builtin `previous-line' but ensuring we end on a visible character.
 198
 199 By advancing forward until reaching a visible character.
 200
 201 Unlike builtin `previous-line' this version accepts no arguments."
 202   (interactive)
 203   (set 'this-command 'previous-line)
 204   (call-interactively 'previous-line)
 205   (while (point-invisible-p)
 206     (forward-char)))
 207
 208 (defun notmuch-show-get-message-id ()
 209   (save-excursion
 210     (beginning-of-line)
 211     (if (not (looking-at notmuch-show-message-begin-regexp))
 212         (re-search-backward notmuch-show-message-begin-regexp))
 213     (re-search-forward notmuch-show-id-regexp)
 214     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 215
 216 (defun notmuch-show-get-filename ()
 217   (save-excursion
 218     (beginning-of-line)
 219     (if (not (looking-at notmuch-show-message-begin-regexp))
 220         (re-search-backward notmuch-show-message-begin-regexp))
 221     (re-search-forward notmuch-show-filename-regexp)
 222     (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 223
 224 (defun notmuch-show-set-tags (tags)
 225   (save-excursion
 226     (beginning-of-line)
 227     (if (not (looking-at notmuch-show-message-begin-regexp))
 228         (re-search-backward notmuch-show-message-begin-regexp))
 229     (re-search-forward notmuch-show-tags-regexp)
 230     (let ((inhibit-read-only t)
 231           (beg (match-beginning 1))
 232           (end (match-end 1)))
 233       (delete-region beg end)
 234       (goto-char beg)
 235       (insert (mapconcat 'identity tags " ")))))
 236
 237 (defun notmuch-show-get-tags ()
 238   (save-excursion
 239     (beginning-of-line)
 240     (if (not (looking-at notmuch-show-message-begin-regexp))
 241         (re-search-backward notmuch-show-message-begin-regexp))
 242     (re-search-forward notmuch-show-tags-regexp)
 243     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
 244
 245 (defun notmuch-show-get-bcc ()
 246   "Return BCC address(es) of current message"
 247   (notmuch-show-get-header-field 'bcc))
 248
 249 (defun notmuch-show-get-cc ()
 250   "Return CC address(es) of current message"
 251   (notmuch-show-get-header-field 'cc))
 252
 253 (defun notmuch-show-get-date ()
 254   "Return Date of current message"
 255   (notmuch-show-get-header-field 'date))
 256
 257 (defun notmuch-show-get-from ()
 258   "Return From address of current message"
 259   (notmuch-show-get-header-field 'from))
 260
 261 (defun notmuch-show-get-subject ()
 262   "Return Subject of current message"
 263   (notmuch-show-get-header-field 'subject))
 264
 265 (defun notmuch-show-get-to ()
 266   "Return To address(es) of current message"
 267   (notmuch-show-get-header-field 'to))
 268
 269 (defun notmuch-show-get-header-field (name)
 270   "Retrieve the header field NAME from the current message.
 271 NAME should be a symbol, in lower case, as returned by
 272 mail-header-extract-no-properties"
 273   (let* ((result (assoc name (notmuch-show-get-header)))
 274         (val (and result (cdr result))))
 275     val))
 276
 277 (defun notmuch-show-get-header ()
 278   "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
 279 where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
 280 pseudoheader summary"
 281   (require 'mailheader)
 282   (save-excursion
 283     (beginning-of-line)
 284     (if (not (looking-at notmuch-show-message-begin-regexp))
 285         (re-search-backward notmuch-show-message-begin-regexp))
 286     (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
 287     (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
 288           (beg (point)))
 289       (re-search-forward notmuch-show-header-end-regexp)
 290       (let ((text (buffer-substring beg (match-beginning 0))))
 291         (with-temp-buffer
 292           (insert text)
 293           (goto-char (point-min))
 294           (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
 295             (delete-region (match-beginning 1) (match-end 1))
 296             (forward-line)
 297             )
 298           (goto-char (point-min))
 299           (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
 300
 301 (defun notmuch-show-add-tag (&rest toadd)
 302   "Add a tag to the current message."
 303   (interactive
 304    (list (notmuch-select-tag-with-completion "Tag to add: ")))
 305   (apply 'notmuch-call-notmuch-process
 306          (append (cons "tag"
 307                        (mapcar (lambda (s) (concat "+" s)) toadd))
 308                  (cons (notmuch-show-get-message-id) nil)))
 309   (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<)))
 310
 311 (defun notmuch-show-remove-tag (&rest toremove)
 312   "Remove a tag from the current message."
 313   (interactive
 314    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
 315   (let ((tags (notmuch-show-get-tags)))
 316     (if (intersection tags toremove :test 'string=)
 317         (progn
 318           (apply 'notmuch-call-notmuch-process
 319                  (append (cons "tag"
 320                                (mapcar (lambda (s) (concat "-" s)) toremove))
 321                          (cons (notmuch-show-get-message-id) nil)))
 322           (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<))))))
 323
 324 (defun notmuch-show-archive-thread-maybe-mark-read (markread)
 325   (save-excursion
 326     (goto-char (point-min))
 327     (while (not (eobp))
 328       (if markread
 329           (notmuch-show-remove-tag "unread" "inbox")
 330         (notmuch-show-remove-tag "inbox"))
 331       (if (not (eobp))
 332           (forward-char))
 333       (if (not (re-search-forward notmuch-show-message-begin-regexp nil t))
 334           (goto-char (point-max)))))
 335   (let ((parent-buffer notmuch-show-parent-buffer))
 336     (kill-this-buffer)
 337     (if parent-buffer
 338         (progn
 339           (switch-to-buffer parent-buffer)
 340           (forward-line)
 341           (notmuch-search-show-thread)))))
 342
 343 (defun notmuch-show-mark-read-then-archive-thread ()
 344   "Remove unread tags from thread, then archive and show next thread.
 345
 346 Archive each message currently shown by removing the \"unread\"
 347 and \"inbox\" tag from each. Then kill this buffer and show the
 348 next thread from the search from which this thread was originally
 349 shown.
 350
 351 Note: This command is safe from any race condition of new messages
 352 being delivered to the same thread. It does not archive the
 353 entire thread, but only the messages shown in the current
 354 buffer."
 355   (interactive)
 356   (notmuch-show-archive-thread-maybe-mark-read t))
 357
 358 (defun notmuch-show-archive-thread ()
 359   "Archive each message in thread, then show next thread from search.
 360
 361 Archive each message currently shown by removing the \"inbox\"
 362 tag from each. Then kill this buffer and show the next thread
 363 from the search from which this thread was originally shown.
 364
 365 Note: This command is safe from any race condition of new messages
 366 being delivered to the same thread. It does not archive the
 367 entire thread, but only the messages shown in the current
 368 buffer."
 369   (interactive)
 370   (notmuch-show-archive-thread-maybe-mark-read nil))
 371
 372 (defun notmuch-show-archive-thread-then-exit ()
 373   "Archive each message in thread, then exit back to search results."
 374   (interactive)
 375   (notmuch-show-archive-thread)
 376   (kill-this-buffer))
 377
 378 (defun notmuch-show-mark-read-then-archive-then-exit ()
 379   "Remove unread tags from thread, then archive and exit to search results."
 380   (interactive)
 381   (notmuch-show-mark-read-then-archive-thread)
 382   (kill-this-buffer))
 383
 384 (defun notmuch-show-view-raw-message ()
 385   "View the raw email of the current message."
 386   (interactive)
 387   (view-file (notmuch-show-get-filename)))
 388
 389 (defmacro with-current-notmuch-show-message (&rest body)
 390   "Evaluate body with current buffer set to the text of current message"
 391   `(save-excursion
 392      (let ((filename (notmuch-show-get-filename)))
 393        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
 394          (with-current-buffer buf
 395            (insert-file-contents filename nil nil nil t)
 396            ,@body)
 397          (kill-buffer buf)))))
 398
 399 (defun notmuch-show-view-all-mime-parts ()
 400   "Use external viewers to view all attachments from the current message."
 401   (interactive)
 402   (with-current-notmuch-show-message
 403    ; We ovverride the mm-inline-media-tests to indicate which message
 404    ; parts are already sufficiently handled by the original
 405    ; presentation of the message in notmuch-show mode. These parts
 406    ; will be inserted directly into the temporary buffer of
 407    ; with-current-notmuch-show-message and silently discarded.
 408    ;
 409    ; Any MIME part not explicitly mentioned here will be handled by an
 410    ; external viewer as configured in the various mailcap files.
 411    (let ((mm-inline-media-tests '(
 412                                   ("text/.*" ignore identity)
 413                                   ("application/pgp-signature" ignore identity)
 414                                   ("multipart/alternative" ignore identity)
 415                                   ("multipart/mixed" ignore identity)
 416                                   ("multipart/related" ignore identity)
 417                                  )))
 418      (mm-display-parts (mm-dissect-buffer)))))
 419
 420 (defun notmuch-foreach-mime-part (function mm-handle)
 421   (cond ((stringp (car mm-handle))
 422          (dolist (part (cdr mm-handle))
 423            (notmuch-foreach-mime-part function part)))
 424         ((bufferp (car mm-handle))
 425          (funcall function mm-handle))
 426         (t (dolist (part mm-handle)
 427              (notmuch-foreach-mime-part function part)))))
 428
 429 (defun notmuch-count-attachments (mm-handle)
 430   (let ((count 0))
 431     (notmuch-foreach-mime-part
 432      (lambda (p)
 433        (let ((disposition (mm-handle-disposition p)))
 434          (and (listp disposition)
 435               (or (equal (car disposition) "attachment")
 436                   (and (equal (car disposition) "inline")
 437                        (assq 'filename disposition)))
 438               (incf count))))
 439      mm-handle)
 440     count))
 441
 442 (defun notmuch-save-attachments (mm-handle &optional queryp)
 443   (notmuch-foreach-mime-part
 444    (lambda (p)
 445      (let ((disposition (mm-handle-disposition p)))
 446        (and (listp disposition)
 447             (or (equal (car disposition) "attachment")
 448                 (and (equal (car disposition) "inline")
 449                      (assq 'filename disposition)))
 450             (or (not queryp)
 451                 (y-or-n-p
 452                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
 453             (mm-save-part p))))
 454    mm-handle))
 455
 456 (defun notmuch-show-save-attachments ()
 457   "Save all attachments from the current message."
 458   (interactive)
 459   (with-current-notmuch-show-message
 460    (let ((mm-handle (mm-dissect-buffer)))
 461      (notmuch-save-attachments
 462       mm-handle (> (notmuch-count-attachments mm-handle) 1))))
 463   (message "Done"))
 464
 465 (defun notmuch-reply (query-string)
 466   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
 467   (call-process notmuch-command nil t nil "reply" query-string)
 468   (message-insert-signature)
 469   (goto-char (point-min))
 470   (if (re-search-forward "^$" nil t)
 471       (progn
 472         (insert "--text follows this line--")
 473         (forward-line)))
 474   (message-mode))
 475
 476 (defun notmuch-show-reply ()
 477   "Begin composing a reply to the current message in a new buffer."
 478   (interactive)
 479   (let ((message-id (notmuch-show-get-message-id)))
 480     (notmuch-reply message-id)))
 481
 482 (defun notmuch-show-forward-current ()
 483   "Forward the current message."
 484   (interactive)
 485   (with-current-notmuch-show-message
 486    (message-forward)))
 487
 488 (defun notmuch-show-pipe-message (command)
 489   "Pipe the contents of the current message to the given command.
 490
 491 The given command will be executed with the raw contents of the
 492 current email message as stdin. Anything printed by the command
 493 to stdout or stderr will appear in the *Messages* buffer."
 494   (interactive "sPipe message to command: ")
 495   (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
 496          (list command " < " (shell-quote-argument (notmuch-show-get-filename)))))
 497
 498 (defun notmuch-show-move-to-current-message-summary-line ()
 499   "Move to the beginning of the one-line summary of the current message.
 500
 501 This gives us a stable place to move to and work from since the
 502 summary line is always visible. This is important since moving to
 503 an invisible location is unreliable, (the main command loop moves
 504 point either forward or backward to the next visible character
 505 when a command ends with point on an invisible character).
 506
 507 Emits an error if point is not within a valid message, (that is
 508 no pattern of `notmuch-show-message-begin-regexp' could be found
 509 by searching backward)."
 510   (beginning-of-line)
 511   (if (not (looking-at notmuch-show-message-begin-regexp))
 512       (if (re-search-backward notmuch-show-message-begin-regexp nil t)
 513           (forward-line 2)
 514         (error "Not within a valid message."))
 515     (forward-line 2)))
 516
 517 (defun notmuch-show-last-message-p ()
 518   "Predicate testing whether point is within the last message."
 519   (save-window-excursion
 520     (save-excursion
 521       (notmuch-show-move-to-current-message-summary-line)
 522       (not (re-search-forward notmuch-show-message-begin-regexp nil t)))))
 523
 524 (defun notmuch-show-message-unread-p ()
 525   "Predicate testing whether current message is unread."
 526   (member "unread" (notmuch-show-get-tags)))
 527
 528 (defun notmuch-show-message-open-p ()
 529   "Predicate testing whether current message is open (body is visible)."
 530   (let ((btn (previous-button (point) t)))
 531     (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type))
 532       (setq btn (previous-button (button-start btn))))
 533     (not (invisible-p (button-get btn 'invisibility-spec)))))
 534
 535 (defun notmuch-show-next-message ()
 536   "Advance to the beginning of the next message in the buffer.
 537
 538 Moves to the last visible character of the current message if
 539 already on the last message in the buffer.
 540
 541 Returns nil if already on the last message in the buffer."
 542   (interactive)
 543   (notmuch-show-move-to-current-message-summary-line)
 544   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 545       (progn
 546         (notmuch-show-move-to-current-message-summary-line)
 547         (recenter 0)
 548         t)
 549     (goto-char (- (point-max) 1))
 550     (while (point-invisible-p)
 551       (backward-char))
 552     (recenter 0)
 553     nil))
 554
 555 (defun notmuch-show-find-next-message ()
 556   "Returns the position of the next message in the buffer.
 557
 558 Or the position of the last visible character of the current
 559 message if already within the last message in the buffer."
 560   ; save-excursion doesn't save our window position
 561   ; save-window-excursion doesn't save point
 562   ; Looks like we have to use both.
 563   (save-excursion
 564     (save-window-excursion
 565       (notmuch-show-next-message)
 566       (point))))
 567
 568 (defun notmuch-show-next-unread-message ()
 569   "Advance to the beginning of the next unread message in the buffer.
 570
 571 Moves to the last visible character of the current message if
 572 there are no more unread messages past the current point."
 573   (notmuch-show-next-message)
 574   (while (and (not (notmuch-show-last-message-p))
 575               (not (notmuch-show-message-unread-p)))
 576     (notmuch-show-next-message))
 577   (if (not (notmuch-show-message-unread-p))
 578       (notmuch-show-next-message)))
 579
 580 (defun notmuch-show-next-open-message ()
 581   "Advance to the next open message (that is, body is not invisible)."
 582   (while (and (notmuch-show-next-message)
 583               (not (notmuch-show-message-open-p)))))
 584
 585 (defun notmuch-show-previous-message ()
 586   "Backup to the beginning of the previous message in the buffer.
 587
 588 If within a message rather than at the beginning of it, then
 589 simply move to the beginning of the current message."
 590   (interactive)
 591   (let ((start (point)))
 592     (notmuch-show-move-to-current-message-summary-line)
 593     (if (not (< (point) start))
 594         ; Go backward twice to skip the current message's marker
 595         (progn
 596           (re-search-backward notmuch-show-message-begin-regexp nil t)
 597           (re-search-backward notmuch-show-message-begin-regexp nil t)
 598           (notmuch-show-move-to-current-message-summary-line)
 599           ))
 600     (recenter 0)))
 601
 602 (defun notmuch-show-find-previous-message ()
 603   "Returns the position of the previous message in the buffer.
 604
 605 Or the position of the beginning of the current message if point
 606 is originally within the message rather than at the beginning of
 607 it."
 608   ; save-excursion doesn't save our window position
 609   ; save-window-excursion doesn't save point
 610   ; Looks like we have to use both.
 611   (save-excursion
 612     (save-window-excursion
 613       (notmuch-show-previous-message)
 614       (point))))
 615
 616 (defun notmuch-show-mark-read-then-next-open-message ()
 617   "Remove unread tag from this message, then advance to next open message."
 618   (interactive)
 619   (notmuch-show-remove-tag "unread")
 620   (notmuch-show-next-open-message))
 621
 622 (defun notmuch-show-rewind ()
 623   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-marking-read-and-archiving]).
 624
 625 Specifically, if the beginning of the previous email is fewer
 626 than `window-height' lines from the current point, move to it
 627 just like `notmuch-show-previous-message'.
 628
 629 Otherwise, just scroll down a screenful of the current message.
 630
 631 This command does not modify any message tags, (it does not undo
 632 any effects from previous calls to
 633 `notmuch-show-advance-marking-read-and-archiving'."
 634   (interactive)
 635   (let ((previous (notmuch-show-find-previous-message)))
 636     (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
 637         (progn
 638           (condition-case nil
 639               (scroll-down nil)
 640             ((beginning-of-buffer) nil))
 641           (goto-char (window-start)))
 642       (notmuch-show-previous-message))))
 643
 644 (defun notmuch-show-advance-marking-read-and-archiving ()
 645   "Advance through thread, marking read and archiving.
 646
 647 This command is intended to be one of the simplest ways to
 648 process a thread of email. It does the following:
 649
 650 If the current message in the thread is not yet fully visible,
 651 scroll by a near screenful to read more of the message.
 652
 653 Otherwise, (the end of the current message is already within the
 654 current window), remove the \"unread\" tag (if present) from the
 655 current message and advance to the next open message.
 656
 657 Finally, if there is no further message to advance to, and this
 658 last message is already read, then archive the entire current
 659 thread, (remove the \"inbox\" tag from each message). Also kill
 660 this buffer, and display the next thread from the search from
 661 which this thread was originally shown."
 662   (interactive)
 663   (let ((next (notmuch-show-find-next-message))
 664         (unread (notmuch-show-message-unread-p)))
 665     (if (> next (window-end))
 666         (scroll-up nil)
 667       (let ((last (notmuch-show-last-message-p)))
 668         (notmuch-show-mark-read-then-next-open-message)
 669         (if last
 670             (notmuch-show-archive-thread))))))
 671
 672 (defun notmuch-show-next-button ()
 673   "Advance point to the next button in the buffer."
 674   (interactive)
 675   (forward-button 1))
 676
 677 (defun notmuch-show-previous-button ()
 678   "Move point back to the previous button in the buffer."
 679   (interactive)
 680   (backward-button 1))
 681
 682 (defun notmuch-toggle-invisible-action (cite-button)
 683   (let ((invis-spec (button-get cite-button 'invisibility-spec)))
 684         (if (invisible-p invis-spec)
 685             (remove-from-invisibility-spec invis-spec)
 686           (add-to-invisibility-spec invis-spec)
 687           ))
 688   (force-window-update)
 689   (redisplay t))
 690
 691 (defun notmuch-show-toggle-current-body ()
 692   "Toggle the display of the current message body."
 693   (interactive)
 694   (save-excursion
 695     (notmuch-show-move-to-current-message-summary-line)
 696     (unless (button-at (point))
 697       (notmuch-show-next-button))
 698     (push-button))
 699   )
 700
 701 (defun notmuch-show-toggle-current-header ()
 702   "Toggle the display of the current message header."
 703   (interactive)
 704   (save-excursion
 705     (notmuch-show-move-to-current-message-summary-line)
 706     (forward-line)
 707     (unless (button-at (point))
 708       (notmuch-show-next-button))
 709     (push-button))
 710   )
 711
 712 (define-button-type 'notmuch-button-invisibility-toggle-type
 713   'action 'notmuch-toggle-invisible-action
 714   'follow-link t
 715   'face 'font-lock-comment-face)
 716 (define-button-type 'notmuch-button-citation-toggle-type 'help-echo "mouse-1, RET: Show citation"
 717   :supertype 'notmuch-button-invisibility-toggle-type)
 718 (define-button-type 'notmuch-button-signature-toggle-type 'help-echo "mouse-1, RET: Show signature"
 719   :supertype 'notmuch-button-invisibility-toggle-type)
 720 (define-button-type 'notmuch-button-headers-toggle-type 'help-echo "mouse-1, RET: Show headers"
 721   :supertype 'notmuch-button-invisibility-toggle-type)
 722 (define-button-type 'notmuch-button-body-toggle-type
 723   'help-echo "mouse-1, RET: Show message"
 724   'face 'notmuch-message-summary-face
 725   :supertype 'notmuch-button-invisibility-toggle-type)
 726
 727 (defun notmuch-show-citation-regexp (depth)
 728   "Build a regexp for matching citations at a given DEPTH (indent)"
 729   (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth)))
 730     (concat "\\(?:^" line-regexp
 731             "\\(?:[[:space:]]*\n" line-regexp
 732             "\\)?\\)+")))
 733
 734 (defun notmuch-show-region-to-button (beg end type prefix button-text)
 735   "Auxilary function to do the actual making of overlays and buttons
 736
 737 BEG and END are buffer locations. TYPE should a string, either
 738 \"citation\" or \"signature\". PREFIX is some arbitrary text to
 739 insert before the button, probably for indentation.  BUTTON-TEXT
 740 is what to put on the button."
 741
 742 ;; This uses some slightly tricky conversions between strings and
 743 ;; symbols because of the way the button code works. Note that
 744 ;; replacing intern-soft with make-symbol will cause this to fail,
 745 ;; since the newly created symbol has no plist.
 746
 747   (let ((overlay (make-overlay beg end))
 748         (invis-spec (make-symbol (concat "notmuch-" type "-region")))
 749         (button-type (intern-soft (concat "notmuch-button-"
 750                                           type "-toggle-type"))))
 751     (add-to-invisibility-spec invis-spec)
 752     (overlay-put overlay 'invisible invis-spec)
 753     (goto-char (1+ end))
 754     (save-excursion
 755       (goto-char (1- beg))
 756       (insert prefix)
 757       (insert-button button-text
 758                      'invisibility-spec invis-spec
 759                      :type button-type)
 760       )))
 761
 762
 763 (defun notmuch-show-markup-citations-region (beg end depth)
 764   "Markup citations, and up to one signature in the given region"
 765   ;; it would be nice if the untabify was not required, but
 766   ;; that would require notmuch to indent with spaces.
 767   (untabify beg end)
 768   (let ((citation-regexp (notmuch-show-citation-regexp depth))
 769         (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
 770                                   notmuch-show-signature-regexp))
 771         (indent (concat "\n" (make-string depth ? ))))
 772     (goto-char beg)
 773     (beginning-of-line)
 774     (while (and (< (point) end)
 775                 (re-search-forward citation-regexp end t))
 776       (let* ((cite-start (match-beginning 0))
 777              (cite-end  (match-end 0))
 778              (cite-lines (count-lines cite-start cite-end)))
 779         (when (> cite-lines (1+ notmuch-show-citation-lines-prefix))
 780           (goto-char cite-start)
 781           (forward-line notmuch-show-citation-lines-prefix)
 782           (notmuch-show-region-to-button
 783            (point) cite-end
 784            "citation"
 785            indent
 786            (format notmuch-show-citation-button-format
 787                    (- cite-lines notmuch-show-citation-lines-prefix))
 788            ))))
 789     (if (and (< (point) end)
 790              (re-search-forward signature-regexp end t))
 791         (let* ((sig-start (match-beginning 0))
 792                (sig-end (match-end 0))
 793                (sig-lines (1- (count-lines sig-start end))))
 794           (if (<= sig-lines notmuch-show-signature-lines-max)
 795               (notmuch-show-region-to-button
 796                sig-start
 797                end
 798                "signature"
 799                indent
 800                (format notmuch-show-signature-button-format sig-lines)
 801                ))))))
 802
 803 (defun notmuch-show-markup-part (beg end depth)
 804   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 805       (progn
 806         (let (mime-message mime-type)
 807           (save-excursion
 808             (re-search-forward notmuch-show-contentype-regexp end t)
 809             (setq mime-type (car (split-string (buffer-substring
 810                                                 (match-beginning 1) (match-end 1))))))
 811
 812           (if (equal mime-type "text/html")
 813               (let ((filename (notmuch-show-get-filename)))
 814                 (with-temp-buffer
 815                   (insert-file-contents filename nil nil nil t)
 816                   (setq mime-message (mm-dissect-buffer)))))
 817           (forward-line)
 818           (let ((beg (point-marker)))
 819             (re-search-forward notmuch-show-part-end-regexp)
 820             (let ((end (copy-marker (match-beginning 0))))
 821               (goto-char end)
 822               (if (not (bolp))
 823                   (insert "\n"))
 824               (indent-rigidly beg end depth)
 825               (if (not (eq mime-message nil))
 826                   (save-excursion
 827                     (goto-char beg)
 828                     (forward-line -1)
 829                     (let ((handle-type (mm-handle-type mime-message))
 830                           mime-type)
 831                       (if (sequencep (car handle-type))
 832                           (setq mime-type (car handle-type))
 833                         (setq mime-type (car (car (cdr handle-type))))
 834                         )
 835                       (if (equal mime-type "text/html")
 836                           (mm-display-part mime-message))))
 837                 )
 838               (notmuch-show-markup-citations-region beg end depth)
 839               ; Advance to the next part (if any) (so the outer loop can
 840               ; determine whether we've left the current message.
 841               (if (re-search-forward notmuch-show-part-begin-regexp nil t)
 842                   (beginning-of-line)))))
 843         (goto-char end))
 844     (goto-char end)))
 845
 846 (defun notmuch-show-markup-parts-region (beg end depth)
 847   (save-excursion
 848     (goto-char beg)
 849     (while (< (point) end)
 850       (notmuch-show-markup-part beg end depth))))
 851
 852 (defun notmuch-show-markup-body (depth match btn)
 853   "Markup a message body, (indenting, buttonizing citations,
 854 etc.), and conditionally hiding the body itself if the message
 855 has been read and does not match the current search.
 856
 857 DEPTH specifies the depth at which this message appears in the
 858 tree of the current thread, (the top-level messages have depth 0
 859 and each reply increases depth by 1). MATCH indicates whether
 860 this message is regarded as matching the current search. BTN is
 861 the button which is used to toggle the visibility of this
 862 message.
 863
 864 When this function is called, point must be within the message, but
 865 before the delimiter marking the beginning of the body."
 866   (re-search-forward notmuch-show-body-begin-regexp)
 867   (forward-line)
 868   (let ((beg (point-marker)))
 869     (re-search-forward notmuch-show-body-end-regexp)
 870     (let ((end (copy-marker (match-beginning 0))))
 871       (notmuch-show-markup-parts-region beg end depth)
 872       (let ((invis-spec (make-symbol "notmuch-show-body-read")))
 873         (overlay-put (make-overlay beg end)
 874                      'invisible invis-spec)
 875         (button-put btn 'invisibility-spec invis-spec)
 876         (if (not (or (notmuch-show-message-unread-p) match))
 877             (add-to-invisibility-spec invis-spec)))
 878       (set-marker beg nil)
 879       (set-marker end nil)
 880       )))
 881
 882 (defun notmuch-fontify-headers ()
 883   (while (looking-at "[[:space:]]")
 884     (forward-char))
 885   (if (looking-at "[Tt]o:")
 886       (progn
 887         (overlay-put (make-overlay (point) (re-search-forward ":"))
 888                      'face 'message-header-name)
 889         (overlay-put (make-overlay (point) (re-search-forward ".*$"))
 890                      'face 'message-header-to))
 891     (if (looking-at "[B]?[Cc][Cc]:")
 892         (progn
 893           (overlay-put (make-overlay (point) (re-search-forward ":"))
 894                        'face 'message-header-name)
 895           (overlay-put (make-overlay (point) (re-search-forward ".*$"))
 896                        'face 'message-header-cc))
 897       (if (looking-at "[Ss]ubject:")
 898           (progn
 899             (overlay-put (make-overlay (point) (re-search-forward ":"))
 900                          'face 'message-header-name)
 901             (overlay-put (make-overlay (point) (re-search-forward ".*$"))
 902                          'face 'message-header-subject))
 903         (if (looking-at "[Ff]rom:")
 904             (progn
 905               (overlay-put (make-overlay (point) (re-search-forward ":"))
 906                            'face 'message-header-name)
 907               (overlay-put (make-overlay (point) (re-search-forward ".*$"))
 908                            'face 'message-header-other)))))))
 909
 910 (defun notmuch-show-markup-header (message-begin depth)
 911   "Buttonize and decorate faces in a message header.
 912
 913 MESSAGE-BEGIN is the position of the absolute first character in
 914 the message (including all delimiters that will end up being
 915 invisible etc.). This is to allow a button to reliably extend to
 916 the beginning of the message even if point is positioned at an
 917 invisible character (such as the beginning of the buffer).
 918
 919 DEPTH specifies the depth at which this message appears in the
 920 tree of the current thread, (the top-level messages have depth 0
 921 and each reply increases depth by 1)."
 922   (re-search-forward notmuch-show-header-begin-regexp)
 923   (forward-line)
 924   (let ((beg (point-marker))
 925         (summary-end (copy-marker (line-beginning-position 2)))
 926         (subject-end (copy-marker (line-end-position 2)))
 927         (invis-spec (make-symbol "notmuch-show-header"))
 928         (btn nil))
 929     (re-search-forward notmuch-show-header-end-regexp)
 930     (beginning-of-line)
 931     (let ((end (point-marker)))
 932       (indent-rigidly beg end depth)
 933       (goto-char beg)
 934       (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type))
 935       (forward-line)
 936       (add-to-invisibility-spec invis-spec)
 937       (overlay-put (make-overlay subject-end end)
 938                    'invisible invis-spec)
 939       (make-button (line-beginning-position) subject-end
 940                    'invisibility-spec invis-spec
 941                    :type 'notmuch-button-headers-toggle-type)
 942       (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:")
 943         (beginning-of-line)
 944         (notmuch-fontify-headers)
 945         (forward-line)
 946         )
 947       (goto-char end)
 948       (insert "\n")
 949       (set-marker beg nil)
 950       (set-marker summary-end nil)
 951       (set-marker subject-end nil)
 952       (set-marker end nil)
 953       )
 954   btn))
 955
 956 (defun notmuch-show-markup-message ()
 957   (if (re-search-forward notmuch-show-message-begin-regexp nil t)
 958       (let ((message-begin (match-beginning 0)))
 959         (re-search-forward notmuch-show-depth-match-regexp)
 960         (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
 961               (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2))))
 962               (btn nil))
 963           (setq btn (notmuch-show-markup-header message-begin depth))
 964           (notmuch-show-markup-body depth match btn)))
 965     (goto-char (point-max))))
 966
 967 (defun notmuch-show-hide-markers ()
 968   (save-excursion
 969     (goto-char (point-min))
 970     (while (not (eobp))
 971       (if (re-search-forward notmuch-show-marker-regexp nil t)
 972           (progn
 973             (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
 974                          'invisible 'notmuch-show-marker))
 975         (goto-char (point-max))))))
 976
 977 (defun notmuch-show-markup-messages ()
 978   (save-excursion
 979     (goto-char (point-min))
 980     (while (not (eobp))
 981       (notmuch-show-markup-message)))
 982   (notmuch-show-hide-markers))
 983
 984 (defun notmuch-documentation-first-line (symbol)
 985   "Return the first line of the documentation string for SYMBOL."
 986   (let ((doc (documentation symbol)))
 987     (if doc
 988         (with-temp-buffer
 989           (insert (documentation symbol t))
 990           (goto-char (point-min))
 991           (let ((beg (point)))
 992             (end-of-line)
 993             (buffer-substring beg (point))))
 994       "")))
 995
 996 (defun notmuch-prefix-key-description (key)
 997   "Given a prefix key code, return a human-readable string representation.
 998
 999 This is basically just `format-kbd-macro' but we also convert ESC to M-."
1000   (let ((desc (format-kbd-macro (vector key))))
1001     (if (string= desc "ESC")
1002         "M-"
1003       (concat desc " "))))
1004
1005 ; I would think that emacs would have code handy for walking a keymap
1006 ; and generating strings for each key, and I would prefer to just call
1007 ; that. But I couldn't find any (could be all implemented in C I
1008 ; suppose), so I wrote my own here.
1009 (defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
1010   "For a key binding, return a string showing a human-readable
1011 representation of the prefixed key as well as the first line of
1012 documentation from the bound function.
1013
1014 For a mouse binding, return nil."
1015   (let ((key (car binding))
1016         (action (cdr binding)))
1017     (if (mouse-event-p key)
1018         nil
1019       (if (keymapp action)
1020           (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
1021                 (as-list))
1022             (map-keymap (lambda (a b)
1023                           (push (cons a b) as-list))
1024                         action)
1025             (mapconcat substitute as-list "\n"))
1026         (concat prefix (format-kbd-macro (vector key))
1027                 "\t"
1028                 (notmuch-documentation-first-line action))))))
1029
1030 (defalias 'notmuch-substitute-one-command-key
1031   (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil))
1032
1033 (defun notmuch-substitute-command-keys (doc)
1034   "Like `substitute-command-keys' but with documentation, not function names."
1035   (let ((beg 0))
1036     (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
1037       (let ((map (substring doc (match-beginning 1) (match-end 1))))
1038         (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
1039                                             (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
1040       (setq beg (match-end 0)))
1041     doc))
1042
1043 (defun notmuch-help ()
1044   "Display help for the current notmuch mode."
1045   (interactive)
1046   (let* ((mode major-mode)
1047          (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
1048     (with-current-buffer (generate-new-buffer "*notmuch-help*")
1049       (insert doc)
1050       (goto-char (point-min))
1051       (set-buffer-modified-p nil)
1052       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
1053
1054 ;;;###autoload
1055 (defun notmuch-show-mode ()
1056   "Major mode for viewing a thread with notmuch.
1057
1058 This buffer contains the results of the \"notmuch show\" command
1059 for displaying a single thread of email from your email archives.
1060
1061 By default, various components of email messages, (citations,
1062 signatures, already-read messages), are hidden. You can make
1063 these parts visible by clicking with the mouse button or by
1064 pressing RET after positioning the cursor on a hidden part, (for
1065 which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful).
1066
1067 Reading the thread sequentially is well-supported by pressing
1068 \\[notmuch-show-advance-marking-read-and-archiving]. This will scroll the current message (if necessary),
1069 advance to the next message, or advance to the next thread (if
1070 already on the last message of a thread). As each message is
1071 scrolled away its \"unread\" tag will be removed, and as each
1072 thread is scrolled away the \"inbox\" tag will be removed from
1073 each message in the thread.
1074
1075 Other commands are available to read or manipulate the thread more
1076 selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without
1077 removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without
1078 scrolling through with \\[notmuch-show-advance-marking-read-and-archiving]).
1079
1080 You can add or remove arbitary tags from the current message with
1081 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
1082
1083 All currently available key bindings:
1084
1085 \\{notmuch-show-mode-map}"
1086   (interactive)
1087   (kill-all-local-variables)
1088   (add-to-invisibility-spec 'notmuch-show-marker)
1089   (use-local-map notmuch-show-mode-map)
1090   (setq major-mode 'notmuch-show-mode
1091         mode-name "notmuch-show")
1092   (setq buffer-read-only t))
1093
1094 (defgroup notmuch nil
1095   "Notmuch mail reader for Emacs."
1096   :group 'mail)
1097
1098 (defcustom notmuch-show-hook nil
1099   "List of functions to call when notmuch displays a message."
1100   :type 'hook
1101   :options '(goto-address)
1102   :group 'notmuch)
1103
1104 (defcustom notmuch-search-hook nil
1105   "List of functions to call when notmuch displays the search results."
1106   :type 'hook
1107   :options '(hl-line-mode)
1108   :group 'notmuch)
1109
1110 (defun notmuch-show-do-stash (text)
1111     (kill-new text)
1112     (message (concat "Saved: " text)))
1113
1114 (defun notmuch-show-stash-cc ()
1115   "Copy CC field of current message to kill-ring."
1116   (interactive)
1117   (notmuch-show-do-stash (notmuch-show-get-cc)))
1118
1119 (defun notmuch-show-stash-date ()
1120   "Copy date of current message to kill-ring."
1121   (interactive)
1122   (notmuch-show-do-stash (notmuch-show-get-date)))
1123
1124 (defun notmuch-show-stash-filename ()
1125   "Copy filename of current message to kill-ring."
1126   (interactive)
1127   (notmuch-show-do-stash (notmuch-show-get-filename)))
1128
1129 (defun notmuch-show-stash-from ()
1130   "Copy From address of current message to kill-ring."
1131   (interactive)
1132   (notmuch-show-do-stash (notmuch-show-get-from)))
1133
1134 (defun notmuch-show-stash-message-id ()
1135   "Copy message ID of current message to kill-ring."
1136   (interactive)
1137   (notmuch-show-do-stash (notmuch-show-get-message-id)))
1138
1139 (defun notmuch-show-stash-subject ()
1140   "Copy Subject field of current message to kill-ring."
1141   (interactive)
1142   (notmuch-show-do-stash (notmuch-show-get-subject)))
1143
1144 (defun notmuch-show-stash-tags ()
1145   "Copy tags of current message to kill-ring as a comma separated list."
1146   (interactive)
1147   (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
1148
1149 (defun notmuch-show-stash-to ()
1150   "Copy To address of current message to kill-ring."
1151   (interactive)
1152   (notmuch-show-do-stash (notmuch-show-get-to)))
1153
1154 ; Make show mode a bit prettier, highlighting URLs and using word wrap
1155
1156 (defun notmuch-show-pretty-hook ()
1157   (goto-address-mode 1)
1158   (visual-line-mode))
1159
1160 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
1161 (add-hook 'notmuch-search-hook
1162           (lambda()
1163             (hl-line-mode 1) ))
1164
1165 (defun notmuch-show (thread-id &optional parent-buffer query-context)
1166   "Run \"notmuch show\" with the given thread ID and display results.
1167
1168 The optional PARENT-BUFFER is the notmuch-search buffer from
1169 which this notmuch-show command was executed, (so that the next
1170 thread from that buffer can be show when done with this one).
1171
1172 The optional QUERY-CONTEXT is a notmuch search term. Only messages from the thread
1173 matching this search term are shown if non-nil. "
1174   (interactive "sNotmuch show: ")
1175   (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*"))))
1176     (switch-to-buffer buffer)
1177     (notmuch-show-mode)
1178     (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
1179     (let ((proc (get-buffer-process (current-buffer)))
1180           (inhibit-read-only t))
1181       (if proc
1182           (error "notmuch search process already running for query `%s'" thread-id)
1183         )
1184       (erase-buffer)
1185       (goto-char (point-min))
1186       (save-excursion
1187         (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id))
1188                 (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args)))
1189           (apply 'call-process args)
1190           (when (and (eq (buffer-size) 0) query-context)
1191             (apply 'call-process basic-args)))
1192         (notmuch-show-markup-messages)
1193         )
1194       (run-hooks 'notmuch-show-hook)
1195       ; Move straight to the first open message
1196       (if (not (notmuch-show-message-open-p))
1197           (notmuch-show-next-open-message))
1198       )))
1199
1200 (defvar notmuch-search-authors-width 40
1201   "Number of columns to use to display authors in a notmuch-search buffer.")
1202
1203 (defvar notmuch-search-mode-map
1204   (let ((map (make-sparse-keymap)))
1205     (define-key map "?" 'notmuch-help)
1206     (define-key map "q" 'kill-this-buffer)
1207     (define-key map "x" 'kill-this-buffer)
1208     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
1209     (define-key map "b" 'notmuch-search-scroll-down)
1210     (define-key map " " 'notmuch-search-scroll-up)
1211     (define-key map "<" 'notmuch-search-first-thread)
1212     (define-key map ">" 'notmuch-search-last-thread)
1213     (define-key map "p" 'notmuch-search-previous-thread)
1214     (define-key map "n" 'notmuch-search-next-thread)
1215     (define-key map "r" 'notmuch-search-reply-to-thread)
1216     (define-key map "m" 'message-mail)
1217     (define-key map "s" 'notmuch-search)
1218     (define-key map "o" 'notmuch-search-toggle-order)
1219     (define-key map "=" 'notmuch-search-refresh-view)
1220     (define-key map "t" 'notmuch-search-filter-by-tag)
1221     (define-key map "f" 'notmuch-search-filter)
1222     (define-key map [mouse-1] 'notmuch-search-show-thread)
1223     (define-key map "*" 'notmuch-search-operate-all)
1224     (define-key map "a" 'notmuch-search-archive-thread)
1225     (define-key map "-" 'notmuch-search-remove-tag)
1226     (define-key map "+" 'notmuch-search-add-tag)
1227     (define-key map (kbd "RET") 'notmuch-search-show-thread)
1228     map)
1229   "Keymap for \"notmuch search\" buffers.")
1230 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
1231
1232 (defvar notmuch-search-query-string)
1233 (defvar notmuch-search-oldest-first t
1234   "Show the oldest mail first in the search-mode")
1235
1236 (defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
1237
1238 (defun notmuch-search-scroll-up ()
1239   "Move forward through search results by one window's worth."
1240   (interactive)
1241   (condition-case nil
1242       (scroll-up nil)
1243     ((end-of-buffer) (notmuch-search-last-thread))))
1244
1245 (defun notmuch-search-scroll-down ()
1246   "Move backward through the search results by one window's worth."
1247   (interactive)
1248   ; I don't know why scroll-down doesn't signal beginning-of-buffer
1249   ; the way that scroll-up signals end-of-buffer, but c'est la vie.
1250   ;
1251   ; So instead of trapping a signal we instead check whether the
1252   ; window begins on the first line of the buffer and if so, move
1253   ; directly to that position. (We have to count lines since the
1254   ; window-start position is not the same as point-min due to the
1255   ; invisible thread-ID characters on the first line.
1256   (if (equal (count-lines (point-min) (window-start)) 0)
1257       (goto-char (point-min))
1258     (scroll-down nil)))
1259
1260 (defun notmuch-search-next-thread ()
1261   "Select the next thread in the search results."
1262   (interactive)
1263   (forward-line 1))
1264
1265 (defun notmuch-search-previous-thread ()
1266   "Select the previous thread in the search results."
1267   (interactive)
1268   (forward-line -1))
1269
1270 (defun notmuch-search-last-thread ()
1271   "Select the last thread in the search results."
1272   (interactive)
1273   (goto-char (point-max))
1274   (forward-line -2))
1275
1276 (defun notmuch-search-first-thread ()
1277   "Select the first thread in the search results."
1278   (interactive)
1279   (goto-char (point-min)))
1280
1281 (defface notmuch-message-summary-face
1282  '((((class color) (background light)) (:background "#f0f0f0"))
1283    (((class color) (background dark)) (:background "#303030")))
1284  "Face for the single-line message summary in notmuch-show-mode."
1285  :group 'notmuch)
1286
1287 (defface notmuch-tag-face
1288   '((((class color)
1289       (background dark))
1290      (:foreground "OliveDrab1"))
1291     (((class color)
1292       (background light))
1293      (:foreground "navy blue" :bold t))
1294     (t
1295      (:bold t)))
1296   "Notmuch search mode face used to highligh tags."
1297   :group 'notmuch)
1298
1299 (defvar notmuch-tag-face-alist nil
1300   "List containing the tag list that need to be highlighed")
1301
1302 (defvar notmuch-search-font-lock-keywords  nil)
1303
1304 ;;;###autoload
1305 (defun notmuch-search-mode ()
1306   "Major mode displaying results of a notmuch search.
1307
1308 This buffer contains the results of a \"notmuch search\" of your
1309 email archives. Each line in the buffer represents a single
1310 thread giving a summary of the thread (a relative date, the
1311 number of matched messages and total messages in the thread,
1312 participants in the thread, a representative subject line, and
1313 any tags).
1314
1315 Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
1316 keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
1317 is a convenience for archiving a thread (removing the \"inbox\"
1318 tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all
1319 threads in the current buffer.
1320
1321 Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
1322 based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include
1323 only messages with a given tag, and '\\[notmuch-search]' to execute a new, global
1324 search.
1325
1326 Complete list of currently available key bindings:
1327
1328 \\{notmuch-search-mode-map}"
1329   (interactive)
1330   (kill-all-local-variables)
1331   (make-local-variable 'notmuch-search-query-string)
1332   (make-local-variable 'notmuch-search-oldest-first)
1333   (set (make-local-variable 'scroll-preserve-screen-position) t)
1334   (add-to-invisibility-spec 'notmuch-search)
1335   (use-local-map notmuch-search-mode-map)
1336   (setq truncate-lines t)
1337   (setq major-mode 'notmuch-search-mode
1338         mode-name "notmuch-search")
1339   (setq buffer-read-only t)
1340   (if (not notmuch-tag-face-alist)
1341       (add-to-list 'notmuch-search-font-lock-keywords (list
1342                 "(\\([^)]*\\))$" '(1  'notmuch-tag-face)))
1343     (let ((notmuch-search-tags (mapcar 'car notmuch-tag-face-alist)))
1344       (loop for notmuch-search-tag  in notmuch-search-tags
1345             do (add-to-list 'notmuch-search-font-lock-keywords (list
1346                         (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
1347                         `(1  ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
1348   (set (make-local-variable 'font-lock-defaults)
1349          '(notmuch-search-font-lock-keywords t)))
1350
1351 (defun notmuch-search-find-thread-id ()
1352   "Return the thread for the current thread"
1353   (get-text-property (point) 'notmuch-search-thread-id))
1354
1355 (defun notmuch-search-find-authors ()
1356   "Return the authors for the current thread"
1357   (get-text-property (point) 'notmuch-search-authors))
1358
1359 (defun notmuch-search-find-subject ()
1360   "Return the subject for the current thread"
1361   (get-text-property (point) 'notmuch-search-subject))
1362
1363 (defun notmuch-search-show-thread ()
1364   "Display the currently selected thread."
1365   (interactive)
1366   (let ((thread-id (notmuch-search-find-thread-id)))
1367     (if (> (length thread-id) 0)
1368         (notmuch-show thread-id (current-buffer) notmuch-search-query-string)
1369       (error "End of search results"))))
1370
1371 (defun notmuch-search-reply-to-thread ()
1372   "Begin composing a reply to the entire current thread in a new buffer."
1373   (interactive)
1374   (let ((message-id (notmuch-search-find-thread-id)))
1375     (notmuch-reply message-id)))
1376
1377 (defun notmuch-call-notmuch-process (&rest args)
1378   "Synchronously invoke \"notmuch\" with the given list of arguments.
1379
1380 Output from the process will be presented to the user as an error
1381 and will also appear in a buffer named \"*Notmuch errors*\"."
1382   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
1383     (with-current-buffer error-buffer
1384         (erase-buffer))
1385     (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
1386         (point)
1387       (progn
1388         (with-current-buffer error-buffer
1389           (let ((beg (point-min))
1390                 (end (- (point-max) 1)))
1391             (error (buffer-substring beg end))
1392             ))))))
1393
1394 (defun notmuch-search-set-tags (tags)
1395   (save-excursion
1396     (end-of-line)
1397     (re-search-backward "(")
1398     (forward-char)
1399     (let ((beg (point))
1400           (inhibit-read-only t))
1401       (re-search-forward ")")
1402       (backward-char)
1403       (let ((end (point)))
1404         (delete-region beg end)
1405         (insert (mapconcat  'identity tags " "))))))
1406
1407 (defun notmuch-search-get-tags ()
1408   (save-excursion
1409     (end-of-line)
1410     (re-search-backward "(")
1411     (let ((beg (+ (point) 1)))
1412       (re-search-forward ")")
1413       (let ((end (- (point) 1)))
1414         (split-string (buffer-substring beg end))))))
1415
1416 (defun notmuch-search-add-tag (tag)
1417   "Add a tag to the currently selected thread.
1418
1419 The tag is added to messages in the currently selected thread
1420 which match the current search terms."
1421   (interactive
1422    (list (notmuch-select-tag-with-completion "Tag to add: ")))
1423   (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
1424   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
1425
1426 (defun notmuch-search-remove-tag (tag)
1427   "Remove a tag from the currently selected thread.
1428
1429 The tag is removed from messages in the currently selected thread
1430 which match the current search terms."
1431   (interactive
1432    (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id))))
1433   (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
1434   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
1435
1436 (defun notmuch-search-archive-thread ()
1437   "Archive the currently selected thread (remove its \"inbox\" tag).
1438
1439 This function advances the next thread when finished."
1440   (interactive)
1441   (notmuch-search-remove-tag "inbox")
1442   (forward-line))
1443
1444 (defun notmuch-search-process-sentinel (proc msg)
1445   "Add a message to let user know when \"notmuch search\" exits"
1446   (let ((buffer (process-buffer proc))
1447         (status (process-status proc))
1448         (exit-status (process-exit-status proc)))
1449     (if (memq status '(exit signal))
1450         (if (buffer-live-p buffer)
1451             (with-current-buffer buffer
1452               (save-excursion
1453                 (let ((inhibit-read-only t))
1454                   (goto-char (point-max))
1455                   (if (eq status 'signal)
1456                       (insert "Incomplete search results (search process was killed).\n"))
1457                   (if (eq status 'exit)
1458                       (progn
1459                         (insert "End of search results.")
1460                         (if (not (= exit-status 0))
1461                             (insert (format " (process returned %d)" exit-status)))
1462                         (insert "\n"))))))))))
1463
1464 (defun notmuch-search-process-filter (proc string)
1465   "Process and filter the output of \"notmuch search\""
1466   (let ((buffer (process-buffer proc)))
1467     (if (buffer-live-p buffer)
1468         (with-current-buffer buffer
1469           (save-excursion
1470             (let ((line 0)
1471                   (more t)
1472                   (inhibit-read-only t))
1473               (while more
1474                 (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
1475                     (let* ((thread-id (match-string 1 string))
1476                            (date (match-string 2 string))
1477                            (count (match-string 3 string))
1478                            (authors (match-string 4 string))
1479                            (authors-length (length authors))
1480                            (subject (match-string 5 string))
1481                            (tags (match-string 6 string)))
1482                       (if (> authors-length 40)
1483                           (set 'authors (concat (substring authors 0 (- 40 3)) "...")))
1484                       (goto-char (point-max))
1485                       (let ((beg (point-marker)))
1486                         (insert (format "%s %-7s %-40s %s (%s)\n" date count authors subject tags))
1487                         (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
1488                         (put-text-property beg (point-marker) 'notmuch-search-authors authors)
1489                         (put-text-property beg (point-marker) 'notmuch-search-subject subject))
1490                       (set 'line (match-end 0)))
1491                   (set 'more nil))))))
1492       (delete-process proc))))
1493
1494 (defun notmuch-search-operate-all (action)
1495   "Add/remove tags from all matching messages.
1496
1497 Tis command adds or removes tags from all messages matching the
1498 current search terms. When called interactively, this command
1499 will prompt for tags to be added or removed. Tags prefixed with
1500 '+' will be added and tags prefixed with '-' will be removed.
1501
1502 Each character of the tag name may consist of alphanumeric
1503 characters as well as `_.+-'.
1504 "
1505   (interactive "sOperation (+add -drop): notmuch tag ")
1506   (let ((action-split (split-string action " +")))
1507     ;; Perform some validation
1508     (let ((words action-split))
1509       (when (null words) (error "No operation given"))
1510       (while words
1511         (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
1512           (error "Action must be of the form `+thistag -that_tag'"))
1513         (setq words (cdr words))))
1514     (apply 'notmuch-call-notmuch-process "tag"
1515            (append action-split (list notmuch-search-query-string) nil))))
1516
1517 ;;;###autoload
1518 (defun notmuch-search (query &optional oldest-first)
1519   "Run \"notmuch search\" with the given query string and display results."
1520   (interactive "sNotmuch search: ")
1521   (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
1522     (switch-to-buffer buffer)
1523     (notmuch-search-mode)
1524     (set 'notmuch-search-query-string query)
1525     (set 'notmuch-search-oldest-first oldest-first)
1526     (let ((proc (get-buffer-process (current-buffer)))
1527           (inhibit-read-only t))
1528       (if proc
1529           (error "notmuch search process already running for query `%s'" query)
1530         )
1531       (erase-buffer)
1532       (goto-char (point-min))
1533       (save-excursion
1534         (let ((proc (start-process-shell-command
1535                      "notmuch-search" buffer notmuch-command "search"
1536                      (if oldest-first "--sort=oldest-first" "--sort=newest-first")
1537                      (shell-quote-argument query))))
1538           (set-process-sentinel proc 'notmuch-search-process-sentinel)
1539           (set-process-filter proc 'notmuch-search-process-filter))))
1540     (run-hooks 'notmuch-search-hook)))
1541
1542 (defun notmuch-search-refresh-view ()
1543   "Refresh the current view.
1544
1545 Kills the current buffer and runs a new search with the same
1546 query string as the current search. If the current thread is in
1547 the new search results, then point will be placed on the same
1548 thread. Otherwise, point will be moved to attempt to be in the
1549 same relative position within the new buffer."
1550   (interactive)
1551   (let ((here (point))
1552         (oldest-first notmuch-search-oldest-first)
1553         (thread (notmuch-search-find-thread-id))
1554         (query notmuch-search-query-string))
1555     (kill-this-buffer)
1556     (notmuch-search query oldest-first)
1557     (goto-char (point-min))
1558     (if (re-search-forward (concat "^" thread) nil t)
1559         (beginning-of-line)
1560       (goto-char here))))
1561
1562 (defun notmuch-search-toggle-order ()
1563   "Toggle the current search order.
1564
1565 By default, the \"inbox\" view created by `notmuch' is displayed
1566 in chronological order (oldest thread at the beginning of the
1567 buffer), while any global searches created by `notmuch-search'
1568 are displayed in reverse-chronological order (newest thread at
1569 the beginning of the buffer).
1570
1571 This command toggles the sort order for the current search.
1572
1573 Note that any filtered searches created by
1574 `notmuch-search-filter' retain the search order of the parent
1575 search."
1576   (interactive)
1577   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
1578   (notmuch-search-refresh-view))
1579
1580 (defun notmuch-search-filter (query)
1581   "Filter the current search results based on an additional query string.
1582
1583 Runs a new search matching only messages that match both the
1584 current search results AND the additional query string provided."
1585   (interactive "sFilter search: ")
1586   (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query) (concat "( " query " )") query)))
1587     (notmuch-search (concat notmuch-search-query-string " and " grouped-query) notmuch-search-oldest-first)))
1588
1589 (defun notmuch-search-filter-by-tag (tag)
1590   "Filter the current search results based on a single tag.
1591
1592 Runs a new search matching only messages that match both the
1593 current search results AND that are tagged with the given tag."
1594   (interactive
1595    (list (notmuch-select-tag-with-completion "Filter by tag: ")))
1596   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
1597
1598
1599 ;;;###autoload
1600 (defun notmuch ()
1601   "Run notmuch to display all mail with tag of 'inbox'"
1602   (interactive)
1603   (notmuch-search "tag:inbox" notmuch-search-oldest-first))
1604
1605 (setq mail-user-agent 'message-user-agent)
1606
1607 (defvar notmuch-folder-mode-map
1608   (let ((map (make-sparse-keymap)))
1609     (define-key map "?" 'notmuch-help)
1610     (define-key map "x" 'kill-this-buffer)
1611     (define-key map "q" 'kill-this-buffer)
1612     (define-key map "m" 'message-mail)
1613     (define-key map "e" 'notmuch-folder-show-empty-toggle)
1614     (define-key map ">" 'notmuch-folder-last)
1615     (define-key map "<" 'notmuch-folder-first)
1616     (define-key map "=" 'notmuch-folder)
1617     (define-key map "s" 'notmuch-search)
1618     (define-key map [mouse-1] 'notmuch-folder-show-search)
1619     (define-key map (kbd "RET") 'notmuch-folder-show-search)
1620     (define-key map " " 'notmuch-folder-show-search)
1621     (define-key map "p" 'notmuch-folder-previous)
1622     (define-key map "n" 'notmuch-folder-next)
1623     map)
1624   "Keymap for \"notmuch folder\" buffers.")
1625
1626 (fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
1627
1628 (defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
1629   "List of searches for the notmuch folder view"
1630   :type '(alist :key-type (string) :value-type (string))
1631   :group 'notmuch)
1632
1633 (defun notmuch-folder-mode ()
1634   "Major mode for showing notmuch 'folders'.
1635
1636 This buffer contains a list of message counts returned by a
1637 customizable set of searches of your email archives. Each line in
1638 the buffer shows the name of a saved search and the resulting
1639 message count.
1640
1641 Pressing RET on any line opens a search window containing the
1642 results for the saved search on that line.
1643
1644 Here is an example of how the search list could be
1645 customized, (the following text would be placed in your ~/.emacs
1646 file):
1647
1648 (setq notmuch-folders '((\"inbox\" . \"tag:inbox\")
1649                         (\"unread\" . \"tag:inbox AND tag:unread\")
1650                         (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\")))
1651
1652 Of course, you can have any number of folders, each configured
1653 with any supported search terms (see \"notmuch help search-terms\").
1654
1655 Currently available key bindings:
1656
1657 \\{notmuch-folder-mode-map}"
1658   (interactive)
1659   (kill-all-local-variables)
1660   (use-local-map 'notmuch-folder-mode-map)
1661   (setq truncate-lines t)
1662   (hl-line-mode 1)
1663   (setq major-mode 'notmuch-folder-mode
1664         mode-name "notmuch-folder")
1665   (setq buffer-read-only t))
1666
1667 (defun notmuch-folder-next ()
1668   "Select the next folder in the list."
1669   (interactive)
1670   (forward-line 1)
1671   (if (eobp)
1672       (forward-line -1)))
1673
1674 (defun notmuch-folder-previous ()
1675   "Select the previous folder in the list."
1676   (interactive)
1677   (forward-line -1))
1678
1679 (defun notmuch-folder-first ()
1680   "Select the first folder in the list."
1681   (interactive)
1682   (goto-char (point-min)))
1683
1684 (defun notmuch-folder-last ()
1685   "Select the last folder in the list."
1686   (interactive)
1687   (goto-char (point-max))
1688   (forward-line -1))
1689
1690 (defun notmuch-folder-count (search)
1691   (car (process-lines notmuch-command "count" search)))
1692
1693 (setq notmuch-folder-show-empty t)
1694
1695 (defun notmuch-folder-show-empty-toggle ()
1696   "Toggle the listing of empty folders"
1697   (interactive)
1698   (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
1699   (notmuch-folder))
1700
1701 (defun notmuch-folder-add (folders)
1702   (if folders
1703       (let* ((name (car (car folders)))
1704             (inhibit-read-only t)
1705             (search (cdr (car folders)))
1706             (count (notmuch-folder-count search)))
1707         (if (or notmuch-folder-show-empty
1708                 (not (equal count "0")))
1709             (progn
1710               (insert name)
1711               (indent-to 16 1)
1712               (insert count)
1713               (insert "\n")
1714               )
1715           )
1716         (notmuch-folder-add (cdr folders)))))
1717
1718 (defun notmuch-folder-find-name ()
1719   (save-excursion
1720     (beginning-of-line)
1721     (let ((beg (point)))
1722       (re-search-forward "\\([ \t]*[^ \t]+\\)")
1723       (filter-buffer-substring (match-beginning 1) (match-end 1)))))
1724
1725 (defun notmuch-folder-show-search (&optional folder)
1726   "Show a search window for the search related to the specified folder."
1727   (interactive)
1728   (if (null folder)
1729       (setq folder (notmuch-folder-find-name)))
1730   (let ((search (assoc folder notmuch-folders)))
1731     (if search
1732         (notmuch-search (cdr search) notmuch-search-oldest-first))))
1733
1734 ;;;###autoload
1735 (defun notmuch-folder ()
1736   "Show the notmuch folder view and update the displayed counts."
1737   (interactive)
1738   (let ((buffer (get-buffer-create "*notmuch-folders*")))
1739     (switch-to-buffer buffer)
1740     (let ((inhibit-read-only t)
1741           (n (line-number-at-pos)))
1742       (erase-buffer)
1743       (notmuch-folder-mode)
1744       (notmuch-folder-add notmuch-folders)
1745       (goto-char (point-min))
1746       (goto-line n))))
1747
1748 (provide 'notmuch)