-; 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 <http://www.gnu.org/licenses/>.
-;
-; Authors: Carl Worth <cworth@cworth.org>
-
-; 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 <notmuch@notmuchmail.org> (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 <http://www.gnu.org/licenses/>.
+;;
+;; Authors: Carl Worth <cworth@cworth.org>
+
+;; 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 <notmuch@notmuchmail.org> (subscription is not
+;; required, but is available from http://notmuchmail.org).
(eval-when-compile (require 'cl))
+(require 'crm)
(require 'mm-view)
(require 'message)
(setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
\(\"subject\" . \"%s\"\)\)\)"
:type '(alist :key-type (string) :value-type (string))
- :group 'notmuch)
+ :group 'notmuch-search)
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries")
-(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
+(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 <tab>
+ ;; 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))
"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
"\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))
"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)))
(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)
(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)))
'((((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)
(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)
(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.
"*")
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.
: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.
the messages that were tagged"
:type 'hook
:options '(hl-line-mode)
- :group 'notmuch)
+ :group 'notmuch-hooks)
(defun notmuch-search-set-tags (tags)
(save-excursion
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.")
(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")))
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-author-propertize (authors)
(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
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
+ (let ((words actions))
+ (when (null words) (error "No operations given"))
+ (while words
+ (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
+ (error "Action must be of the form `+this_tag' or `-that_tag'"))
+ (setq words (cdr words))))
+ (apply 'notmuch-tag notmuch-search-query-string actions))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
(t (list string)))))))
;; this was simpler than convincing completing-read to accept spaces:
(define-key keymap (kbd "<tab>") 'minibuffer-complete)
- (read-from-minibuffer prompt nil keymap nil
- 'notmuch-query-history nil nil))))
+ (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 (list (notmuch-read-query "Notmuch 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)
(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."
(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)
projects / notmuch / blobdiff