Commit c5dd5a51 authored by Chong Yidong's avatar Chong Yidong

Print theme summaries in *Custom Themes* buffer.

* lisp/cus-theme.el (describe-theme-1): Use custom-theme-p.
(custom-theme-summary): New function.
(customize-themes): Use it.

* etc/themes/light-blue-theme.el:
* etc/themes/misterioso-theme.el:
* etc/themes/tango-dark-theme.el:
* etc/themes/tango-theme.el:
* etc/themes/tsdh-dark-theme.el:
* etc/themes/tsdh-light-theme.el:
* etc/themes/wheatgrass-theme.el:
* etc/themes/wombat-theme.el: Tweak summaries for better listability.
parent b9958282
......@@ -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