Merge from trunk.

7 files changed, 97 insertions, 61 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7f4462179ec..abae693d0c8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2011-10-15  Glenn Morris  <rgm@gnu.org>
+
+	* emacs-lisp/ert.el (ert--explain-equal-rec, ert-select-tests):
+	Doc fixes.
+
+2011-10-15  Chong Yidong  <cyd@stupidchicken.com>
+
+	* net/network-stream.el (network-stream-open-starttls): Improve
+	detection of failure due to lack of TLS support.
+
+	* mail/sendmail.el (sendmail-query-once): Tweak prompt message,
+	putting the input text in front and in bold.
+
 2011-10-14  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* pcmpl-unix.el (pcomplete/ssh): SSH does allow ganging.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index b2e20843856..2afe42dc070 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -577,8 +577,7 @@ failed."
     (t x)))
 
 (defun ert--explain-equal-rec (a b)
-  "Returns a programmer-readable explanation of why A and B are not `equal'.
-
+  "Return a programmer-readable explanation of why A and B are not `equal'.
 Returns nil if they are."
   (if (not (equal (type-of a) (type-of b)))
       `(different-types ,a ,b)
@@ -1020,36 +1019,36 @@ t -- Always matches.
   (ert-test-result-type-p result (ert-test-expected-result-type test)))
 
 (defun ert-select-tests (selector universe)
-  "Return the tests that match SELECTOR.
-
-UNIVERSE specifies the set of tests to select from; it should be
-a list of tests, or t, which refers to all tests named by symbols
-in `obarray'.
+  "Return a list of tests that match SELECTOR.
 
-Returns the set of tests as a list.
+UNIVERSE specifies the set of tests to select from; it should be a list
+of tests, or t, which refers to all tests named by symbols in `obarray'.
 
-Valid selectors:
+Valid SELECTORs:
 
-nil -- Selects the empty set.
-t -- Selects UNIVERSE.
+nil  -- Selects the empty set.
+t    -- Selects UNIVERSE.
 :new -- Selects all tests that have not been run yet.
-:failed, :passed -- Select tests according to their most recent result.
+:failed, :passed       -- Select tests according to their most recent result.
 :expected, :unexpected -- Select tests according to their most recent result.
-a string -- Selects all tests that have a name that matches the string,
-            a regexp.
-a test -- Selects that test.
+a string -- A regular expression selecting all tests with matching names.
+a test   -- (i.e., an object of the ert-test data-type) Selects that test.
 a symbol -- Selects the test that the symbol names, errors if none.
-\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests.
+\(member TESTS...) -- Selects the elements of TESTS, a list of tests
+    or symbols naming tests.
 \(eql TEST\) -- Selects TEST, a test or a symbol naming a test.
-\(and SELECTORS...\) -- Selects the tests that match all SELECTORS.
-\(or SELECTORS...\) -- Selects the tests that match any SELECTOR.
-\(not SELECTOR\) -- Selects all tests that do not match SELECTOR.
+\(and SELECTORS...) -- Selects the tests that match all SELECTORS.
+\(or SELECTORS...)  -- Selects the tests that match any of the SELECTORS.
+\(not SELECTOR)     -- Selects all tests that do not match SELECTOR.
 \(tag TAG) -- Selects all tests that have TAG on their tags list.
-\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE.
+    A tag is an arbitrary label you can apply when you define a test.
+\(satisfies PREDICATE) -- Selects all tests that satisfy PREDICATE.
+    PREDICATE is a function that takes an ert-test object as argument,
+    and returns non-nil if it is selected.
 
 Only selectors that require a superset of tests, such
 as (satisfies ...), strings, :new, etc. make use of UNIVERSE.
-Selectors that do not, such as \(member ...\), just return the
+Selectors that do not, such as (member ...), just return the
 set implied by them without checking whether it is really
 contained in UNIVERSE."
   ;; This code needs to match the etypecase in
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2fd624e819b..cc2568a3647 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2011-10-17  Daiki Ueno  <ueno@unixuser.org>
+
+	* mml2015.el (mml2015-epg-find-usable-key): Skip the whole key if the
+	primary key is marked as disabled.
+	* mml1991.el (mml1991-epg-find-usable-key): Ditto.
+	Thanks to Christian von Roques <roques@mti.ag>.
+
 2011-10-11  Andreas Schwab  <schwab@linux-m68k.org>
 
 	* html2text.el (html2text-clean-anchor): Check for quotes around
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index ad9f95796fe..1777a660319 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -282,13 +282,16 @@ Whether the passphrase is cached at all is controlled by
   (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 'disabled (epg-sub-key-capability (car pointer))))
-		   (not (memq (epg-sub-key-validity (car pointer))
-			      '(revoked expired))))
-	      (throw 'found (car keys)))
-	  (setq pointer (cdr pointer))))
+	;; The primary key will be marked as disabled, when the entire
+	;; key is disabled (see 12 Field, Format of colon listings, in
+	;; gnupg/doc/DETAILS)
+	(unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+	  (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)))))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index b9310beed58..028955a8c33 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -788,13 +788,16 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
   (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 'disabled (epg-sub-key-capability (car pointer))))
-		   (not (memq (epg-sub-key-validity (car pointer))
-			      '(revoked expired))))
-	      (throw 'found (car keys)))
-	  (setq pointer (cdr pointer))))
+	;; The primary key will be marked as disabled, when the entire
+	;; key is disabled (see 12 Field, Format of colon listings, in
+	;; gnupg/doc/DETAILS)
+	(unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+	  (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)))))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index d685b8b3e70..6044392d4e0 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -513,34 +513,40 @@ This also saves the value of `send-mail-function' via Customize."
   ;; a second time, probably because someone's using an old value
   ;; of send-mail-function.
   (when (eq send-mail-function 'sendmail-query-once)
-    (let* ((options `(("Mail client" . mailclient-send-it)
+    (let* ((options `(("mail client" . mailclient-send-it)
                       ,@(when (and sendmail-program
                                    (executable-find sendmail-program))
-                          '(("Mail transport agent" . sendmail-send-it)))
-                      ("SMTP server" . smtpmail-send-it)))
+                          '(("transport" . sendmail-send-it)))
+                      ("smtp" . smtpmail-send-it)))
            (choice
             ;; Query the user.
             (with-temp-buffer
               (rename-buffer "*Emacs Mail Setup Help*" t)
               (insert "\
- Emacs is about to send an email message.  However, it was not configured
- for sending email.  You can instruct Emacs to send email in one of the
- following ways:
-
- - Start your default mail client and pass to it the message text.
-   Type \"Mail client\" at the prompt below to select this option.\n\n")
-	      (if (and sendmail-program
-		       (executable-find sendmail-program))
-		  (insert "\
- - Invoke the system's mail transport agent (\"sendmail\").
-   Type \"Mail transport agent\" at the prompt below to select this option.\n\n"))
+ Emacs is about to send an email message, but it has not been
+ configured for sending email.  To tell Emacs how to send email:
+
+ - Type `"
+		      (propertize "mail client" 'face 'bold)
+		      "' to start your default email client and
+   pass it the message text.\n\n")
+	      (and sendmail-program
+		   (executable-find sendmail-program)
+		   (insert "\
+ - Type `"
+			   (propertize "transport" 'face 'bold)
+			   "' to invoke the system's mail transport agent
+   (the `"
+			   sendmail-program
+			   "' program).\n\n"))
 	      (insert "\
- - Send mail directly by communicating with your mail server
-   (this requires setting up SMTP parameters).
-   Type \"SMTP server\" at the prompt below to select this option.
+ - Type `"
+		      (propertize "smtp" 'face 'bold)
+		      "' to send mail directly to an \"outgoing mail\" server.
+   (Emacs may prompt you for SMTP settings).
 
- Emacs will record your selection and will use it thereafter.  To change
- your selection later, customize the option `send-mail-function'.\n")
+ Emacs will record your selection and will use it thereafter.
+ To change it later, customize the option `send-mail-function'.\n")
               (goto-char (point-min))
               (display-buffer (current-buffer))
               (let ((completion-ignore-case t))
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 0c3d0285f91..e27b4541ab5 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -218,7 +218,7 @@ functionality.
 	 (resulting-type 'plain)
 	 (builtin-starttls (and (fboundp 'gnutls-available-p)
 				(gnutls-available-p)))
-	 starttls-command error)
+	 starttls-available starttls-command error)
 
     ;; First check whether the server supports STARTTLS at all.
     (when (and capabilities success-string starttls-function)
@@ -227,10 +227,11 @@ functionality.
     ;; If we have built-in STARTTLS support, try to upgrade the
     ;; connection.
     (when (and starttls-command
-	       (or builtin-starttls
-		   (and (or require-tls
-			    (plist-get parameters :use-starttls-if-possible))
-			(starttls-available-p)))
+	       (setq starttls-available
+		     (or builtin-starttls
+			 (and (or require-tls
+				  (plist-get parameters :use-starttls-if-possible))
+			      (starttls-available-p))))
 	       (not (eq (plist-get parameters :type) 'plain)))
       ;; If using external STARTTLS, drop this connection and start
       ;; anew with `starttls-open-stream'.
@@ -298,9 +299,13 @@ functionality.
 	       ;; support, or no gnutls-cli installed.
 	       (eq resulting-type 'plain))
       (setq error
-	    (if require-tls
+	    (if starttls-available
 		"Server does not support TLS"
-	      "Server supports STARTTLS, but Emacs does not have support for it"))
+	      (concat "Emacs does not support TLS, and no external `"
+		      (if starttls-use-gnutls
+			  starttls-gnutls-program
+			starttls-program)
+		      "' program was found")))
       (delete-process stream)
       (setq stream nil))
     ;; Return value: