Emacs Lisp: rcd-mail.el package as bindings to GNU Mailutils "mail" program

;;; rcd-mail.el --- RCD Emacs bindings to GNU Mailutils mail program  -*- lexical-binding: t; -*-

;; Copyright (C) 2016-2021 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 1.65
;; Package-Requires: (rcd-utilities rfc2047)
;; Keywords:
;; URL: https://hyperscope.link/3/8/3/0/3/rcd-mail-el-GNU-Mailutils-mail-program.html

;; This file is not part of GNU Emacs.

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; RCD Emacs bindings to GNU Mailutils mail 📧 program help with
;; formatting and sending of bulk mail. It required GNU Mailutils
;; software. See: https://mailutils.org/
;;
;; Main function is `rcd-mailutils-mail' to send emails.

;;; Change Log:

;;; Code:

(require 'rcd-utilities)
(require 'rfc2047)

(defcustom rcd-mailutils-sendmail-program nil
  "The specialized sendmail program that will be used in case
standard sendmail is not found."
  :group 'rcd
  :type 'string)

(defun rcd-mailutils-flt2047 (string &optional encoding q-or-b)
"Use GNU Mailutils \"mailutils\" prorgram to encode STRING by RFC 2047 rules.

Optional ENCODING may be supplied.  Otherwise default is \"utf-8\".
Optional Q-OR-B may be supplied, default is \"Q\" encoding."
  (let*  ((encoding (or encoding "utf-8"))
	  (q-or-b (or "Q" q-or-b)))
    (string-trim
     (call-process-to-string "mailutils" nil nil "flt2047" "-c" encoding "-E" q-or-b string))))

;; Unsure if I can replace GNU mailutils flt2047 with 'rfc-2047-encode-string
(defalias 'rcd-rfc2047-encode 'rcd-mailutils-flt2047)
;; (defalias 'rcd-rfc2047-encode 'rfc2047-encode-string)

(defun rcd-mailutils-mail-copy (copy-type copy)
  "Return Cc: or Bcc: GNU Mailutils \"mail\" program arguments.

COPY-TYPE shall be either \"bcc\" or \"cc\".  COPY is either
string or list of emails to receive the copy of the email. No
names can be supplied."
  (when copy
    (let ((copy-type (cond ((string-match "bcc" copy-type) "Bcc")
			   (t "Cc"))))
      (let ((list))
	(cond ((stringp copy) (progn
				(push (format "%s: %s" copy-type copy) list)
				(push "-a" list)
				list))
	      ((listp copy) (progn
			      (while copy
				(push (format "%s: %s" copy-type (pop copy)) list)
				(push "-a" list))
			      list)))))))

(defun rcd-mailutils-mail-from (from-email &optional from-name)
  "Retuern list with \"mail\" program arguments containng FROM-EMAIL.

Optionally FROM-NAME may be suppplied."
  (let ((list))
    (if from-name (push (format "From: %s <%s>" (rcd-rfc2047-encode from-name) from-email) list)
      (push (format "From: %s" from-email) list))
    (push "-a" list)))

(defun rcd-mailutils-mail-headers (headers)
  "Return list of additional headers to \"mail\" program."
  (let ((list)
	(headers (if (stringp headers) (list headers) headers)))
    ;; Date: header is not set automatically
    ;; (push (concat "Date: " (rcd-timestamp-email)) list)
    ;; (push "-a" list)
    ;; End of Date: header
    (while headers
      (push (pop headers) list)
      (push "-a" list))
    list))

(defun rcd-mailutils-mail-to (to-email &optional to-name)
  "Return list with \"mail\" program arguments with TO-EMAIL.
 Optionally provide TO-NAME, the name of recipient of email."
  (cond
   ((and (stringp to-name) (string-match "@" to-name))
    (list to-email))
   ((not (seq-empty-p to-name))
    (list (concat "\"" (rcd-rfc2047-encode to-name) "\" <" to-email ">")))
   (t (list to-email)))) ;; TODO quote names in each email format

 (defun rcd-mailutils-mail-sendmail (sendmail)
  "Return list with \"mail\" program arguments supplying \"SENDMAIL\" program."
  (let ((sendmail (or sendmail rcd-mailutils-sendmail-program)))
    (when sendmail
      (list "-E" (format "set sendmail=sendmail:%s" sendmail)))))

(defun rcd-mailutils-mail-subject (subject)
  "Return list with \"mail\" program arguments for SUBJECT.
If SUBJECT is NIL return the default \"Re: your mail\" subject."
  (if subject (list "-s" (rcd-rfc2047-encode subject))
    (list "-s" "Re: your mail")))

(defun rcd-mailutils-mail-html (html)
  "Return list with \"mail\" program arguments providing the contents of HTML."
  (when html
    (let* ((html-file (concat (slash-add (rcd-memory-dir)) "html-file"))
	   (html-file (string-to-file-force html html-file)))
      (list "--content-type=text/html" "-A" html-file))))

(defun rcd-mailutils-mail-text (text)
  "Return temporary file name location with TEXT contents."
  (let* ((text-file (concat (slash-add (rcd-memory-dir)) "text-file"))
	 (text-file (string-to-file-force text text-file)))
    text-file))

(defun rcd-mailutils-mail-files (files)
  "Return list with \"mail\" program arguments for file attachments."
  (cond ((stringp files) (list "--content-type" (rcd-mime-type files t) "-A" files))
	((listp files) (let (list)
			 (when files
			   (let ((file (pop files)))
			     (push file list)
			     (push "-A" list)
			     (push (rcd-mime-type files t) list)
			     (push "--content-type" list)))
			 list))))

(defun rcd-mailutils-mail-exec (exec)
  "Return --exec arguments to \"mail\" program."
  (let (list)
    (cond ((stringp exec) (setq list (list "--exec" exec)))
	  ((listp exec) (while exec
			     (push (pop exec) list)
			     (push "--exec" list))))
    list))

(defun rcd-mailutils-mail (text subject from-name from-email to-name to-email &optional html cc-list bcc-list sendmail files headers exec)
  "📧 Send email with GNU Mailutils \"mail\" program.

Required arguments are TEXT, SUBJECT, FROM-NAME, FROM-EMAIL,
TO-NAME and TO-EMAIL.

TEXT and HTML are both strings.

Optional arguments are HTML, CC-LIST BCC-LIST and SENDMAIL. Both
CC-LIST and BCC-LIST are supplied without names of recipients."
  (let* ((alternative (when html '("--alternative")))
	 (html-file (when html (rcd-mailutils-mail-html html)))
	 (text-file (rcd-mailutils-mail-text text))
	 (subject (rcd-mailutils-mail-subject subject))
	 (return (list "-r" from-email))
	 (cc (rcd-mailutils-mail-copy "cc" cc-list))
	 (bcc (rcd-mailutils-mail-copy "bcc" bcc-list))
	 (from (rcd-mailutils-mail-from from-email from-name))
	 (to (rcd-mailutils-mail-to to-email to-name))
	 (sendmail (rcd-mailutils-mail-sendmail sendmail))
	 (files (rcd-mailutils-mail-files files))
	 (exec (rcd-mailutils-mail-exec exec))
	 (headers (rcd-mailutils-mail-headers headers))
	 (content-type (list "--content-type=text/plain"))
	 (args (append (list "-F") sendmail exec subject from cc bcc headers return files alternative html-file content-type to)))
    (apply 'call-process "mail" text-file nil nil args)))

;; Internal hyperlink for testing with private data:
;; Hyperscope: (hyperscope-description-show 38302)

(provide 'rcd-mail)

;;; rcd-mail.el ends here