;;; set-theme.el
;;;
;;; Copyright (C) 2000, 2002, 2003, 2004, 2006, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released under
;;; the terms of the GNU General Public License as published by the
;;; Free Software Foundation; either version 3, or (at your option) any
;;; later version.  There is NO WARRANTY.  See file COPYING for details.
;;;
;;; Description: Select an appearance configuration.

(defvar themes '(;;name       bg    fg        m-fg    m-bg (optional)
                 (classic-ttn \#a85 black     white   black)
                 (new-earthy  black sienna    gray30)
                 (zzzzzzzzzz  black darkgreen black)
                 (caffeine    black yellow    white)
                 (polar       white black     white   black)
                 (dream       black cyan      white   blue)
                 (fuori-fuso  black green     magenta)
                 (vt220       black goldenrod gray30))
  "List w/ elements of form:
 \(NAME BACKGROUND FOREGROUND MODELINE-FOREGROUND [MODELINE-BACKGROUND]\)
If MODELINE-BACKGROUND is not specified, it defaults to BACKGROUND.
All elements are symbols.  Use `\\#RGB' to specify a color using RGB components.")

;;;###autoload
(defun set-theme (name)
  "Select appearance configuration NAME.  (See variable `themes'.)"
  (interactive (list (completing-read "Theme: "
                                      (mapcar 'list
                                              (mapcar 'symbol-name
                                                      (mapcar 'car
                                                              themes)))
                                      nil       ;;; predicate
                                      t)))      ;;; require-match
  (when (symbolp name)
    (setq name (symbol-name name)))
  (if (string= "" name)
      (message "(%d themes, none chosen)"
               (and
                (describe-variable 'themes)
                (length themes)))
    (apply (lambda (bg fg m-fg &optional m-bg)
             (set-face-foreground 'default fg)
             (set-face-background 'default bg)
             (let ((v [set-face-background set-face-foreground])
                   (i (if (face-inverse-video-p 'mode-line) 0 1)))
               (funcall (aref v      i)  'mode-line m-fg)
               (funcall (aref v (- 1 i)) 'mode-line (or m-bg bg))))
           (mapcar 'symbol-name
                   (cdr (assq (intern name) themes))))))

(provide 'set-theme)

;;; set-theme.el ends here