Add aliases for encrypting mail.

* epa.el (epa-mail-aliases): New option.
* epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs.
Bind inhibit-read-only so read-only text doesn't ruin everything.
(epa-mail-default-recipients): New subroutine broken out.
Handle epa-mail-aliases.

3 files changed, 133 insertions, 79 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 84919e634be..28a2f5b492d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2013-07-26  Richard Stallman  <rms@gnu.org>
+
+	Add aliases for encrypting mail.
+	* epa.el (epa-mail-aliases): New option.
+	* epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs.
+	Bind inhibit-read-only so read-only text doesn't ruin everything.
+	(epa-mail-default-recipients): New subroutine broken out.
+	Handle epa-mail-aliases.
+
 2013-07-26  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	Add support for lexical variables to the debugger's `e' command.
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 6ba29d3748f..896fc2a954e 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -109,94 +109,127 @@ If no one is selected, default secret key is used.  "
 	     (if verbose
 		 (epa--read-signature-type)
 	       'clear)))))
-  (epa-sign-region start end signers mode))
+  (let ((inhibit-read-only t))
+    (epa-sign-region start end signers mode)))
+
+(defun epa-mail-default-recipients ()
+  "Return the default list of encryption recipients for a mail buffer."
+  (let ((config (epg-configuration))
+	recipients-string real-recipients)
+    (save-excursion
+      (goto-char (point-min))
+      (save-restriction
+	(narrow-to-region (point)
+			  (if (search-forward mail-header-separator nil 0)
+			      (match-beginning 0)
+			    (point)))
+	(setq recipients-string
+	      (mapconcat #'identity
+			 (nconc (mail-fetch-field "to" nil nil t)
+				(mail-fetch-field "cc" nil nil t)
+				(mail-fetch-field "bcc" nil nil t))
+			 ","))
+	(setq recipients-string
+	      (mail-strip-quoted-names
+	       (with-temp-buffer
+		 (insert "to: " recipients-string "\n")
+		 (expand-mail-aliases (point-min) (point-max))
+		 (car (mail-fetch-field "to" nil nil t))))))
+
+      (setq real-recipients
+	    (split-string recipients-string "," t "[ \t\n]*"))
+
+      ;; Process all the recipients thru the list of GnuPG groups.
+      ;; Expand GnuPG group names to what they stand for.
+      (setq real-recipients
+	    (apply #'nconc
+		   (mapcar
+		    (lambda (recipient)
+		      (or (epg-expand-group config recipient)
+			  (list recipient)))
+		    real-recipients)))
+
+      ;; Process all the recipients thru the user's list
+      ;; of encryption aliases.
+      (setq real-recipients
+	    (apply #'nconc
+		   (mapcar
+		    (lambda (recipient)
+		      (let ((tem (assoc recipient epa-mail-aliases)))
+			(if tem (cdr tem)
+			  (list recipient))))
+		    real-recipients)))
+      )))
 
 ;;;###autoload
-(defun epa-mail-encrypt (start end recipients sign signers)
-  "Encrypt the current buffer.
-The buffer is expected to contain a mail message.
+(defun epa-mail-encrypt (&optional recipients signers)
+  "Encrypt the outgoing mail message in the current buffer.
+Takes the recipients from the text in the header in the buffer
+and translates them through `epa-mail-aliases'.
+With prefix argument, asks you to select among them interactively
+and also whether and how to sign.
 
-Don't use this command in Lisp programs!"
+Called from Lisp, the optional argument RECIPIENTS is a list
+of recipient addresses, t to perform symmetric encryption,
+or nil meaning use the defaults.
+
+SIGNERS is a list of keys to sign the message with."
   (interactive
-   (save-excursion
-     (let ((verbose current-prefix-arg)
-	   (config (epg-configuration))
-	   (context (epg-make-context epa-protocol))
-	   recipients-string recipients recipient-key sign)
-       (goto-char (point-min))
-       (save-restriction
-	 (narrow-to-region (point)
-			   (if (search-forward mail-header-separator nil 0)
-			       (match-beginning 0)
-			     (point)))
-	 (setq recipients-string
-	       (mapconcat #'identity
-			  (nconc (mail-fetch-field "to" nil nil t)
-				 (mail-fetch-field "cc" nil nil t)
-				 (mail-fetch-field "bcc" nil nil t))
-			  ","))
-	 (setq recipients
-	       (mail-strip-quoted-names
-		(with-temp-buffer
-		  (insert "to: " recipients-string "\n")
-		  (expand-mail-aliases (point-min) (point-max))
-		  (car (mail-fetch-field "to" nil nil t))))))
-       (if recipients
-	   (setq recipients (delete ""
-				    (split-string recipients
-						  "[ \t\n]*,[ \t\n]*"))))
-
-       ;; Process all the recipients thru the list of GnuPG groups.
-       ;; Expand GnuPG group names to what they stand for.
-       (setq recipients
-	     (apply #'nconc
-		    (mapcar
-		     (lambda (recipient)
-		       (or (epg-expand-group config recipient)
-			   (list recipient)))
-		     recipients)))
-
-       (goto-char (point-min))
-       (if (search-forward mail-header-separator nil t)
-	   (forward-line))
-       (setq epa-last-coding-system-specified
-	     (or coding-system-for-write
-		 (epa--select-safe-coding-system (point) (point-max))))
-       (list (point) (point-max)
-	     (if verbose
-		 (epa-select-keys
-		  context
-		  "Select recipients for encryption.
+   (let ((verbose current-prefix-arg)
+	 (context (epg-make-context epa-protocol)))
+     (list (if verbose
+	       (or (epa-select-keys
+		    context
+		    "Select recipients for encryption.
 If no one is selected, symmetric encryption will be performed.  "
-		  recipients)
-	       (if recipients
+		    (epa-mail-default-recipients))
+		   t))
+	   (and verbose (y-or-n-p "Sign? ")
+		(epa-select-keys context
+				 "Select keys for signing.  ")))))
+  (let (start recipient-keys default-recipients)
+    (save-excursion
+      (setq recipient-keys
+	    (cond ((eq recipients t)
+		   nil)
+		  (recipients recipients)
+		  (t
+		   (setq default-recipients
+			 (epa-mail-default-recipients))
+		   ;; Convert recipients to keys.
 		   (apply
 		    'nconc
 		    (mapcar
 		     (lambda (recipient)
-		       (setq recipient-key
-			     (epa-mail--find-usable-key
-			      (epg-list-keys
-			       (epg-make-context epa-protocol)
-			       (if (string-match "@" recipient)
-				   (concat "<" recipient ">")
-				 recipient))
-			      'encrypt))
-		       (unless (or recipient-key
-				   (y-or-n-p
-				    (format
-				     "No public key for %s; skip it? "
-				     recipient)))
-			 (error "No public key for %s" recipient))
-		       (if recipient-key (list recipient-key)))
-		     recipients))))
-	     (setq sign (if verbose (y-or-n-p "Sign? ")))
-	     (if sign
-		 (epa-select-keys context
-				  "Select keys for signing.  "))))))
-  ;; Don't let some read-only text stop us from encrypting.
-  (let ((inhibit-read-only t))
-    (epa-encrypt-region start end recipients sign signers)))
+		       (let ((recipient-key
+			      (epa-mail--find-usable-key
+			       (epg-list-keys
+				(epg-make-context epa-protocol)
+				(if (string-match "@" recipient)
+				    (concat "<" recipient ">")
+				  recipient))
+			       'encrypt)))
+			 (unless (or recipient-key
+				     (y-or-n-p
+				      (format
+				       "No public key for %s; skip it? "
+				       recipient)))
+			   (error "No public key for %s" recipient))
+			 (if recipient-key (list recipient-key))))
+		       default-recipients)))))
+
+      (goto-char (point-min))
+      (if (search-forward mail-header-separator nil t)
+	  (forward-line))
+      (setq start (point))
+
+      (setq epa-last-coding-system-specified
+	    (or coding-system-for-write
+		(epa--select-safe-coding-system (point) (point-max)))))
+
+    ;; Don't let some read-only text stop us from encrypting.
+    (let ((inhibit-read-only t))
+      (epa-encrypt-region start (point-max) recipient-keys signers signers))))
 
 ;;;###autoload
 (defun epa-mail-import-keys ()
diff --git a/lisp/epa.el b/lisp/epa.el
index 68e7a18fe17..a99fb9230e1 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -48,6 +48,18 @@
   :version "23.1"
   :group 'epa)
 
+(defcustom epa-mail-aliases nil
+  "Alist of aliases of email addresses that stand for encryption keys.
+Each element is (ALIAS EXPANSIONS...).
+It means that when a message is addressed to ALIAS,
+instead of encrypting it for ALIAS, encrypt it for EXPANSIONS...
+If EXPANSIONS is empty, ignore ALIAS as regards encryption.
+That is a handy way to avoid warnings about addresses
+that you don't have any key for."
+  :type '(repeat (cons (string :tag "Alias") (repeat '(string :tag "Expansion"))))
+  :group 'epa
+  :version "24.4")
+
 (defface epa-validity-high
   '((default :weight bold)
     (((class color) (background dark)) :foreground "PaleTurquoise"))