diff options
| -rw-r--r-- | emacsconf-mail.el | 206 |
1 files changed, 206 insertions, 0 deletions
diff --git a/emacsconf-mail.el b/emacsconf-mail.el new file mode 100644 index 0000000..c5ec599 --- /dev/null +++ b/emacsconf-mail.el @@ -0,0 +1,206 @@ +;;; emacsconf-mail.el --- Mail merge functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Sacha Chua + +;; Author: Sacha Chua <sacha@sachachua.com> +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(defun emacsconf-mail-complete-email-group (&optional info) + "Return (email . (talk talk))." + (setq info (emacsconf-filter-talks (or info (emacsconf-get-talk-info)))) + (save-window-excursion + (let* ((grouped (seq-group-by (lambda (o) (plist-get o :email)) info)) + (slug (emacsconf-get-slug-from-string (emacsconf-complete-talk))) + (email (plist-get (seq-find (lambda (o) (string= (plist-get o :slug) slug)) info) :email))) + (assoc email grouped)))) + +(defun emacsconf-mail-prepare (template group attrs) + (compose-mail + (car group) + (emacsconf-replace-plist-in-string attrs (plist-get template :subject)) + `(("Reply-To" . ,(emacsconf-replace-plist-in-string attrs (plist-get template :reply-to))) + ("Mail-Followup-To" . ,(emacsconf-replace-plist-in-string attrs (plist-get template :mail-followup-to))) + ("Cc" . ,(plist-get template :cc)))) + (message-sort-headers) + (message-goto-body) + (save-excursion (insert (emacsconf-replace-plist-in-string attrs (plist-get template :body))) + (goto-char (point-min)) + (emacsconf-mail-merge-wrap))) + +(defun emacsconf-mail-template-to-me () + "Might be useful for testing." + (interactive) + (let* ((template (if (org-entry-get (point) "EMAIL_ID") + (emacsconf-mail-merge-get-template-from-subtree) + (emacsconf-mail-merge-get-template + (completing-read "Template: " (org-property-values "EMAIL_ID"))))) + (mail-func (plist-get template :function)) + (group (emacsconf-mail-complete-email-group))) + (funcall mail-func (cons user-mail-address (cdr group)) template))) + +(defun emacsconf-mail-template-to-group () + "Prompt for a speaker and e-mail current template to them." + (interactive) + (let* ((template (if (org-entry-get (point) "EMAIL_ID") + (emacsconf-mail-merge-get-template-from-subtree) + (emacsconf-mail-merge-get-template + (completing-read "Template: " (org-property-values "EMAIL_ID"))))) + (mail-func (plist-get template :function))) + (funcall mail-func (emacsconf-mail-complete-email-group) template))) + +(defun emacsconf-mail-template-to-all () + "Uses the current template to draft messages to all the speakers." + (interactive) + (let* ((template (if (org-entry-get (point) "EMAIL_ID") + (emacsconf-mail-merge-get-template-from-subtree) + (emacsconf-mail-merge-get-template + (completing-read "Template: " (org-property-values "EMAIL_ID"))))) + (info (seq-filter (lambda (o) + (if (plist-get template :slugs) + (member (plist-get o :slug) + (split-string (plist-get template :slugs) " ")) + t)) + (emacsconf-filter-talks (emacsconf-get-talk-info)))) + (grouped (emacsconf-mail-group-by-email info)) + (mail-func (plist-get template :function))) + (mapc (lambda (group) + (funcall mail-func group template)) + grouped))) + +(defun emacsconf-mail-group-by-email (info) + (seq-group-by (lambda (o) (plist-get o :email)) info)) + +(defun emacsconf-mail-speaker (&optional subject body) + "Compose a message to the speaker of the current talk." + (interactive) + (compose-mail (format "%s <%s>" (org-entry-get (point) "NAME") (org-entry-get (point) "EMAIL")) subject) + (when body (message-goto-body) (insert body))) + +(defun emacsconf-mail-speaker-schedule (&optional subject body) + (interactive (list (read-string "Subject: ") nil)) + (let ((info (emacsconf-get-talk-info-for-subtree))) + (emacsconf-mail-speaker subject body) + (when body (message-goto-body) (insert body)) + (goto-char (point-max)) + (insert (string-join (emacsconf-timezone-strings info) "\n")))) + +(defvar emacsconf-submit-email "emacsconf-submit@gnu.org" "E-mail address for submissions.") + +(defun emacsconf-mail-speaker-cc-submit (&optional subject body) + "Compose a message to the speaker of the current talk." + (interactive) + (compose-mail (format "%s <%s>" (org-entry-get (point) "NAME") (org-entry-get (point) "EMAIL")) + subject '(("Reply-To" . emacsconf-submit-email) ("Cc" . emacsconf-submit-email))) + (message-goto-body) + (when body (insert body)) + (save-excursion (insert "Please keep " emacsconf-submit-email " in the To: or Cc: when replying. Thank you!"))) + +(defun emacsconf-mail-show-talk-info () + (interactive) + (let ((email (or (mail-fetch-field "reply-to") (mail-fetch-field "from")))) + (when (string-match "<\\(\\(\\sw\\|\\s_\\|\\s.\\)+@\\(\\sw\\|\\s_\\|\\s.\\)+\\)>" email) + (setq email (match-string 1 email))) + (pop-to-buffer (find-file-noselect emacsconf-org-file)) + (goto-char (point-min)) + (goto-char + (or (org-find-property "EMAIL" email) + (org-find-property "NAME" + (completing-read "Name: " (delq nil (org-map-entries (lambda () (org-entry-get "NAME")))))))))) + + + + + +(defun emacsconf-mail-merge-wrap () + (interactive) + (with-undo-amalgamate + (save-excursion + (while (re-search-forward " *${wrap}" nil t) + (replace-match "") + (fill-paragraph))))) + +(defun emacsconf-mail-merge-get-template-from-subtree () + (list :subject (org-entry-get-with-inheritance "SUBJECT") + :cc (org-entry-get-with-inheritance "CC") + :slugs (org-entry-get-with-inheritance "SLUGS") + :reply-to (or (org-entry-get-with-inheritance "REPLY_TO") (org-entry-get-with-inheritance "REPLY-TO")) + :mail-followup-to (or (org-entry-get-with-inheritance "MAIL_FOLLOWUP_TO") + (org-entry-get-with-inheritance "MAIL-FOLLOWUP-TO")) + :body (replace-regexp-in-string "\n *," "\n" (buffer-substring-no-properties + (progn (org-end-of-meta-data) (point)) + (org-end-of-subtree))) + :function (when (org-entry-get-with-inheritance "FUNCTION") + (intern (org-entry-get-with-inheritance "FUNCTION"))))) + +(defun emacsconf-mail-merge-get-template (id) + "Return the information for the e-mail template with EMAIL_ID set to ID." + (save-excursion + (goto-char (org-find-property "EMAIL_ID" id)) + (emacsconf-mail-merge-get-template-from-subtree))) + +(defun emacsconf-mail-merge-fill (string) + "Fill in the values for STRING using the properties at point. +Include some other things, too, such as emacsconf-year, title, name, email, url, and duration." + (let (start (values `(("year" . ,emacsconf-year) + ("title" . ,(org-entry-get (point) "ITEM")) + ("name" . ,(org-entry-get (point) "NAME")) + ("email" . ,(org-entry-get (point) "EMAIL")) + ("url" . ,(format "%s%s/talks/%s" emacsconf-base-url emacsconf-year (org-entry-get (point) "SLUG"))) + ("duration" . ,(org-entry-get (point) "TIME"))))) + (while (string-match "\\${\\([-a-zA-Z_]+?\\)}" string start) + (if (assoc-default (match-string 1 string) values) + (setq string (replace-match (assoc-default (match-string 1 string) values) t t string)) + (setq string (replace-match (save-match-data (org-entry-get (point) (match-string 1 string))) t t string))) + (setq start (1+ (match-beginning 0)))) + string)) + +(defun emacsconf-mail-merge-format-email-address-for-subtree () + (if (string-match "," (org-entry-get (point) "EMAIL")) + (org-entry-get (point) "EMAIL") + (format "%s <%s>" (org-entry-get (point) "NAME") (org-entry-get (point) "EMAIL")))) + +(defun emacsconf-mail-merge-for-subtree (id note-field) + (let* ((template (emacsconf-mail-merge-get-template id)) + (body (emacsconf-mail-merge-fill (plist-get template :body))) + (subject (emacsconf-mail-merge-fill (plist-get template :subject))) + (note (org-entry-get (point) note-field))) + (compose-mail (emacsconf-mail-merge-format-email-address-for-subtree) + subject + `(("Reply-To" . ,(plist-get template :reply-to)) + ("Mail-Followup-To" . ,(plist-get template :mail-followup-to)) + ("Cc" . ,(plist-get template :cc)))) + (message-goto-body) + (save-excursion + (when note (insert "#+NOTE: " note "\n======== Delete above before sending =============\n\n")) + (insert body)))) + +(defun emacsconf-mail-merge-cancel () + (interactive) + (mapc (lambda (buffer) + (when (string-match "unsent" (buffer-name buffer)) + (let ((kill-buffer-query-functions nil)) + (set-buffer-modified-p nil) + (kill-buffer buffer)))) + (buffer-list))) + +(provide 'emacsconf-mail) +;;; emacsconf-mail.el ends here |