notmuch: Patch helm, notmuch, init message
Pierre Neidhardt
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
|
||||
|
||||
(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)
|
||||
(helm-defswitcher
|
||||
"notmuch"
|
||||
|
|
@ -13,16 +31,22 @@
|
|||
notmuch-hello))
|
||||
|
||||
(when (require 'helm-notmuch nil t)
|
||||
;; TODO: Send PR.
|
||||
(defun helm-notmuch-maybe-match-incomplete (pattern)
|
||||
(if helm-notmuch-match-incomplete-words
|
||||
(concat (mapconcat #'identity (split-string pattern) "* ") "*")
|
||||
;; (if (string-match-p "[[:alnum:]]$" pattern)
|
||||
;; (concat pattern "*")
|
||||
;; pattern)
|
||||
pattern))
|
||||
|
||||
(dolist (map (list notmuch-search-mode-map notmuch-hello-mode-map notmuch-show-mode-map))
|
||||
(setq helm-notmuch-match-incomplete-words t)
|
||||
(require 'patch-helm-notmuch)
|
||||
(dolist (map (list notmuch-search-mode-map
|
||||
notmuch-hello-mode-map
|
||||
notmuch-show-mode-map
|
||||
notmuch-tree-mode-map))
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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