git.notmuchmail.org Git - notmuch/blob - emacs/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 (require 'notmuch-lib)
  55 (require 'notmuch-show)
  56
  57 (defcustom notmuch-search-result-format
  58   `(("date" . "%s ")
  59     ("count" . "%-7s ")
  60     ("authors" . "%-20s ")
  61     ("subject" . "%s ")
  62     ("tags" . "(%s)"))
  63   "Search result formating. Supported fields are:
  64         date, count, authors, subject, tags
  65 For example:
  66         (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
  67                                              \(\"subject\" . \"%s\"\)\)\)"
  68   :type '(alist :key-type (string) :value-type (string))
  69   :group 'notmuch)
  70
  71 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
  72   (let ((tag-list
  73          (with-output-to-string
  74            (with-current-buffer standard-output
  75              (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
  76     (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
  77
  78 (defun notmuch-foreach-mime-part (function mm-handle)
  79   (cond ((stringp (car mm-handle))
  80          (dolist (part (cdr mm-handle))
  81            (notmuch-foreach-mime-part function part)))
  82         ((bufferp (car mm-handle))
  83          (funcall function mm-handle))
  84         (t (dolist (part mm-handle)
  85              (notmuch-foreach-mime-part function part)))))
  86
  87 (defun notmuch-count-attachments (mm-handle)
  88   (let ((count 0))
  89     (notmuch-foreach-mime-part
  90      (lambda (p)
  91        (let ((disposition (mm-handle-disposition p)))
  92          (and (listp disposition)
  93               (or (equal (car disposition) "attachment")
  94                   (and (equal (car disposition) "inline")
  95                        (assq 'filename disposition)))
  96               (incf count))))
  97      mm-handle)
  98     count))
  99
 100 (defun notmuch-save-attachments (mm-handle &optional queryp)
 101   (notmuch-foreach-mime-part
 102    (lambda (p)
 103      (let ((disposition (mm-handle-disposition p)))
 104        (and (listp disposition)
 105             (or (equal (car disposition) "attachment")
 106                 (and (equal (car disposition) "inline")
 107                      (assq 'filename disposition)))
 108             (or (not queryp)
 109                 (y-or-n-p
 110                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
 111             (mm-save-part p))))
 112    mm-handle))
 113
 114 (defun notmuch-reply (query-string)
 115   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
 116   (call-process notmuch-command nil t nil "reply" query-string)
 117   (message-insert-signature)
 118   (goto-char (point-min))
 119   (if (re-search-forward "^$" nil t)
 120       (progn
 121         (insert "--text follows this line--")
 122         (forward-line)))
 123   (message-mode))
 124
 125 (defun notmuch-documentation-first-line (symbol)
 126   "Return the first line of the documentation string for SYMBOL."
 127   (let ((doc (documentation symbol)))
 128     (if doc
 129         (with-temp-buffer
 130           (insert (documentation symbol t))
 131           (goto-char (point-min))
 132           (let ((beg (point)))
 133             (end-of-line)
 134             (buffer-substring beg (point))))
 135       "")))
 136
 137 (defun notmuch-prefix-key-description (key)
 138   "Given a prefix key code, return a human-readable string representation.
 139
 140 This is basically just `format-kbd-macro' but we also convert ESC to M-."
 141   (let ((desc (format-kbd-macro (vector key))))
 142     (if (string= desc "ESC")
 143         "M-"
 144       (concat desc " "))))
 145
 146 ; I would think that emacs would have code handy for walking a keymap
 147 ; and generating strings for each key, and I would prefer to just call
 148 ; that. But I couldn't find any (could be all implemented in C I
 149 ; suppose), so I wrote my own here.
 150 (defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
 151   "For a key binding, return a string showing a human-readable
 152 representation of the prefixed key as well as the first line of
 153 documentation from the bound function.
 154
 155 For a mouse binding, return nil."
 156   (let ((key (car binding))
 157         (action (cdr binding)))
 158     (if (mouse-event-p key)
 159         nil
 160       (if (keymapp action)
 161           (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
 162                 (as-list))
 163             (map-keymap (lambda (a b)
 164                           (push (cons a b) as-list))
 165                         action)
 166             (mapconcat substitute as-list "\n"))
 167         (concat prefix (format-kbd-macro (vector key))
 168                 "\t"
 169                 (notmuch-documentation-first-line action))))))
 170
 171 (defalias 'notmuch-substitute-one-command-key
 172   (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil))
 173
 174 (defun notmuch-substitute-command-keys (doc)
 175   "Like `substitute-command-keys' but with documentation, not function names."
 176   (let ((beg 0))
 177     (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
 178       (let ((map (substring doc (match-beginning 1) (match-end 1))))
 179         (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
 180                                             (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
 181       (setq beg (match-end 0)))
 182     doc))
 183
 184 (defun notmuch-help ()
 185   "Display help for the current notmuch mode."
 186   (interactive)
 187   (let* ((mode major-mode)
 188          (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
 189     (with-current-buffer (generate-new-buffer "*notmuch-help*")
 190       (insert doc)
 191       (goto-char (point-min))
 192       (set-buffer-modified-p nil)
 193       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
 194
 195 (defcustom notmuch-search-hook '(hl-line-mode)
 196   "List of functions to call when notmuch displays the search results."
 197   :type 'hook
 198   :options '(hl-line-mode)
 199   :group 'notmuch)
 200
 201 (defvar notmuch-search-mode-map
 202   (let ((map (make-sparse-keymap)))
 203     (define-key map "?" 'notmuch-help)
 204     (define-key map "q" 'notmuch-search-quit)
 205     (define-key map "x" 'notmuch-search-quit)
 206     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
 207     (define-key map "b" 'notmuch-search-scroll-down)
 208     (define-key map " " 'notmuch-search-scroll-up)
 209     (define-key map "<" 'notmuch-search-first-thread)
 210     (define-key map ">" 'notmuch-search-last-thread)
 211     (define-key map "p" 'notmuch-search-previous-thread)
 212     (define-key map "n" 'notmuch-search-next-thread)
 213     (define-key map "r" 'notmuch-search-reply-to-thread)
 214     (define-key map "m" 'message-mail)
 215     (define-key map "s" 'notmuch-search)
 216     (define-key map "o" 'notmuch-search-toggle-order)
 217     (define-key map "=" 'notmuch-search-refresh-view)
 218     (define-key map "G" 'notmuch-search-poll-and-refresh-view)
 219     (define-key map "t" 'notmuch-search-filter-by-tag)
 220     (define-key map "f" 'notmuch-search-filter)
 221     (define-key map [mouse-1] 'notmuch-search-show-thread)
 222     (define-key map "*" 'notmuch-search-operate-all)
 223     (define-key map "a" 'notmuch-search-archive-thread)
 224     (define-key map "-" 'notmuch-search-remove-tag)
 225     (define-key map "+" 'notmuch-search-add-tag)
 226     (define-key map (kbd "RET") 'notmuch-search-show-thread)
 227     map)
 228   "Keymap for \"notmuch search\" buffers.")
 229 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
 230
 231 (defvar notmuch-search-query-string)
 232 (defvar notmuch-search-target-thread)
 233 (defvar notmuch-search-target-line)
 234 (defvar notmuch-search-oldest-first t
 235   "Show the oldest mail first in the search-mode")
 236
 237 (defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
 238
 239 (defun notmuch-search-quit ()
 240   "Exit the search buffer, calling any defined continuation function."
 241   (interactive)
 242   (let ((continuation notmuch-search-continuation))
 243     (kill-this-buffer)
 244     (when continuation
 245       (funcall continuation))))
 246
 247 (defun notmuch-search-scroll-up ()
 248   "Move forward through search results by one window's worth."
 249   (interactive)
 250   (condition-case nil
 251       (scroll-up nil)
 252     ((end-of-buffer) (notmuch-search-last-thread))))
 253
 254 (defun notmuch-search-scroll-down ()
 255   "Move backward through the search results by one window's worth."
 256   (interactive)
 257   ; I don't know why scroll-down doesn't signal beginning-of-buffer
 258   ; the way that scroll-up signals end-of-buffer, but c'est la vie.
 259   ;
 260   ; So instead of trapping a signal we instead check whether the
 261   ; window begins on the first line of the buffer and if so, move
 262   ; directly to that position. (We have to count lines since the
 263   ; window-start position is not the same as point-min due to the
 264   ; invisible thread-ID characters on the first line.
 265   (if (equal (count-lines (point-min) (window-start)) 0)
 266       (goto-char (point-min))
 267     (scroll-down nil)))
 268
 269 (defun notmuch-search-next-thread ()
 270   "Select the next thread in the search results."
 271   (interactive)
 272   (forward-line 1))
 273
 274 (defun notmuch-search-previous-thread ()
 275   "Select the previous thread in the search results."
 276   (interactive)
 277   (forward-line -1))
 278
 279 (defun notmuch-search-last-thread ()
 280   "Select the last thread in the search results."
 281   (interactive)
 282   (goto-char (point-max))
 283   (forward-line -2))
 284
 285 (defun notmuch-search-first-thread ()
 286   "Select the first thread in the search results."
 287   (interactive)
 288   (goto-char (point-min)))
 289
 290 (defface notmuch-message-summary-face
 291  '((((class color) (background light)) (:background "#f0f0f0"))
 292    (((class color) (background dark)) (:background "#303030")))
 293  "Face for the single-line message summary in notmuch-show-mode."
 294  :group 'notmuch)
 295
 296 (defface notmuch-tag-face
 297   '((((class color)
 298       (background dark))
 299      (:foreground "OliveDrab1"))
 300     (((class color)
 301       (background light))
 302      (:foreground "navy blue" :bold t))
 303     (t
 304      (:bold t)))
 305   "Notmuch search mode face used to highligh tags."
 306   :group 'notmuch)
 307
 308 ;;;###autoload
 309 (defun notmuch-search-mode ()
 310   "Major mode displaying results of a notmuch search.
 311
 312 This buffer contains the results of a \"notmuch search\" of your
 313 email archives. Each line in the buffer represents a single
 314 thread giving a summary of the thread (a relative date, the
 315 number of matched messages and total messages in the thread,
 316 participants in the thread, a representative subject line, and
 317 any tags).
 318
 319 Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
 320 keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
 321 is a convenience for archiving a thread (removing the \"inbox\"
 322 tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all
 323 threads in the current buffer.
 324
 325 Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
 326 based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include
 327 only messages with a given tag, and '\\[notmuch-search]' to execute a new, global
 328 search.
 329
 330 Complete list of currently available key bindings:
 331
 332 \\{notmuch-search-mode-map}"
 333   (interactive)
 334   (kill-all-local-variables)
 335   (make-local-variable 'notmuch-search-query-string)
 336   (make-local-variable 'notmuch-search-oldest-first)
 337   (make-local-variable 'notmuch-search-target-thread)
 338   (make-local-variable 'notmuch-search-target-line)
 339   (set (make-local-variable 'notmuch-search-continuation) nil)
 340   (set (make-local-variable 'scroll-preserve-screen-position) t)
 341   (add-to-invisibility-spec 'notmuch-search)
 342   (use-local-map notmuch-search-mode-map)
 343   (setq truncate-lines t)
 344   (setq major-mode 'notmuch-search-mode
 345         mode-name "notmuch-search")
 346   (setq buffer-read-only t))
 347
 348 (defun notmuch-search-properties-in-region (property beg end)
 349   (save-excursion
 350     (let ((output nil)
 351           (last-line (line-number-at-pos end))
 352           (max-line (- (line-number-at-pos (point-max)) 2)))
 353       (goto-char beg)
 354       (beginning-of-line)
 355       (while (<= (line-number-at-pos) (min last-line max-line))
 356         (setq output (cons (get-text-property (point) property) output))
 357         (forward-line 1))
 358       output)))
 359
 360 (defun notmuch-search-find-thread-id ()
 361   "Return the thread for the current thread"
 362   (get-text-property (point) 'notmuch-search-thread-id))
 363
 364 (defun notmuch-search-find-thread-id-region (beg end)
 365   "Return a list of threads for the current region"
 366   (notmuch-search-properties-in-region 'notmuch-search-thread-id beg end))
 367
 368 (defun notmuch-search-find-authors ()
 369   "Return the authors for the current thread"
 370   (get-text-property (point) 'notmuch-search-authors))
 371
 372 (defun notmuch-search-find-authors-region (beg end)
 373   "Return a list of authors for the current region"
 374   (notmuch-search-properties-in-region 'notmuch-search-authors beg end))
 375
 376 (defun notmuch-search-find-subject ()
 377   "Return the subject for the current thread"
 378   (get-text-property (point) 'notmuch-search-subject))
 379
 380 (defun notmuch-search-find-subject-region (beg end)
 381   "Return a list of authors for the current region"
 382   (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
 383
 384 (defun notmuch-search-show-thread ()
 385   "Display the currently selected thread."
 386   (interactive)
 387   (let ((thread-id (notmuch-search-find-thread-id))
 388         (subject (notmuch-search-find-subject)))
 389     (if (> (length thread-id) 0)
 390         (notmuch-show thread-id
 391                       (current-buffer)
 392                       notmuch-search-query-string
 393                       ;; name the buffer based on notmuch-search-find-subject
 394                       (if (string-match "^[ \t]*$" subject)
 395                           "[No Subject]"
 396                         (truncate-string-to-width
 397                          (concat "*"
 398                                  (truncate-string-to-width subject 32 nil nil t)
 399                                  "*")
 400                          32 nil nil t)))
 401       (error "End of search results"))))
 402
 403 (defun notmuch-search-reply-to-thread ()
 404   "Begin composing a reply to the entire current thread in a new buffer."
 405   (interactive)
 406   (let ((message-id (notmuch-search-find-thread-id)))
 407     (notmuch-reply message-id)))
 408
 409 (defun notmuch-call-notmuch-process (&rest args)
 410   "Synchronously invoke \"notmuch\" with the given list of arguments.
 411
 412 Output from the process will be presented to the user as an error
 413 and will also appear in a buffer named \"*Notmuch errors*\"."
 414   (let ((error-buffer (get-buffer-create "*Notmuch errors*")))
 415     (with-current-buffer error-buffer
 416         (erase-buffer))
 417     (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0)
 418         (point)
 419       (progn
 420         (with-current-buffer error-buffer
 421           (let ((beg (point-min))
 422                 (end (- (point-max) 1)))
 423             (error (buffer-substring beg end))
 424             ))))))
 425
 426 (defun notmuch-search-set-tags (tags)
 427   (save-excursion
 428     (end-of-line)
 429     (re-search-backward "(")
 430     (forward-char)
 431     (let ((beg (point))
 432           (inhibit-read-only t))
 433       (re-search-forward ")")
 434       (backward-char)
 435       (let ((end (point)))
 436         (delete-region beg end)
 437         (insert (propertize (mapconcat  'identity tags " ")
 438                             'font-lock-face 'notmuch-tag-face))))))
 439
 440 (defun notmuch-search-get-tags ()
 441   (save-excursion
 442     (end-of-line)
 443     (re-search-backward "(")
 444     (let ((beg (+ (point) 1)))
 445       (re-search-forward ")")
 446       (let ((end (- (point) 1)))
 447         (split-string (buffer-substring beg end))))))
 448
 449 (defun notmuch-search-get-tags-region (beg end)
 450   (save-excursion
 451     (let ((output nil)
 452           (last-line (line-number-at-pos end))
 453           (max-line (- (line-number-at-pos (point-max)) 2)))
 454       (goto-char beg)
 455       (while (<= (line-number-at-pos) (min last-line max-line))
 456         (setq output (append output (notmuch-search-get-tags)))
 457         (forward-line 1))
 458       output)))
 459
 460 (defun notmuch-search-add-tag-thread (tag)
 461   (notmuch-search-add-tag-region tag (point) (point)))
 462
 463 (defun notmuch-search-add-tag-region (tag beg end)
 464   (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
 465     (notmuch-call-notmuch-process "tag" (concat "+" tag) search-id-string)
 466     (save-excursion
 467       (let ((last-line (line-number-at-pos end))
 468             (max-line (- (line-number-at-pos (point-max)) 2)))
 469         (goto-char beg)
 470         (while (<= (line-number-at-pos) (min last-line max-line))
 471           (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))
 472           (forward-line))))))
 473
 474 (defun notmuch-search-remove-tag-thread (tag)
 475   (notmuch-search-remove-tag-region tag (point) (point)))
 476
 477 (defun notmuch-search-remove-tag-region (tag beg end)
 478   (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
 479     (notmuch-call-notmuch-process "tag" (concat "-" tag) search-id-string)
 480     (save-excursion
 481       (let ((last-line (line-number-at-pos end))
 482             (max-line (- (line-number-at-pos (point-max)) 2)))
 483         (goto-char beg)
 484         (while (<= (line-number-at-pos) (min last-line max-line))
 485           (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))
 486           (forward-line))))))
 487
 488 (defun notmuch-search-add-tag (tag)
 489   "Add a tag to the currently selected thread or region.
 490
 491 The tag is added to all messages in the currently selected thread
 492 or threads in the current region."
 493   (interactive
 494    (list (notmuch-select-tag-with-completion "Tag to add: ")))
 495   (save-excursion
 496     (if (region-active-p)
 497         (let* ((beg (region-beginning))
 498                (end (region-end)))
 499           (notmuch-search-add-tag-region tag beg end))
 500       (notmuch-search-add-tag-thread tag))))
 501
 502 (defun notmuch-search-remove-tag (tag)
 503   "Remove a tag from the currently selected thread or region.
 504
 505 The tag is removed from all messages in the currently selected
 506 thread or threads in the current region."
 507   (interactive
 508    (list (notmuch-select-tag-with-completion
 509           "Tag to remove: "
 510           (if (region-active-p)
 511               (mapconcat 'identity
 512                          (notmuch-search-find-thread-id-region (region-beginning) (region-end))
 513                          " ")
 514             (notmuch-search-find-thread-id)))))
 515   (save-excursion
 516     (if (region-active-p)
 517         (let* ((beg (region-beginning))
 518                (end (region-end)))
 519           (notmuch-search-remove-tag-region tag beg end))
 520       (notmuch-search-remove-tag-thread tag))))
 521
 522 (defun notmuch-search-archive-thread ()
 523   "Archive the currently selected thread (remove its \"inbox\" tag).
 524
 525 This function advances the next thread when finished."
 526   (interactive)
 527   (notmuch-search-remove-tag-thread "inbox")
 528   (forward-line))
 529
 530 (defun notmuch-search-process-sentinel (proc msg)
 531   "Add a message to let user know when \"notmuch search\" exits"
 532   (let ((buffer (process-buffer proc))
 533         (status (process-status proc))
 534         (exit-status (process-exit-status proc))
 535         (never-found-target-thread nil))
 536     (if (memq status '(exit signal))
 537         (if (buffer-live-p buffer)
 538             (with-current-buffer buffer
 539               (save-excursion
 540                 (let ((inhibit-read-only t)
 541                       (atbob (bobp)))
 542                   (goto-char (point-max))
 543                   (if (eq status 'signal)
 544                       (insert "Incomplete search results (search process was killed).\n"))
 545                   (if (eq status 'exit)
 546                       (progn
 547                         (insert "End of search results.")
 548                         (if (not (= exit-status 0))
 549                             (insert (format " (process returned %d)" exit-status)))
 550                         (insert "\n")
 551                         (if (and atbob
 552                                  (not (string= notmuch-search-target-thread "found")))
 553                             (set 'never-found-target-thread t))))))
 554               (if (and never-found-target-thread
 555                        notmuch-search-target-line)
 556                   (goto-line notmuch-search-target-line)))))))
 557
 558 (defcustom notmuch-search-line-faces nil
 559   "Tag/face mapping for line highlighting in notmuch-search.
 560
 561 Here is an example of how to color search results based on tags.
 562 (the following text would be placed in your ~/.emacs file):
 563
 564 (setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\"))
 565                                  (\"unread\" . '(:foreground \"green\"))))
 566
 567 Order matters: for lines with multiple tags, the the first
 568 matching will be applied."
 569   :type '(alist :key-type (string) :value-type (list))
 570   :group 'notmuch)
 571
 572 (defun notmuch-search-color-line (start end line-tag-list)
 573   "Colorize lines in notmuch-show based on tags"
 574   (if notmuch-search-line-faces
 575       (let ((overlay (make-overlay start end))
 576             (tags-faces (copy-alist notmuch-search-line-faces)))
 577         (while tags-faces
 578           (let* ((tag-face (car tags-faces))
 579                  (tag (car tag-face))
 580                  (face (cdr tag-face)))
 581             (cond ((member tag line-tag-list)
 582                    (overlay-put overlay 'face face)
 583                    (setq tags-faces nil))
 584                   (t
 585                    (setq tags-faces (cdr tags-faces)))))))))
 586
 587 (defun notmuch-search-insert-field (field date count authors subject tags)
 588   (cond
 589    ((string-equal field "date")
 590     (insert (format (cdr (assoc field notmuch-search-result-format)) date)))
 591    ((string-equal field "count")
 592     (insert (format (cdr (assoc field notmuch-search-result-format)) count)))
 593    ((string-equal field "authors")
 594     (insert (let ((sample (format (cdr (assoc field notmuch-search-result-format)) "")))
 595               (if (> (length authors)
 596                      (length sample))
 597                   (concat (substring authors 0 (- (length sample) 4)) "... ")
 598                 (format (cdr (assoc field notmuch-search-result-format)) authors)))))
 599    ((string-equal field "subject")
 600     (insert (format (cdr (assoc field notmuch-search-result-format)) subject)))
 601    ((string-equal field "tags")
 602     (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")")))))
 603
 604 (defun notmuch-search-show-result (date count authors subject tags)
 605   (let ((fields) (field))
 606     (setq fields (mapcar 'car notmuch-search-result-format))
 607     (loop for field in fields
 608           do (notmuch-search-insert-field field date count authors subject tags)))
 609   (insert "\n"))
 610
 611 (defun notmuch-search-process-filter (proc string)
 612   "Process and filter the output of \"notmuch search\""
 613   (let ((buffer (process-buffer proc))
 614         (found-target nil))
 615     (if (buffer-live-p buffer)
 616         (with-current-buffer buffer
 617           (save-excursion
 618             (let ((line 0)
 619                   (more t)
 620                   (inhibit-read-only t))
 621               (while more
 622                 (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
 623                     (let* ((thread-id (match-string 1 string))
 624                            (date (match-string 2 string))
 625                            (count (match-string 3 string))
 626                            (authors (match-string 4 string))
 627                            (subject (match-string 5 string))
 628                            (tags (match-string 6 string))
 629                            (tag-list (if tags (save-match-data (split-string tags)))))
 630                       (goto-char (point-max))
 631                       (let ((beg (point-marker)))
 632                         (notmuch-search-show-result date count authors subject tags)
 633                         (notmuch-search-color-line beg (point-marker) tag-list)
 634                         (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
 635                         (put-text-property beg (point-marker) 'notmuch-search-authors authors)
 636                         (put-text-property beg (point-marker) 'notmuch-search-subject subject)
 637                         (if (string= thread-id notmuch-search-target-thread)
 638                             (progn
 639                               (set 'found-target beg)
 640                               (set 'notmuch-search-target-thread "found"))))
 641                       (set 'line (match-end 0)))
 642                   (set 'more nil)))))
 643           (if found-target
 644               (goto-char found-target)))
 645       (delete-process proc))))
 646
 647 (defun notmuch-search-operate-all (action)
 648   "Add/remove tags from all matching messages.
 649
 650 Tis command adds or removes tags from all messages matching the
 651 current search terms. When called interactively, this command
 652 will prompt for tags to be added or removed. Tags prefixed with
 653 '+' will be added and tags prefixed with '-' will be removed.
 654
 655 Each character of the tag name may consist of alphanumeric
 656 characters as well as `_.+-'.
 657 "
 658   (interactive "sOperation (+add -drop): notmuch tag ")
 659   (let ((action-split (split-string action " +")))
 660     ;; Perform some validation
 661     (let ((words action-split))
 662       (when (null words) (error "No operation given"))
 663       (while words
 664         (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
 665           (error "Action must be of the form `+thistag -that_tag'"))
 666         (setq words (cdr words))))
 667     (apply 'notmuch-call-notmuch-process "tag"
 668            (append action-split (list notmuch-search-query-string) nil))))
 669
 670 (defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
 671   "List of searches for the notmuch folder view"
 672   :type '(alist :key-type (string) :value-type (string))
 673   :group 'notmuch)
 674
 675 (defun notmuch-search-buffer-title (query)
 676   "Returns the title for a buffer with notmuch search results."
 677   (let* ((folder (rassoc-if (lambda (key)
 678                               (string-match (concat "^" (regexp-quote key))
 679                                             query))
 680                             notmuch-folders))
 681          (folder-name (car folder))
 682          (folder-query (cdr folder)))
 683     (cond ((and folder (equal folder-query query))
 684            ;; Query is the same as folder search (ignoring case)
 685            (concat "*notmuch-folder-" folder-name "*"))
 686           (folder
 687            (concat "*notmuch-search-"
 688                    (replace-regexp-in-string (concat "^" (regexp-quote folder-query))
 689                                              (concat "[ " folder-name " ]")
 690                                              query)
 691                    "*"))
 692           (t
 693            (concat "*notmuch-search-" query "*"))
 694           )))
 695
 696 ;;;###autoload
 697 (defun notmuch-search (query &optional oldest-first target-thread target-line continuation)
 698   "Run \"notmuch search\" with the given query string and display results.
 699
 700 The optional parameters are used as follows:
 701
 702   oldest-first: A Boolean controlling the sort order of returned threads
 703   target-thread: A thread ID (with the thread: prefix) that will be made
 704                  current if it appears in the search results.
 705   target-line: The line number to move to if the target thread does not
 706                appear in the search results."
 707   (interactive "sNotmuch search: ")
 708   (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
 709     (switch-to-buffer buffer)
 710     (notmuch-search-mode)
 711     (set 'notmuch-search-query-string query)
 712     (set 'notmuch-search-oldest-first oldest-first)
 713     (set 'notmuch-search-target-thread target-thread)
 714     (set 'notmuch-search-target-line target-line)
 715     (set 'notmuch-search-continuation continuation)
 716     (let ((proc (get-buffer-process (current-buffer)))
 717           (inhibit-read-only t))
 718       (if proc
 719           (error "notmuch search process already running for query `%s'" query)
 720         )
 721       (erase-buffer)
 722       (goto-char (point-min))
 723       (save-excursion
 724         (let ((proc (start-process-shell-command
 725                      "notmuch-search" buffer notmuch-command "search"
 726                      (if oldest-first "--sort=oldest-first" "--sort=newest-first")
 727                      (shell-quote-argument query))))
 728           (set-process-sentinel proc 'notmuch-search-process-sentinel)
 729           (set-process-filter proc 'notmuch-search-process-filter))))
 730     (run-hooks 'notmuch-search-hook)))
 731
 732 (defun notmuch-search-refresh-view ()
 733   "Refresh the current view.
 734
 735 Kills the current buffer and runs a new search with the same
 736 query string as the current search. If the current thread is in
 737 the new search results, then point will be placed on the same
 738 thread. Otherwise, point will be moved to attempt to be in the
 739 same relative position within the new buffer."
 740   (interactive)
 741   (let ((target-line (line-number-at-pos))
 742         (oldest-first notmuch-search-oldest-first)
 743         (target-thread (notmuch-search-find-thread-id))
 744         (query notmuch-search-query-string)
 745         (continuation notmuch-search-continuation))
 746     (kill-this-buffer)
 747     (notmuch-search query oldest-first target-thread target-line continuation)
 748     (goto-char (point-min))))
 749
 750 (defcustom notmuch-poll-script ""
 751   "An external script to incorporate new mail into the notmuch database.
 752
 753 If this variable is non empty, then it should name a script to be
 754 invoked by `notmuch-search-poll-and-refresh-view' and
 755 `notmuch-folder-poll-and-refresh-view' (each have a default
 756 keybinding of 'G'). The script could do any of the following
 757 depending on the user's needs:
 758
 759 1. Invoke a program to transfer mail to the local mail store
 760 2. Invoke \"notmuch new\" to incorporate the new mail
 761 3. Invoke one or more \"notmuch tag\" commands to classify the mail"
 762   :type 'string
 763   :group 'notmuch)
 764
 765 (defun notmuch-poll ()
 766   "Run external script to import mail.
 767
 768 Invokes `notmuch-poll-script' if it is not set to an empty string."
 769   (interactive)
 770   (if (not (string= notmuch-poll-script ""))
 771       (call-process notmuch-poll-script nil nil)))
 772
 773 (defun notmuch-search-poll-and-refresh-view ()
 774   "Invoke `notmuch-poll' to import mail, then refresh the current view."
 775   (interactive)
 776   (notmuch-poll)
 777   (notmuch-search-refresh-view))
 778
 779 (defun notmuch-search-toggle-order ()
 780   "Toggle the current search order.
 781
 782 By default, the \"inbox\" view created by `notmuch' is displayed
 783 in chronological order (oldest thread at the beginning of the
 784 buffer), while any global searches created by `notmuch-search'
 785 are displayed in reverse-chronological order (newest thread at
 786 the beginning of the buffer).
 787
 788 This command toggles the sort order for the current search.
 789
 790 Note that any filtered searches created by
 791 `notmuch-search-filter' retain the search order of the parent
 792 search."
 793   (interactive)
 794   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
 795   (notmuch-search-refresh-view))
 796
 797 (defun notmuch-search-filter (query)
 798   "Filter the current search results based on an additional query string.
 799
 800 Runs a new search matching only messages that match both the
 801 current search results AND the additional query string provided."
 802   (interactive "sFilter search: ")
 803   (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query)
 804                            (concat "( " query " )")
 805                          query)))
 806     (notmuch-search (if (string= notmuch-search-query-string "*")
 807                         grouped-query
 808                       (concat notmuch-search-query-string " and " grouped-query)) notmuch-search-oldest-first)))
 809
 810 (defun notmuch-search-filter-by-tag (tag)
 811   "Filter the current search results based on a single tag.
 812
 813 Runs a new search matching only messages that match both the
 814 current search results AND that are tagged with the given tag."
 815   (interactive
 816    (list (notmuch-select-tag-with-completion "Filter by tag: ")))
 817   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 818
 819 ;;;###autoload
 820 (defun notmuch ()
 821   "Run notmuch to display all mail with tag of 'inbox'"
 822   (interactive)
 823   (notmuch-search "tag:inbox" notmuch-search-oldest-first))
 824
 825 (setq mail-user-agent 'message-user-agent)
 826
 827 (defvar notmuch-folder-mode-map
 828   (let ((map (make-sparse-keymap)))
 829     (define-key map "?" 'notmuch-help)
 830     (define-key map "x" 'kill-this-buffer)
 831     (define-key map "q" 'kill-this-buffer)
 832     (define-key map "m" 'message-mail)
 833     (define-key map "e" 'notmuch-folder-show-empty-toggle)
 834     (define-key map ">" 'notmuch-folder-last)
 835     (define-key map "<" 'notmuch-folder-first)
 836     (define-key map "=" 'notmuch-folder)
 837     (define-key map "G" 'notmuch-folder-poll-and-refresh-view)
 838     (define-key map "s" 'notmuch-search)
 839     (define-key map [mouse-1] 'notmuch-folder-show-search)
 840     (define-key map (kbd "RET") 'notmuch-folder-show-search)
 841     (define-key map " " 'notmuch-folder-show-search)
 842     (define-key map "p" 'notmuch-folder-previous)
 843     (define-key map "n" 'notmuch-folder-next)
 844     map)
 845   "Keymap for \"notmuch folder\" buffers.")
 846
 847 (fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
 848
 849 (defun notmuch-folder-mode ()
 850   "Major mode for showing notmuch 'folders'.
 851
 852 This buffer contains a list of message counts returned by a
 853 customizable set of searches of your email archives. Each line in
 854 the buffer shows the name of a saved search and the resulting
 855 message count.
 856
 857 Pressing RET on any line opens a search window containing the
 858 results for the saved search on that line.
 859
 860 Here is an example of how the search list could be
 861 customized, (the following text would be placed in your ~/.emacs
 862 file):
 863
 864 (setq notmuch-folders '((\"inbox\" . \"tag:inbox\")
 865                         (\"unread\" . \"tag:inbox AND tag:unread\")
 866                         (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\")))
 867
 868 Of course, you can have any number of folders, each configured
 869 with any supported search terms (see \"notmuch help search-terms\").
 870
 871 Currently available key bindings:
 872
 873 \\{notmuch-folder-mode-map}"
 874   (interactive)
 875   (kill-all-local-variables)
 876   (use-local-map 'notmuch-folder-mode-map)
 877   (setq truncate-lines t)
 878   (hl-line-mode 1)
 879   (setq major-mode 'notmuch-folder-mode
 880         mode-name "notmuch-folder")
 881   (setq buffer-read-only t))
 882
 883 (defun notmuch-folder-next ()
 884   "Select the next folder in the list."
 885   (interactive)
 886   (forward-line 1)
 887   (if (eobp)
 888       (forward-line -1)))
 889
 890 (defun notmuch-folder-previous ()
 891   "Select the previous folder in the list."
 892   (interactive)
 893   (forward-line -1))
 894
 895 (defun notmuch-folder-first ()
 896   "Select the first folder in the list."
 897   (interactive)
 898   (goto-char (point-min)))
 899
 900 (defun notmuch-folder-last ()
 901   "Select the last folder in the list."
 902   (interactive)
 903   (goto-char (point-max))
 904   (forward-line -1))
 905
 906 (defun notmuch-folder-count (search)
 907   (car (process-lines notmuch-command "count" search)))
 908
 909 (defvar notmuch-folder-show-empty t
 910   "Whether `notmuch-folder-mode' should display empty folders.")
 911
 912 (defun notmuch-folder-show-empty-toggle ()
 913   "Toggle the listing of empty folders"
 914   (interactive)
 915   (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
 916   (notmuch-folder))
 917
 918 (defun notmuch-folder-add (folders)
 919   (if folders
 920       (let* ((name (car (car folders)))
 921             (inhibit-read-only t)
 922             (search (cdr (car folders)))
 923             (count (notmuch-folder-count search)))
 924         (if (or notmuch-folder-show-empty
 925                 (not (equal count "0")))
 926             (progn
 927               (insert name)
 928               (indent-to 16 1)
 929               (insert count)
 930               (insert "\n")
 931               )
 932           )
 933         (notmuch-folder-add (cdr folders)))))
 934
 935 (defun notmuch-folder-find-name ()
 936   (save-excursion
 937     (beginning-of-line)
 938     (let ((beg (point)))
 939       (re-search-forward "\\([ \t]*[^ \t]+\\)")
 940       (filter-buffer-substring (match-beginning 1) (match-end 1)))))
 941
 942 (defun notmuch-folder-show-search (&optional folder)
 943   "Show a search window for the search related to the specified folder."
 944   (interactive)
 945   (if (null folder)
 946       (setq folder (notmuch-folder-find-name)))
 947   (let ((search (assoc folder notmuch-folders)))
 948     (if search
 949         (notmuch-search (cdr search) notmuch-search-oldest-first))))
 950
 951 (defun notmuch-folder-poll-and-refresh-view ()
 952   "Invoke `notmuch-poll' to import mail, then refresh the folder view."
 953   (interactive)
 954   (notmuch-poll)
 955   (notmuch-folder))
 956
 957 ;;;###autoload
 958 (defun notmuch-folder ()
 959   "Show the notmuch folder view and update the displayed counts."
 960   (interactive)
 961   (let ((buffer (get-buffer-create "*notmuch-folders*")))
 962     (switch-to-buffer buffer)
 963     (let ((inhibit-read-only t)
 964           (n (line-number-at-pos)))
 965       (erase-buffer)
 966       (notmuch-folder-mode)
 967       (notmuch-folder-add notmuch-folders)
 968       (goto-char (point-min))
 969       (goto-line n))))
 970
 971 (provide 'notmuch)