]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
emacs: logically group def{custom,face}s
[notmuch] / emacs / notmuch.el
index c1827cc2691f66cb0f566668fede9116bfb62776..3602361bd93b5d4679e92ea2d3712248c188c32d 100644 (file)
@@ -70,7 +70,7 @@ 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")
@@ -164,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))
 
@@ -192,7 +199,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 +214,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)
@@ -299,27 +308,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 +345,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 +358,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.
@@ -438,13 +454,19 @@ Complete list of currently available key bindings:
                                 "*")
                         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.
@@ -488,7 +510,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 +521,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
@@ -646,32 +668,33 @@ 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\"
 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)
@@ -805,12 +828,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)
@@ -885,7 +908,7 @@ PROMPT is the string to prompt with."
                      "subject:" "attachment:")
                (mapcar (lambda (tag)
                          (concat "tag:" tag))
-                       (process-lines "notmuch" "search" "--output=tags" "*")))))
+                       (process-lines notmuch-command "search" "--output=tags" "*")))))
     (let ((keymap (copy-keymap minibuffer-local-map))
          (minibuffer-completion-table
           (completion-table-dynamic
@@ -920,6 +943,8 @@ The optional parameters are used as follows:
   (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)
@@ -963,28 +988,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
-  :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)
+      (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."
@@ -1038,6 +1078,41 @@ 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-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)