diff options
Diffstat (limited to 'emacs/notmuch.el')
| -rw-r--r-- | emacs/notmuch.el | 351 |
1 files changed, 208 insertions, 143 deletions
diff --git a/emacs/notmuch.el b/emacs/notmuch.el index fde23779..cd04ffda 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 <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) @@ -70,17 +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) (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)) @@ -139,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 @@ -164,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)) @@ -192,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))) @@ -206,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) @@ -262,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))) @@ -299,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) @@ -331,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) @@ -343,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. @@ -424,27 +467,27 @@ Complete list of currently available key bindings: "Display the currently selected thread." (interactive "P") (let ((thread-id (notmuch-search-find-thread-id)) - (subject (notmuch-search-find-subject))) + (subject (notmuch-prettify-subject (notmuch-search-find-subject)))) (if (> (length thread-id) 0) (notmuch-show thread-id (current-buffer) notmuch-search-query-string - ;; name the buffer based on notmuch-search-find-subject - (if (string-match "^[ \t]*$" subject) - "[No Subject]" - (truncate-string-to-width - (concat "*" - (truncate-string-to-width subject 32 nil nil t) - "*") - 32 nil nil t)) + ;; Name the buffer based on the subject. + (concat "*" (truncate-string-to-width subject 30 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. @@ -488,7 +531,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. @@ -499,7 +542,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 @@ -603,7 +646,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.") @@ -624,17 +667,16 @@ This function advances the next thread when finished." (goto-char (point-max)) (if (eq status 'signal) (insert "Incomplete search results (search process was killed).\n")) - (if (eq status 'exit) - (progn - (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))) - (insert "\n") - (if (and atbob - (not (string= notmuch-search-target-thread "found"))) - (set 'never-found-target-thread t)))))) + (when (eq status 'exit) + (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.") + (unless (= exit-status 0) + (insert (format " (process returned %d)" exit-status))) + (insert "\n") + (if (and atbob + (not (string= notmuch-search-target-thread "found"))) + (set 'never-found-target-thread t))))) (when (and never-found-target-thread notmuch-search-target-line) (goto-char (point-min)) @@ -655,7 +697,8 @@ 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." @@ -806,15 +849,15 @@ non-authors is found, assume that all of the authors match." (if (/= (match-beginning 1) line) (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n"))) (let ((beg (point))) - (notmuch-search-show-result date count authors subject tags) + (notmuch-search-show-result date count authors + (notmuch-prettify-subject subject) tags) (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) - (set 'notmuch-search-target-thread "found")))) + (when (string= thread-id notmuch-search-target-thread) + (set 'found-target beg) + (set 'notmuch-search-target-thread "found"))) (set 'line (match-end 0))) (set 'more nil) (while (and (< line (length string)) (= (elt string line) ?\n)) @@ -826,7 +869,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 @@ -837,16 +880,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." @@ -902,21 +945,25 @@ PROMPT is the string to prompt with." (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) @@ -990,7 +1037,7 @@ Note that the recommended way of achieving the same is using :type '(choice (const :tag "notmuch new" nil) (const :tag "Disabled" "") (string :tag "Custom script")) - :group 'notmuch) + :group 'notmuch-external) (defun notmuch-poll () "Run \"notmuch new\" or an external script to import mail. @@ -999,8 +1046,8 @@ Invokes `notmuch-poll-script', \"notmuch new\", or does nothing depending on the value of `notmuch-poll-script'." (interactive) (if (stringp notmuch-poll-script) - (if (not (string= notmuch-poll-script "")) - (call-process notmuch-poll-script nil nil)) + (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 () @@ -1055,21 +1102,39 @@ 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-jump-to-recent-buffer () - "Jump to the most recent notmuch buffer (search, show or hello). +(defun notmuch-cycle-notmuch-buffers () + "Cycle through any existing notmuch buffers (search, show or hello). -If no recent buffer is found, run `notmuch'." +If the current buffer is the only notmuch buffer, bury it. If no +notmuch buffers exist, run `notmuch'." (interactive) - (let ((last - (loop for buffer in (buffer-list) - if (with-current-buffer buffer - (memq major-mode '(notmuch-show-mode - notmuch-search-mode - notmuch-hello-mode))) - return buffer))) - (if last - (switch-to-buffer last) + + (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) |