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>
* 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 @@
;;; 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
......
......@@ -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))))
......
......@@ -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.")
......
......@@ -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.")
......
......@@ -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
......
......@@ -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
......
......@@ -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.")
......
......@@ -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.")
......
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.
......
......@@ -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)
......
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