diff options
Diffstat (limited to 'emacs')
-rw-r--r-- | emacs/Makefile.local | 3 | ||||
-rw-r--r-- | emacs/notmuch-hello.el | 11 | ||||
-rw-r--r-- | emacs/notmuch-jump.el | 173 | ||||
-rw-r--r-- | emacs/notmuch-lib.el | 35 | ||||
-rw-r--r-- | emacs/notmuch-mua.el | 3 | ||||
-rw-r--r-- | emacs/notmuch-show.el | 185 | ||||
-rw-r--r-- | emacs/notmuch-tree.el | 25 | ||||
-rw-r--r-- | emacs/notmuch.el | 23 |
8 files changed, 355 insertions, 103 deletions
diff --git a/emacs/Makefile.local b/emacs/Makefile.local index c0d6b190..1109cfa6 100644 --- a/emacs/Makefile.local +++ b/emacs/Makefile.local @@ -18,7 +18,8 @@ emacs_sources := \ $(dir)/notmuch-tag.el \ $(dir)/coolj.el \ $(dir)/notmuch-print.el \ - $(dir)/notmuch-version.el + $(dir)/notmuch-version.el \ + $(dir)/notmuch-jump.el \ $(dir)/notmuch-version.el: $(dir)/Makefile.local version.stamp $(dir)/notmuch-version.el: $(srcdir)/$(dir)/notmuch-version.el.tmpl diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 3de52386..65d06276 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -85,6 +85,7 @@ searches so they still work in customize." (group :format "%v" :inline t (const :format " Query: " :query) (string :format "%v"))) (checklist :inline t :format "%v" + (group :format "%v" :inline t (const :format "Shortcut key: " :key) (key-sequence :format "%v")) (group :format "%v" :inline t (const :format "Count-Query: " :count-query) (string :format "%v")) (group :format "%v" :inline t (const :format "" :sort-order) (choice :tag " Sort Order" @@ -92,8 +93,13 @@ searches so they still work in customize." (const :tag "Oldest-first" oldest-first) (const :tag "Newest-first" newest-first)))))) -(defcustom notmuch-saved-searches '((:name "inbox" :query "tag:inbox") - (:name "unread" :query "tag:unread")) +(defcustom notmuch-saved-searches + `((:name "inbox" :query "tag:inbox" :key ,(kbd "i")) + (:name "unread" :query "tag:unread" :key ,(kbd "u")) + (:name "flagged" :query "tag:flagged" :key ,(kbd "f")) + (:name "sent" :query "tag:sent" :key ,(kbd "t")) + (:name "drafts" :query "tag:draft" :key ,(kbd "d")) + (:name "all mail" :query "*" :key ,(kbd "a"))) "A list of saved searches to display. The saved search can be given in 3 forms. The preferred way is as @@ -101,6 +107,7 @@ a plist. Supported properties are :name Name of the search (required). :query Search to run (required). + :key Optional shortcut key for `notmuch-jump-search'. :count-query Optional extra query to generate the count shown. If not present then the :query property is used. diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el new file mode 100644 index 00000000..05bbce5e --- /dev/null +++ b/emacs/notmuch-jump.el @@ -0,0 +1,173 @@ +;; notmuch-jump.el --- User-friendly shortcut keys +;; +;; Copyright © Austin Clements +;; +;; 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 <http://www.gnu.org/licenses/>. +;; +;; Authors: Austin Clements <aclements@csail.mit.edu> +;; David Edmondson <dme@dme.org> + +(eval-when-compile (require 'cl)) + +(require 'notmuch-lib) +(require 'notmuch-hello) + +;;;###autoload +(defun notmuch-jump-search () + "Jump to a saved search by shortcut key. + +This prompts for and performs a saved search using the shortcut +keys configured in the :key property of `notmuch-saved-searches'. +Typically these shortcuts are a single key long, so this is a +fast way to jump to a saved search from anywhere in Notmuch." + (interactive) + + ;; Build the action map + (let (action-map) + (dolist (saved-search notmuch-saved-searches) + (let* ((saved-search (notmuch-hello-saved-search-to-plist saved-search)) + (key (plist-get saved-search :key))) + (when key + (let ((name (plist-get saved-search :name)) + (query (plist-get saved-search :query)) + (oldest-first + (case (plist-get saved-search :sort-order) + (newest-first nil) + (oldest-first t) + (otherwise (default-value notmuch-search-oldest-first))))) + (push (list key name + `(lambda () (notmuch-search ',query ',oldest-first))) + action-map))))) + (setq action-map (nreverse action-map)) + + (if action-map + (notmuch-jump action-map "Search: ") + (error "To use notmuch-jump, please customize shortcut keys in notmuch-saved-searches.")))) + +(defvar notmuch-jump--action nil) + +(defun notmuch-jump (action-map prompt) + "Interactively prompt for one of the keys in ACTION-MAP. + +Displays a summary of all bindings in ACTION-MAP in the +minibuffer, reads a key from the minibuffer, and performs the +corresponding action. The prompt can be canceled with C-g or +RET. PROMPT must be a string to use for the prompt. PROMPT +should include a space at the end. + +ACTION-MAP must be a list of triples of the form + (KEY LABEL ACTION) +where KEY is a key binding, LABEL is a string label to display in +the buffer, and ACTION is a nullary function to call. LABEL may +be null, in which case the action will still be bound, but will +not appear in the pop-up buffer. +" + + (let* ((items (notmuch-jump--format-actions action-map)) + ;; Format the table of bindings and the full prompt + (table + (with-temp-buffer + (notmuch-jump--insert-items (window-body-width) items) + (buffer-string))) + (full-prompt + (concat table "\n\n" + (propertize prompt 'face 'minibuffer-prompt))) + ;; By default, the minibuffer applies the minibuffer face to + ;; the entire prompt. However, we want to clearly + ;; distinguish bindings (which we put in the prompt face + ;; ourselves) from their labels, so disable the minibuffer's + ;; own re-face-ing. + (minibuffer-prompt-properties + (notmuch-plist-delete + (copy-sequence minibuffer-prompt-properties) + 'face)) + ;; Build the keymap with our bindings + (minibuffer-map (notmuch-jump--make-keymap action-map)) + ;; The bindings save the the action in notmuch-jump--action + (notmuch-jump--action nil)) + ;; Read the action + (read-from-minibuffer full-prompt nil minibuffer-map) + + ;; If we got an action, do it + (when notmuch-jump--action + (funcall notmuch-jump--action)))) + +(defun notmuch-jump--format-actions (action-map) + "Format the actions in ACTION-MAP. + +Returns a list of strings, one for each item with a label in +ACTION-MAP. These strings can be inserted into a tabular +buffer." + + ;; Compute the maximum key description width + (let ((key-width 1)) + (dolist (entry action-map) + (setq key-width + (max key-width + (string-width (format-kbd-macro (first entry)))))) + ;; Format each action + (mapcar (lambda (entry) + (let ((key (format-kbd-macro (first entry))) + (desc (second entry))) + (concat + (propertize key 'face 'minibuffer-prompt) + (make-string (- key-width (length key)) ? ) + " " desc))) + action-map))) + +(defun notmuch-jump--insert-items (width items) + "Make a table of ITEMS up to WIDTH wide in the current buffer." + (let* ((nitems (length items)) + (col-width (+ 3 (apply #'max (mapcar #'string-width items)))) + (ncols (if (> (* col-width nitems) width) + (max 1 (/ width col-width)) + ;; Items fit on one line. Space them out + (setq col-width (/ width nitems)) + (length items)))) + (while items + (dotimes (col ncols) + (when items + (let ((item (pop items))) + (insert item) + (when (and items (< col (- ncols 1))) + (insert (make-string (- col-width (string-width item)) ? )))))) + (when items + (insert "\n"))))) + +(defvar notmuch-jump-minibuffer-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + ;; Make this like a special-mode keymap, with no self-insert-command + (suppress-keymap map) + map) + "Base keymap for notmuch-jump's minibuffer keymap.") + +(defun notmuch-jump--make-keymap (action-map) + "Translate ACTION-MAP into a minibuffer keymap." + (let ((map (make-sparse-keymap))) + (set-keymap-parent map notmuch-jump-minibuffer-map) + (dolist (action action-map) + (define-key map (first action) + `(lambda () (interactive) + (setq notmuch-jump--action ',(third action)) + (exit-minibuffer)))) + map)) + +(unless (fboundp 'window-body-width) + ;; Compatibility for Emacs pre-24 + (defun window-body-width (&optional window) + (let ((edges (window-inside-edges window))) + (- (caddr edges) (car edges))))) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 2941da3e..19269e3c 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -25,8 +25,8 @@ (require 'mm-decode) (require 'cl) -(defvar notmuch-command "notmuch" - "Command to run the notmuch binary.") +(autoload 'notmuch-jump-search "notmuch-jump" + "Jump to a saved search by shortcut key." t) (defgroup notmuch nil "Notmuch mail reader for Emacs." @@ -66,6 +66,16 @@ "Graphical attributes for displaying text" :group 'notmuch) +(defcustom notmuch-command "notmuch" + "Name of the notmuch binary. + +This can be a relative or absolute path to the notmuch binary. +If this is a relative path, it will be searched for in all of the +directories given in `exec-path' (which is, by default, based on +$PATH)." + :type 'string + :group 'notmuch-external) + (defcustom notmuch-search-oldest-first t "Show the oldest mail first when searching. @@ -77,7 +87,11 @@ search." :group 'notmuch-search) (defcustom notmuch-poll-script nil - "An external script to incorporate new mail into the notmuch database. + "[Deprecated] Command to run to incorporate new mail into the notmuch database. + +This option has been deprecated in favor of \"notmuch new\" +hooks (see man notmuch-hooks). To change the path to the notmuch +binary, customize `notmuch-command'. This variable controls the action invoked by `notmuch-poll-and-refresh-this-buffer' (bound by default to 'G') @@ -93,10 +107,7 @@ 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 - -Note that the recommended way of achieving the same is using -\"notmuch new\" hooks." +3. Invoke one or more \"notmuch tag\" commands to classify the mail" :type '(choice (const :tag "notmuch new" nil) (const :tag "Disabled" "") (string :tag "Custom script")) @@ -130,6 +141,7 @@ For example, if you wanted to remove an \"inbox\" tag and add an (define-key map "m" 'notmuch-mua-new-mail) (define-key map "=" 'notmuch-refresh-this-buffer) (define-key map "G" 'notmuch-poll-and-refresh-this-buffer) + (define-key map "j" 'notmuch-jump-search) map) "Keymap shared by all notmuch modes.") @@ -464,6 +476,15 @@ This replaces spaces, percents, and double quotes in STR with (setq list (cdr list))) (nreverse out))) +(defun notmuch-plist-delete (plist property) + (let* ((xplist (cons nil plist)) + (pred xplist)) + (while (cdr pred) + (when (eq (cadr pred) property) + (setcdr pred (cdddr pred))) + (setq pred (cddr pred))) + (cdr xplist))) + (defun notmuch-split-content-type (content-type) "Split content/type into 'content' and 'type'" (split-string content-type "/")) diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 95e4a4d3..2c588860 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -346,7 +346,8 @@ the From: address first." (message-forward-make-body cur) ;; `message-forward-make-body' shows the User-agent header. Hide ;; it again. - (message-hide-headers))) + (message-hide-headers) + (set-buffer-modified-p nil))) (defun notmuch-mua-new-reply (query-string &optional prompt-for-sender reply-all) "Compose a reply to the message identified by QUERY-STRING. diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index df10d4ba..7549fbb2 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -46,6 +46,7 @@ (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp)) (declare-function notmuch-tree "notmuch-tree" (&optional query query-context target buffer-name open-target)) +(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil) (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") "Headers that should be shown in a message, in this order. @@ -180,10 +181,21 @@ each attachment handler is logged in buffers with names beginning ) "List of Mailing List Archives to use when stashing links. -These URIs are concatenated with the current message's -Message-Id in `notmuch-show-stash-mlarchive-link'." +This list is used for generating a Mailing List Archive reference +URI with the current message's Message-Id in +`notmuch-show-stash-mlarchive-link'. + +If the cdr of the alist element is not a function, the cdr is +expected to contain a URI that is concatenated with the current +message's Message-Id to create a ML archive reference URI. + +If the cdr is a function, the function is called with the +Message-Id as the argument, and the function is expected to +return the ML archive reference URI." :type '(alist :key-type (string :tag "Name") - :value-type (string :tag "URL")) + :value-type (choice + (string :tag "URL") + (function :tag "Function returning the URL"))) :group 'notmuch-show) (defcustom notmuch-show-stash-mlarchive-link-default "Gmane" @@ -211,6 +223,10 @@ For example, if you wanted to remove an \"unread\" tag and add a :type '(repeat string) :group 'notmuch-show) +(defcustom notmuch-show-mark-read-function #'notmuch-show-seen-current-message + "Function to control which messages are marked read." + :type 'function + :group 'notmuch-show) (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" @@ -1145,6 +1161,8 @@ function is used." (let ((inhibit-read-only t)) (notmuch-show-mode) + (add-hook 'post-command-hook #'notmuch-show-command-hook nil t) + ;; Don't track undo information for this buffer (set 'buffer-undo-list t) @@ -1186,6 +1204,15 @@ This includes: - the current message." (list (notmuch-show-get-message-id) (notmuch-show-get-message-ids-for-open-messages))) +(defun notmuch-show-get-query () + "Return the current query in this show buffer" + (if notmuch-show-query-context + (concat notmuch-show-thread-id + " and (" + notmuch-show-query-context + ")") + notmuch-show-thread-id)) + (defun notmuch-show-apply-state (state) "Apply STATE to the current buffer. @@ -1264,46 +1291,46 @@ reset based on the original query." (fset 'notmuch-show-part-map notmuch-show-part-map) (defvar notmuch-show-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map notmuch-common-keymap) - (define-key map "Z" 'notmuch-tree-from-show-current-query) - (define-key map (kbd "<C-tab>") 'widget-backward) - (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) - (define-key map (kbd "<backtab>") 'notmuch-show-previous-button) - (define-key map (kbd "TAB") 'notmuch-show-next-button) - (define-key map "f" 'notmuch-show-forward-message) - (define-key map "r" 'notmuch-show-reply-sender) - (define-key map "R" 'notmuch-show-reply) - (define-key map "|" 'notmuch-show-pipe-message) - (define-key map "w" 'notmuch-show-save-attachments) - (define-key map "V" 'notmuch-show-view-raw-message) - (define-key map "c" 'notmuch-show-stash-map) - (define-key map "h" 'notmuch-show-toggle-visibility-headers) - (define-key map "*" 'notmuch-show-tag-all) - (define-key map "-" 'notmuch-show-remove-tag) - (define-key map "+" 'notmuch-show-add-tag) - (define-key map "X" 'notmuch-show-archive-thread-then-exit) - (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit) - (define-key map "A" 'notmuch-show-archive-thread-then-next) - (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread) - (define-key map "N" 'notmuch-show-next-message) - (define-key map "P" 'notmuch-show-previous-message) - (define-key map "n" 'notmuch-show-next-open-message) - (define-key map "p" 'notmuch-show-previous-open-message) - (define-key map (kbd "M-n") 'notmuch-show-next-thread-show) - (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show) - (define-key map (kbd "DEL") 'notmuch-show-rewind) - (define-key map " " 'notmuch-show-advance-and-archive) - (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all) - (define-key map (kbd "RET") 'notmuch-show-toggle-message) - (define-key map "#" 'notmuch-show-print-message) - (define-key map "!" 'notmuch-show-toggle-elide-non-matching) - (define-key map "$" 'notmuch-show-toggle-process-crypto) - (define-key map "<" 'notmuch-show-toggle-thread-indentation) - (define-key map "t" 'toggle-truncate-lines) - (define-key map "." 'notmuch-show-part-map) - map) - "Keymap for \"notmuch show\" buffers.") + (let ((map (make-sparse-keymap))) + (set-keymap-parent map notmuch-common-keymap) + (define-key map "Z" 'notmuch-tree-from-show-current-query) + (define-key map (kbd "<C-tab>") 'widget-backward) + (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) + (define-key map (kbd "<backtab>") 'notmuch-show-previous-button) + (define-key map (kbd "TAB") 'notmuch-show-next-button) + (define-key map "f" 'notmuch-show-forward-message) + (define-key map "r" 'notmuch-show-reply-sender) + (define-key map "R" 'notmuch-show-reply) + (define-key map "|" 'notmuch-show-pipe-message) + (define-key map "w" 'notmuch-show-save-attachments) + (define-key map "V" 'notmuch-show-view-raw-message) + (define-key map "c" 'notmuch-show-stash-map) + (define-key map "h" 'notmuch-show-toggle-visibility-headers) + (define-key map "*" 'notmuch-show-tag-all) + (define-key map "-" 'notmuch-show-remove-tag) + (define-key map "+" 'notmuch-show-add-tag) + (define-key map "X" 'notmuch-show-archive-thread-then-exit) + (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit) + (define-key map "A" 'notmuch-show-archive-thread-then-next) + (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread) + (define-key map "N" 'notmuch-show-next-message) + (define-key map "P" 'notmuch-show-previous-message) + (define-key map "n" 'notmuch-show-next-open-message) + (define-key map "p" 'notmuch-show-previous-open-message) + (define-key map (kbd "M-n") 'notmuch-show-next-thread-show) + (define-key map (kbd "M-p") 'notmuch-show-previous-thread-show) + (define-key map (kbd "DEL") 'notmuch-show-rewind) + (define-key map " " 'notmuch-show-advance-and-archive) + (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all) + (define-key map (kbd "RET") 'notmuch-show-toggle-message) + (define-key map "#" 'notmuch-show-print-message) + (define-key map "!" 'notmuch-show-toggle-elide-non-matching) + (define-key map "$" 'notmuch-show-toggle-process-crypto) + (define-key map "<" 'notmuch-show-toggle-thread-indentation) + (define-key map "t" 'toggle-truncate-lines) + (define-key map "." 'notmuch-show-part-map) + map) + "Keymap for \"notmuch show\" buffers.") (fset 'notmuch-show-mode-map notmuch-show-mode-map) (defun notmuch-show-mode () @@ -1448,8 +1475,18 @@ an error if there is no part containing point." (notmuch-show-set-message-properties props))) (defun notmuch-show-get-prop (prop &optional props) + "Get property PROP from current message in show or tree mode. + +It gets property PROP from PROPS or, if PROPS is nil, the current +message in either tree or show. This means that several utility +functions in notmuch-show can be used directly by notmuch-tree as +they just need the correct message properties." (let ((props (or props - (notmuch-show-get-message-properties)))) + (cond ((eq major-mode 'notmuch-show-mode) + (notmuch-show-get-message-properties)) + ((eq major-mode 'notmuch-tree-mode) + (notmuch-tree-get-message-properties)) + (t nil))))) (plist-get props prop))) (defun notmuch-show-get-message-id (&optional bare) @@ -1533,6 +1570,23 @@ marked as unread, i.e. the tag changes in (apply 'notmuch-show-tag-message (notmuch-tag-change-list notmuch-show-mark-read-tags unread)))) +(defun notmuch-show-seen-current-message (start end) + "Mark the current message read if it is open. + +We only mark it read once: if it is changed back then that is a +user decision and we should not override it." + (when (and (notmuch-show-message-visible-p) + (not (notmuch-show-get-prop :seen))) + (notmuch-show-mark-read) + (notmuch-show-set-prop :seen t))) + +(defun notmuch-show-command-hook () + (when (eq major-mode 'notmuch-show-mode) + ;; We need to redisplay to get window-start and window-end correct. + (redisplay) + (save-excursion + (funcall notmuch-show-mark-read-function (window-start) (window-end))))) + ;; Functions for getting attributes of several messages in the current ;; thread. @@ -1668,9 +1722,7 @@ If a prefix argument is given and this is the last message in the thread, navigate to the next thread in the parent search buffer." (interactive "P") (if (notmuch-show-goto-message-next) - (progn - (notmuch-show-mark-read) - (notmuch-show-message-adjust)) + (notmuch-show-message-adjust) (if pop-at-end (notmuch-show-next-thread) (goto-char (point-max))))) @@ -1681,7 +1733,6 @@ thread, navigate to the next thread in the parent search buffer." (if (= (point) (notmuch-show-message-top)) (notmuch-show-goto-message-previous) (notmuch-show-move-to-message-top)) - (notmuch-show-mark-read) (notmuch-show-message-adjust)) (defun notmuch-show-next-open-message (&optional pop-at-end) @@ -1696,9 +1747,7 @@ to show, nil otherwise." (while (and (setq r (notmuch-show-goto-message-next)) (not (notmuch-show-message-visible-p)))) (if r - (progn - (notmuch-show-mark-read) - (notmuch-show-message-adjust)) + (notmuch-show-message-adjust) (if pop-at-end (notmuch-show-next-thread) (goto-char (point-max)))) @@ -1711,9 +1760,7 @@ to show, nil otherwise." (while (and (setq r (notmuch-show-goto-message-next)) (not (notmuch-show-get-prop :match)))) (if r - (progn - (notmuch-show-mark-read) - (notmuch-show-message-adjust)) + (notmuch-show-message-adjust) (goto-char (point-max))))) (defun notmuch-show-open-if-matched () @@ -1724,8 +1771,7 @@ to show, nil otherwise." (defun notmuch-show-goto-first-wanted-message () "Move to the first open message and mark it read" (goto-char (point-min)) - (if (notmuch-show-message-visible-p) - (notmuch-show-mark-read) + (unless (notmuch-show-message-visible-p) (notmuch-show-next-open-message)) (when (eobp) ;; There are no matched non-excluded messages so open all matched @@ -1733,8 +1779,7 @@ to show, nil otherwise." (notmuch-show-mapc 'notmuch-show-open-if-matched) (force-window-update) (goto-char (point-min)) - (if (notmuch-show-message-visible-p) - (notmuch-show-mark-read) + (unless (notmuch-show-message-visible-p) (notmuch-show-next-open-message)))) (defun notmuch-show-previous-open-message () @@ -1744,7 +1789,6 @@ to show, nil otherwise." (notmuch-show-goto-message-previous) (notmuch-show-move-to-message-top)) (not (notmuch-show-message-visible-p)))) - (notmuch-show-mark-read) (notmuch-show-message-adjust)) (defun notmuch-show-view-raw-message () @@ -2055,16 +2099,19 @@ This presumes that the message is available at the selected Mailing List Archive If optional argument MLA is non-nil, use the provided key instead of prompting the user (see `notmuch-show-stash-mlarchive-link-alist')." (interactive) - (notmuch-common-do-stash - (concat (cdr (assoc - (or mla - (let ((completion-ignore-case t)) - (completing-read - "Mailing List Archive: " - notmuch-show-stash-mlarchive-link-alist - nil t nil nil notmuch-show-stash-mlarchive-link-default))) - notmuch-show-stash-mlarchive-link-alist)) - (notmuch-show-get-message-id t)))) + (let ((url (cdr (assoc + (or mla + (let ((completion-ignore-case t)) + (completing-read + "Mailing List Archive: " + notmuch-show-stash-mlarchive-link-alist + nil t nil nil + notmuch-show-stash-mlarchive-link-default))) + notmuch-show-stash-mlarchive-link-alist)))) + (notmuch-common-do-stash + (if (functionp url) + (funcall url (notmuch-show-get-message-id t)) + (concat url (notmuch-show-get-message-id t)))))) (defun notmuch-show-stash-mlarchive-link-and-go (&optional mla) "Copy an ML Archive URI for the current message to the kill-ring and visit it. diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index 7d5f4750..e859cc24 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -290,22 +290,6 @@ Some useful entries are: (beginning-of-line) (get-text-property (point) :notmuch-message-properties))) -;; XXX This should really be a lib function but we are trying to -;; reduce impact on the code base. -(defun notmuch-show-get-prop (prop &optional props) - "This is a tree view overridden version of notmuch-show-get-prop - -It gets property PROP from PROPS or, if PROPS is nil, the current -message in either tree or show. This means that several functions -in notmuch-show now work unchanged in tree as they just need the -correct message properties." - (let ((props (or props - (cond ((eq major-mode 'notmuch-show-mode) - (notmuch-show-get-message-properties)) - ((eq major-mode 'notmuch-tree-mode) - (notmuch-tree-get-message-properties)))))) - (plist-get props prop))) - (defun notmuch-tree-set-message-properties (props) (save-excursion (beginning-of-line) @@ -897,6 +881,15 @@ the same as for the function notmuch-tree." (set-process-filter proc 'notmuch-tree-process-filter) (set-process-query-on-exit-flag proc nil)))) +(defun notmuch-tree-get-query () + "Return the current query in this tree buffer" + (if notmuch-tree-query-context + (concat notmuch-tree-basic-query + " and (" + notmuch-tree-query-context + ")") + notmuch-tree-basic-query)) + (defun notmuch-tree (&optional query query-context target buffer-name open-target) "Display threads matching QUERY in Tree View. diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 1adea9c2..b44a907a 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -580,7 +580,8 @@ This function advances the next thread when finished." (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 @@ -649,12 +650,12 @@ of the result." 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\" +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)) @@ -862,6 +863,10 @@ PROMPT is the string to prompt with." (concat "tag:" (notmuch-escape-boolean-term tag))) (process-lines notmuch-command "search" "--output=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) @@ -879,7 +884,11 @@ PROMPT is the string to prompt with." (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.") |