Transition to notmuch for main mail setup

5 files changed, 245 insertions, 164 deletions

diff --git a/.gitignore b/.gitignore
index a3da545..f5d2648 100644
--- a/.gitignore
+++ b/.gitignore
@@ -22,3 +22,4 @@ bookmarks
 /.pydoc-names
 /eww-bookmarks
 /lisp/km-emacs-autoloads.el
+/lisp/mail-config.el
diff --git a/init.el b/init.el
index b8942f4..1511424 100644
--- a/init.el
+++ b/init.el
@@ -44,6 +44,9 @@
 (require 'km-util)
 (require 'km-emacs-autoloads nil t)
 
+(setq user-full-name "Kyle Meyer")
+(setq user-mail-address "kyle@kyleam.com")
+
 
 ;;; Appearance
 
@@ -85,7 +88,6 @@
 (define-prefix-command 'km/gnus-summary-prefix-map)
 (define-prefix-command 'km/magit-map)
 (define-prefix-command 'km/magit-wip-map)
-(define-prefix-command 'km/notmuch-show-prefix-map)
 (define-prefix-command 'km/org-prefix-map)
 (define-prefix-command 'km/projectile-ctl-x-4-map)
 (define-prefix-command 'km/python-prefix-map)
@@ -2009,34 +2011,52 @@
 
 ;;; Mail
 
-(use-package notmuch
-  :defer t
-  :init (define-key km/mail-map "n" #'notmuch)
-  :config
-  (setq notmuch-fcc-dirs nil
-        notmuch-search-oldest-first nil)
-  (add-to-list 'notmuch-saved-searches
-               '(:name "today" :query "date:today.." :key "."))
-  (define-key notmuch-show-mode-map (kbd "C-c m") 'km/notmuch-show-prefix-map)
-
-  (define-key km/notmuch-show-prefix-map "p"
-    #'km/notmuch-show-open-github-patch)
-  (define-key km/notmuch-show-prefix-map "i"
-    #'km/notmuch-show-copy-message-id-as-kill))
-
 (use-package message
   :defer t
+  :init
+  (setq message-directory "~/.mail")
   :config
+  (load "mail-config.el")
   (setq message-send-mail-function 'message-send-mail-with-sendmail
         message-sendmail-envelope-from 'header
         message-kill-buffer-on-exit t)
+
+  (defun km/message-confirm-sender ()
+    "Stop sending messages from the wrong address."
+    (unless (y-or-n-p (format "Send message from %s?"
+                              (message-field-value "From")))
+      (user-error "Not sending message")))
+  (add-hook 'message-send-hook #'km/message-confirm-sender)
+
   (add-hook 'message-mode-hook #'flyspell-mode)
   (add-hook 'message-mode-hook #'whitespace-mode))
 
+(use-package notmuch
+  :defer t
+  :init
+  (autoload 'notmuch "notmuch" "Notmuch mail" t)
+  (define-key km/mail-map "n" #'notmuch)
+  :config
+  (setq notmuch-hello-sections '(notmuch-hello-insert-saved-searches
+                                 notmuch-hello-insert-recent-searches))
+  (setq notmuch-archive-tags '("-unread"))
+  (setq notmuch-search-oldest-first nil)
+
+  (setq notmuch-wash-citation-lines-prefix 10)
+  (setq notmuch-wash-citation-lines-suffix 10)
+
+  (define-key notmuch-common-keymap "d" #'notmuch-jump-search)
+  (define-key notmuch-message-mode-map (kbd "C-c C-s") nil)
+  (define-key notmuch-search-mode-map "e" #'notmuch-search-show-thread))
+
 (use-package mml
   :defer t
   :diminish (mml-mode . "ML"))
 
+(use-package org-notmuch
+  :defer t
+  :after org)
+
 (use-package mm-decode
   :defer t
   :config
@@ -2118,13 +2138,15 @@
 (use-package sendmail
   :defer t
   :config
-  (setq sendmail-program "/usr/bin/msmtp"))
+  (setq sendmail-program "/usr/bin/msmtp")
+  (setq mail-specify-envelope-from t)
+  (setq mail-envelope-from 'header))
 
-(use-package km-mail
+(use-package km-gnus
   :defer t
   :after gnus
   :config
-  (add-hook 'message-send-hook #'km/message-confirm-sender)
+
   (add-hook 'kill-emacs-hook #'km/gnus-grace-exit-before-kill-emacs)
 
   (setq gnus-group-sort-function '(gnus-group-sort-by-alphabet
@@ -2220,6 +2242,9 @@
             (cons (propertize " [Mail] " 'face 'font-lock-doc-face)
                   mode-line-misc-info))
       (key-chord-define-global "jg" 'km/mail-map)
+      (after 'notmuch-lib
+        (define-key notmuch-common-keymap "G" #'km/notmuch-sync-mail)
+        (define-key notmuch-common-keymap "g" #'km/notmuch-sync-mail-fast))
       (setq recentf-save-file "~/.emacs.d/cache/recentf-mail")
       (setq save-abbrevs nil)))))
 
diff --git a/lisp/km-gnus.el b/lisp/km-gnus.el
new file mode 100644
index 0000000..39a8842
--- /dev/null
+++ b/lisp/km-gnus.el
@@ -0,0 +1,144 @@
+;;; km-mail.el --- Gnus-related extensions
+
+;; Copyright (C) 2012-2016 Kyle Meyer <kyle@kyleam.com>
+
+;; Author: Kyle Meyer <kyle@kyleam.com>
+;; URL: https://github.com/kyleam/emacs.d
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'dash)
+(require 'projectile)
+(require 'gnus)
+(require 'gnus-group)
+(require 'gnus-topic)
+(require 'gnus-sum)
+(require 'shr)
+
+(require 'km-util)
+
+;; http://www.emacswiki.org/emacs/GnusSync
+(defun km/gnus-grace-exit-before-kill-emacs ()
+  (if (and (fboundp 'gnus-alive-p)
+           (gnus-alive-p))
+      (let ((noninteractive t))
+        (gnus-group-exit))))
+
+(defun km/gnus-group-sort-by-topic (info1 info2)
+  "Sort alphabetically by group topic.
+This allows groups to be ordered by topics even when topic mode
+is off."
+  (require 'gnus-topic)
+  (string< (gnus-group-topic (gnus-info-group info1))
+           (gnus-group-topic (gnus-info-group info2))))
+
+(defun km/gnus-summary-set-current-article ()
+  (unless gnus-summary-buffer
+    (user-error "No summary buffer"))
+  (with-current-buffer gnus-summary-buffer
+    (save-window-excursion (gnus-summary-select-article))))
+
+(defun km/gnus--last-message-link ()
+  (with-current-buffer gnus-article-buffer
+    (save-excursion
+      (goto-char (point-max))
+      (widget-forward -1)
+      (--when-let (or (get-text-property (point) 'gnus-string)
+                      (get-text-property (point) 'shr-url))
+        (kill-new it)))))
+
+(defun km/gnus--gmane-link (&optional perma)
+  (with-current-buffer gnus-original-article-buffer
+    (-when-let* ((blink (message-field-value "Archived-At"))
+                 (link (or (and (string-match "\\`<\\(.*\\)>\\'" blink)
+                                (match-string 1 blink))
+                           blink)))
+      (if perma
+          link
+        (replace-regexp-in-string "\\`http://permalink\.gmane\.org/"
+                                    "http://thread.gmane.org/"
+                                    link)))))
+
+(defun km/gnus-copy-gmane-link-as-kill (&optional perma)
+  (interactive "P")
+  (km/gnus-summary-set-current-article)
+  (with-current-buffer gnus-original-article-buffer
+    (--when-let (km/gnus--gmane-link perma)
+      (kill-new (message it)))))
+
+(defun km/gnus-copy-message-link (follow)
+  "Copy link for current message.
+If it has an \"Archived-At\" header, use that.  Otherwise, get
+the link from the last widget in the buffer.  With prefix
+argument FOLLOW, follow link instead of copying it."
+  (interactive "P")
+  (km/gnus-summary-set-current-article)
+  (with-current-buffer gnus-original-article-buffer
+    (save-excursion
+      (--when-let (or (km/gnus--gmane-link)
+                      (km/gnus--last-message-link))
+        (funcall (if follow
+                     #'browse-url
+                   (lambda (s) (kill-new (message s))))
+                 it)))))
+
+;;;###autoload
+(defun km/gnus-copy-message-id-as-kill ()
+  (interactive)
+  (with-current-buffer gnus-original-article-buffer
+    (--when-let (message-field-value "Message-ID")
+      (kill-new (message "%s" it)))))
+
+(defun km/gnus-open-github-patch ()
+  "Open patch from GitHub email."
+  (interactive)
+  (km/gnus-summary-set-current-article)
+  (km/open-github-patch gnus-original-article-buffer))
+
+(defun km/gnus-summary-catchup (&optional no-next)
+  "Mark all articles as read.
+Don't ask for confirmation.  With prefix argument NO-NEXT, exit
+to group buffer instead of moving to next group."
+  (interactive "P")
+  (let ((gnus-auto-select-next (unless no-next 'quietly)))
+    (gnus-summary-catchup-and-exit nil t)))
+
+(defun km/shr-browse-url-and-goto-next ()
+  "Run `shr-browse-url' followed by `shr-next-link'."
+  (interactive)
+  (shr-browse-url)
+  (shr-next-link))
+
+(defun km/gnus-pipe-to-project ()
+  "Call `gnus-summary-pipe-output' in project root."
+  (interactive)
+  (let ((gnus-summary-pipe-output-default-command
+         (format "cd %s && %s"
+                 (completing-read "Project: "
+                                  (projectile-relevant-known-projects))
+                 (cond
+                  ((not gnus-summary-pipe-output-default-command)
+                   "git am")
+                  ((string-match "\\`cd .* && \\(.*\\)"
+                                 gnus-summary-pipe-output-default-command)
+                   (match-string-no-properties
+                    1 gnus-summary-pipe-output-default-command))
+                  (t
+                   gnus-summary-pipe-output-default-command)))))
+    (call-interactively #'gnus-summary-pipe-output)))
+
+(provide 'km-gnus)
+;;; km-gnus.el ends here
diff --git a/lisp/km-mail.el b/lisp/km-mail.el
index c23ff26..d64ee96 100644
--- a/lisp/km-mail.el
+++ b/lisp/km-mail.el
@@ -20,166 +20,61 @@
 
 ;;; Code:
 
-(require 'dash)
-(require 'projectile)
-(require 'gnus)
-(require 'gnus-group)
-(require 'gnus-topic)
-(require 'gnus-sum)
+(require 'compile)
 (require 'notmuch)
-(require 'shr)
-
-;; http://www.emacswiki.org/emacs/GnusSync
-(defun km/gnus-grace-exit-before-kill-emacs ()
-  (if (and (fboundp 'gnus-alive-p)
-           (gnus-alive-p))
-      (let ((noninteractive t))
-        (gnus-group-exit))))
-
-
-(defun km/gnus-group-sort-by-topic (info1 info2)
-  "Sort alphabetically by group topic.
-This allows groups to be ordered by topics even when topic mode
-is off."
-  (require 'gnus-topic)
-  (string< (gnus-group-topic (gnus-info-group info1))
-           (gnus-group-topic (gnus-info-group info2))))
-
-(defun km/gnus-summary-set-current-article ()
-  (unless gnus-summary-buffer
-    (user-error "No summary buffer"))
-  (with-current-buffer gnus-summary-buffer
-    (save-window-excursion (gnus-summary-select-article))))
-
-(defun km/gnus--last-message-link ()
-  (with-current-buffer gnus-article-buffer
-    (save-excursion
-      (goto-char (point-max))
-      (widget-forward -1)
-      (--when-let (or (get-text-property (point) 'gnus-string)
-                      (get-text-property (point) 'shr-url))
-        (kill-new it)))))
-
-(defun km/gnus--gmane-link (&optional perma)
-  (with-current-buffer gnus-original-article-buffer
-    (-when-let* ((blink (message-field-value "Archived-At"))
-                 (link (or (and (string-match "\\`<\\(.*\\)>\\'" blink)
-                                (match-string 1 blink))
-                           blink)))
-      (if perma
-          link
-        (replace-regexp-in-string "\\`http://permalink\.gmane\.org/"
-                                    "http://thread.gmane.org/"
-                                    link)))))
-
-(defun km/gnus-copy-gmane-link-as-kill (&optional perma)
-  (interactive "P")
-  (km/gnus-summary-set-current-article)
-  (with-current-buffer gnus-original-article-buffer
-    (--when-let (km/gnus--gmane-link perma)
-      (kill-new (message it)))))
-
-(defun km/gnus-copy-message-link (follow)
-  "Copy link for current message.
-If it has an \"Archived-At\" header, use that.  Otherwise, get
-the link from the last widget in the buffer.  With prefix
-argument FOLLOW, follow link instead of copying it."
-  (interactive "P")
-  (km/gnus-summary-set-current-article)
-  (with-current-buffer gnus-original-article-buffer
-    (save-excursion
-      (--when-let (or (km/gnus--gmane-link)
-                      (km/gnus--last-message-link))
-        (funcall (if follow
-                     #'browse-url
-                   (lambda (s) (kill-new (message s))))
-                 it)))))
 
-;;;###autoload
-(defun km/gnus-copy-message-id-as-kill ()
-  (interactive)
-  (with-current-buffer gnus-original-article-buffer
-    (--when-let (message-field-value "Message-ID")
-      (kill-new (message "%s" it)))))
-
-(defun km/open-github-patch (buffer)
-  "Find GitHub patch link in BUFFER and show it in a new buffer."
-  (let ((url
-         (with-current-buffer buffer
-           (save-excursion
-             (goto-char (point-min))
-             (if (re-search-forward "https://github.com/.*\\.patch" nil t)
-                 (match-string-no-properties 0)
-               (user-error "No patch found"))))))
-    (with-current-buffer (get-buffer-create
-                          (generate-new-buffer-name "*mail-github-patch*"))
-      (url-insert-file-contents url)
-      (diff-mode)
-      (view-mode 1)
-      (pop-to-buffer (current-buffer)))))
-
-(defun km/gnus-open-github-patch ()
-  "Open patch from GitHub email."
-  (interactive)
-  (km/gnus-summary-set-current-article)
-  (km/open-github-patch gnus-original-article-buffer))
+(require 'km-util)
 
+;;;###autoload
 (defun km/notmuch-show-open-github-patch ()
   "Open patch from GitHub email."
   (interactive)
   (with-current-notmuch-show-message
-   (km/mail-open-github-patch (current-buffer))))
-
-(defun km/gnus-summary-catchup (&optional no-next)
-  "Mark all articles as read.
-Don't ask for confirmation.  With prefix argument NO-NEXT, exit
-to group buffer instead of moving to next group."
-  (interactive "P")
-  (let ((gnus-auto-select-next (unless no-next 'quietly)))
-    (gnus-summary-catchup-and-exit nil t)))
-
-(defun km/shr-browse-url-and-goto-next ()
-  "Run `shr-browse-url' followed by `shr-next-link'."
-  (interactive)
-  (shr-browse-url)
-  (shr-next-link))
-
-(defun km/gnus-pipe-to-project ()
-  "Call `gnus-summary-pipe-output' in project root."
-  (interactive)
-  (let ((gnus-summary-pipe-output-default-command
-         (format "cd %s && %s"
-                 (completing-read "Project: "
-                                  (projectile-relevant-known-projects))
-                 (cond
-                  ((not gnus-summary-pipe-output-default-command)
-                   "git am")
-                  ((string-match "\\`cd .* && \\(.*\\)"
-                                 gnus-summary-pipe-output-default-command)
-                   (match-string-no-properties
-                    1 gnus-summary-pipe-output-default-command))
-                  (t
-                   gnus-summary-pipe-output-default-command)))))
-    (call-interactively #'gnus-summary-pipe-output)))
+   (km/open-github-patch (current-buffer))))
 
 
-;;; Message mode
+;;; Mail sync
 
-(defun km/message-confirm-sender ()
-  "Stop sending message from the wrong address."
-  (unless (y-or-n-p (format "Send message from %s?"
-                            (message-field-value "From")))
-    (user-error "Not sending message")))
+(defun mail-sync-log-buffer (buf _)
+  (let ((bstring (with-current-buffer buf
+                   (buffer-string))))
+    (with-current-buffer (get-buffer-create "*mail-sync-log*")
+      (goto-char (point-max))
+      (insert "\n\n\n")
+      (insert bstring))))
+
+(defvar mail-sync-calling-buffer nil)
+(defun mail-sync-refresh-caller (_ exit)
+  (when (equal exit "finished\n")
+    (when (and mail-sync-calling-buffer
+               (buffer-live-p mail-sync-calling-buffer))
+      (with-current-buffer mail-sync-calling-buffer
+        (notmuch-refresh-this-buffer))))
+  (setq mail-sync-calling-buffer nil))
 
-
-;;; Notmuch
+;;;###autoload
+(define-compilation-mode mail-sync-mode "Mail-sync"
+  "Sync mail, logging output to *mail-sync-log*."
+  (set (make-local-variable 'compilation-finish-functions)
+       '(mail-sync-log-buffer mail-sync-refresh-caller)))
 
-(require 'notmuch)
+;;;###autoload
+(defun km/notmuch-sync-mail (&optional cmd-append)
+  (interactive (list (and current-prefix-arg
+                          (read-string "sync-mail args: "))))
+  (setq mail-sync-calling-buffer (current-buffer))
+  (let ((default-directory (expand-file-name "~/"))
+        (display-buffer-overriding-action
+         '(display-buffer-below-selected)))
+    (compilation-start (concat "sync-mail"
+                               (and cmd-append " ")
+                               cmd-append)
+                       'mail-sync-mode)))
 
 ;;;###autoload
-(defun km/notmuch-show-copy-message-id-as-kill ()
+(defun km/notmuch-sync-mail-fast ()
   (interactive)
-  (kill-new (message "%s" (notmuch-show-get-message-id))))
+  (km/notmuch-sync-mail "--fast"))
 
 (provide 'km-mail)
 ;;; km-mail.el ends here
diff --git a/lisp/km-util.el b/lisp/km-util.el
index 40672d7..1678161 100644
--- a/lisp/km-util.el
+++ b/lisp/km-util.el
@@ -45,5 +45,21 @@ point in the buffer."
             (progn (goto-char (region-end)) (1+ (point-at-eol))))
     (list (point-min) (point-max))))
 
+(defun km/open-github-patch (buffer)
+  "Find GitHub patch link in BUFFER and show it in a new buffer."
+  (let ((url
+         (with-current-buffer buffer
+           (save-excursion
+             (goto-char (point-min))
+             (if (re-search-forward "https://github.com/.*\\.patch" nil t)
+                 (match-string-no-properties 0)
+               (user-error "No patch found"))))))
+    (with-current-buffer (get-buffer-create
+                          (generate-new-buffer-name "*mail-github-patch*"))
+      (url-insert-file-contents url)
+      (diff-mode)
+      (view-mode 1)
+      (pop-to-buffer (current-buffer)))))
+
 (provide 'km-util)
 ;;; km-util.el ends here