[Emacs-diffs] trunk r113552: Add aliases for encrypting mail.

[Richard M. Stallman]

------------------------------------------------------------
revno: 113552
revision-id: address@hidden
parent: address@hidden
committer: Richard Stallman <address@hidden>
branch nick: trunk
timestamp: Fri 2013-07-26 05:32:44 -0400
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/epa-mail.el               epamail.el-20091113204419-o5vbwnq5f7feedwu-8555
  lisp/epa.el                    epa.el-20091113204419-o5vbwnq5f7feedwu-8557

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-26 07:38:18 +0000
+++ b/lisp/ChangeLog    2013-07-26 09:32:44 +0000
@@ -1,3 +1,12 @@
+2013-07-26  Richard Stallman  <address@hidden>
+
+       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  <address@hidden>
 
        Add support for lexical variables to the debugger's `e' command.

=== modified file 'lisp/epa-mail.el'
--- a/lisp/epa-mail.el  2013-01-01 09:11:05 +0000
+++ b/lisp/epa-mail.el  2013-07-26 09:32:44 +0000
@@ -109,94 +109,127 @@
             (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.
-
-Don't use this command in Lisp programs!"
+(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.
+
+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 ()

=== modified file 'lisp/epa.el'
--- a/lisp/epa.el       2013-07-19 13:30:58 +0000
+++ b/lisp/epa.el       2013-07-26 09:32:44 +0000
@@ -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"))