summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKyle Meyer <kyle@kyleam.com>2017-02-25 23:32:07 -0500
committerKyle Meyer <kyle@kyleam.com>2017-03-01 00:00:41 -0500
commit575a326334b9504873cd5c18844676c76e5daef2 (patch)
treea881dbba127879428b283b0d6ff85a65864cf225
parentf4c304c8543c6805fbd0569e8d710d7b32e91a23 (diff)
downloademacs.d-575a326334b9504873cd5c18844676c76e5daef2.tar.gz
Transition to notmuch for main mail setup
-rw-r--r--.gitignore1
-rw-r--r--init.el63
-rw-r--r--lisp/km-gnus.el144
-rw-r--r--lisp/km-mail.el185
-rw-r--r--lisp/km-util.el16
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