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 @@ ...@@ -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