Commit e8f2a944 authored by Paul Eggert's avatar Paul Eggert
Browse files

Merge from trunk.

parents f66c7cf8 c5dd5a51
2011-06-14 Chong Yidong <cyd@stupidchicken.com>
* themes/dichromacy-theme.el: New theme.
2011-06-07 Paul Eggert <eggert@cs.ucla.edu> 2011-06-07 Paul Eggert <eggert@cs.ucla.edu>
* NEWS: Mention new configure option --with-wide-int. * NEWS: Mention new configure option --with-wide-int.
......
;;; 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
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
;;; Code: ;;; Code:
(deftheme light-blue (deftheme light-blue
"Theme with a light blue backgound.") "Face colors utilizing a light blue backgound.")
(let ((class '((class color) (min-colors 89)))) (let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces (custom-theme-set-faces
......
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
;;; Code: ;;; Code:
(deftheme misterioso (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)))) (let ((class '((class color) (min-colors 89))))
......
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
;;; Code: ;;; Code:
(deftheme tango-dark (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, Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.") Semantic, and Ansi-Color faces are included.")
......
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
;;; Code: ;;; Code:
(deftheme tango (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, Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.") Semantic, and Ansi-Color faces are included.")
......
...@@ -20,7 +20,8 @@ ...@@ -20,7 +20,8 @@
;;; Code: ;;; Code:
(deftheme tsdh-dark (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 (custom-theme-set-faces
'tsdh-dark 'tsdh-dark
......
...@@ -20,7 +20,8 @@ ...@@ -20,7 +20,8 @@
;;; Code: ;;; Code:
(deftheme tsdh-light (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 (custom-theme-set-faces
'tsdh-light 'tsdh-light
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
;;; Code: ;;; Code:
(deftheme wheatgrass (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. Basic, Font Lock, Isearch, Gnus, and Message faces are included.
The default face foreground is wheat, with other faces in shades The default face foreground is wheat, with other faces in shades
of green, brown, and blue.") of green, brown, and blue.")
......
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
;;; Code: ;;; Code:
(deftheme wombat (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. Adapted, with permission, from a Vim color scheme by Lars H. Nielsen.
Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces
are included.") are included.")
......
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> 2011-06-13 Glenn Morris <rgm@gnu.org>
* cus-dep.el (custom-make-dependencies): Use up command-line-args-left. * cus-dep.el (custom-make-dependencies): Use up command-line-args-left.
......
...@@ -483,25 +483,24 @@ It includes all faces in list FACES." ...@@ -483,25 +483,24 @@ It includes all faces in list FACES."
'help-theme-def fn) 'help-theme-def fn)
(princ "'")) (princ "'"))
(princ ".\n") (princ ".\n")
(if (not (memq theme custom-known-themes)) (if (custom-theme-p theme)
(progn (progn
(princ "It is not loaded.") (if (custom-theme-enabled-p theme)
;; Attempt to grab the theme documentation (princ "It is loaded and enabled.")
(when fn (princ "It is loaded but disabled."))
(with-temp-buffer (setq doc (get theme 'theme-documentation)))
(insert-file-contents fn) (princ "It is not loaded.")
(let ((sexp (let ((read-circle nil)) ;; Attempt to grab the theme documentation
(condition-case nil (when fn
(read (current-buffer)) (with-temp-buffer
(end-of-file nil))))) (insert-file-contents fn)
(and sexp (listp sexp) (let ((sexp (let ((read-circle nil))
(eq (car sexp) 'deftheme) (condition-case nil
(setq doc (nth 2 sexp))))))) (read (current-buffer))
(if (custom-theme-enabled-p theme) (end-of-file nil)))))
(princ "It is loaded and enabled.") (and sexp (listp sexp)
(princ "It is loaded but disabled.")) (eq (car sexp) 'deftheme)
(setq doc (get theme 'theme-documentation))) (setq doc (nth 2 sexp)))))))
(princ "\n\nDocumentation:\n") (princ "\n\nDocumentation:\n")
(princ (if (stringp doc) (princ (if (stringp doc)
doc doc
...@@ -605,26 +604,56 @@ Theme files are named *-theme.el in `")) ...@@ -605,26 +604,56 @@ Theme files are named *-theme.el in `"))
(widget-create 'checkbox (widget-create 'checkbox
:value custom-theme-allow-multiple-selections :value custom-theme-allow-multiple-selections
:action 'custom-theme-selections-toggle) :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)))) 'face '(variable-pitch (:height 0.9))))
(widget-insert "\n\nAvailable Custom Themes:\n") (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)) (dolist (theme (custom-available-themes))
(setq widget (widget-create 'checkbox (setq widget (widget-create 'checkbox
:value (custom-theme-enabled-p theme) :value (custom-theme-enabled-p theme)
:theme-name theme :theme-name theme
:help-echo help-echo
:action 'custom-theme-checkbox-toggle)) :action 'custom-theme-checkbox-toggle))
(push (cons theme widget) custom--listed-themes) (push (cons theme widget) custom--listed-themes)
(widget-create-child-and-convert widget 'push-button (widget-create-child-and-convert widget 'push-button
:button-face-get 'ignore :button-face-get 'ignore
:mouse-face-get 'ignore :mouse-face-get 'ignore
:value (format " %s" theme) :value (format " %s" theme)
:action 'widget-parent-action) :action 'widget-parent-action
(widget-insert ?\n))) :help-echo help-echo)
(widget-insert " -- "
(propertize (custom-theme-summary theme)
'face 'shadow)
?\n)))
(goto-char (point-min)) (goto-char (point-min))
(widget-setup)) (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) (defun custom-theme-checkbox-toggle (widget &optional event)
(let ((this-theme (widget-get widget :theme-name))) (let ((this-theme (widget-get widget :theme-name)))
(if (widget-value widget) (if (widget-value widget)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment