message: Clean up bogus GitHub recipients

master
Pierre Neidhardt 2019-05-18 16:18:10 +02:00
parent 9b0194af99
commit 1da0cae55f
1 changed files with 38 additions and 9 deletions

View File

@ -66,15 +66,44 @@ systematically send encrypted emails when possible."
(add-hook 'message-send-hook #'ambrevar/message-sign-encrypt-if-all-keys-trusted)
;; Fix replying to GitHub. TODO: Does not work.
(defun ambrevar/message-alter-bogus-github-recipients (addrcell)
"Discard @reply.github.com mail addresses.
ADDRCELL is a cons cell where the car is the mail address and the
cdr is the complete address (full name and mail address)."
(unless (string-match (rx "@noreply.github.com" string-end)
(cdr addrcell))
addrcell))
(setq message-alter-recipients-function 'ambrevar/message-alter-bogus-github-recipients)
;; Fix replying to GitHub.
;; We could leverage `message-alter-recipients-function' but it does not seem to
;; be called with Notmuch for instance.
(defun ambrevar/cleanup-github-recipients ()
"When replying to a github message, clean up all bogus recipients.
Also remove signature.
This function is useful in `message-setup-hook'."
(interactive)
(let ((to (message-fetch-field "To")))
(when (and to
(string-match (rx "@reply.github.com" string-end)
(cadr (mail-extract-address-components to))))
(dolist (hdr '("To" "Cc" "Bcc"))
(let ((header-value (message-fetch-field hdr)))
(when header-value
(message-replace-header
hdr
(mapconcat (lambda (addrcell)
(format "\"%s\" <%s>" (car addrcell) (cadr addrcell)))
(cl-delete-if
(lambda (addrcell)
(string-match (rx "@noreply.github.com" string-end)
(cadr addrcell)))
(mail-extract-address-components header-value t))
", ")))))
;; Delete signature if any.
(delete-region (save-excursion
(message-goto-signature)
(unless (eobp)
(forward-line -1))
(point))
(point-max))
;; Deleting trailing blank lines.
(save-excursion
(goto-char (point-max))
(delete-blank-lines)
(delete-blank-lines)))))
(add-hook 'message-setup-hook 'ambrevar/cleanup-github-recipients)
(defvar ambrevar/message-compose-fortune-p nil