-;; notmuch.el --- run notmuch within emacs
+;;; notmuch.el --- run notmuch within emacs
;;
;; Copyright © Carl Worth
;;
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
+;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>.
;;
;; Authors: Carl Worth <cworth@cworth.org>
+;; Homepage: https://notmuchmail.org/
+
+;;; Commentary:
;; This is an emacs-based interface to the notmuch mail system.
;;
;; You will first need to have the notmuch program installed and have a
;; notmuch database built in order to use this. See
-;; http://notmuchmail.org for details.
+;; https://notmuchmail.org for details.
;;
;; To install this software, copy it to a directory that is on the
;; `load-path' variable within emacs (a good candidate is
;;
;; Then, to actually run it, add:
;;
-;; (require 'notmuch)
+;; (autoload 'notmuch "notmuch" "Notmuch mail" t)
;;
;; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
;; or run:
;;
;; Have fun, and let us know if you have any comment, questions, or
;; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
-;; required, but is available from http://notmuchmail.org).
+;; required, but is available from https://notmuchmail.org).
+
+;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-view)
:type '(alist :key-type (string) :value-type (string))
:group 'notmuch-search)
+;; The name of this variable `notmuch-init-file' is consistent with the
+;; convention used in e.g. emacs and gnus. The value, `notmuch-config[.el[c]]'
+;; is consistent with notmuch cli configuration file `~/.notmuch-config'.
+(defcustom notmuch-init-file (locate-user-emacs-file "notmuch-config")
+ "Your Notmuch Emacs-Lisp configuration file name.
+If a file with one of the suffixes defined by `get-load-suffixes' exists,
+it will be read instead.
+This file is read once when notmuch is loaded; the notmuch hooks added
+there will be called at other points of notmuch execution."
+ :type 'file
+ :group 'notmuch)
+
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries")
(defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-common-keymap)
- (define-key map "x" 'notmuch-kill-this-buffer)
+ (define-key map "x" 'notmuch-bury-or-kill-this-buffer)
(define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
(define-key map "b" 'notmuch-search-scroll-down)
(define-key map " " 'notmuch-search-scroll-up)
(define-key map "o" 'notmuch-search-toggle-order)
(define-key map "c" 'notmuch-search-stash-map)
(define-key map "t" 'notmuch-search-filter-by-tag)
- (define-key map "f" 'notmuch-search-filter)
+ (define-key map "l" 'notmuch-search-filter)
(define-key map [mouse-1] 'notmuch-search-show-thread)
(define-key map "*" 'notmuch-search-tag-all)
(define-key map "a" 'notmuch-search-archive-thread)
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "i" 'notmuch-search-stash-thread-id)
+ (define-key map "q" 'notmuch-stash-query)
+ (define-key map "?" 'notmuch-subkeymap-help)
map)
"Submap for stash commands")
(fset 'notmuch-search-stash-map notmuch-search-stash-map)
(interactive)
(notmuch-common-do-stash (notmuch-search-find-thread-id)))
+(defun notmuch-stash-query ()
+ "Copy current query to kill-ring."
+ (interactive)
+ (notmuch-common-do-stash (notmuch-search-get-query)))
+
(defvar notmuch-search-query-string)
(defvar notmuch-search-target-thread)
(defvar notmuch-search-target-line)
:group 'notmuch-search
:group 'notmuch-faces)
+(defface notmuch-search-flagged-face
+ '((t
+ (:weight bold)))
+ "Face used in search mode face for flagged threads.
+
+This face is the default value for the \"flagged\" tag in
+`notmuch-search-line-faces`."
+ :group 'notmuch-search
+ :group 'notmuch-faces)
+
+(defface notmuch-search-unread-face
+ '((t
+ (:foreground "blue")))
+ "Face used in search mode for unread threads.
+
+This face is the default value for the \"unread\" tag in
+`notmuch-search-line-faces`."
+ :group 'notmuch-search
+ :group 'notmuch-faces)
+
(defun notmuch-search-mode ()
"Major mode displaying results of a notmuch search.
(let ((thread (plist-get (notmuch-search-get-result) :thread)))
(when thread (concat (unless bare "thread:") thread))))
-(defun notmuch-search-find-thread-id-region (beg end)
- "Return a list of threads for the current region"
- (mapcar (lambda (thread) (concat "thread:" thread))
- (notmuch-search-properties-in-region :thread beg end)))
+(defun notmuch-search-find-stable-query ()
+ "Return the stable queries for the current thread.
-(defun notmuch-search-find-thread-id-region-search (beg end)
- "Return a search string for threads for the current region"
- (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))
+This returns a list (MATCHED-QUERY UNMATCHED-QUERY) for the
+matched and unmatched messages in the current thread."
+ (plist-get (notmuch-search-get-result) :query))
+
+(defun notmuch-search-find-stable-query-region (beg end &optional only-matched)
+ "Return the stable query for the current region.
+
+If ONLY-MATCHED is non-nil, include only matched messages. If it
+is nil, include both matched and unmatched messages. If there are
+no messages in the region then return nil."
+ (let ((query-list nil) (all (not only-matched)))
+ (dolist (queries (notmuch-search-properties-in-region :query beg end))
+ (when (first queries)
+ (push (first queries) query-list))
+ (when (and all (second queries))
+ (push (second queries) query-list)))
+ (when query-list
+ (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
(defun notmuch-search-find-authors ()
"Return the authors for the current thread"
(notmuch-search-properties-in-region :subject beg end))
(defun notmuch-search-show-thread (&optional elide-toggle)
- "Display the currently selected thread."
+ "Display the currently selected thread.
+
+With a prefix argument, invert the default value of
+`notmuch-show-only-matching-messages' when displaying the
+thread."
(interactive "P")
(let ((thread-id (notmuch-search-find-thread-id))
(subject (notmuch-search-find-subject)))
(let ((message-id (notmuch-search-find-thread-id)))
(notmuch-mua-new-reply message-id prompt-for-sender nil)))
-(defun notmuch-call-notmuch-process (&rest args)
- "Synchronously invoke \"notmuch\" with the given list of arguments.
-
-If notmuch exits with a non-zero status, output from the process
-will appear in a buffer named \"*Notmuch errors*\" and an error
-will be signaled."
- (with-temp-buffer
- (let ((status (apply #'call-process notmuch-command nil t nil args)))
- (notmuch-check-exit-status status (cons notmuch-command args)
- (buffer-string)))))
-
(defun notmuch-search-set-tags (tags &optional pos)
(let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
(notmuch-search-update-result new-result pos)))
(notmuch-search-get-tags-region beg end) prompt initial-input)
region)))
-(defun notmuch-search-tag (tag-changes &optional beg end)
+(defun notmuch-search-tag (tag-changes &optional beg end only-matched)
"Change tags for the currently selected thread or region.
See `notmuch-tag' for information on the format of TAG-CHANGES.
When called interactively, this uses the region if the region is
active. When called directly, BEG and END provide the region.
If these are nil or not provided, this applies to the thread at
-point."
+point.
+
+If ONLY-MATCHED is non-nil, only tag matched messages."
(interactive (notmuch-search-interactive-tag-changes))
(unless (and beg end) (setq beg (point) end (point)))
- (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
+ (let ((search-string (notmuch-search-find-stable-query-region
+ beg end only-matched)))
(notmuch-tag search-string tag-changes)
(notmuch-search-foreach-result beg end
(lambda (pos)
(when notmuch-archive-tags
(notmuch-search-tag
(notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))
- (notmuch-search-next-thread))
+ (when (eq beg end)
+ (notmuch-search-next-thread)))
(defun notmuch-search-update-result (result &optional pos)
"Replace the result object of the thread at POS (or point) by
(goto-char (point-min))
(forward-line (1- notmuch-search-target-line)))))))))
-(defcustom notmuch-search-line-faces '(("unread" :weight bold)
- ("flagged" :foreground "blue"))
- "Tag/face mapping for line highlighting in notmuch-search.
+(defcustom notmuch-search-line-faces
+ '(("unread" 'notmuch-search-unread-face)
+ ("flagged" 'notmuch-search-flagged-face))
+ "Alist of tags to faces for line highlighting in notmuch-search.
+Each element looks like (TAG . FACE).
+A thread with TAG will have FACE applied.
Here is an example of how to color search results based on tags.
(the following text would be placed in your ~/.emacs file):
- (setq notmuch-search-line-faces '((\"deleted\" . (:foreground \"red\"
- :background \"blue\"))
- (\"unread\" . (:foreground \"green\"))))
+ (setq notmuch-search-line-faces '((\"unread\" . (:foreground \"green\"))
+ (\"deleted\" . (:foreground \"red\"
+ :background \"blue\"))))
-The attributes defined for matching tags are merged, with later
-attributes overriding earlier. A message having both \"deleted\"
-and \"unread\" tags with the above settings would have a green
-foreground and blue background."
+The FACE must be a face name (a symbol or string), a property
+list of face attributes, or a list of these. The faces for
+matching tags are merged, with earlier attributes overriding
+later. A message having both \"deleted\" and \"unread\" tags with
+the above settings would have a green foreground and blue
+background."
:type '(alist :key-type (string) :value-type (custom-face-edit))
:group 'notmuch-search
:group 'notmuch-faces)
(let ((tag (car elem))
(attributes (cdr elem)))
(when (member tag line-tag-list)
- (notmuch-combine-face-text-property start end attributes))))
+ (notmuch-apply-face nil attributes nil start end))))
;; Reverse the list so earlier entries take precedence
(reverse notmuch-search-line-faces)))
format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags")
- (let ((tags (plist-get result :tags)))
- (insert (format format-string (notmuch-tag-format-tags tags)))))))
+ (let ((tags (plist-get result :tags))
+ (orig-tags (plist-get result :orig-tags)))
+ (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
-(defun notmuch-search-show-result (result &optional pos)
- "Insert RESULT at POS or the end of the buffer if POS is null."
+(defun notmuch-search-show-result (result pos)
+ "Insert RESULT at POS."
;; Ignore excluded matches
(unless (= (plist-get result :matched) 0)
- (let ((beg (or pos (point-max))))
- (save-excursion
- (goto-char beg)
- (dolist (spec notmuch-search-result-format)
- (notmuch-search-insert-field (car spec) (cdr spec) result))
- (insert "\n")
- (notmuch-search-color-line beg (point) (plist-get result :tags))
- (put-text-property beg (point) 'notmuch-search-result result))
- (when (string= (plist-get result :thread) notmuch-search-target-thread)
- (setq notmuch-search-target-thread "found")
- (goto-char beg)))))
+ (save-excursion
+ (goto-char pos)
+ (dolist (spec notmuch-search-result-format)
+ (notmuch-search-insert-field (car spec) (cdr spec) result))
+ (insert "\n")
+ (notmuch-search-color-line pos (point) (plist-get result :tags))
+ (put-text-property pos (point) 'notmuch-search-result result))))
+
+(defun notmuch-search-append-result (result)
+ "Insert RESULT at the end of the buffer.
+
+This is only called when a result is first inserted so it also
+sets the :orig-tag property."
+ (let ((new-result (plist-put result :orig-tags (plist-get result :tags)))
+ (pos (point-max)))
+ (notmuch-search-show-result new-result pos)
+ (when (string= (plist-get result :thread) notmuch-search-target-thread)
+ (setq notmuch-search-target-thread "found")
+ (goto-char pos))))
(defun notmuch-search-process-filter (proc string)
"Process and filter the output of \"notmuch search\""
(save-excursion
(goto-char (point-max))
(insert string))
- (notmuch-sexp-parse-partial-list 'notmuch-search-show-result
+ (notmuch-sexp-parse-partial-list 'notmuch-search-append-result
results-buf)))))
(defun notmuch-search-tag-all (tag-changes)
(interactive
(list (notmuch-read-tag-changes
(notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
- (notmuch-tag notmuch-search-query-string tag-changes))
+ (notmuch-search-tag tag-changes (point-min) (point-max) t))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
(let (longest
(longest-length 0))
(loop for tuple in notmuch-saved-searches
- if (let ((quoted-query (regexp-quote (cdr tuple))))
+ if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query))))
(and (string-match (concat "^" quoted-query) query)
(> (length (match-string 0 query))
longest-length)))
do (setq longest tuple))
longest))
- (saved-search-name (car saved-search))
- (saved-search-query (cdr saved-search)))
+ (saved-search-name (notmuch-saved-search-get saved-search :name))
+ (saved-search-query (notmuch-saved-search-get saved-search :query)))
(cond ((and saved-search (equal saved-search-query query))
;; Query is the same as saved search (ignoring case)
(concat "*notmuch-saved-search-" saved-search-name "*"))
"Read a notmuch-query from the minibuffer with completion.
PROMPT is the string to prompt with."
- (lexical-let
- ((completions
- (append (list "folder:" "thread:" "id:" "date:" "from:" "to:"
- "subject:" "attachment:")
- (mapcar (lambda (tag)
- (concat "tag:" (notmuch-escape-boolean-term tag)))
- (process-lines notmuch-command "search" "--output=tags" "*")))))
+ (lexical-let*
+ ((all-tags
+ (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
+ (process-lines notmuch-command "search" "--output=tags" "*")))
+ (completions
+ (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
+ "subject:" "attachment:" "mimetype:")
+ (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
+ (mapcar (lambda (tag) (concat "is:" tag)) all-tags))))
(let ((keymap (copy-keymap minibuffer-local-map))
+ (current-query (case major-mode
+ (notmuch-search-mode (notmuch-search-get-query))
+ (notmuch-show-mode (notmuch-show-get-query))
+ (notmuch-tree-mode (notmuch-tree-get-query))))
(minibuffer-completion-table
(completion-table-dynamic
(lambda (string)
(define-key keymap (kbd "TAB") 'minibuffer-complete)
(let ((history-delete-duplicates t))
(read-from-minibuffer prompt nil keymap nil
- 'notmuch-search-history nil nil)))))
+ 'notmuch-search-history current-query nil)))))
+
+(defun notmuch-search-get-query ()
+ "Return the current query in this search buffer"
+ notmuch-search-query-string)
;;;###autoload
(put 'notmuch-search 'notmuch-doc "Search for messages.")
(set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line)
+ (notmuch-tag-clear-cache)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
(save-excursion
(let ((proc (notmuch-start-notmuch
"notmuch-search" buffer #'notmuch-search-process-sentinel
- "search" "--format=sexp" "--format-version=1"
+ "search" "--format=sexp" "--format-version=2"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
(oldest-first notmuch-search-oldest-first)
(target-thread (notmuch-search-find-thread-id 'bare))
(query notmuch-search-query-string))
- (notmuch-kill-this-buffer)
+ (notmuch-bury-or-kill-this-buffer)
(notmuch-search query oldest-first target-thread target-line)
(goto-char (point-min))))
(set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
(notmuch-search-refresh-view))
+(defun notmuch-group-disjunctive-query-string (query-string)
+ "Group query if it contains a complex expression.
+
+Enclose QUERY-STRING in parentheses if it matches
+`notmuch-search-disjunctive-regexp'."
+ (if (string-match-p notmuch-search-disjunctive-regexp query-string)
+ (concat "( " query-string " )")
+ query-string))
+
(defun notmuch-search-filter (query)
- "Filter the current search results based on an additional query string.
+ "Filter or LIMIT the current search results based on an additional query string.
Runs a new search matching only messages that match both the
current search results AND the additional query string provided."
(interactive (list (notmuch-read-query "Filter search: ")))
- (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query)
- (concat "( " query " )")
- query)))
- (notmuch-search (if (string= notmuch-search-query-string "*")
+ (let ((grouped-query (notmuch-group-disjunctive-query-string query))
+ (grouped-original-query (notmuch-group-disjunctive-query-string
+ notmuch-search-query-string)))
+ (notmuch-search (if (string= grouped-original-query "*")
grouped-query
- (concat notmuch-search-query-string " and " grouped-query)) notmuch-search-oldest-first)))
+ (concat grouped-original-query " and " grouped-query))
+ notmuch-search-oldest-first)))
(defun notmuch-search-filter-by-tag (tag)
"Filter the current search results based on a single tag.
(setq mail-user-agent 'notmuch-user-agent)
(provide 'notmuch)
+
+;; After provide to avoid loops if notmuch was require'd via notmuch-init-file.
+(if init-file-user ; don't load init file if the -q option was used.
+ (let ((init-file (locate-file notmuch-init-file '("/")
+ (get-load-suffixes))))
+ (if init-file (load init-file nil t t))))
+
+;;; notmuch.el ends here