]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
emacs: add support for replying just to the sender
[notmuch] / emacs / notmuch.el
index a23d0c2031654ec563cd729092bb49d4f94d557a..9ac28887839f02f55d1a2c9ab881bc79c9476485 100644 (file)
@@ -64,7 +64,7 @@
     ("authors" . "%-20s ")
     ("subject" . "%s ")
     ("tags" . "(%s)"))
-  "Search result formating. Supported fields are:
+  "Search result formatting. Supported fields are:
        date, count, authors, subject, tags
 For example:
        (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
@@ -72,6 +72,9 @@ For example:
   :type '(alist :key-type (string) :value-type (string))
   :group 'notmuch)
 
+(defvar notmuch-query-history nil
+  "Variable to store minibuffer history for notmuch queries")
+
 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
   (let ((tag-list
         (with-output-to-string
@@ -161,16 +164,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))
 
@@ -204,7 +214,8 @@ For a mouse binding, return nil."
     (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 "m" 'notmuch-mua-mail)
+    (define-key map "R" 'notmuch-search-reply-to-thread-sender)
+    (define-key map "m" 'notmuch-mua-new-mail)
     (define-key map "s" 'notmuch-search)
     (define-key map "o" 'notmuch-search-toggle-order)
     (define-key map "c" 'notmuch-search-stash-map)
@@ -374,7 +385,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
@@ -417,9 +428,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 ()
+(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)
@@ -433,14 +444,21 @@ Complete list of currently available key bindings:
                         (concat "*"
                                 (truncate-string-to-width subject 32 nil nil t)
                                 "*")
-                        32 nil nil t)))
-      (error "End of search results"))))
+                        32 nil nil t))
+                     crypto-switch)
+      (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 ()
+(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)
+  (interactive "P")
   (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-mua-reply message-id)))
+    (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.
@@ -459,6 +477,44 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
            (error (buffer-substring beg end))
            ))))))
 
+(defun notmuch-tag (query &rest tags)
+  "Add/remove tags in TAGS to messages matching QUERY.
+
+TAGS should be a list of strings of the form \"+TAG\" or \"-TAG\" and
+QUERY should be a string containing the search-query.
+
+Note: Other code should always use this function alter tags of
+messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
+directly, so that hooks specified in notmuch-before-tag-hook and
+notmuch-after-tag-hook will be run."
+  (run-hooks 'notmuch-before-tag-hook)
+  (apply 'notmuch-call-notmuch-process
+        (append (list "tag") tags (list "--" query)))
+  (run-hooks 'notmuch-after-tag-hook))
+
+(defcustom notmuch-before-tag-hook nil
+  "Hooks that are run before tags of a message are modified.
+
+'tags' will contain the tags that are about to be added or removed as
+a list of strings of the form \"+TAG\" or \"-TAG\".
+'query' will be a string containing the search query that determines
+the messages that are about to be tagged"
+
+  :type 'hook
+  :options '(hl-line-mode)
+  :group 'notmuch)
+
+(defcustom notmuch-after-tag-hook nil
+  "Hooks that are run after tags of a message are modified.
+
+'tags' will contain the tags that were added or removed as
+a list of strings of the form \"+TAG\" or \"-TAG\".
+'query' will be a string containing the search query that determines
+the messages that were tagged"
+  :type 'hook
+  :options '(hl-line-mode)
+  :group 'notmuch)
+
 (defun notmuch-search-set-tags (tags)
   (save-excursion
     (end-of-line)
@@ -498,7 +554,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
 
 (defun notmuch-search-add-tag-region (tag beg end)
   (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
-    (notmuch-call-notmuch-process "tag" (concat "+" tag) search-id-string)
+    (notmuch-tag search-id-string (concat "+" tag))
     (save-excursion
       (let ((last-line (line-number-at-pos end))
            (max-line (- (line-number-at-pos (point-max)) 2)))
@@ -512,7 +568,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
 
 (defun notmuch-search-remove-tag-region (tag beg end)
   (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
-    (notmuch-call-notmuch-process "tag" (concat "-" tag) search-id-string)
+    (notmuch-tag search-id-string (concat "-" tag))
     (save-excursion
       (let ((last-line (line-number-at-pos end))
            (max-line (- (line-number-at-pos (point-max)) 2)))
@@ -604,9 +660,9 @@ 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\"
@@ -620,21 +676,18 @@ foreground and blue background."
   ;; 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
@@ -708,13 +761,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)
@@ -768,12 +819,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)
@@ -792,7 +843,7 @@ non-authors is found, assume that all of the authors match."
 (defun notmuch-search-operate-all (action)
   "Add/remove tags from all matching messages.
 
-Tis command adds or removes tags from all messages matching the
+This command adds or removes tags from all messages matching the
 current search terms. When called interactively, this command
 will prompt for tags to be added or removed. Tags prefixed with
 '+' will be added and tags prefixed with '-' will be removed.
@@ -809,8 +860,7 @@ characters as well as `_.+-'.
        (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
          (error "Action must be of the form `+thistag -that_tag'"))
        (setq words (cdr words))))
-    (apply 'notmuch-call-notmuch-process "tag"
-          (append action-split (list notmuch-search-query-string) nil))))
+    (apply 'notmuch-tag notmuch-search-query-string action-split)))
 
 (defun notmuch-search-buffer-title (query)
   "Returns the title for a buffer with notmuch search results."
@@ -839,6 +889,36 @@ 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 "<tab>") 'minibuffer-complete)
+      (read-from-minibuffer prompt nil keymap nil
+                           'notmuch-query-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.
@@ -850,10 +930,12 @@ The optional parameters are used as follows:
                  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 (list (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)
@@ -875,7 +957,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 ()
@@ -896,28 +979,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
+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)
 
 (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)
+      (if (not (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."
@@ -948,7 +1046,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)))
@@ -971,6 +1069,23 @@ current search results AND that are tagged with the given tag."
   (interactive)
   (notmuch-hello))
 
+;;;###autoload
+(defun notmuch-jump-to-recent-buffer ()
+  "Jump to the most recent notmuch buffer (search, show or hello).
+
+If no recent buffer is found, 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)
+      (notmuch))))
+
 (setq mail-user-agent 'notmuch-user-agent)
 
 (provide 'notmuch)