use several identities when sending mail

[Francesco Potortì]

About ten years ago I wrote some code for switching identitites when
sending mail with sendmail-user-agent.

I just revamped it to use the smtp library and, unless something like
that already exists, I think this is a worthwhile addition to Emacs,
once it is cleaned up.  I think it should work with message mode too.

I attach the code below as it is.  It works, but it needs cleanup, or
submission to Elpa, or to the wiki.  If people are interested in the
code and in publishing it, that may avoid ten more years waiting.


===File ~/elisp/mail-identity.el============================
:;; Define identities for sending mail
:;; For Emacs 24 and newer
:;;
:;; GPL v3 or later
:;; Francesco Potortì, 2000-2021
;;;
;;; Supports sendmail and smtpmail transports, no support for feedmail or 
mailclient

(setq smtpmail-debug-info nil)

;; List of identities
(defvar mail-identity-list
  '(("isti"
     "Potorti@isti.cnr.it"
     ("smtp-out.isti.cnr.it" "pot" 587)
     "CNR-ISTI, via Moruzzi 1, I-56124 Pisa, +39-0503153058"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
    ("cnr"
     "Francesco.Potorti@cnr.it"
     ("smtp.cnr.it" "francesco.potorti" 25)
     "CNR-ISTI, via Moruzzi 1, I-56124 Pisa, +39-0503153058"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
    ("gnu"
     "pot@gnu.org"
     ("smtp.gnu.org" "pot" 25)
     "The GNU project"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
    ("ipin19"
     "info@ipin2019.isti.cnr.it"
     ("smtp.ipin19.it" "pot" 465 ssl)
     "IPIN 2019 conference"
     "From: Francesco Potortì -- general chair <info@ipin2019.isti.cnr.it>"
     "CC: IPIN 2019 conference <info@ipin2019.isti.cnr.it>")
    )
  "List of possible mail sending styles.
The car of each element of the list is a unique string that is the style name.
The following elements are:
- value for `user-mail-address' which is the only necessary element after the 
name
- a list with the following elements (trailing missing ones are set to nil)
  - value for `smtpmail-smtp-server'
  - value for `smtpmail-smtp-user'
  - value for `smtpmail-smtp-service'
  - value for `smtpmail-stream-type'
- value for `message-user-organization', if any
- any number of header lines, each without a trailing newline")

;; The default identity
(defvar mail-default-identity
  (car (car mail-identity-list))
  "Default style for sending mail")

;; Assume all servers require authorization
(setq smtpmail-servers-requiring-authorization ".")

;; Use this in mail sending hooks for setting your identity (see below)
(defun mail-choose-identity ()
  (let* ((completion-ignore-case t)
         (style
          (completing-read "Mail sending style: "
                           (append '("sendmail" "local") mail-identity-list)
                           nil 'required nil nil
                           mail-default-identity t))
         (identity (cdr (assoc style mail-identity-list))))

    (if (string-match-p "^\\(smtpmail\\|local\\)$" style)
        (setq send-mail-function 'sendmail-send-it ; use local transport
              user-mail-address
              (read-string "From: " nil nil
                           (cadr (assoc mail-default-identity
                                        mail-identity-list))))
      (setq send-mail-function 'smtpmail-send-it ; use smtp transport
            user-mail-address (nth 0 identity)
            smtpmail-smtp-server  (nth 0 (nth 1 identity))
            smtpmail-smtp-user    (nth 1 (nth 1 identity))
            smtpmail-smtp-service (nth 2 (nth 1 identity))
            smtpmail-stream-type  (nth 3 (nth 1 identity))
            message-user-organization (nth 2 identity)))

    ;; Insert headers specific to identity, if any
    (when message-user-organization
      (goto-char (mail-header-end))
      (unless (search-backward "\nOrganization: " nil t)
        (insert "Organization: " message-user-organization "\n")))
    (dolist (hdr (nthcdr 3 identity))
      (goto-char (mail-header-end))
      (unless (search-backward (concat "\n" hdr "\n") nil t)
        (insert hdr "\n")))
    ))

(add-hook 'mail-send-hook 'mail-choose-identity)
(add-hook 'message-send-hook 'mail-choose-identity)
(defadvice rmail-resend (before mail-choose-identity activate)
  (if (interactive-p) (funcall 'mail-choose-identity)))
============================================================