]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
emacs: add completion to "tag all" operation ("*" binding)
[notmuch] / emacs / notmuch.el
index ef4dcc78130eec43ed76b39df5099cebb2af0d0c..291eca2e0b2dba51dc3d213f75abd36fd4505e98 100644 (file)
@@ -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
@@ -199,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)))
@@ -270,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)))
@@ -307,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)
@@ -339,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)
@@ -351,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.
@@ -502,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.
@@ -513,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
@@ -617,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.")
@@ -643,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")))
@@ -669,7 +704,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."
@@ -840,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
@@ -851,16 +887,17 @@ 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
+  (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."
@@ -916,21 +953,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)
@@ -1004,7 +1045,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.
@@ -1013,8 +1054,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 ()