X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=72f78edcbcd401e5a729b1586753c143734ce52d;hp=f11ec24e76111dd813e399ad1ccf15791c4077ca;hb=58d714e5ced2b6d16dcbd91589715e5ec52c97b4;hpb=68a2c7a8b0f749cb33a8ce7cfa2aa7781d2529bb diff --git a/emacs/notmuch.el b/emacs/notmuch.el index f11ec24e..72f78edc 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -1,53 +1,54 @@ -; notmuch.el --- run notmuch within emacs -; -; Copyright © Carl Worth -; -; This file is part of Notmuch. -; -; Notmuch is free software: you can redistribute it and/or modify it -; under the terms of the GNU General Public License as published by -; the Free Software Foundation, either version 3 of the License, or -; (at your option) any later version. -; -; Notmuch is distributed in the hope that it will be useful, but -; WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -; General Public License for more details. -; -; You should have received a copy of the GNU General Public License -; along with Notmuch. If not, see . -; -; Authors: Carl Worth - -; 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. -; -; To install this software, copy it to a directory that is on the -; `load-path' variable within emacs (a good candidate is -; /usr/local/share/emacs/site-lisp). If you are viewing this from the -; notmuch source distribution then you can simply run: -; -; sudo make install-emacs -; -; to install it. -; -; Then, to actually run it, add: -; -; (require 'notmuch) -; -; to your ~/.emacs file, and then run "M-x notmuch" from within emacs, -; or run: -; -; emacs -f notmuch -; -; Have fun, and let us know if you have any comment, questions, or -; kudos: Notmuch list (subscription is not -; required, but is available from http://notmuchmail.org). +;; notmuch.el --- run notmuch within emacs +;; +;; Copyright © Carl Worth +;; +;; This file is part of Notmuch. +;; +;; Notmuch is free software: you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; Notmuch is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with Notmuch. If not, see . +;; +;; Authors: Carl Worth + +;; 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. +;; +;; To install this software, copy it to a directory that is on the +;; `load-path' variable within emacs (a good candidate is +;; /usr/local/share/emacs/site-lisp). If you are viewing this from the +;; notmuch source distribution then you can simply run: +;; +;; sudo make install-emacs +;; +;; to install it. +;; +;; Then, to actually run it, add: +;; +;; (require 'notmuch) +;; +;; to your ~/.emacs file, and then run "M-x notmuch" from within emacs, +;; or run: +;; +;; emacs -f notmuch +;; +;; Have fun, and let us know if you have any comment, questions, or +;; kudos: Notmuch list (subscription is not +;; required, but is available from http://notmuchmail.org). (eval-when-compile (require 'cl)) +(require 'crm) (require 'mm-view) (require 'message) @@ -70,14 +71,43 @@ For example: (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\) \(\"subject\" . \"%s\"\)\)\)" :type '(alist :key-type (string) :value-type (string)) - :group 'notmuch) + :group 'notmuch-search) -(defun notmuch-select-tag-with-completion (prompt &rest search-terms) +(defvar notmuch-query-history nil + "Variable to store minibuffer history for notmuch queries") + +(defun notmuch-tag-completions (&optional prefixes search-terms) (let ((tag-list - (with-output-to-string - (with-current-buffer standard-output - (apply 'call-process notmuch-command nil t nil "search-tags" search-terms))))) - (completing-read prompt (split-string tag-list "\n+" t) nil nil nil))) + (split-string + (with-output-to-string + (with-current-buffer standard-output + (apply 'call-process notmuch-command nil t + nil "search-tags" search-terms))) + "\n+" t))) + (if (null prefixes) + tag-list + (apply #'append + (mapcar (lambda (tag) + (mapcar (lambda (prefix) + (concat prefix tag)) prefixes)) + tag-list))))) + +(defun notmuch-select-tag-with-completion (prompt &rest search-terms) + (let ((tag-list (notmuch-tag-completions nil search-terms))) + (completing-read prompt tag-list))) + +(defun notmuch-select-tags-with-completion (prompt &optional prefixes &rest search-terms) + (let ((tag-list (notmuch-tag-completions prefixes search-terms)) + (crm-separator " ") + ;; By default, space is bound to "complete word" function. + ;; Re-bind it to insert a space instead. Note that + ;; still does the completion. + (crm-local-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map crm-local-completion-map) + (define-key map " " 'self-insert-command) + map))) + (delete "" (completing-read-multiple prompt tag-list)))) (defun notmuch-foreach-mime-part (function mm-handle) (cond ((stringp (car mm-handle)) @@ -136,10 +166,10 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-." "M-" (concat desc " ")))) -; I would think that emacs would have code handy for walking a keymap -; and generating strings for each key, and I would prefer to just call -; that. But I couldn't find any (could be all implemented in C I -; suppose), so I wrote my own here. +;; I would think that emacs would have code handy for walking a keymap +;; and generating strings for each key, and I would prefer to just call +;; that. But I couldn't find any (could be all implemented in C I +;; suppose), so I wrote my own here. (defun notmuch-substitute-one-command-key-with-prefix (prefix binding) "For a key binding, return a string showing a human-readable representation of the prefixed key as well as the first line of @@ -161,16 +191,23 @@ For a mouse binding, return nil." "\t" (notmuch-documentation-first-line action)))))) -(defalias 'notmuch-substitute-one-command-key - (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil)) +(defun notmuch-substitute-command-keys-one (key) + ;; A `keymap' key indicates inheritance from a parent keymap - the + ;; inherited mappings follow, so there is nothing to print for + ;; `keymap' itself. + (when (not (eq key 'keymap)) + (notmuch-substitute-one-command-key-with-prefix nil key))) (defun notmuch-substitute-command-keys (doc) "Like `substitute-command-keys' but with documentation, not function names." (let ((beg 0)) (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg) - (let ((map (substring doc (match-beginning 1) (match-end 1)))) - (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key - (cdr (symbol-value (intern map))) "\n") 1 1 doc))) + (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1))) + (keymap (symbol-value (intern keymap-name)))) + (setq doc (replace-match + (mapconcat #'notmuch-substitute-command-keys-one + (cdr keymap) "\n") + 1 1 doc))) (setq beg (match-end 0))) doc)) @@ -189,7 +226,8 @@ For a mouse binding, return nil." "List of functions to call when notmuch displays the search results." :type 'hook :options '(hl-line-mode) - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-hooks) (defvar notmuch-search-mode-map (let ((map (make-sparse-keymap))) @@ -203,7 +241,8 @@ For a mouse binding, return nil." (define-key map ">" 'notmuch-search-last-thread) (define-key map "p" 'notmuch-search-previous-thread) (define-key map "n" 'notmuch-search-next-thread) - (define-key map "r" 'notmuch-search-reply-to-thread) + (define-key map "r" 'notmuch-search-reply-to-thread-sender) + (define-key map "R" 'notmuch-search-reply-to-thread) (define-key map "m" 'notmuch-mua-new-mail) (define-key map "s" 'notmuch-search) (define-key map "o" 'notmuch-search-toggle-order) @@ -218,7 +257,6 @@ For a mouse binding, return nil." (define-key map "-" 'notmuch-search-remove-tag) (define-key map "+" 'notmuch-search-add-tag) (define-key map (kbd "RET") 'notmuch-search-show-thread) - (define-key map (kbd "M-RET") 'notmuch-search-show-thread-crypto-switch) map) "Keymap for \"notmuch search\" buffers.") (fset 'notmuch-search-mode-map notmuch-search-mode-map) @@ -260,14 +298,14 @@ For a mouse binding, return nil." (defun notmuch-search-scroll-down () "Move backward through the search results by one window's worth." (interactive) - ; I don't know why scroll-down doesn't signal beginning-of-buffer - ; the way that scroll-up signals end-of-buffer, but c'est la vie. - ; - ; So instead of trapping a signal we instead check whether the - ; window begins on the first line of the buffer and if so, move - ; directly to that position. (We have to count lines since the - ; window-start position is not the same as point-min due to the - ; invisible thread-ID characters on the first line. + ;; I don't know why scroll-down doesn't signal beginning-of-buffer + ;; the way that scroll-up signals end-of-buffer, but c'est la vie. + ;; + ;; So instead of trapping a signal we instead check whether the + ;; window begins on the first line of the buffer and if so, move + ;; directly to that position. (We have to count lines since the + ;; window-start position is not the same as point-min due to the + ;; invisible thread-ID characters on the first line. (if (equal (count-lines (point-min) (window-start)) 0) (goto-char (point-min)) (scroll-down nil))) @@ -297,27 +335,32 @@ For a mouse binding, return nil." '((((class color) (background light)) (:background "#f0f0f0")) (((class color) (background dark)) (:background "#303030"))) "Face for the single-line message summary in notmuch-show-mode." - :group 'notmuch) + :group 'notmuch-show + :group 'notmuch-faces) (defface notmuch-search-date '((t :inherit default)) "Face used in search mode for dates." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defface notmuch-search-count '((t :inherit default)) "Face used in search mode for the count matching the query." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defface notmuch-search-subject '((t :inherit default)) "Face used in search mode for subjects." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defface notmuch-search-matching-authors '((t :inherit default)) "Face used in search mode for authors matching the query." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defface notmuch-search-non-matching-authors '((((class color) @@ -329,7 +372,8 @@ For a mouse binding, return nil." (t (:italic t))) "Face used in search mode for authors not matching the query." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defface notmuch-tag-face '((((class color) @@ -341,7 +385,8 @@ For a mouse binding, return nil." (t (:bold t))) "Face used in search mode face for tags." - :group 'notmuch) + :group 'notmuch-search + :group 'notmuch-faces) (defun notmuch-search-mode () "Major mode displaying results of a notmuch search. @@ -375,7 +420,7 @@ Complete list of currently available key bindings: (make-local-variable 'notmuch-search-target-line) (set (make-local-variable 'notmuch-search-continuation) nil) (set (make-local-variable 'scroll-preserve-screen-position) t) - (add-to-invisibility-spec 'notmuch-search) + (add-to-invisibility-spec (cons 'ellipsis t)) (use-local-map notmuch-search-mode-map) (setq truncate-lines t) (setq major-mode 'notmuch-search-mode @@ -418,13 +463,9 @@ Complete list of currently available key bindings: "Return a list of authors for the current region" (notmuch-search-properties-in-region 'notmuch-search-subject beg end)) -(defun notmuch-search-show-thread-crypto-switch () - (interactive) - (notmuch-search-show-thread t)) - (defun notmuch-search-show-thread (&optional crypto-switch) "Display the currently selected thread." - (interactive) + (interactive "P") (let ((thread-id (notmuch-search-find-thread-id)) (subject (notmuch-search-find-subject))) (if (> (length thread-id) 0) @@ -440,13 +481,19 @@ Complete list of currently available key bindings: "*") 32 nil nil t)) crypto-switch) - (error "End of search results")))) + (message "End of search results.")))) (defun notmuch-search-reply-to-thread (&optional prompt-for-sender) + "Begin composing a reply-all to the entire current thread in a new buffer." + (interactive "P") + (let ((message-id (notmuch-search-find-thread-id))) + (notmuch-mua-new-reply message-id prompt-for-sender t))) + +(defun notmuch-search-reply-to-thread-sender (&optional prompt-for-sender) "Begin composing a reply to the entire current thread in a new buffer." (interactive "P") (let ((message-id (notmuch-search-find-thread-id))) - (notmuch-mua-new-reply message-id prompt-for-sender))) + (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. @@ -490,7 +537,7 @@ the messages that are about to be tagged" :type 'hook :options '(hl-line-mode) - :group 'notmuch) + :group 'notmuch-hooks) (defcustom notmuch-after-tag-hook nil "Hooks that are run after tags of a message are modified. @@ -501,7 +548,7 @@ a list of strings of the form \"+TAG\" or \"-TAG\". the messages that were tagged" :type 'hook :options '(hl-line-mode) - :group 'notmuch) + :group 'notmuch-hooks) (defun notmuch-search-set-tags (tags) (save-excursion @@ -605,7 +652,7 @@ thread or threads in the current region." This function advances the next thread when finished." (interactive) (notmuch-search-remove-tag-thread "inbox") - (forward-line)) + (notmuch-search-next-thread)) (defvar notmuch-search-process-filter-data nil "Data that has not yet been processed.") @@ -631,8 +678,8 @@ This function advances the next thread when finished." (if notmuch-search-process-filter-data (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data))) (insert "End of search results.") - (if (not (= exit-status 0)) - (insert (format " (process returned %d)" exit-status))) + (unless (= exit-status 0) + (insert (format " (process returned %d)" exit-status))) (insert "\n") (if (and atbob (not (string= notmuch-search-target-thread "found"))) @@ -648,37 +695,35 @@ This function advances the next thread when finished." 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 '((\"delete\" . '(:foreground \"red\" - :background \"blue\")) - (\"unread\" . '(:foreground \"green\")))) + (setq notmuch-search-line-faces '((\"delete\" . (:foreground \"red\" + :background \"blue\")) + (\"unread\" . (:foreground \"green\")))) The attributes defined for matching tags are merged, with later attributes overriding earlier. A message having both \"delete\" 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) + :group 'notmuch-search + :group 'notmuch-faces) (defun notmuch-search-color-line (start end line-tag-list) "Colorize lines in `notmuch-show' based on tags." ;; Create the overlay only if the message has tags which match one ;; of those specified in `notmuch-search-line-faces'. (let (overlay) - (mapc '(lambda (elem) - (let ((tag (car elem)) - (attributes (cdr elem))) - (when (member tag line-tag-list) - (when (not overlay) - (setq overlay (make-overlay start end))) - ;; Merge the specified properties with any already - ;; applied from an earlier match. - (overlay-put overlay 'face - (append (overlay-get overlay 'face) attributes))))) + (mapc (lambda (elem) + (let ((tag (car elem)) + (attributes (cdr elem))) + (when (member tag line-tag-list) + (when (not overlay) + (setq overlay (make-overlay start end))) + ;; Merge the specified properties with any already + ;; applied from an earlier match. + (overlay-put overlay 'face + (append (overlay-get overlay 'face) attributes))))) notmuch-search-line-faces))) -(defun notmuch-search-isearch-authors-show (overlay) - (remove-from-invisibility-spec (cons (overlay-get overlay 'invisible) t))) - (defun notmuch-search-author-propertize (authors) "Split `authors' into matching and non-matching authors and propertize appropriately. If no boundary between authors and @@ -752,13 +797,11 @@ non-authors is found, assume that all of the authors match." (insert visible-string) (when (not (string= invisible-string "")) (let ((start (point)) - (invis-spec (make-symbol "notmuch-search-authors")) overlay) (insert invisible-string) - (add-to-invisibility-spec (cons invis-spec t)) (setq overlay (make-overlay start (point))) - (overlay-put overlay 'invisible invis-spec) - (overlay-put overlay 'isearch-open-invisible #'notmuch-search-isearch-authors-show))) + (overlay-put overlay 'invisible 'ellipsis) + (overlay-put overlay 'isearch-open-invisible #'delete-overlay))) (insert padding)))) (defun notmuch-search-insert-field (field date count authors subject tags) @@ -812,12 +855,12 @@ non-authors is found, assume that all of the authors match." (goto-char (point-max)) (if (/= (match-beginning 1) line) (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n"))) - (let ((beg (point-marker))) + (let ((beg (point))) (notmuch-search-show-result date count authors subject tags) - (notmuch-search-color-line beg (point-marker) tag-list) - (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id) - (put-text-property beg (point-marker) 'notmuch-search-authors authors) - (put-text-property beg (point-marker) 'notmuch-search-subject subject) + (notmuch-search-color-line beg (point) tag-list) + (put-text-property beg (point) 'notmuch-search-thread-id thread-id) + (put-text-property beg (point) 'notmuch-search-authors authors) + (put-text-property beg (point) 'notmuch-search-subject subject) (if (string= thread-id notmuch-search-target-thread) (progn (set 'found-target beg) @@ -833,7 +876,7 @@ non-authors is found, assume that all of the authors match." (goto-char found-target))) (delete-process proc)))) -(defun notmuch-search-operate-all (action) +(defun notmuch-search-operate-all (&rest actions) "Add/remove tags from all matching messages. This command adds or removes tags from all messages matching the @@ -844,16 +887,16 @@ will prompt for tags to be added or removed. Tags prefixed with Each character of the tag name may consist of alphanumeric characters as well as `_.+-'. " - (interactive "sOperation (+add -drop): notmuch tag ") - (let ((action-split (split-string action " +"))) - ;; Perform some validation - (let ((words action-split)) - (when (null words) (error "No operation given")) - (while words - (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words)) - (error "Action must be of the form `+thistag -that_tag'")) - (setq words (cdr words)))) - (apply 'notmuch-tag notmuch-search-query-string action-split))) + (interactive (notmuch-select-tags-with-completion + "Operations (+add -drop): notmuch tag " + '("+" "-"))) + ;; Perform some validation + (when (null actions) (error "No operations given")) + (mapc (lambda (action) + (unless (string-match-p "^[-+][-+_.[:word:]]+$" action) + (error "Action must be of the form `+this_tag' or `-that_tag'"))) + actions) + (apply 'notmuch-tag notmuch-search-query-string actions)) (defun notmuch-search-buffer-title (query) "Returns the title for a buffer with notmuch search results." @@ -882,21 +925,57 @@ characters as well as `_.+-'. (concat "*notmuch-search-" query "*")) ))) +(defun notmuch-read-query (prompt) + "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:" tag)) + (process-lines notmuch-command "search" "--output=tags" "*"))))) + (let ((keymap (copy-keymap minibuffer-local-map)) + (minibuffer-completion-table + (completion-table-dynamic + (lambda (string) + ;; generate a list of possible completions for the current input + (cond + ;; this ugly regexp is used to get the last word of the input + ;; possibly preceded by a '(' + ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string) + (mapcar (lambda (compl) + (concat (match-string-no-properties 1 string) compl)) + (all-completions (match-string-no-properties 2 string) + completions))) + (t (list string))))))) + ;; this was simpler than convincing completing-read to accept spaces: + (define-key keymap (kbd "") 'minibuffer-complete) + (let ((history-delete-duplicates t)) + (read-from-minibuffer prompt nil keymap nil + 'notmuch-search-history nil nil))))) + ;;;###autoload -(defun notmuch-search (query &optional oldest-first target-thread target-line continuation) - "Run \"notmuch search\" with the given query string and display results. +(defun notmuch-search (&optional query oldest-first target-thread target-line continuation) + "Run \"notmuch search\" with the given `query' and display results. -The optional parameters are used as follows: +If `query' is nil, it is read interactively from the minibuffer. +Other optional parameters are used as follows: oldest-first: A Boolean controlling the sort order of returned threads target-thread: A thread ID (with the thread: prefix) that will be made 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." - (interactive "sNotmuch search: ") + (interactive) + (if (null query) + (setq query (notmuch-read-query "Notmuch search: "))) (let ((buffer (get-buffer-create (notmuch-search-buffer-title query)))) (switch-to-buffer buffer) (notmuch-search-mode) + ;; Don't track undo information for this buffer + (set 'buffer-undo-list t) (set 'notmuch-search-query-string query) (set 'notmuch-search-oldest-first oldest-first) (set 'notmuch-search-target-thread target-thread) @@ -918,7 +997,8 @@ The optional parameters are used as follows: "--sort=newest-first") query))) (set-process-sentinel proc 'notmuch-search-process-sentinel) - (set-process-filter proc 'notmuch-search-process-filter)))) + (set-process-filter proc 'notmuch-search-process-filter) + (set-process-query-on-exit-flag proc nil)))) (run-hooks 'notmuch-search-hook))) (defun notmuch-search-refresh-view () @@ -939,28 +1019,43 @@ same relative position within the new buffer." (notmuch-search query oldest-first target-thread target-line continuation) (goto-char (point-min)))) -(defcustom notmuch-poll-script "" +(defcustom notmuch-poll-script nil "An external script to incorporate new mail into the notmuch database. -If this variable is non empty, then it should name a script to be -invoked by `notmuch-search-poll-and-refresh-view' and +This variable controls the action invoked by +`notmuch-search-poll-and-refresh-view' and `notmuch-hello-poll-and-update' (each have a default keybinding -of 'G'). The script could do any of the following depending on +of 'G') to incorporate new mail into the notmuch database. + +If set to nil (the default), new mail is processed by invoking +\"notmuch new\". Otherwise, this should be set to a string that +gives the name of an external script that processes new mail. If +set to the empty string, no command will be run. + +The external script could do any of the following depending on the user's needs: 1. Invoke a program to transfer mail to the local mail store 2. Invoke \"notmuch new\" to incorporate the new mail -3. Invoke one or more \"notmuch tag\" commands to classify the mail" - :type 'string - :group 'notmuch) +3. Invoke one or more \"notmuch tag\" commands to classify the mail + +Note that the recommended way of achieving the same is using +\"notmuch new\" hooks." + :type '(choice (const :tag "notmuch new" nil) + (const :tag "Disabled" "") + (string :tag "Custom script")) + :group 'notmuch-external) (defun notmuch-poll () - "Run external script to import mail. + "Run \"notmuch new\" or an external script to import mail. -Invokes `notmuch-poll-script' if it is not set to an empty string." +Invokes `notmuch-poll-script', \"notmuch new\", or does nothing +depending on the value of `notmuch-poll-script'." (interactive) - (if (not (string= notmuch-poll-script "")) - (call-process notmuch-poll-script nil nil))) + (if (stringp notmuch-poll-script) + (unless (string= notmuch-poll-script "") + (call-process notmuch-poll-script nil nil)) + (call-process notmuch-command nil nil nil "new"))) (defun notmuch-search-poll-and-refresh-view () "Invoke `notmuch-poll' to import mail, then refresh the current view." @@ -991,7 +1086,7 @@ search." Runs a new search matching only messages that match both the current search results AND the additional query string provided." - (interactive "sFilter search: ") + (interactive (list (notmuch-read-query "Filter search: "))) (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query) (concat "( " query " )") query))) @@ -1014,6 +1109,41 @@ current search results AND that are tagged with the given tag." (interactive) (notmuch-hello)) +(defun notmuch-interesting-buffer (b) + "Is the current buffer of interest to a notmuch user?" + (with-current-buffer b + (memq major-mode '(notmuch-show-mode + notmuch-search-mode + notmuch-hello-mode + message-mode)))) + +;;;###autoload +(defun notmuch-cycle-notmuch-buffers () + "Cycle through any existing notmuch buffers (search, show or hello). + +If the current buffer is the only notmuch buffer, bury it. If no +notmuch buffers exist, run `notmuch'." + (interactive) + + (let (start first) + ;; If the current buffer is a notmuch buffer, remember it and then + ;; bury it. + (when (notmuch-interesting-buffer (current-buffer)) + (setq start (current-buffer)) + (bury-buffer)) + + ;; Find the first notmuch buffer. + (setq first (loop for buffer in (buffer-list) + if (notmuch-interesting-buffer buffer) + return buffer)) + + (if first + ;; If the first one we found is any other than the starting + ;; buffer, switch to it. + (unless (eq first start) + (switch-to-buffer first)) + (notmuch)))) + (setq mail-user-agent 'notmuch-user-agent) (provide 'notmuch)