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