notmuch: Patch helm, notmuch, init message
parent
5ef5fa331b
commit
080efc54cc
|
@ -0,0 +1,51 @@
|
||||||
|
;; Message mode
|
||||||
|
;; This is common to Gnus, mu4e, notmuch, etc.
|
||||||
|
|
||||||
|
(setq mm-default-directory "~/temp" ; Where to save attachments.
|
||||||
|
message-kill-buffer-on-exit t
|
||||||
|
;; Sending mail:
|
||||||
|
mail-specify-envelope-from t
|
||||||
|
mail-envelope-from 'header
|
||||||
|
message-send-mail-function 'smtpmail-send-it)
|
||||||
|
|
||||||
|
(load "~/personal/mail/smtpmail.el" 'noerror)
|
||||||
|
|
||||||
|
;; TODO: Use the following to automatically set the From: field when replying.
|
||||||
|
;; message-alternative-emails
|
||||||
|
|
||||||
|
;; Sign messages by default.
|
||||||
|
(add-hook 'message-setup-hook 'mml-secure-sign-pgpmime)
|
||||||
|
|
||||||
|
(defun message-recipients ()
|
||||||
|
"Return a list of all recipients in the message, looking at TO, CC and BCC.
|
||||||
|
|
||||||
|
Each recipient is in the format of `mail-extract-address-components'."
|
||||||
|
(mapcan (lambda (header)
|
||||||
|
(let ((header-value (message-fetch-field header)))
|
||||||
|
(and
|
||||||
|
header-value
|
||||||
|
(mail-extract-address-components header-value t))))
|
||||||
|
'("To" "Cc" "Bcc")))
|
||||||
|
|
||||||
|
(defun message-all-epg-keys-available-p ()
|
||||||
|
"Return non-nil if the pgp keyring has a public key for each recipient."
|
||||||
|
(require 'epa)
|
||||||
|
(let ((context (epg-make-context epa-protocol)))
|
||||||
|
(catch 'break
|
||||||
|
(dolist (recipient (message-recipients))
|
||||||
|
(let ((recipient-email (cadr recipient)))
|
||||||
|
(when (and recipient-email (not (epg-list-keys context recipient-email)))
|
||||||
|
(throw 'break nil))))
|
||||||
|
t)))
|
||||||
|
|
||||||
|
(defun message-sign-encrypt-if-all-keys-available ()
|
||||||
|
"Add MML tag to encrypt message when there is a key for each recipient.
|
||||||
|
|
||||||
|
Consider adding this function to `message-send-hook' to
|
||||||
|
systematically send encrypted emails when possible."
|
||||||
|
(when (message-all-epg-keys-available-p)
|
||||||
|
(mml-secure-message-sign-encrypt)))
|
||||||
|
|
||||||
|
;; (add-hook 'message-send-hook #'message-sign-encrypt-if-all-keys-available)
|
||||||
|
|
||||||
|
(provide 'init-message)
|
|
@ -1,5 +1,23 @@
|
||||||
;; Notmuch
|
;; Notmuch
|
||||||
|
|
||||||
|
(require 'init-message)
|
||||||
|
(require 'patch-notmuch)
|
||||||
|
|
||||||
|
;; To find files matching email:
|
||||||
|
;; notmuch search --output=files FOO
|
||||||
|
(setq notmuch-fcc-dirs
|
||||||
|
'(("mail@ambrevar.xyz" . "mail/Sent +sent")
|
||||||
|
("pierre@atlas.engineer" . "atlas/Sent")))
|
||||||
|
|
||||||
|
(defun notmuch-change-sender ()
|
||||||
|
(interactive)
|
||||||
|
(unless (derived-mode-p 'message-mode)
|
||||||
|
(error "Must be in message mode"))
|
||||||
|
(let ((sender (completing-read "Sender: " (mapcar 'car notmuch-fcc-dirs))))
|
||||||
|
(message-replace-header "From" sender)
|
||||||
|
(message-remove-header "Fcc")
|
||||||
|
(notmuch-fcc-header-setup)))
|
||||||
|
|
||||||
(when (require 'patch-helm nil 'noerror)
|
(when (require 'patch-helm nil 'noerror)
|
||||||
(helm-defswitcher
|
(helm-defswitcher
|
||||||
"notmuch"
|
"notmuch"
|
||||||
|
@ -13,16 +31,22 @@
|
||||||
notmuch-hello))
|
notmuch-hello))
|
||||||
|
|
||||||
(when (require 'helm-notmuch nil t)
|
(when (require 'helm-notmuch nil t)
|
||||||
;; TODO: Send PR.
|
(setq helm-notmuch-match-incomplete-words t)
|
||||||
(defun helm-notmuch-maybe-match-incomplete (pattern)
|
(require 'patch-helm-notmuch)
|
||||||
(if helm-notmuch-match-incomplete-words
|
(dolist (map (list notmuch-search-mode-map
|
||||||
(concat (mapconcat #'identity (split-string pattern) "* ") "*")
|
notmuch-hello-mode-map
|
||||||
;; (if (string-match-p "[[:alnum:]]$" pattern)
|
notmuch-show-mode-map
|
||||||
;; (concat pattern "*")
|
notmuch-tree-mode-map))
|
||||||
;; pattern)
|
|
||||||
pattern))
|
|
||||||
|
|
||||||
(dolist (map (list notmuch-search-mode-map notmuch-hello-mode-map notmuch-show-mode-map))
|
|
||||||
(define-key map "s" 'helm-notmuch)))
|
(define-key map "s" 'helm-notmuch)))
|
||||||
|
|
||||||
|
(require 'org-notmuch nil 'noerror)
|
||||||
|
|
||||||
|
(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)
|
||||||
|
|
||||||
(provide 'init-notmuch)
|
(provide 'init-notmuch)
|
||||||
|
|
|
@ -0,0 +1,77 @@
|
||||||
|
;; TODO: Send PR.
|
||||||
|
|
||||||
|
(defun helm-notmuch-candidate-formatter (cand)
|
||||||
|
"Format the single entry CAND."
|
||||||
|
(if (not (string-match-p "\\[" cand))
|
||||||
|
""
|
||||||
|
(let ((text (substring cand (+ 2 helm-notmuch-thread-id-length)))
|
||||||
|
(id (substring cand 0 helm-notmuch-thread-id-length))
|
||||||
|
cstart astart alen tstart tags)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert text)
|
||||||
|
(goto-char (point-min))
|
||||||
|
|
||||||
|
;; Align message counts
|
||||||
|
(search-forward "[")
|
||||||
|
(setq cstart (point))
|
||||||
|
(search-forward "]")
|
||||||
|
(save-excursion
|
||||||
|
(save-restriction
|
||||||
|
(narrow-to-region cstart (point))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(when (re-search-forward "\([0-9]\+\)" nil t)
|
||||||
|
(replace-match ""))))
|
||||||
|
(forward-char)
|
||||||
|
(just-one-space (- helm-notmuch-thread-count-width
|
||||||
|
(- (point) cstart)))
|
||||||
|
(forward-char)
|
||||||
|
|
||||||
|
;; Align (and truncate) authors
|
||||||
|
(setq astart (point))
|
||||||
|
(search-forward ";")
|
||||||
|
(delete-char -1)
|
||||||
|
(setq alen (- (point) astart))
|
||||||
|
(if (> alen helm-notmuch-author-width)
|
||||||
|
(progn
|
||||||
|
(delete-region (- (point) (- alen
|
||||||
|
(- helm-notmuch-author-width 3)))
|
||||||
|
(point))
|
||||||
|
(insert "..."))
|
||||||
|
(just-one-space (- (+ helm-notmuch-author-width 1) alen)))
|
||||||
|
|
||||||
|
;; Colour tags
|
||||||
|
(goto-char (- (point-max) 1))
|
||||||
|
(save-excursion
|
||||||
|
(search-backward "(")
|
||||||
|
(setq tstart (+ (point) 1)))
|
||||||
|
(setq tags (split-string (buffer-substring tstart (point))))
|
||||||
|
(delete-region tstart (point))
|
||||||
|
(insert (notmuch-tag-format-tags tags tags))
|
||||||
|
|
||||||
|
;; Colour the whole line according to tags
|
||||||
|
(notmuch-search-color-line (point-min) (point-max) tags)
|
||||||
|
(setq text (buffer-string)))
|
||||||
|
(cons text id))))
|
||||||
|
|
||||||
|
(defun helm-notmuch-maybe-match-incomplete (pattern)
|
||||||
|
(if helm-notmuch-match-incomplete-words
|
||||||
|
(mapconcat #'identity
|
||||||
|
(mapcar (lambda (term)
|
||||||
|
(if (string-match-p "^[[:alnum:]]+$" term)
|
||||||
|
(concat term "*")
|
||||||
|
term))
|
||||||
|
(split-string pattern))
|
||||||
|
" ")
|
||||||
|
pattern))
|
||||||
|
|
||||||
|
(defun helm-notmuch-show (_candidate)
|
||||||
|
"Display CANDIDATE using notmuch-show, retaining the query context."
|
||||||
|
(helm-window-show-buffers
|
||||||
|
(save-window-excursion
|
||||||
|
(cl-loop for candidate in (helm-marked-candidates)
|
||||||
|
collect (progn (notmuch-show candidate nil nil
|
||||||
|
(helm-notmuch-maybe-match-incomplete
|
||||||
|
helm-pattern))
|
||||||
|
(current-buffer))))))
|
||||||
|
|
||||||
|
(provide 'patch-helm-notmuch)
|
|
@ -0,0 +1,41 @@
|
||||||
|
(require 'notmuch-message)
|
||||||
|
;; From https://notmuchmail.org/pipermail/notmuch/2018/026423.html
|
||||||
|
|
||||||
|
;; attachment checks
|
||||||
|
;;
|
||||||
|
;; should be sent upstream, but needs unit tests in test/T310-emacs.sh
|
||||||
|
(defcustom notmuch-message-attach-regex
|
||||||
|
"\\b\\(attache\?ment\\|attached\\|attach\\|pi[èe]ce\s+jointe?\\)\\b"
|
||||||
|
"Pattern of text announcing there should be an attachment.
|
||||||
|
|
||||||
|
This is used by `notmuch-message-check-attach' to check email
|
||||||
|
bodies for words that might indicate the email should have an
|
||||||
|
attachement. If the pattern matches and there is no attachment (a
|
||||||
|
`<#part ...>' magic block), notmuch will show a confirmation
|
||||||
|
prompt before sending the email.
|
||||||
|
|
||||||
|
The default regular expression is deliberately liberal: we prefer
|
||||||
|
false positive than forgotten attachments. This should be
|
||||||
|
customized for non-english languages and notmuch welcomes
|
||||||
|
additions to the pattern for your native language, unless it
|
||||||
|
conflicts with common words in other languages."
|
||||||
|
:type '(regexp)
|
||||||
|
:group 'notmuch-send)
|
||||||
|
|
||||||
|
(defun notmuch-message-check-attach ()
|
||||||
|
"""Check for missing attachments.
|
||||||
|
|
||||||
|
This is normally added to `message-send-hook' and is configured
|
||||||
|
through `notmuch-message-attach-regex'."""
|
||||||
|
(save-excursion ;; XXX: this fails somehow: point is at the end of the buffer on error
|
||||||
|
(goto-char (point-min))
|
||||||
|
(if (re-search-forward notmuch-message-attach-regex nil t)
|
||||||
|
(progn
|
||||||
|
(goto-char (point-min))
|
||||||
|
(unless (re-search-forward "<#part [^>]*filename=[^>]*>" nil t)
|
||||||
|
(or (y-or-n-p "Email seem to refer to attachment, but nothing attached, send anyways?")
|
||||||
|
(error "No attachment found, aborting")))))))
|
||||||
|
|
||||||
|
(add-hook 'message-send-hook 'notmuch-message-check-attach)
|
||||||
|
|
||||||
|
(provide 'patch-notmuch)
|
Loading…
Reference in New Issue