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 (eval-when-compile (require 'cl))
  51 (require 'mm-view)
  52 (require 'message)
  53
  54 (require 'notmuch-lib)
  55 (require 'notmuch-tag)
  56 (require 'notmuch-show)
  57 (require 'notmuch-mua)
  58 (require 'notmuch-hello)
  59 (require 'notmuch-maildir-fcc)
  60 (require 'notmuch-message)
  61 (require 'notmuch-parser)
  62
  63 (defcustom notmuch-search-result-format
  64   `(("date" . "%12s ")
  65     ("count" . "%-7s ")
  66     ("authors" . "%-20s ")
  67     ("subject" . "%s ")
  68     ("tags" . "(%s)"))
  69   "Search result formatting. Supported fields are:
  70         date, count, authors, subject, tags
  71 For example:
  72         (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
  73                                              \(\"subject\" . \"%s\"\)\)\)
  74 Line breaks are permitted in format strings (though this is
  75 currently experimental).  Note that a line break at the end of an
  76 \"authors\" field will get elided if the authors list is long;
  77 place it instead at the beginning of the following field.  To
  78 enter a line break when setting this variable with setq, use \\n.
  79 To enter a line break in customize, press \\[quoted-insert] C-j."
  80   :type '(alist :key-type (string) :value-type (string))
  81   :group 'notmuch-search)
  82
  83 (defvar notmuch-query-history nil
  84   "Variable to store minibuffer history for notmuch queries")
  85
  86 (defun notmuch-foreach-mime-part (function mm-handle)
  87   (cond ((stringp (car mm-handle))
  88          (dolist (part (cdr mm-handle))
  89            (notmuch-foreach-mime-part function part)))
  90         ((bufferp (car mm-handle))
  91          (funcall function mm-handle))
  92         (t (dolist (part mm-handle)
  93              (notmuch-foreach-mime-part function part)))))
  94
  95 (defun notmuch-count-attachments (mm-handle)
  96   (let ((count 0))
  97     (notmuch-foreach-mime-part
  98      (lambda (p)
  99        (let ((disposition (mm-handle-disposition p)))
 100          (and (listp disposition)
 101               (or (equal (car disposition) "attachment")
 102                   (and (equal (car disposition) "inline")
 103                        (assq 'filename disposition)))
 104               (incf count))))
 105      mm-handle)
 106     count))
 107
 108 (defun notmuch-save-attachments (mm-handle &optional queryp)
 109   (notmuch-foreach-mime-part
 110    (lambda (p)
 111      (let ((disposition (mm-handle-disposition p)))
 112        (and (listp disposition)
 113             (or (equal (car disposition) "attachment")
 114                 (and (equal (car disposition) "inline")
 115                      (assq 'filename disposition)))
 116             (or (not queryp)
 117                 (y-or-n-p
 118                  (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
 119             (mm-save-part p))))
 120    mm-handle))
 121
 122 (require 'hl-line)
 123
 124 (defun notmuch-hl-line-mode ()
 125   (prog1 (hl-line-mode)
 126     (when hl-line-overlay
 127       (overlay-put hl-line-overlay 'priority 1))))
 128
 129 (defcustom notmuch-search-hook '(notmuch-hl-line-mode)
 130   "List of functions to call when notmuch displays the search results."
 131   :type 'hook
 132   :options '(notmuch-hl-line-mode)
 133   :group 'notmuch-search
 134   :group 'notmuch-hooks)
 135
 136 (defvar notmuch-search-mode-map
 137   (let ((map (make-sparse-keymap)))
 138     (set-keymap-parent map notmuch-common-keymap)
 139     (define-key map "x" 'notmuch-kill-this-buffer)
 140     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
 141     (define-key map "b" 'notmuch-search-scroll-down)
 142     (define-key map " " 'notmuch-search-scroll-up)
 143     (define-key map "<" 'notmuch-search-first-thread)
 144     (define-key map ">" 'notmuch-search-last-thread)
 145     (define-key map "p" 'notmuch-search-previous-thread)
 146     (define-key map "n" 'notmuch-search-next-thread)
 147     (define-key map "r" 'notmuch-search-reply-to-thread-sender)
 148     (define-key map "R" 'notmuch-search-reply-to-thread)
 149     (define-key map "o" 'notmuch-search-toggle-order)
 150     (define-key map "c" 'notmuch-search-stash-map)
 151     (define-key map "t" 'notmuch-search-filter-by-tag)
 152     (define-key map "f" 'notmuch-search-filter)
 153     (define-key map [mouse-1] 'notmuch-search-show-thread)
 154     (define-key map "*" 'notmuch-search-tag-all)
 155     (define-key map "a" 'notmuch-search-archive-thread)
 156     (define-key map "-" 'notmuch-search-remove-tag)
 157     (define-key map "+" 'notmuch-search-add-tag)
 158     (define-key map (kbd "RET") 'notmuch-search-show-thread)
 159     map)
 160   "Keymap for \"notmuch search\" buffers.")
 161 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
 162
 163 (defvar notmuch-search-stash-map
 164   (let ((map (make-sparse-keymap)))
 165     (define-key map "i" 'notmuch-search-stash-thread-id)
 166     map)
 167   "Submap for stash commands")
 168 (fset 'notmuch-search-stash-map notmuch-search-stash-map)
 169
 170 (defun notmuch-search-stash-thread-id ()
 171   "Copy thread ID of current thread to kill-ring."
 172   (interactive)
 173   (notmuch-common-do-stash (notmuch-search-find-thread-id)))
 174
 175 (defvar notmuch-search-query-string)
 176 (defvar notmuch-search-target-thread)
 177 (defvar notmuch-search-target-line)
 178
 179 (defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
 180
 181 (defun notmuch-search-scroll-up ()
 182   "Move forward through search results by one window's worth."
 183   (interactive)
 184   (condition-case nil
 185       (scroll-up nil)
 186     ((end-of-buffer) (notmuch-search-last-thread))))
 187
 188 (defun notmuch-search-scroll-down ()
 189   "Move backward through the search results by one window's worth."
 190   (interactive)
 191   ;; I don't know why scroll-down doesn't signal beginning-of-buffer
 192   ;; the way that scroll-up signals end-of-buffer, but c'est la vie.
 193   ;;
 194   ;; So instead of trapping a signal we instead check whether the
 195   ;; window begins on the first line of the buffer and if so, move
 196   ;; directly to that position. (We have to count lines since the
 197   ;; window-start position is not the same as point-min due to the
 198   ;; invisible thread-ID characters on the first line.
 199   (if (equal (count-lines (point-min) (window-start)) 0)
 200       (goto-char (point-min))
 201     (scroll-down nil)))
 202
 203 (defun notmuch-search-next-thread ()
 204   "Select the next thread in the search results."
 205   (interactive)
 206   (when (notmuch-search-get-result)
 207     (goto-char (notmuch-search-result-end))))
 208
 209 (defun notmuch-search-previous-thread ()
 210   "Select the previous thread in the search results."
 211   (interactive)
 212   (if (notmuch-search-get-result)
 213       (unless (bobp)
 214         (goto-char (notmuch-search-result-beginning (- (point) 1))))
 215     ;; We must be past the end; jump to the last result
 216     (notmuch-search-last-thread)))
 217
 218 (defun notmuch-search-last-thread ()
 219   "Select the last thread in the search results."
 220   (interactive)
 221   (goto-char (point-max))
 222   (forward-line -2)
 223   (let ((beg (notmuch-search-result-beginning)))
 224     (when beg (goto-char beg))))
 225
 226 (defun notmuch-search-first-thread ()
 227   "Select the first thread in the search results."
 228   (interactive)
 229   (goto-char (point-min)))
 230
 231 (defface notmuch-message-summary-face
 232  '((((class color) (background light)) (:background "#f0f0f0"))
 233    (((class color) (background dark)) (:background "#303030")))
 234  "Face for the single-line message summary in notmuch-show-mode."
 235  :group 'notmuch-show
 236  :group 'notmuch-faces)
 237
 238 (defface notmuch-search-date
 239   '((t :inherit default))
 240   "Face used in search mode for dates."
 241   :group 'notmuch-search
 242   :group 'notmuch-faces)
 243
 244 (defface notmuch-search-count
 245   '((t :inherit default))
 246   "Face used in search mode for the count matching the query."
 247   :group 'notmuch-search
 248   :group 'notmuch-faces)
 249
 250 (defface notmuch-search-subject
 251   '((t :inherit default))
 252   "Face used in search mode for subjects."
 253   :group 'notmuch-search
 254   :group 'notmuch-faces)
 255
 256 (defface notmuch-search-matching-authors
 257   '((t :inherit default))
 258   "Face used in search mode for authors matching the query."
 259   :group 'notmuch-search
 260   :group 'notmuch-faces)
 261
 262 (defface notmuch-search-non-matching-authors
 263   '((((class color)
 264       (background dark))
 265      (:foreground "grey30"))
 266     (((class color)
 267       (background light))
 268      (:foreground "grey60"))
 269     (t
 270      (:italic t)))
 271   "Face used in search mode for authors not matching the query."
 272   :group 'notmuch-search
 273   :group 'notmuch-faces)
 274
 275 (defface notmuch-tag-face
 276   '((((class color)
 277       (background dark))
 278      (:foreground "OliveDrab1"))
 279     (((class color)
 280       (background light))
 281      (:foreground "navy blue" :bold t))
 282     (t
 283      (:bold t)))
 284   "Face used in search mode face for tags."
 285   :group 'notmuch-search
 286   :group 'notmuch-faces)
 287
 288 (defun notmuch-search-mode ()
 289   "Major mode displaying results of a notmuch search.
 290
 291 This buffer contains the results of a \"notmuch search\" of your
 292 email archives. Each line in the buffer represents a single
 293 thread giving a summary of the thread (a relative date, the
 294 number of matched messages and total messages in the thread,
 295 participants in the thread, a representative subject line, and
 296 any tags).
 297
 298 Pressing \\[notmuch-search-show-thread] on any line displays that
 299 thread. The '\\[notmuch-search-add-tag]' and
 300 '\\[notmuch-search-remove-tag]' keys can be used to add or remove
 301 tags from a thread. The '\\[notmuch-search-archive-thread]' key
 302 is a convenience for archiving a thread (applying changes in
 303 `notmuch-archive-tags'). The '\\[notmuch-search-tag-all]' key can
 304 be used to add and/or remove tags from all messages (as opposed
 305 to threads) that match the current query.  Use with caution, as
 306 this will also tag matching messages that arrived *after*
 307 constructing the buffer.
 308
 309 Other useful commands are '\\[notmuch-search-filter]' for
 310 filtering the current search based on an additional query string,
 311 '\\[notmuch-search-filter-by-tag]' for filtering to include only
 312 messages with a given tag, and '\\[notmuch-search]' to execute a
 313 new, global search.
 314
 315 Complete list of currently available key bindings:
 316
 317 \\{notmuch-search-mode-map}"
 318   (interactive)
 319   (kill-all-local-variables)
 320   (make-local-variable 'notmuch-search-query-string)
 321   (make-local-variable 'notmuch-search-oldest-first)
 322   (make-local-variable 'notmuch-search-target-thread)
 323   (make-local-variable 'notmuch-search-target-line)
 324   (setq notmuch-buffer-refresh-function #'notmuch-search-refresh-view)
 325   (set (make-local-variable 'scroll-preserve-screen-position) t)
 326   (add-to-invisibility-spec (cons 'ellipsis t))
 327   (use-local-map notmuch-search-mode-map)
 328   (setq truncate-lines t)
 329   (setq major-mode 'notmuch-search-mode
 330         mode-name "notmuch-search")
 331   (setq buffer-read-only t))
 332
 333 (defun notmuch-search-get-result (&optional pos)
 334   "Return the result object for the thread at POS (or point).
 335
 336 If there is no thread at POS (or point), returns nil."
 337   (get-text-property (or pos (point)) 'notmuch-search-result))
 338
 339 (defun notmuch-search-result-beginning (&optional pos)
 340   "Return the point at the beginning of the thread at POS (or point).
 341
 342 If there is no thread at POS (or point), returns nil."
 343   (when (notmuch-search-get-result pos)
 344     ;; We pass 1+point because previous-single-property-change starts
 345     ;; searching one before the position we give it.
 346     (previous-single-property-change (1+ (or pos (point)))
 347                                      'notmuch-search-result nil (point-min))))
 348
 349 (defun notmuch-search-result-end (&optional pos)
 350   "Return the point at the end of the thread at POS (or point).
 351
 352 The returned point will be just after the newline character that
 353 ends the result line.  If there is no thread at POS (or point),
 354 returns nil"
 355   (when (notmuch-search-get-result pos)
 356     (next-single-property-change (or pos (point)) 'notmuch-search-result
 357                                  nil (point-max))))
 358
 359 (defun notmuch-search-foreach-result (beg end function)
 360   "Invoke FUNCTION for each result between BEG and END.
 361
 362 FUNCTION should take one argument.  It will be applied to the
 363 character position of the beginning of each result that overlaps
 364 the region between points BEG and END.  As a special case, if (=
 365 BEG END), FUNCTION will be applied to the result containing point
 366 BEG."
 367
 368   (lexical-let ((pos (notmuch-search-result-beginning beg))
 369                 ;; End must be a marker in case function changes the
 370                 ;; text.
 371                 (end (copy-marker end))
 372                 ;; Make sure we examine at least one result, even if
 373                 ;; (= beg end).
 374                 (first t))
 375     ;; We have to be careful if the region extends beyond the results.
 376     ;; In this case, pos could be null or there could be no result at
 377     ;; pos.
 378     (while (and pos (or (< pos end) first))
 379       (when (notmuch-search-get-result pos)
 380         (funcall function pos))
 381       (setq pos (notmuch-search-result-end pos)
 382             first nil))))
 383 ;; Unindent the function argument of notmuch-search-foreach-result so
 384 ;; the indentation of callers doesn't get out of hand.
 385 (put 'notmuch-search-foreach-result 'lisp-indent-function 2)
 386
 387 (defun notmuch-search-properties-in-region (property beg end)
 388   (let (output)
 389     (notmuch-search-foreach-result beg end
 390       (lambda (pos)
 391         (push (plist-get (notmuch-search-get-result pos) property) output)))
 392     output))
 393
 394 (defun notmuch-search-find-thread-id (&optional bare)
 395   "Return the thread for the current thread
 396
 397 If BARE is set then do not prefix with \"thread:\""
 398   (let ((thread (plist-get (notmuch-search-get-result) :thread)))
 399     (when thread (concat (unless bare "thread:") thread))))
 400
 401 (defun notmuch-search-find-thread-id-region (beg end)
 402   "Return a list of threads for the current region"
 403   (mapcar (lambda (thread) (concat "thread:" thread))
 404           (notmuch-search-properties-in-region :thread beg end)))
 405
 406 (defun notmuch-search-find-thread-id-region-search (beg end)
 407   "Return a search string for threads for the current region"
 408   (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))
 409
 410 (defun notmuch-search-find-authors ()
 411   "Return the authors for the current thread"
 412   (plist-get (notmuch-search-get-result) :authors))
 413
 414 (defun notmuch-search-find-authors-region (beg end)
 415   "Return a list of authors for the current region"
 416   (notmuch-search-properties-in-region :authors beg end))
 417
 418 (defun notmuch-search-find-subject ()
 419   "Return the subject for the current thread"
 420   (plist-get (notmuch-search-get-result) :subject))
 421
 422 (defun notmuch-search-find-subject-region (beg end)
 423   "Return a list of authors for the current region"
 424   (notmuch-search-properties-in-region :subject beg end))
 425
 426 (defun notmuch-search-show-thread (&optional elide-toggle)
 427   "Display the currently selected thread."
 428   (interactive "P")
 429   (let ((thread-id (notmuch-search-find-thread-id))
 430         (subject (notmuch-search-find-subject)))
 431     (if (> (length thread-id) 0)
 432         (notmuch-show thread-id
 433                       elide-toggle
 434                       (current-buffer)
 435                       notmuch-search-query-string
 436                       ;; Name the buffer based on the subject.
 437                       (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))
 438       (message "End of search results."))))
 439
 440 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
 441   "Begin composing a reply-all to the entire current thread in a new buffer."
 442   (interactive "P")
 443   (let ((message-id (notmuch-search-find-thread-id)))
 444     (notmuch-mua-new-reply message-id prompt-for-sender t)))
 445
 446 (defun notmuch-search-reply-to-thread-sender (&optional prompt-for-sender)
 447   "Begin composing a reply to the entire current thread in a new buffer."
 448   (interactive "P")
 449   (let ((message-id (notmuch-search-find-thread-id)))
 450     (notmuch-mua-new-reply message-id prompt-for-sender nil)))
 451
 452 (defun notmuch-call-notmuch-process (&rest args)
 453   "Synchronously invoke \"notmuch\" with the given list of arguments.
 454
 455 If notmuch exits with a non-zero status, output from the process
 456 will appear in a buffer named \"*Notmuch errors*\" and an error
 457 will be signaled."
 458   (with-temp-buffer
 459     (let ((status (apply #'call-process notmuch-command nil t nil args)))
 460       (notmuch-check-exit-status status (cons notmuch-command args)
 461                                  (buffer-string)))))
 462
 463 (defun notmuch-search-set-tags (tags &optional pos)
 464   (let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
 465     (notmuch-search-update-result new-result pos)))
 466
 467 (defun notmuch-search-get-tags (&optional pos)
 468   (plist-get (notmuch-search-get-result pos) :tags))
 469
 470 (defun notmuch-search-get-tags-region (beg end)
 471   (let (output)
 472     (notmuch-search-foreach-result beg end
 473       (lambda (pos)
 474         (setq output (append output (notmuch-search-get-tags pos)))))
 475     output))
 476
 477 (defun notmuch-search-interactive-region ()
 478   "Return the bounds of the current interactive region.
 479
 480 This returns (BEG END), where BEG and END are the bounds of the
 481 region if the region is active, or both `point' otherwise."
 482   (if (region-active-p)
 483       (list (region-beginning) (region-end))
 484     (list (point) (point))))
 485
 486 (defun notmuch-search-interactive-tag-changes (&optional initial-input)
 487   "Prompt for tag changes for the current thread or region.
 488
 489 Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
 490   (let* ((region (notmuch-search-interactive-region))
 491          (beg (first region)) (end (second region))
 492          (prompt (if (= beg end) "Tag thread" "Tag region")))
 493     (cons (notmuch-read-tag-changes
 494            (notmuch-search-get-tags-region beg end) prompt initial-input)
 495           region)))
 496
 497 (defun notmuch-search-tag (tag-changes &optional beg end)
 498   "Change tags for the currently selected thread or region.
 499
 500 See `notmuch-tag' for information on the format of TAG-CHANGES.
 501 When called interactively, this uses the region if the region is
 502 active.  When called directly, BEG and END provide the region.
 503 If these are nil or not provided, this applies to the thread at
 504 point."
 505   (interactive (notmuch-search-interactive-tag-changes))
 506   (unless (and beg end) (setq beg (point) end (point)))
 507   (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
 508     (notmuch-tag search-string tag-changes)
 509     (notmuch-search-foreach-result beg end
 510       (lambda (pos)
 511         (notmuch-search-set-tags
 512          (notmuch-update-tags (notmuch-search-get-tags pos) tag-changes)
 513          pos)))))
 514
 515 (defun notmuch-search-add-tag (tag-changes &optional beg end)
 516   "Change tags for the current thread or region (defaulting to add).
 517
 518 Same as `notmuch-search-tag' but sets initial input to '+'."
 519   (interactive (notmuch-search-interactive-tag-changes "+"))
 520   (notmuch-search-tag tag-changes beg end))
 521
 522 (defun notmuch-search-remove-tag (tag-changes &optional beg end)
 523   "Change tags for the current thread or region (defaulting to remove).
 524
 525 Same as `notmuch-search-tag' but sets initial input to '-'."
 526   (interactive (notmuch-search-interactive-tag-changes "-"))
 527   (notmuch-search-tag tag-changes beg end))
 528
 529 (put 'notmuch-search-archive-thread 'notmuch-prefix-doc
 530      "Un-archive the currently selected thread.")
 531 (defun notmuch-search-archive-thread (&optional unarchive beg end)
 532   "Archive the currently selected thread or region.
 533
 534 Archive each message in the currently selected thread by applying
 535 the tag changes in `notmuch-archive-tags' to each (remove the
 536 \"inbox\" tag by default). If a prefix argument is given, the
 537 messages will be \"unarchived\" (i.e. the tag changes in
 538 `notmuch-archive-tags' will be reversed).
 539
 540 This function advances the next thread when finished."
 541   (interactive (cons current-prefix-arg (notmuch-search-interactive-region)))
 542   (when notmuch-archive-tags
 543     (notmuch-search-tag
 544      (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))
 545   (notmuch-search-next-thread))
 546
 547 (defun notmuch-search-update-result (result &optional pos)
 548   "Replace the result object of the thread at POS (or point) by
 549 RESULT and redraw it.
 550
 551 This will keep point in a reasonable location.  However, if there
 552 are enclosing save-excursions and the saved point is in the
 553 result being updated, the point will be restored to the beginning
 554 of the result."
 555   (let ((start (notmuch-search-result-beginning pos))
 556         (end (notmuch-search-result-end pos))
 557         (init-point (point))
 558         (inhibit-read-only t))
 559     ;; Delete the current thread
 560     (delete-region start end)
 561     ;; Insert the updated thread
 562     (notmuch-search-show-result result start)
 563     ;; If point was inside the old result, make an educated guess
 564     ;; about where to place it now.  Unfortunately, this won't work
 565     ;; with save-excursion (or any other markers that would be nice to
 566     ;; preserve, such as the window start), but there's nothing we can
 567     ;; do about that without a way to retrieve markers in a region.
 568     (when (and (>= init-point start) (<= init-point end))
 569       (let* ((new-end (notmuch-search-result-end start))
 570              (new-point (if (= init-point end)
 571                             new-end
 572                           (min init-point (- new-end 1)))))
 573         (goto-char new-point)))))
 574
 575 (defun notmuch-search-process-sentinel (proc msg)
 576   "Add a message to let user know when \"notmuch search\" exits"
 577   (let ((buffer (process-buffer proc))
 578         (status (process-status proc))
 579         (exit-status (process-exit-status proc))
 580         (never-found-target-thread nil))
 581     (when (memq status '(exit signal))
 582       (catch 'return
 583         (kill-buffer (process-get proc 'parse-buf))
 584         (if (buffer-live-p buffer)
 585             (with-current-buffer buffer
 586               (save-excursion
 587                 (let ((inhibit-read-only t)
 588                       (atbob (bobp)))
 589                   (goto-char (point-max))
 590                   (if (eq status 'signal)
 591                       (insert "Incomplete search results (search process was killed).\n"))
 592                   (when (eq status 'exit)
 593                     (insert "End of search results.\n")
 594                     ;; For version mismatch, there's no point in
 595                     ;; showing the search buffer
 596                     (when (or (= exit-status 20) (= exit-status 21))
 597                       (kill-buffer)
 598                       (throw 'return nil))
 599                     (if (and atbob
 600                              (not (string= notmuch-search-target-thread "found")))
 601                         (set 'never-found-target-thread t)))))
 602               (when (and never-found-target-thread
 603                        notmuch-search-target-line)
 604                   (goto-char (point-min))
 605                   (forward-line (1- notmuch-search-target-line)))))))))
 606
 607 (defcustom notmuch-search-line-faces '(("unread" :weight bold)
 608                                        ("flagged" :foreground "blue"))
 609   "Tag/face mapping for line highlighting in notmuch-search.
 610
 611 Here is an example of how to color search results based on tags.
 612  (the following text would be placed in your ~/.emacs file):
 613
 614  (setq notmuch-search-line-faces '((\"deleted\" . (:foreground \"red\"
 615                                                   :background \"blue\"))
 616                                    (\"unread\" . (:foreground \"green\"))))
 617
 618 The attributes defined for matching tags are merged, with later
 619 attributes overriding earlier. A message having both \"deleted\"
 620 and \"unread\" tags with the above settings would have a green
 621 foreground and blue background."
 622   :type '(alist :key-type (string) :value-type (custom-face-edit))
 623   :group 'notmuch-search
 624   :group 'notmuch-faces)
 625
 626 (defun notmuch-search-color-line (start end line-tag-list)
 627   "Colorize lines in `notmuch-show' based on tags."
 628   (mapc (lambda (elem)
 629           (let ((tag (car elem))
 630                 (attributes (cdr elem)))
 631             (when (member tag line-tag-list)
 632               (notmuch-combine-face-text-property start end attributes))))
 633         ;; Reverse the list so earlier entries take precedence
 634         (reverse notmuch-search-line-faces)))
 635
 636 (defun notmuch-search-author-propertize (authors)
 637   "Split `authors' into matching and non-matching authors and
 638 propertize appropriately. If no boundary between authors and
 639 non-authors is found, assume that all of the authors match."
 640   (if (string-match "\\(.*\\)|\\(.*\\)" authors)
 641       (concat (propertize (concat (match-string 1 authors) ",")
 642                           'face 'notmuch-search-matching-authors)
 643               (propertize (match-string 2 authors)
 644                           'face 'notmuch-search-non-matching-authors))
 645     (propertize authors 'face 'notmuch-search-matching-authors)))
 646
 647 (defun notmuch-search-insert-authors (format-string authors)
 648   ;; Save the match data to avoid interfering with
 649   ;; `notmuch-search-process-filter'.
 650   (save-match-data
 651     (let* ((formatted-authors (format format-string authors))
 652            (formatted-sample (format format-string ""))
 653            (visible-string formatted-authors)
 654            (invisible-string "")
 655            (padding ""))
 656
 657       ;; Truncate the author string to fit the specification.
 658       (if (> (length formatted-authors)
 659              (length formatted-sample))
 660           (let ((visible-length (- (length formatted-sample)
 661                                    (length "... "))))
 662             ;; Truncate the visible string according to the width of
 663             ;; the display string.
 664             (setq visible-string (substring formatted-authors 0 visible-length)
 665                   invisible-string (substring formatted-authors visible-length))
 666             ;; If possible, truncate the visible string at a natural
 667             ;; break (comma or pipe), as incremental search doesn't
 668             ;; match across the visible/invisible border.
 669             (when (string-match "\\(.*\\)\\([,|] \\)\\([^,|]*\\)" visible-string)
 670               ;; Second clause is destructive on `visible-string', so
 671               ;; order is important.
 672               (setq invisible-string (concat (match-string 3 visible-string)
 673                                              invisible-string)
 674                     visible-string (concat (match-string 1 visible-string)
 675                                            (match-string 2 visible-string))))
 676             ;; `visible-string' may be shorter than the space allowed
 677             ;; by `format-string'. If so we must insert some padding
 678             ;; after `invisible-string'.
 679             (setq padding (make-string (- (length formatted-sample)
 680                                           (length visible-string)
 681                                           (length "..."))
 682                                        ? ))))
 683
 684       ;; Use different faces to show matching and non-matching authors.
 685       (if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
 686           ;; The visible string contains both matching and
 687           ;; non-matching authors.
 688           (setq visible-string (notmuch-search-author-propertize visible-string)
 689                 ;; The invisible string must contain only non-matching
 690                 ;; authors, as the visible-string contains both.
 691                 invisible-string (propertize invisible-string
 692                                              'face 'notmuch-search-non-matching-authors))
 693         ;; The visible string contains only matching authors.
 694         (setq visible-string (propertize visible-string
 695                                          'face 'notmuch-search-matching-authors)
 696               ;; The invisible string may contain both matching and
 697               ;; non-matching authors.
 698               invisible-string (notmuch-search-author-propertize invisible-string)))
 699
 700       ;; If there is any invisible text, add it as a tooltip to the
 701       ;; visible text.
 702       (when (not (string= invisible-string ""))
 703         (setq visible-string (propertize visible-string 'help-echo (concat "..." invisible-string))))
 704
 705       ;; Insert the visible and, if present, invisible author strings.
 706       (insert visible-string)
 707       (when (not (string= invisible-string ""))
 708         (let ((start (point))
 709               overlay)
 710           (insert invisible-string)
 711           (setq overlay (make-overlay start (point)))
 712           (overlay-put overlay 'invisible 'ellipsis)
 713           (overlay-put overlay 'isearch-open-invisible #'delete-overlay)))
 714       (insert padding))))
 715
 716 (defun notmuch-search-insert-field (field format-string result)
 717   (cond
 718    ((string-equal field "date")
 719     (insert (propertize (format format-string (plist-get result :date_relative))
 720                         'face 'notmuch-search-date)))
 721    ((string-equal field "count")
 722     (insert (propertize (format format-string
 723                                 (format "[%s/%s]" (plist-get result :matched)
 724                                         (plist-get result :total)))
 725                         'face 'notmuch-search-count)))
 726    ((string-equal field "subject")
 727     (insert (propertize (format format-string
 728                                 (notmuch-sanitize (plist-get result :subject)))
 729                         'face 'notmuch-search-subject)))
 730
 731    ((string-equal field "authors")
 732     (notmuch-search-insert-authors
 733      format-string (notmuch-sanitize (plist-get result :authors))))
 734
 735    ((string-equal field "tags")
 736     (let ((tags (plist-get result :tags)))
 737       (insert (format format-string (notmuch-tag-format-tags tags)))))))
 738
 739 (defun notmuch-search-show-result (result &optional pos)
 740   "Insert RESULT at POS or the end of the buffer if POS is null."
 741   ;; Ignore excluded matches
 742   (unless (= (plist-get result :matched) 0)
 743     (let ((beg (or pos (point-max))))
 744       (save-excursion
 745         (goto-char beg)
 746         (dolist (spec notmuch-search-result-format)
 747           (notmuch-search-insert-field (car spec) (cdr spec) result))
 748         (insert "\n")
 749         (notmuch-search-color-line beg (point) (plist-get result :tags))
 750         (put-text-property beg (point) 'notmuch-search-result result))
 751       (when (string= (plist-get result :thread) notmuch-search-target-thread)
 752         (setq notmuch-search-target-thread "found")
 753         (goto-char beg)))))
 754
 755 (defun notmuch-search-process-filter (proc string)
 756   "Process and filter the output of \"notmuch search\""
 757   (let ((results-buf (process-buffer proc))
 758         (parse-buf (process-get proc 'parse-buf))
 759         (inhibit-read-only t)
 760         done)
 761     (when (buffer-live-p results-buf)
 762       (with-current-buffer parse-buf
 763         ;; Insert new data
 764         (save-excursion
 765           (goto-char (point-max))
 766           (insert string))
 767         (notmuch-sexp-parse-partial-list 'notmuch-search-show-result
 768                                          results-buf)))))
 769
 770 (defun notmuch-search-tag-all (tag-changes)
 771   "Add/remove tags from all messages in current search buffer.
 772
 773 See `notmuch-tag' for information on the format of TAG-CHANGES."
 774   (interactive
 775    (list (notmuch-read-tag-changes
 776           (notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
 777   (notmuch-tag notmuch-search-query-string tag-changes))
 778
 779 (defun notmuch-search-buffer-title (query)
 780   "Returns the title for a buffer with notmuch search results."
 781   (let* ((saved-search
 782           (let (longest
 783                 (longest-length 0))
 784             (loop for tuple in notmuch-saved-searches
 785                   if (let ((quoted-query (regexp-quote (cdr tuple))))
 786                        (and (string-match (concat "^" quoted-query) query)
 787                             (> (length (match-string 0 query))
 788                                longest-length)))
 789                   do (setq longest tuple))
 790             longest))
 791          (saved-search-name (car saved-search))
 792          (saved-search-query (cdr saved-search)))
 793     (cond ((and saved-search (equal saved-search-query query))
 794            ;; Query is the same as saved search (ignoring case)
 795            (concat "*notmuch-saved-search-" saved-search-name "*"))
 796           (saved-search
 797            (concat "*notmuch-search-"
 798                    (replace-regexp-in-string (concat "^" (regexp-quote saved-search-query))
 799                                              (concat "[ " saved-search-name " ]")
 800                                              query)
 801                    "*"))
 802           (t
 803            (concat "*notmuch-search-" query "*"))
 804           )))
 805
 806 (defun notmuch-read-query (prompt)
 807   "Read a notmuch-query from the minibuffer with completion.
 808
 809 PROMPT is the string to prompt with."
 810   (lexical-let
 811       ((completions
 812         (append (list "folder:" "thread:" "id:" "date:" "from:" "to:"
 813                       "subject:" "attachment:")
 814                 (mapcar (lambda (tag)
 815                           (concat "tag:" (notmuch-escape-boolean-term tag)))
 816                         (process-lines notmuch-command "search" "--output=tags" "*")))))
 817     (let ((keymap (copy-keymap minibuffer-local-map))
 818           (minibuffer-completion-table
 819            (completion-table-dynamic
 820             (lambda (string)
 821               ;; generate a list of possible completions for the current input
 822               (cond
 823                ;; this ugly regexp is used to get the last word of the input
 824                ;; possibly preceded by a '('
 825                ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
 826                 (mapcar (lambda (compl)
 827                           (concat (match-string-no-properties 1 string) compl))
 828                         (all-completions (match-string-no-properties 2 string)
 829                                          completions)))
 830                (t (list string)))))))
 831       ;; this was simpler than convincing completing-read to accept spaces:
 832       (define-key keymap (kbd "TAB") 'minibuffer-complete)
 833       (let ((history-delete-duplicates t))
 834         (read-from-minibuffer prompt nil keymap nil
 835                               'notmuch-search-history nil nil)))))
 836
 837 ;;;###autoload
 838 (put 'notmuch-search 'notmuch-doc "Search for messages.")
 839 (defun notmuch-search (&optional query oldest-first target-thread target-line)
 840   "Display threads matching QUERY in a notmuch-search buffer.
 841
 842 If QUERY is nil, it is read interactively from the minibuffer.
 843 Other optional parameters are used as follows:
 844
 845   OLDEST-FIRST: A Boolean controlling the sort order of returned threads
 846   TARGET-THREAD: A thread ID (without the thread: prefix) that will be made
 847                  current if it appears in the search results.
 848   TARGET-LINE: The line number to move to if the target thread does not
 849                appear in the search results.
 850
 851 When called interactively, this will prompt for a query and use
 852 the configured default sort order."
 853   (interactive
 854    (list
 855     ;; Prompt for a query
 856     nil
 857     ;; Use the default search order (if we're doing a search from a
 858     ;; search buffer, ignore any buffer-local overrides)
 859     (default-value 'notmuch-search-oldest-first)))
 860
 861   (let* ((query (or query (notmuch-read-query "Notmuch search: ")))
 862          (buffer (get-buffer-create (notmuch-search-buffer-title query))))
 863     (switch-to-buffer buffer)
 864     (notmuch-search-mode)
 865     ;; Don't track undo information for this buffer
 866     (set 'buffer-undo-list t)
 867     (set 'notmuch-search-query-string query)
 868     (set 'notmuch-search-oldest-first oldest-first)
 869     (set 'notmuch-search-target-thread target-thread)
 870     (set 'notmuch-search-target-line target-line)
 871     (let ((proc (get-buffer-process (current-buffer)))
 872           (inhibit-read-only t))
 873       (if proc
 874           (error "notmuch search process already running for query `%s'" query)
 875         )
 876       (erase-buffer)
 877       (goto-char (point-min))
 878       (save-excursion
 879         (let ((proc (notmuch-start-notmuch
 880                      "notmuch-search" buffer #'notmuch-search-process-sentinel
 881                      "search" "--format=sexp" "--format-version=1"
 882                      (if oldest-first
 883                          "--sort=oldest-first"
 884                        "--sort=newest-first")
 885                      query))
 886               ;; Use a scratch buffer to accumulate partial output.
 887               ;; This buffer will be killed by the sentinel, which
 888               ;; should be called no matter how the process dies.
 889               (parse-buf (generate-new-buffer " *notmuch search parse*")))
 890           (process-put proc 'parse-buf parse-buf)
 891           (set-process-filter proc 'notmuch-search-process-filter)
 892           (set-process-query-on-exit-flag proc nil))))
 893     (run-hooks 'notmuch-search-hook)))
 894
 895 (defun notmuch-search-refresh-view ()
 896   "Refresh the current view.
 897
 898 Kills the current buffer and runs a new search with the same
 899 query string as the current search. If the current thread is in
 900 the new search results, then point will be placed on the same
 901 thread. Otherwise, point will be moved to attempt to be in the
 902 same relative position within the new buffer."
 903   (let ((target-line (line-number-at-pos))
 904         (oldest-first notmuch-search-oldest-first)
 905         (target-thread (notmuch-search-find-thread-id 'bare))
 906         (query notmuch-search-query-string))
 907     (notmuch-kill-this-buffer)
 908     (notmuch-search query oldest-first target-thread target-line)
 909     (goto-char (point-min))))
 910
 911 (defun notmuch-search-toggle-order ()
 912   "Toggle the current search order.
 913
 914 This command toggles the sort order for the current search. The
 915 default sort order is defined by `notmuch-search-oldest-first'."
 916   (interactive)
 917   (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
 918   (notmuch-search-refresh-view))
 919
 920 (defun notmuch-search-filter (query)
 921   "Filter the current search results based on an additional query string.
 922
 923 Runs a new search matching only messages that match both the
 924 current search results AND the additional query string provided."
 925   (interactive (list (notmuch-read-query "Filter search: ")))
 926   (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query)
 927                            (concat "( " query " )")
 928                          query)))
 929     (notmuch-search (if (string= notmuch-search-query-string "*")
 930                         grouped-query
 931                       (concat notmuch-search-query-string " and " grouped-query)) notmuch-search-oldest-first)))
 932
 933 (defun notmuch-search-filter-by-tag (tag)
 934   "Filter the current search results based on a single tag.
 935
 936 Runs a new search matching only messages that match both the
 937 current search results AND that are tagged with the given tag."
 938   (interactive
 939    (list (notmuch-select-tag-with-completion "Filter by tag: ")))
 940   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 941
 942 ;;;###autoload
 943 (defun notmuch ()
 944   "Run notmuch and display saved searches, known tags, etc."
 945   (interactive)
 946   (notmuch-hello))
 947
 948 (defun notmuch-interesting-buffer (b)
 949   "Is the current buffer of interest to a notmuch user?"
 950   (with-current-buffer b
 951     (memq major-mode '(notmuch-show-mode
 952                        notmuch-search-mode
 953                        notmuch-hello-mode
 954                        message-mode))))
 955
 956 ;;;###autoload
 957 (defun notmuch-cycle-notmuch-buffers ()
 958   "Cycle through any existing notmuch buffers (search, show or hello).
 959
 960 If the current buffer is the only notmuch buffer, bury it. If no
 961 notmuch buffers exist, run `notmuch'."
 962   (interactive)
 963
 964   (let (start first)
 965     ;; If the current buffer is a notmuch buffer, remember it and then
 966     ;; bury it.
 967     (when (notmuch-interesting-buffer (current-buffer))
 968       (setq start (current-buffer))
 969       (bury-buffer))
 970
 971     ;; Find the first notmuch buffer.
 972     (setq first (loop for buffer in (buffer-list)
 973                      if (notmuch-interesting-buffer buffer)
 974                      return buffer))
 975
 976     (if first
 977         ;; If the first one we found is any other than the starting
 978         ;; buffer, switch to it.
 979         (unless (eq first start)
 980           (switch-to-buffer first))
 981       (notmuch))))
 982
 983 (setq mail-user-agent 'notmuch-user-agent)
 984
 985 (provide 'notmuch)