Merge from trunk.

etc/ChangeLog

+2011-06-14  Chong Yidong  <cyd@stupidchicken.com>
+
+	* themes/dichromacy-theme.el: New theme.
+
 2011-06-07  Paul Eggert  <eggert@cs.ucla.edu>
 
 	* NEWS: Mention new configure option --with-wide-int.

etc/themes/dichromacy-theme.el

+;;; dichromacy-theme.el --- color theme suitable for color-blind users
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Chong Yidong <cyd@stupidchicken>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(deftheme dichromacy
+  "Face colors suitable for red/green color-blind users.
+The color palette is from B. Wong, Nature Methods 8, 441 (2011).
+It is intended to provide good variability while being easily
+differentiated by individuals with protanopia or deuteranopia.
+
+Basic, Font Lock, Isearch, Gnus, Message, Flyspell, and
+Ansi-Color faces are included.")
+
+(let ((class '((class color) (min-colors 89)))
+      (orange "#e69f00")
+      (skyblue "#56b4e9")
+      (bluegreen "#009e73")
+      (yellow "#f8ec59")
+      (blue "#0072b2")
+      (vermillion "#d55e00")
+      (redpurple "#cc79a7")
+      (bluegray "#848ea9"))
+  (custom-theme-set-faces
+   'dichromacy
+   `(default ((,class (:foreground "black" :background "white"))))
+   `(cursor ((,class (:foreground "white" :background "black"))))
+   ;; Highlighting faces
+   `(fringe ((,class (:background "#f7f7f7"))))
+   `(highlight ((,class (:foreground ,blue :background "#e5e5e5"))))
+   `(region ((,class (:foreground unspecified :background ,yellow))))
+   `(secondary-selection ((,class (:background "#e5e5e5"))))
+   `(isearch ((,class (:foreground "white" :background ,vermillion))))
+   `(lazy-highlight ((,class (:foreground "white" :background ,redpurple))))
+   `(trailing-whitespace ((,class (:background ,vermillion))))
+   ;; Mode line faces
+   `(mode-line ((,class (:box (:line-width -1 :style released-button)
+			      :background "#e5e5e5" :foreground "black"))))
+   `(mode-line-inactive ((,class (:box (:line-width -1 :style released-button)
+				       :background "#b0b0b0"
+				       :foreground "black"))))
+   ;; Escape and prompt faces
+   `(minibuffer-prompt ((,class (:weight bold :foreground ,blue))))
+   `(escape-glyph ((,class (:foreground ,vermillion))))
+   ;; Font lock faces
+   `(font-lock-builtin-face ((,class (:foreground ,blue))))
+   `(font-lock-comment-face ((,class (:slant italic :foreground ,bluegreen))))
+   `(font-lock-constant-face ((,class (:weight bold :foreground ,vermillion))))
+   `(font-lock-function-name-face ((,class (:foreground ,vermillion))))
+   `(font-lock-keyword-face ((,class (:weight bold :foreground ,skyblue))))
+   `(font-lock-string-face ((,class (:foreground ,bluegray))))
+   `(font-lock-type-face ((,class (:weight bold :foreground ,blue))))
+   `(font-lock-variable-name-face ((,class (:weight bold :foreground ,orange))))
+   `(font-lock-warning-face ((,class (:weight bold :slant italic
+				      :foreground ,vermillion))))
+   ;; Button and link faces
+   `(button ((,class (:underline t :foreground ,blue))))
+   `(link ((,class (:underline t :foreground ,blue))))
+   `(link-visited ((,class (:underline t :foreground ,redpurple))))
+   ;; Gnus faces
+   `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermillion))))
+   `(gnus-group-news-1-low ((,class (:foreground ,vermillion))))
+   `(gnus-group-news-2 ((,class (:weight bold :foreground ,orange))))
+   `(gnus-group-news-2-low ((,class (:foreground ,orange))))
+   `(gnus-group-news-3 ((,class (:weight bold :foreground ,skyblue))))
+   `(gnus-group-news-3-low ((,class (:foreground ,skyblue))))
+   `(gnus-group-news-4 ((,class (:weight bold :foreground ,redpurple))))
+   `(gnus-group-news-4-low ((,class (:foreground ,redpurple))))
+   `(gnus-group-news-5 ((,class (:weight bold :foreground ,blue))))
+   `(gnus-group-news-5-low ((,class (:foreground ,blue))))
+   `(gnus-group-news-low ((,class (:foreground ,bluegreen))))
+   `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermillion))))
+   `(gnus-group-mail-1-low ((,class (:foreground ,vermillion))))
+   `(gnus-group-mail-2 ((,class (:weight bold :foreground ,orange))))
+   `(gnus-group-mail-2-low ((,class (:foreground ,orange))))
+   `(gnus-group-mail-3 ((,class (:weight bold :foreground ,skyblue))))
+   `(gnus-group-mail-3-low ((,class (:foreground ,skyblue))))
+   `(gnus-group-mail-low ((,class (:foreground ,bluegreen))))
+   `(gnus-header-content ((,class (:foreground ,redpurple))))
+   `(gnus-header-from ((,class (:weight bold :foreground ,blue))))
+   `(gnus-header-subject ((,class (:foreground ,orange))))
+   `(gnus-header-name ((,class (:foreground ,skyblue))))
+   `(gnus-header-newsgroups ((,class (:foreground ,vermillion))))
+   ;; Message faces
+   `(message-header-name ((,class (:foreground ,skyblue))))
+   `(message-header-cc ((,class (:foreground ,vermillion))))
+   `(message-header-other ((,class (:foreground ,bluegreen))))
+   `(message-header-subject ((,class (:foreground ,orange))))
+   `(message-header-to ((,class (:weight bold :foreground ,blue))))
+   `(message-cited-text ((,class (:slant italic :foreground ,bluegreen))))
+   `(message-separator ((,class (:weight bold :foreground ,redpurple))))
+   ;; Flyspell
+   `(flyspell-duplicate ((,class (:weight unspecified :foreground unspecified
+				  :slant unspecified :underline ,orange))))
+   `(flyspell-incorrect ((,class (:weight unspecified :foreground unspecified
+				  :slant unspecified :underline ,redpurple)))))
+
+  (custom-theme-set-variables
+   'dichromacy
+   `(ansi-color-names-vector ["black" ,vermillion ,bluegreen ,yellow
+			      ,blue ,redpurple ,skyblue "white"])))
+
+(provide-theme 'dichromacy)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; dichromacy-theme.el ends here

etc/themes/light-blue-theme.el

@@ -26,7 +26,7 @@
 ;;; Code:
 
 (deftheme light-blue
-  "Theme with a light blue backgound.")
+  "Face colors utilizing a light blue backgound.")
 
 (let ((class '((class color) (min-colors 89))))
   (custom-theme-set-faces

etc/themes/misterioso-theme.el

@@ -22,7 +22,7 @@
 ;;; Code:
 
 (deftheme misterioso
-  "Theme for faces, using light colors on a dark gray background.")
+  "Predominantly blue/cyan faces on a dark cyan background.")
 
 (let ((class '((class color) (min-colors 89))))
 

etc/themes/tango-dark-theme.el

@@ -28,7 +28,7 @@
 ;;; Code:
 
 (deftheme tango-dark
-  "Theme for faces, based on the Tango palette with a dark background.
+  "Face colors using the Tango palette (dark background).
 Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
 Semantic, and Ansi-Color faces are included.")
 

etc/themes/tango-theme.el

@@ -28,7 +28,7 @@
 ;;; Code:
 
 (deftheme tango
-  "Theme for faces, based on the Tango palette with a light background.
+  "Face colors using the Tango palette (light background).
 Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
 Semantic, and Ansi-Color faces are included.")
 

etc/themes/tsdh-dark-theme.el

@@ -20,7 +20,8 @@
 ;;; Code:
 
 (deftheme tsdh-dark
-  "Theme with dark background used and created by Tassilo Horn.")
+  "Minor tweaks to the Emacs dark-background defaults.
+Used and created by Tassilo Horn.")
 
 (custom-theme-set-faces
  'tsdh-dark

etc/themes/tsdh-light-theme.el

@@ -20,7 +20,8 @@
 ;;; Code:
 
 (deftheme tsdh-light
-  "Black on white theme used and created by Tassilo Horn.")
+  "Minor tweaks to the Emacs white-background defaults.
+Used and created by Tassilo Horn.")
 
 (custom-theme-set-faces
  'tsdh-light

etc/themes/wheatgrass-theme.el

@@ -20,7 +20,7 @@
 ;;; Code:
 
 (deftheme wheatgrass
-  "A high-contrast theme with a black background.
+  "High-contrast green/blue/brown faces on a black background.
 Basic, Font Lock, Isearch, Gnus, and Message faces are included.
 The default face foreground is wheat, with other faces in shades
 of green, brown, and blue.")

etc/themes/wombat-theme.el

@@ -22,7 +22,7 @@
 ;;; Code:
 
 (deftheme wombat
-  "Theme for faces, using easy-on-the eyes colors on a dark gray background.
+  "Medium-contrast faces with a dark gray background.
 Adapted, with permission, from a Vim color scheme by Lars H. Nielsen.
 Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces
 are included.")

lisp/ChangeLog

+2011-06-14  Chong Yidong  <cyd@stupidchicken.com>
+
+	* cus-theme.el (describe-theme-1): Use custom-theme-p.
+	(custom-theme-summary): New function.
+	(customize-themes): Use it.
+
 2011-06-13  Glenn Morris  <rgm@gnu.org>
 
 	* cus-dep.el (custom-make-dependencies): Use up command-line-args-left.

lisp/cus-theme.el

@@ -483,25 +483,24 @@ It includes all faces in list FACES."
 			       'help-theme-def fn)
       (princ "'"))
     (princ ".\n")
-    (if (not (memq theme custom-known-themes))
+    (if (custom-theme-p theme)
 	(progn
-	  (princ "It is not loaded.")
-	  ;; Attempt to grab the theme documentation
-	  (when fn
-	    (with-temp-buffer
-	      (insert-file-contents fn)
-	      (let ((sexp (let ((read-circle nil))
-			    (condition-case nil
-				(read (current-buffer))
-			      (end-of-file nil)))))
-		(and sexp (listp sexp)
-		     (eq (car sexp) 'deftheme)
-		     (setq doc (nth 2 sexp)))))))
-      (if (custom-theme-enabled-p theme)
-	  (princ "It is loaded and enabled.")
-	(princ "It is loaded but disabled."))
-      (setq doc (get theme 'theme-documentation)))
-
+	  (if (custom-theme-enabled-p theme)
+	      (princ "It is loaded and enabled.")
+	    (princ "It is loaded but disabled."))
+	  (setq doc (get theme 'theme-documentation)))
+      (princ "It is not loaded.")
+      ;; Attempt to grab the theme documentation
+      (when fn
+	(with-temp-buffer
+	  (insert-file-contents fn)
+	  (let ((sexp (let ((read-circle nil))
+			(condition-case nil
+			    (read (current-buffer))
+			  (end-of-file nil)))))
+	    (and sexp (listp sexp)
+		 (eq (car sexp) 'deftheme)
+		 (setq doc (nth 2 sexp)))))))
     (princ "\n\nDocumentation:\n")
     (princ (if (stringp doc)
 	       doc
@@ -605,26 +604,56 @@ Theme files are named *-theme.el in `"))
   (widget-create 'checkbox
 		 :value custom-theme-allow-multiple-selections
 		 :action 'custom-theme-selections-toggle)
-  (widget-insert (propertize " Allow more than one theme at a time"
+  (widget-insert (propertize " Select more than one theme at a time"
 			     'face '(variable-pitch (:height 0.9))))
 
   (widget-insert "\n\nAvailable Custom Themes:\n")
-  (let (widget)
+  (let ((help-echo "mouse-2: Enable this theme for this session")
+	widget)
     (dolist (theme (custom-available-themes))
       (setq widget (widget-create 'checkbox
 				  :value (custom-theme-enabled-p theme)
 				  :theme-name theme
+				  :help-echo help-echo
 				  :action 'custom-theme-checkbox-toggle))
       (push (cons theme widget) custom--listed-themes)
       (widget-create-child-and-convert widget 'push-button
 				       :button-face-get 'ignore
 				       :mouse-face-get 'ignore
 				       :value (format " %s" theme)
-				       :action 'widget-parent-action)
-      (widget-insert ?\n)))
+				       :action 'widget-parent-action
+				       :help-echo help-echo)
+      (widget-insert " -- "
+		     (propertize (custom-theme-summary theme)
+				 'face 'shadow)
+		     ?\n)))
   (goto-char (point-min))
   (widget-setup))
 
+(defun custom-theme-summary (theme)
+  "Return the summary line of THEME."
+  (let (doc)
+    (if (custom-theme-p theme)
+	(setq doc (get theme 'theme-documentation))
+      (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
+			     (custom-theme--load-path)
+			     '("" "c"))))
+	(when fn
+	  (with-temp-buffer
+	    (insert-file-contents fn)
+	    (let ((sexp (let ((read-circle nil))
+			  (condition-case nil
+			      (read (current-buffer))
+			    (end-of-file nil)))))
+	      (and sexp (listp sexp)
+		   (eq (car sexp) 'deftheme)
+		   (setq doc (nth 2 sexp))))))))
+    (cond ((null doc)
+	   "(no documentation available)")
+	  ((string-match ".*" doc)
+	   (match-string 0 doc))
+	  (t doc))))
+
 (defun custom-theme-checkbox-toggle (widget &optional event)
   (let ((this-theme (widget-get widget :theme-name)))
     (if (widget-value widget)