diff --git a/.emacs.d/lisp/init-message.el b/.emacs.d/lisp/init-message.el new file mode 100644 index 00000000..ad2c3c49 --- /dev/null +++ b/.emacs.d/lisp/init-message.el @@ -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) diff --git a/.emacs.d/lisp/init-notmuch.el b/.emacs.d/lisp/init-notmuch.el index 8a5d2d4b..e9727459 100644 --- a/.emacs.d/lisp/init-notmuch.el +++ b/.emacs.d/lisp/init-notmuch.el @@ -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) diff --git a/.emacs.d/lisp/patch-helm-notmuch.el b/.emacs.d/lisp/patch-helm-notmuch.el new file mode 100644 index 00000000..f7750139 --- /dev/null +++ b/.emacs.d/lisp/patch-helm-notmuch.el @@ -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) diff --git a/.emacs.d/lisp/patch-notmuch.el b/.emacs.d/lisp/patch-notmuch.el new file mode 100644 index 00000000..771094a2 --- /dev/null +++ b/.emacs.d/lisp/patch-notmuch.el @@ -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)