2019-03-17 09:27:18 +01:00
|
|
|
;; Notmuch
|
|
|
|
|
2019-03-17 20:18:01 +01:00
|
|
|
(require 'init-message)
|
|
|
|
(require 'patch-notmuch)
|
2019-03-18 18:55:24 +01:00
|
|
|
(require 'init-notmuch-sync)
|
2019-03-17 20:18:01 +01:00
|
|
|
|
|
|
|
;; To find files matching email:
|
|
|
|
;; notmuch search --output=files FOO
|
2019-03-18 10:22:29 +01:00
|
|
|
;; The following is good enough for multiple-account support if they use the
|
|
|
|
;; same SMTP server.
|
2019-03-17 20:18:01 +01:00
|
|
|
(setq notmuch-fcc-dirs
|
2019-03-18 10:22:29 +01:00
|
|
|
'(("mail@ambrevar.xyz" . "mail/Sent +sent -inbox -unread")
|
|
|
|
("pierre@atlas.engineer" . "atlas/Sent +sent -inbox -unread")))
|
2019-03-17 20:18:01 +01:00
|
|
|
|
2019-03-19 13:54:17 +01:00
|
|
|
(setq notmuch-saved-searches
|
|
|
|
`((:name "inbox" :query "tag:inbox and date:1w.." :key ,(kbd "i"))
|
|
|
|
(:name "unread" :query "tag:unread" :key ,(kbd "u"))
|
|
|
|
(:name "flagged" :query "tag:flagged" :key ,(kbd "f"))
|
|
|
|
(:name "sent" :query "tag:sent and date:1w.." :key ,(kbd "t"))
|
|
|
|
(:name "drafts" :query "tag:draft" :key ,(kbd "d"))
|
|
|
|
(:name "all mail" :query "date:2w.." :key ,(kbd "a"))))
|
|
|
|
|
2019-05-18 15:32:49 +02:00
|
|
|
(defun ambrevar/notmuch-change-sender (&optional sender)
|
2019-03-17 20:18:01 +01:00
|
|
|
(interactive)
|
|
|
|
(unless (derived-mode-p 'message-mode)
|
|
|
|
(error "Must be in message mode"))
|
2019-05-18 15:32:49 +02:00
|
|
|
(unless sender
|
|
|
|
(setq sender (completing-read "Sender: " (mapcar 'car notmuch-fcc-dirs))))
|
|
|
|
(message-replace-header "From" sender)
|
|
|
|
(message-remove-header "Fcc")
|
|
|
|
(notmuch-fcc-header-setup))
|
2019-03-17 20:18:01 +01:00
|
|
|
|
2019-03-17 09:27:18 +01:00
|
|
|
(when (require 'helm-notmuch nil t)
|
2019-03-17 20:18:01 +01:00
|
|
|
(setq helm-notmuch-match-incomplete-words t)
|
|
|
|
(dolist (map (list notmuch-search-mode-map
|
|
|
|
notmuch-hello-mode-map
|
|
|
|
notmuch-show-mode-map
|
|
|
|
notmuch-tree-mode-map))
|
2019-04-05 15:08:35 +02:00
|
|
|
(define-key map "s" 'helm-notmuch))
|
|
|
|
(define-key notmuch-show-mode-map (kbd "M-s f") #'helm-imenu))
|
2019-03-18 18:55:24 +01:00
|
|
|
|
2019-12-08 16:12:58 +01:00
|
|
|
(when (require 'ol-notmuch nil 'noerror)
|
2019-03-18 10:51:26 +01:00
|
|
|
(dolist (map (list notmuch-show-mode-map notmuch-tree-mode-map))
|
|
|
|
(define-key map (kbd "C-c C-t") 'org-capture))
|
|
|
|
(add-to-list 'org-capture-templates
|
|
|
|
`("t" "Mark e-mail in agenda" entry (file+headline ,(car org-agenda-files) "E-mails")
|
|
|
|
"* %?\nSCHEDULED: %(org-insert-time-stamp (org-read-date nil t \"++7d\" nil (notmuch-show-get-date)))\n%a\n")))
|
2019-03-17 09:27:18 +01:00
|
|
|
|
2019-03-17 20:18:01 +01:00
|
|
|
|
|
|
|
(defun notmuch-show-bounce (&optional address)
|
|
|
|
"Bounce the current message."
|
|
|
|
(interactive "sBounce To: ")
|
|
|
|
(notmuch-show-view-raw-message)
|
|
|
|
(message-resend address))
|
|
|
|
|
|
|
|
(define-key notmuch-show-mode-map "b" #'notmuch-show-bounce)
|
|
|
|
|
2019-04-25 09:34:20 +02:00
|
|
|
;; Improve address completion with Helm.
|
|
|
|
(setq notmuch-address-use-company nil)
|
|
|
|
(setq notmuch-address-selection-function
|
|
|
|
(lambda (prompt collection initial-input)
|
|
|
|
(completing-read prompt (cons initial-input collection) nil t nil 'notmuch-address-history)))
|
|
|
|
|
2019-06-15 11:21:46 +02:00
|
|
|
|
|
|
|
;; The following can be used to use notmuch with debbugs, but it won't retrieve
|
|
|
|
;; the emails so this has to be done separately.
|
|
|
|
(defun debbugs-notmuch-select-report (&rest _)
|
|
|
|
(let* ((status (debbugs-gnu-current-status))
|
|
|
|
(id (cdr (assq 'id status)))
|
|
|
|
(merged (cdr (assq 'mergedwith status))))
|
|
|
|
(setq merged (if (listp merged) merged (list merged)))
|
|
|
|
(unless id
|
|
|
|
(user-error "No bug report on the current line"))
|
|
|
|
(let ((address (format "%s@debbugs.gnu.org" id))
|
|
|
|
(merged-addresses (string-join (mapcar (lambda (id)
|
|
|
|
(format "%s@debbugs.gnu.org %s" id))
|
|
|
|
merged)
|
|
|
|
" ")))
|
|
|
|
(notmuch-search (format "%s %s" address merged-addresses)))))
|
|
|
|
|
2020-04-03 11:12:18 +02:00
|
|
|
(defun ambrevar/notmuch-poll-async ()
|
|
|
|
"Like `notmuch-poll' but asynchronous."
|
|
|
|
(notmuch-start-notmuch
|
|
|
|
"notmuch-new"
|
|
|
|
nil
|
|
|
|
(lambda (_proc change)
|
2020-09-08 14:59:19 +02:00
|
|
|
(with-current-buffer (cl-find-if (lambda (b)
|
2020-04-03 11:12:18 +02:00
|
|
|
(with-current-buffer b
|
|
|
|
(eq major-mode 'notmuch-search-mode)))
|
|
|
|
(buffer-list))
|
|
|
|
(notmuch-refresh-this-buffer))
|
|
|
|
(message "notmuch-new: %s" change))
|
|
|
|
"new"))
|
|
|
|
|
|
|
|
;; TODO: This is a bit brittle since it only works if the given gpg file exists.
|
2019-09-10 11:28:41 +02:00
|
|
|
;; Is there a way to unlock gpg manually without a file?
|
2020-04-03 11:12:18 +02:00
|
|
|
(defun ambrevar/notmuch-poll-after-gpg-unlock ()
|
|
|
|
"Unlock GPG and get Notmuch mail."
|
|
|
|
;; The gpg unlock needs to be asynchronous for EXWM, or else pinentry-emacs
|
|
|
|
;; will be blocked.
|
2019-09-10 11:28:41 +02:00
|
|
|
(let ((sentinel (lambda (_process _args)
|
2020-04-03 11:12:18 +02:00
|
|
|
(ambrevar/notmuch-poll-async))))
|
2019-09-10 11:28:41 +02:00
|
|
|
(make-process :name "gpg" :buffer nil
|
2020-04-03 11:12:18 +02:00
|
|
|
:command (list "gpg" "--decrypt"
|
|
|
|
(expand-file-name
|
2020-09-08 14:59:19 +02:00
|
|
|
(or (cl-find-if (lambda (agenda) (string-suffix-p ".gpg" agenda))
|
2020-04-03 11:12:18 +02:00
|
|
|
org-agenda-files)
|
|
|
|
(error "No .gpg file in `org-agenda-files'."))))
|
2019-09-10 11:28:41 +02:00
|
|
|
:sentinel sentinel)))
|
|
|
|
|
2020-04-03 11:12:18 +02:00
|
|
|
(advice-add 'notmuch-poll-and-refresh-this-buffer
|
|
|
|
:override #'ambrevar/notmuch-poll-after-gpg-unlock)
|
|
|
|
|
|
|
|
;; (advice-add 'debbugs-gnu-select-report :override #'debbugs-notmuch-select-report)
|
2019-09-10 11:28:41 +02:00
|
|
|
|
2020-11-25 10:20:17 +01:00
|
|
|
;; Extend `notmuch-show-stash-mlarchive-link':
|
|
|
|
(defvar ambrevar/known-mailing-list-archives
|
2020-12-01 10:09:22 +01:00
|
|
|
'(("help-guix@gnu.org" . "guix")
|
|
|
|
("guix-devel@gnu.org" . "guix")
|
|
|
|
("debbugs.gnu.org" . "guix"))
|
2020-11-26 10:52:02 +01:00
|
|
|
"Alist of mail adresses and their Yhetil name.
|
|
|
|
Alternatively the key may just be a host name against which a
|
|
|
|
recipient will be matched.")
|
2020-11-25 10:20:17 +01:00
|
|
|
|
|
|
|
(defun ambrevar/guess-yhetil-link (message-id)
|
2020-12-01 10:09:22 +01:00
|
|
|
(let* ((all-addresses (mapcar #'second
|
|
|
|
(mail-extract-address-components
|
|
|
|
(mapconcat #'identity
|
|
|
|
(list
|
|
|
|
(notmuch-show-get-header :To)
|
|
|
|
(notmuch-show-get-header :Cc))
|
|
|
|
", ")
|
|
|
|
'all)))
|
|
|
|
(match-address (lambda (address-or-host)
|
|
|
|
(if (string-match "@" address-or-host)
|
|
|
|
(member address-or-host all-addresses)
|
|
|
|
(seq-find (lambda (address)
|
|
|
|
(string-match address-or-host address))
|
|
|
|
all-addresses))))
|
|
|
|
(mailing-list (alist-get
|
|
|
|
(seq-find match-address
|
|
|
|
(mapcar #'car ambrevar/known-mailing-list-archives))
|
|
|
|
ambrevar/known-mailing-list-archives
|
|
|
|
nil nil #'string=)))
|
2020-11-25 10:20:17 +01:00
|
|
|
(when mailing-list
|
|
|
|
(concat "https://yhetil.org/"
|
|
|
|
mailing-list "/" message-id))))
|
|
|
|
|
|
|
|
(add-to-list 'notmuch-show-stash-mlarchive-link-alist
|
|
|
|
(cons "Yhetil" #'ambrevar/guess-yhetil-link))
|
2020-11-26 10:52:02 +01:00
|
|
|
|
|
|
|
(setq notmuch-show-stash-mlarchive-link-default "Yhetil")
|
2020-11-25 10:20:17 +01:00
|
|
|
|
2019-03-17 09:27:18 +01:00
|
|
|
(provide 'init-notmuch)
|