-;; 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
;;
;; 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)
(require 'notmuch-message)
(require 'notmuch-parser)
-(unless (require 'notmuch-version nil t)
- (defconst notmuch-emacs-version "unknown"
- "Placeholder variable when notmuch-version.el[c] is not available."))
-
(defcustom notmuch-search-result-format
`(("date" . "%12s ")
("count" . "%-7s ")
(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 "k" 'notmuch-tag-jump)
(define-key map "*" 'notmuch-search-tag-all)
(define-key map "a" 'notmuch-search-archive-thread)
(define-key map "-" 'notmuch-search-remove-tag)
(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")
(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)
-(defun notmuch-search-mode ()
+(defface notmuch-search-flagged-face
+ '((((class color)
+ (background dark))
+ (:foreground "LightBlue1"))
+ (((class color)
+ (background light))
+ (:foreground "blue")))
+ "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
+ (:weight bold)))
+ "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)
+
+(define-derived-mode notmuch-search-mode fundamental-mode "notmuch-search"
"Major mode displaying results of a notmuch search.
This buffer contains the results of a \"notmuch search\" of your
Complete list of currently available key bindings:
\\{notmuch-search-mode-map}"
- (interactive)
- (kill-all-local-variables)
(make-local-variable 'notmuch-search-query-string)
(make-local-variable 'notmuch-search-oldest-first)
(make-local-variable 'notmuch-search-target-thread)
(setq notmuch-buffer-refresh-function #'notmuch-search-refresh-view)
(set (make-local-variable 'scroll-preserve-screen-position) t)
(add-to-invisibility-spec (cons 'ellipsis t))
- (use-local-map notmuch-search-mode-map)
(setq truncate-lines t)
- (setq major-mode 'notmuch-search-mode
- mode-name "notmuch-search")
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (setq imenu-prev-index-position-function
+ #'notmuch-search-imenu-prev-index-position-function)
+ (setq imenu-extract-index-name-function
+ #'notmuch-search-imenu-extract-index-name-function))
(defun notmuch-search-get-result (&optional pos)
"Return the result object for the thread at POS (or point).
(next-single-property-change (or pos (point)) 'notmuch-search-result
nil (point-max))))
-(defun notmuch-search-foreach-result (beg end function)
- "Invoke FUNCTION for each result between BEG and END.
+(defun notmuch-search-foreach-result (beg end fn)
+ "Invoke FN for each result between BEG and END.
-FUNCTION should take one argument. It will be applied to the
+FN should take one argument. It will be applied to the
character position of the beginning of each result that overlaps
the region between points BEG and END. As a special case, if (=
-BEG END), FUNCTION will be applied to the result containing point
+BEG END), FN will be applied to the result containing point
BEG."
(lexical-let ((pos (notmuch-search-result-beginning beg))
- ;; End must be a marker in case function changes the
+ ;; End must be a marker in case fn changes the
;; text.
(end (copy-marker end))
;; Make sure we examine at least one result, even if
;; pos.
(while (and pos (or (< pos end) first))
(when (notmuch-search-get-result pos)
- (funcall function pos))
+ (funcall fn pos))
(setq pos (notmuch-search-result-end pos)
first nil))))
;; Unindent the function argument of notmuch-search-foreach-result so
(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)))
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.
+If these are nil or not provided, then, if the region is active
+this applied to all threads meeting the region, and if the region
+is inactive this applies to the thread at 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)))
+ (unless (and beg end)
+ (setq beg (car (notmuch-search-interactive-region))
+ end (cadr (notmuch-search-interactive-region))))
(let ((search-string (notmuch-search-find-stable-query-region
beg end only-matched)))
(notmuch-tag search-string tag-changes)
(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.
+(define-widget 'notmuch--custom-face-edit 'lazy
+ "Custom face edit with a tag Edit Face"
+ ;; I could not persuage custom-face-edit to respect the :tag
+ ;; property so create a widget specially
+ :tag "Manually specify face"
+ :type 'custom-face-edit)
+
+(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):
(\"deleted\" . (:foreground \"red\"
:background \"blue\"))))
-The attributes defined 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))
+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 (radio (face :tag "Face name")
+ (notmuch--custom-face-edit)))
:group 'notmuch-search
:group 'notmuch-faces)
(defun notmuch-search-color-line (start end line-tag-list)
"Colorize lines in `notmuch-show' based on tags."
- (mapc (lambda (elem)
- (let ((tag (car elem))
- (attributes (cdr elem)))
- (when (member tag line-tag-list)
- (notmuch-apply-face nil attributes nil start end))))
- ;; Reverse the list so earlier entries take precedence
- (reverse notmuch-search-line-faces)))
+ ;; Reverse the list so earlier entries take precedence
+ (dolist (elem (reverse notmuch-search-line-faces))
+ (let ((tag (car elem))
+ (face (cdr elem)))
+ (when (member tag line-tag-list)
+ (notmuch-apply-face nil face nil start end)))))
(defun notmuch-search-author-propertize (authors)
"Split `authors' into matching and non-matching authors and
"Read a notmuch-query from the minibuffer with completion.
PROMPT is the string to prompt with."
- (lexical-let
- ((completions
- (append (list "folder:" "path:" "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:")
+ (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
+ (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
+ (mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types)))))
(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.")
-(defun notmuch-search (&optional query oldest-first target-thread target-line)
+;;;###autoload
+(defun notmuch-search (&optional query oldest-first target-thread target-line no-display)
"Display threads matching QUERY in a notmuch-search buffer.
If QUERY is nil, it is read interactively from the minibuffer.
current if it appears in the search results.
TARGET-LINE: The line number to move to if the target thread does not
appear in the search results.
+ NO-DISPLAY: Do not try to foreground the search results buffer. If it is
+ already foregrounded i.e. displayed in a window, this has no
+ effect, meaning the buffer will remain visible.
When called interactively, this will prompt for a query and use
the configured default sort order."
(let* ((query (or query (notmuch-read-query "Notmuch search: ")))
(buffer (get-buffer-create (notmuch-search-buffer-title query))))
- (switch-to-buffer buffer)
+ (if no-display
+ (set-buffer buffer)
+ (switch-to-buffer buffer))
(notmuch-search-mode)
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
(save-excursion
(let ((proc (notmuch-start-notmuch
"notmuch-search" buffer #'notmuch-search-process-sentinel
- "search" "--format=sexp" "--format-version=2"
+ "search" "--format=sexp" "--format-version=3"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
(defun notmuch-search-refresh-view ()
"Refresh the current view.
-Kills the current buffer and runs a new search with the same
+Erases the current buffer and runs a new search with the same
query string as the current search. If the current thread is in
the new search results, then point will be placed on the same
thread. Otherwise, point will be moved to attempt to be in the
same relative position within the new buffer."
+ (interactive)
(let ((target-line (line-number-at-pos))
(oldest-first notmuch-search-oldest-first)
(target-thread (notmuch-search-find-thread-id 'bare))
(query notmuch-search-query-string))
- (notmuch-kill-this-buffer)
- (notmuch-search query oldest-first target-thread target-line)
+ ;; notmuch-search erases the current buffer.
+ (notmuch-search query oldest-first target-thread target-line t)
(goto-char (point-min))))
(defun notmuch-search-toggle-order ()
(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.
(with-current-buffer b
(memq major-mode '(notmuch-show-mode
notmuch-search-mode
+ notmuch-tree-mode
notmuch-hello-mode
- message-mode))))
+ notmuch-message-mode))))
;;;###autoload
(defun notmuch-cycle-notmuch-buffers ()
;; Find the first notmuch buffer.
(setq first (loop for buffer in (buffer-list)
- if (notmuch-interesting-buffer buffer)
- return buffer))
+ if (notmuch-interesting-buffer buffer)
+ return buffer))
(if first
;; If the first one we found is any other than the starting
(switch-to-buffer first))
(notmuch))))
+;;;; Imenu Support
+
+(defun notmuch-search-imenu-prev-index-position-function ()
+ "Move point to previous message in notmuch-search buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+ (notmuch-search-previous-thread))
+
+(defun notmuch-search-imenu-extract-index-name-function ()
+ "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'. Point should be at the
+beginning of the line."
+ (let ((subject (notmuch-search-find-subject))
+ (author (notmuch-search-find-authors)))
+ (format "%s (%s)" subject author)))
+
(setq mail-user-agent 'notmuch-user-agent)
(provide 'notmuch)
(let ((init-file (locate-file notmuch-init-file '("/")
(get-load-suffixes))))
(if init-file (load init-file nil t t))))
+
+;;; notmuch.el ends here
projects / notmuch / blobdiff