From: ueno <ueno>
Date: Tue, 22 Jan 2008 12:00:02 +0000 (+0000)
Subject: (epa-mail--find-usable-key): New function.
X-Git-Tag: emacs-merge-branchpoint~5
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7f32132982be06fe7ef290e06a7299612c9a5118;p=elisp%2Fepg.git

(epa-mail--find-usable-key): New function.
(epa-mail-encrypt): Use it.
Reported by intrigeri <intrigeri@boum.org>.
---

diff --git a/ChangeLog b/ChangeLog
index 8488c60..5d662ce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-01-22  Daiki Ueno  <ueno@unixuser.org>
+
+	* epa-mail.el (epa-mail--find-usable-key): New function.
+	(epa-mail-encrypt): Use it.
+	Reported by intrigeri <intrigeri@boum.org>.
+
 2007-11-26  Daiki Ueno  <ueno@unixuser.org>
 
 	* epg-package-info.el.in (epg-bug-report-address): New constant.
diff --git a/epa-mail.el b/epa-mail.el
index 2541d53..97b3204 100644
--- a/epa-mail.el
+++ b/epa-mail.el
@@ -44,6 +44,19 @@
   "A minor-mode for composing encrypted/clearsigned mails."
   nil " epa-mail" epa-mail-mode-map)
 
+(defun epa-mail--find-usable-key (keys usage)
+  "Find a usable key from KEYS for USAGE."
+  (catch 'found
+    (while keys
+      (let ((pointer (epg-key-sub-key-list (car keys))))
+	(while pointer
+	  (if (and (memq usage (epg-sub-key-capability (car pointer)))
+		   (not (memq (epg-sub-key-validity (car pointer))
+			      '(revoked expired))))
+	      (throw 'found (car keys)))
+	  (setq pointer (cdr pointer))))
+      (setq keys (cdr keys)))))
+
 ;;;###autoload
 (defun epa-mail-decrypt ()
   "Decrypt OpenPGP armors in the current buffer.
@@ -98,7 +111,7 @@ Don't use this command in Lisp programs!"
    (save-excursion
      (let ((verbose current-prefix-arg)
 	   (context (epg-make-context epa-protocol))
-	   recipients recipient-keys)
+	   recipients recipient-key)
        (goto-char (point-min))
        (save-restriction
 	 (narrow-to-region (point)
@@ -129,21 +142,22 @@ Don't use this command in Lisp programs!"
 If no one is selected, symmetric encryption will be performed.  "
 		  recipients)
 	       (if recipients
-		   (apply #'nconc
-			  (mapcar
-			   (lambda (recipient)
-			     (setq recipient-keys
-				   (epg-list-keys
-				    (epg-make-context epa-protocol)
-				    (concat "<" recipient ">")))
-			     (unless (or recipient-keys
-					 (y-or-n-p
-					  (format
-					   "No public key for %s; skip it? "
-					   recipient)))
-			       (error "No public key for %s" recipient))
-			     recipient-keys)
-			   recipients))))
+		   (mapcar
+		    (lambda (recipient)
+		      (setq recipient-key
+			    (epa-mail--find-usable-key
+			     (epg-list-keys
+			      (epg-make-context epa-protocol)
+			      (concat "<" 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))
+		      recipient-key)
+		    recipients)))
 	     (setq sign (if verbose (y-or-n-p "Sign? ")))
 	     (if sign
 		 (epa-select-keys context