;;; emacsconf-mail.el --- Mail merge functions -*- lexical-binding: t; -*- ;; Copyright (C) 2022 Sacha Chua ;; Author: Sacha Chua ;; 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 . ;;; 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 email attrs) (compose-mail email (emacsconf-replace-plist-in-string attrs (or (plist-get template :subject) "")) (delq nil (list (if (plist-get template :reply-to) (cons "Reply-To" (emacsconf-replace-plist-in-string attrs (plist-get template :reply-to)))) (if (plist-get template :mail-followup-to) (cons "Mail-Followup-To" (emacsconf-replace-plist-in-string attrs (plist-get template :mail-followup-to)))) (if (plist-get template :cc) (cons "Cc" (emacsconf-replace-plist-in-string attrs (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))) (funcall mail-func user-mail-address template))) (defun emacsconf-mail-template-to-volunteer (volunteer) "Prompt for a volunteer and e-mail current template to them." (interactive (list (with-current-buffer (find-file-noselect emacsconf-org-file)))) (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"))))) (volunteers (emacsconf-get-volunteer-info)) (mail-func (plist-get template :function))) (funcall mail-func (emacsconf-complete-volunteer) 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-groups () "Uses the current template to draft messages to all the speakers. Group by e-mail." (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-prepare-for-display (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-log-message-when-sent (o message) (add-hook 'message-sent-hook `(lambda () (save-window-excursion (emacsconf-add-to-talk-logbook ,(plist-get o :slug) ,message))) nil t)) (defun emacsconf-mail-group-by-email (info) (seq-group-by (lambda (o) (plist-get o :email)) info)) (defun emacsconf-mail-speaker (&optional subject body talk) "Compose a message to the speaker of the current talk." (interactive (list nil nil (emacsconf-complete-talk-info))) (compose-mail (plist-get talk :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-back-to-heading) (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 (let ((char (org-find-property "EMAIL_ID" id))) (if char (progn (goto-char char) (emacsconf-mail-merge-get-template-from-subtree)) (with-current-buffer (find-file-noselect (expand-file-name "organizers-notebook/index.org" (expand-file-name emacsconf-year emacsconf-directory))) (setq char (org-find-property "EMAIL_ID" id)) (if char (progn (goto-char char) (emacsconf-mail-merge-get-template-from-subtree)) ;; Try the conf.org file (with-current-buffer (find-file-noselect emacsconf-org-file) (setq char (org-find-property "EMAIL_ID" id)) (if char (progn (goto-char char) (emacsconf-mail-merge-get-template-from-subtree)) (error "Could not find template %s" id))))))))) (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) (buffer-modified-p nil)) (set-buffer-modified-p nil) (kill-buffer buffer)))) (buffer-list))) (provide 'emacsconf-mail) ;;; emacsconf-mail.el ends here