emacs.d/lisp: added color-theme module

2 files changed, 1664 insertions, 0 deletions

diff --git a/emacs.d/lisp/color-theme.el b/emacs.d/lisp/color-theme.el
new file mode 100644
index 0000000..0467ca6
--- /dev/null
+++ b/emacs.d/lisp/color-theme.el
@@ -0,0 +1,1664 @@
+;;; color-theme.el --- install color themes
+
+;; Copyright (C) 1999, 2000  Jonadab the Unsightly One <jonadab@bright.net>
+;; Copyright (C) 2000, 2001, 2002, 2003  Alex Schroeder <alex@gnu.org>
+;; Copyright (C) 2003, 2004, 2005, 2006  Xavier Maillard <zedek@gnu.org>
+
+;; Version: 6.6.0
+;; Keywords: faces
+;; Author: Jonadab the Unsightly One <jonadab@bright.net>
+;; Maintainer: Xavier Maillard <zedek@gnu.org>
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme
+
+;; This file is not (YET) part of GNU Emacs.
+
+;; This 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 2, or (at your option) any later
+;; version.
+;;
+;; This 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Please read README and BUGS files for any relevant help.
+;; Contributors (not themers) should also read HACKING file.
+
+;;; Thanks
+
+;; Deepak Goel  <deego@glue.umd.edu>
+;; S. Pokrovsky <pok@nbsp.nsk.su> for ideas and discussion.
+;; Gordon Messmer <gordon@dragonsdawn.net> for ideas and discussion.
+;; Sriram Karra <karra@cs.utah.edu> for the color-theme-submit stuff.
+;; Olgierd `Kingsajz' Ziolko <kingsajz@rpg.pl> for the spec-filter idea.
+;; Brian Palmer for color-theme-library ideas and code
+;; All the users that contributed their color themes.
+
+
+
+;;; Code:
+(eval-when-compile
+  (require 'easymenu)
+  (require 'reporter)
+  (require 'sendmail))
+
+(require 'cl); set-difference is a function...
+
+;; for custom-face-attributes-get or face-custom-attributes-get
+(require 'cus-face)
+(require 'wid-edit); for widget-apply stuff in cus-face.el
+
+(defconst color-theme-maintainer-address "zedek@gnu.org"
+  "Address used by `submit-color-theme'.")
+
+;; Emacs / XEmacs compatibility and workaround layer
+
+(cond ((and (facep 'tool-bar)
+	    (not (facep 'toolbar)))
+       (put 'toolbar 'face-alias 'tool-bar))
+      ((and (facep 'toolbar)
+	    (not (facep 'tool-bar)))
+       (put 'tool-bar 'face-alias 'toolbar)))
+
+(defvar color-theme-xemacs-p (and (featurep 'xemacs) 
+                                  (string-match "XEmacs" emacs-version))
+  "Non-nil if running XEmacs.")
+
+;; face-attr-construct has a problem in Emacs 20.7 and older when
+;; dealing with inverse-video faces.  Here is a short test to check
+;; wether you are affected.
+
+;; (set-background-color "wheat")
+;; (set-foreground-color "black")
+;; (setq a (make-face 'a-face))
+;; (face-spec-set a '((t (:background "white" :foreground "black" :inverse-video t))))
+;; (face-attr-construct a)
+;;     => (:background "black" :inverse-video t)
+
+;; The expected response is the original specification:
+;;     => (:background "white" :foreground "black" :inverse-video t)
+
+;; That's why we depend on cus-face.el functionality.
+
+(cond ((fboundp 'custom-face-attributes-get)
+       (defun color-theme-face-attr-construct (face frame)
+         (if (atom face)
+             (custom-face-attributes-get face frame)
+             (if (and (consp face) (eq (car face) 'quote))
+                 (custom-face-attributes-get (cadr face) frame)
+                 (custom-face-attributes-get (car face) frame)))))
+      ((fboundp 'face-custom-attributes-get)
+       (defalias 'color-theme-face-attr-construct
+	 'face-custom-attributes-get))
+      (t
+       (defun color-theme-face-attr-construct (&rest ignore)
+	 (error "Unable to construct face attributes"))))
+
+(defun color-theme-alist (plist)
+  "Transform PLIST into an alist if it is a plist and return it.
+If the first element of PLIST is a cons cell, we just return PLIST,
+assuming PLIST to be an alist.  If the first element of plist is not a
+symbol, this is an error: We cannot distinguish a plist from an ordinary
+list, but a list that doesn't start with a symbol is certainly no plist
+and no alist.
+
+This is used to make sure `default-frame-alist' really is an alist and not
+a plist.  In XEmacs, the alist is deprecated; a plist is used instead."
+  (cond ((consp (car plist))
+	 plist)
+	((not (symbolp (car plist)))
+	 (error "Wrong type argument: plist, %S" plist))
+	((featurep 'xemacs)
+	 (plist-to-alist plist)))); XEmacs only
+
+;; Customization
+
+(defgroup color-theme nil
+  "Color Themes for Emacs.
+A color theme consists of frame parameter settings, variable settings,
+and face definitions."
+  :version "20.6"
+  :group 'faces)
+
+(defcustom color-theme-legal-frame-parameters "\\(color\\|mode\\)$"
+  "Regexp that matches frame parameter names.
+Only frame parameter names that match this regexp can be changed as part
+of a color theme."
+  :type '(choice (const :tag "Colors only" "\\(color\\|mode\\)$")
+		 (const :tag "Colors, fonts, and size"
+			"\\(color\\|mode\\|font\\|height\\|width\\)$")
+		 (regexp :tag "Custom regexp"))
+  :group 'color-theme
+  :link '(info-link "(elisp)Window Frame Parameters"))
+
+(defcustom color-theme-legal-variables "\\(color\\|face\\)$"
+  "Regexp that matches variable names.
+Only variables that match this regexp can be changed as part of a color
+theme.  In addition to matching this name, the variables have to be user
+variables (see function `user-variable-p')."
+  :type 'regexp
+  :group 'color-theme)
+
+(defcustom color-theme-illegal-faces "^w3-"
+  "Regexp that matches face names forbidden in themes.
+The default setting \"^w3-\" excludes w3 faces since these
+are created dynamically."
+  :type 'regexp
+  :group 'color-theme
+  :link '(info-link "(elisp)Faces for Font Lock")
+  :link '(info-link "(elisp)Standard Faces"))
+
+(defcustom color-theme-illegal-default-attributes '(:family :height :width)
+  "A list of face properties to be ignored when installing faces.
+This prevents Emacs from doing terrible things to your display just because
+a theme author likes weird fonts."
+  :type '(repeat symbol)
+  :group 'color-theme)
+
+(defcustom color-theme-is-global t
+  "*Determines wether a color theme is installed on all frames or not.
+If non-nil, color themes will be installed for all frames.
+If nil, color themes will be installed for the selected frame only.
+
+A possible use for this variable is dynamic binding. Here is a larger
+example to put in your ~/.emacs; it will make the Blue Sea color theme
+the default used for the first frame, and it will create two additional
+frames with different color themes.
+
+setup:
+    \(require 'color-theme)
+    ;; set default color theme
+    \(color-theme-blue-sea)
+    ;; create some frames with different color themes
+    \(let ((color-theme-is-global nil))
+      \(select-frame (make-frame))
+      \(color-theme-gnome2)
+      \(select-frame (make-frame))
+      \(color-theme-standard))
+
+Please note that using XEmacs and and a nil value for
+color-theme-is-global will ignore any variable settings for the color
+theme, since XEmacs doesn't have frame-local variable bindings.
+
+Also note that using Emacs and a non-nil value for color-theme-is-global
+will install a new color theme for all frames.  Using XEmacs and a
+non-nil value for color-theme-is-global will install a new color theme
+only on those frames that are not using a local color theme."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-is-cumulative t
+  "*Determines wether new color themes are installed on top of each other.
+If non-nil, installing a color theme will undo all settings made by
+previous color themes."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-directory nil
+  "Directory where we can find additionnal themes (personnal).
+Note that there is at least one directory shipped with the official
+color-theme distribution where all contributed themes are located.
+This official selection can't be changed with that variable. 
+However, you still can decide to turn it on or off and thus,
+not be shown with all themes but yours."
+  :type '(repeat string)
+  :group 'color-theme)
+
+(defcustom color-theme-libraries (directory-files 
+                                  (concat 
+                                   (file-name-directory (locate-library "color-theme"))
+                                   "/themes") t "^color-theme")
+  "A list of files, which will be loaded in color-theme-initialize depending
+on `color-theme-load-all-themes' value. 
+This allows a user to prune the default color-themes (which can take a while
+to load)."
+  :type '(repeat string)
+  :group 'color-theme)
+
+(defcustom color-theme-load-all-themes t
+  "When t, load all color-theme theme files
+as presented by `color-theme-libraries'. Else
+do not load any of this themes."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-mode-hook nil
+  "Hook for color-theme-mode."
+  :type 'hook
+  :group 'color-theme)
+
+(defvar color-theme-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'color-theme-install-at-point)
+    (define-key map (kbd "c") 'list-colors-display)
+    (define-key map (kbd "d") 'color-theme-describe)
+    (define-key map (kbd "f") 'list-faces-display)
+    (define-key map (kbd "i") 'color-theme-install-at-point)
+    (define-key map (kbd "l") 'color-theme-install-at-point-for-current-frame)
+    (define-key map (kbd "p") 'color-theme-print)
+    (define-key map (kbd "q") 'bury-buffer)
+    (define-key map (kbd "?") 'color-theme-describe)
+    (if color-theme-xemacs-p
+	(define-key map (kbd "<button2>") 'color-theme-install-at-mouse)
+      (define-key map (kbd "<mouse-2>") 'color-theme-install-at-mouse))
+    map)
+  "Mode map used for the buffer created by `color-theme-select'.")
+
+(defvar color-theme-initialized nil
+  "Internal variable determining whether color-theme-initialize has been invoked yet")
+
+(defvar color-theme-buffer-name "*Color Theme Selection*"
+  "Name of the color theme selection buffer.")
+
+(defvar color-theme-original-frame-alist nil
+  "nil until one of the color themes has been installed.")
+
+(defvar color-theme-history nil
+  "List of color-themes called, in reverse order")
+
+(defcustom color-theme-history-max-length nil
+  "Max length of history to maintain.
+Two other values are acceptable: t means no limit, and
+nil means that no history is maintained."
+  :type '(choice (const :tag "No history" nil)
+		 (const :tag "Unlimited length" t)
+		 integer)
+  :group 'color-theme)
+
+(defvar color-theme-counter 0
+  "Counter for every addition to `color-theme-history'.
+This counts how many themes were installed, regardless
+of `color-theme-history-max-length'.")
+
+(defvar color-theme-entry-path (cond
+                                ;; Emacs 22.x and later
+                                ((lookup-key global-map [menu-bar tools])
+                                 '("tools"))
+                                ;; XEmacs
+                                ((featurep 'xemacs)
+                                 (setq tool-entry '("Tools")))
+                                ;; Emacs < 22
+                                (t
+                                 '("Tools")))
+  "Menu tool entry path.")
+
+(defun color-theme-add-to-history (name)
+  "Add color-theme NAME to `color-theme-history'."
+  (setq color-theme-history
+	(cons (list name color-theme-is-cumulative)
+	      color-theme-history)
+	color-theme-counter (+ 1 color-theme-counter))
+  ;; Truncate the list if necessary.
+  (when (and (integerp color-theme-history-max-length)
+	     (>= (length color-theme-history)
+		 color-theme-history-max-length))
+    (setcdr (nthcdr (1- color-theme-history-max-length)
+		    color-theme-history)
+	    nil)))
+
+;; (let ((l '(1 2 3 4 5)))
+;;   (setcdr (nthcdr 2 l) nil)
+;;   l)
+
+
+
+;; List of color themes used to create the *Color Theme Selection*
+;; buffer.
+
+(defvar color-themes
+  '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto <jari.aalto@poboxes.com>")
+    (color-theme-aalto-light "Aalto Light" "Jari Aalto <jari.aalto@poboxes.com>")
+    (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-andreas "Andreas" "Andreas Busch <Andreas.Busch@politics.ox.ac.uk>")
+    (color-theme-arjen "Arjen" "Arjen Wiersma <arjen@wiersma.org>")
+    (color-theme-beige-diff "Beige Diff" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-billw "Billw" "Bill White <billw@wolfram.com>")
+    (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani <sbhojwani@altoweb.com>")
+    (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten<thomas@biopython.org>")
+    (color-theme-simple-1 "Black" "Jonadab <jonadab@bright.net>")
+    (color-theme-blue-erc "Blue ERC" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-blue-mood "Blue Mood" "Nelson Loyola <nloyola@yahoo.com>")
+    (color-theme-blue-sea "Blue Sea" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-calm-forest "Calm Forest" "Artur Hefczyc <kobit@plusnet.pl>")
+    (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann <jazz@zqz.dk>")
+    (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-clarity "Clarity and Beauty" "Richard Wellum <rwellum@cisco.com>")
+    (color-theme-classic "Classic" "Frederic Giroud <postcard@worldonline.fr>")
+    (color-theme-comidia "Comidia" "Marcelo Dias de Toledo <mtole@ig.com.br>")
+    (color-theme-jsc-dark "Cooper Dark" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-jsc-light "Cooper Light" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-dark-blue "Dark Blue" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-dark-green "Dark Green" "eddy_woody@hotmail.com")
+    (color-theme-dark-laptop "Dark Laptop" "Laurent Michel <ldm@cs.brown.edu>")
+    (color-theme-deep-blue "Deep Blue" "Tomas Cerha <cerha@brailcom.org>")
+    (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen <gowen@gwowen.freeserve.co.uk>")
+    (color-theme-euphoria "Euphoria" "oGLOWo@oGLOWo.cjb.net")
+    (color-theme-feng-shui "Feng Shui" "Walter Higgins <walterh@rocketmail.com>")
+    (color-theme-fischmeister "Fischmeister"
+			      "Sebastian Fischmeister <sfischme@nexus.lzk.tuwien.ac.at>")
+    (color-theme-gnome "Gnome" "Jonadab <jonadab@bright.net>")
+    (color-theme-gnome2 "Gnome 2" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-gray1 "Gray1" "Paul Pulli <P.Pulli@motorola.com>")
+    (color-theme-gray30 "Gray30" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko <kingsajz@rpg.pl>")
+    (color-theme-greiner "Greiner" "Kevin Greiner <kgreiner@mapquest.com>")
+    (color-theme-gtk-ide "GTK IDE" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-high-contrast "High Contrast" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-hober "Hober" "Edward O'Connor <ted@oconnor.cx>")
+    (color-theme-infodoc "Infodoc" "Frederic Giroud <postcard@worldonline.fr>")
+    (color-theme-jb-simple "JB Simple" "jeff@dvns.com")
+    (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-jonadabian "Jonadab" "Jonadab <jonadab@bright.net>")
+    (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab <jonadab@bright.net>")
+    (color-theme-katester "Katester" "Higgins_Walter@emc.com")
+    (color-theme-late-night "Late Night" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-lawrence "Lawrence" "lawrence mitchell <wence@gmx.li>")
+    (color-theme-lethe "Lethe" "Ivica Loncar <ivica.loncar@srk.fer.hr>")
+    (color-theme-ld-dark "Linh Dang Dark" "Linh Dang <linhd@nortelnetworks.com>")
+    (color-theme-marine "Marine" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-matrix "Matrix" "Walter Higgins <walterh@rocketmail.com>")
+    (color-theme-marquardt "Marquardt" "Colin Marquardt <colin@marquardt-home.de>")
+    (color-theme-midnight "Midnight" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-mistyday "Misty Day" "Hari Kumar <Hari.Kumar@mtm.kuleuven.ac.be>")
+    (color-theme-montz "Montz" "Brady Montz <bradym@becomm.com>")
+    (color-theme-oswald "Oswald" "Tom Oswald <toswald@sharplabs.com>")
+    (color-theme-parus "Parus" "Jon K Hellan <hellan@acm.org>")
+    (color-theme-pierson "Pierson" "Dan L. Pierson <dan@sol.control.com>")
+    (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy <solofo@irisa.fr>")
+    (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic <pedja@lsil.com>")
+    (color-theme-renegade "Renegade" "Dave Benjamin <ramen@ramenfest.com>")
+    (color-theme-resolve "Resolve" "Damien Elmes <resolve@repose.cx>")
+    (color-theme-retro-green "Retro Green" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-retro-orange "Retro Orange" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-robin-hood "Robin Hood" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-rotor "Rotor" "Jinwei Shen <shenjw@wam.umd.edu>")
+    (color-theme-ryerson "Ryerson" "Luis Fernandes <elf@ee.ryerson.ca>")
+    (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-scintilla "Scintilla" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-shaman "Shaman" "shaman@interdon.net")
+    (color-theme-sitaramv-nt "Sitaram NT"
+			     "Sitaram Venkatraman <sitaramv@loc251.tandem.com>")
+    (color-theme-sitaramv-solaris "Sitaram Solaris"
+				  "Sitaram Venkatraman <sitaramv@loc251.tandem.com>")
+    (color-theme-snow "Snow" "Nicolas Rist <Nicolas.Rist@alcatel.de>")
+    (color-theme-snowish "Snowish" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel <deego@gnufans.org>")
+    (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-subtle-blue "Subtle Blue" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters <levanti@verbum.org>")
+    (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson <erik@aarg.net>")
+    (color-theme-taylor "Taylor" "Art Taylor <reeses@hemisphere.org>")
+    (color-theme-tty-dark "TTY Dark" "O Polite <m2@plusseven.com>")
+    (color-theme-vim-colors "Vim Colors" "Michael Soulier <msoulier@biryani.nssg.mitel.com>")
+    (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso <penso@linuxfr.org>, color by Scott Jaderholm <scott@jaderholm.com>")
+    (color-theme-wheat "Wheat" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-pok-wob "White On Black" "S. Pokrovsky <pok@nbsp.nsk.su>")
+    (color-theme-pok-wog "White On Grey" "S. Pokrovsky <pok@nbsp.nsk.su>")
+    (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein <Thomas.Gehrlein@t-online.de>")
+    (color-theme-xp "XP" "Girish Bharadwaj <girishb@gbvsoft.com>"))
+  "List of color themes.
+
+Each THEME is itself a three element list (FUNC NAME MAINTAINER &optional LIBRARY).
+
+FUNC is a color theme function which does the setup.  The function
+FUNC may call `color-theme-install'.  The color theme function may be
+interactive.
+
+NAME is the name of the theme and MAINTAINER is the name and/or email of
+the maintainer of the theme.
+
+If LIBRARY is non-nil, the color theme will be considered a library and
+may not be shown in the default menu.
+
+If you defined your own color theme and want to add it to this list,
+use something like this:
+
+  (add-to-list 'color-themes '(color-theme-gnome2 \"Gnome2\" \"Alex\"))")
+
+;;; Functions
+
+(defun color-theme-backup-original-values ()
+  "Back up the original `default-frame-alist'.
+The values are stored in `color-theme-original-frame-alist' on
+startup."
+  (if (null color-theme-original-frame-alist)
+      (setq color-theme-original-frame-alist
+	    (color-theme-filter (frame-parameters (selected-frame))
+				color-theme-legal-frame-parameters))))
+(add-hook 'after-init-hook 'color-theme-backup-original-values)
+
+;;;###autoload
+(defun color-theme-select (&optional arg)
+  "Displays a special buffer for selecting and installing a color theme.
+With optional prefix ARG, this buffer will include color theme libraries
+as well.  A color theme library is in itself not complete, it must be
+used as part of another color theme to be useful.  Thus, color theme
+libraries are mainly useful for color theme authors."
+  (interactive "P")
+  (unless color-theme-initialized (color-theme-initialize))
+  (switch-to-buffer (get-buffer-create color-theme-buffer-name))
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  ;; recreate the snapshot if necessary
+  (when (or (not (assq 'color-theme-snapshot color-themes))
+	    (not (commandp 'color-theme-snapshot)))
+    (fset 'color-theme-snapshot (color-theme-make-snapshot))
+    (setq color-themes (delq (assq 'color-theme-snapshot color-themes)
+			     color-themes)
+	  color-themes (delq (assq 'bury-buffer color-themes)
+			     color-themes)
+	  color-themes (append '((color-theme-snapshot
+				  "[Reset]" "Undo changes, if possible.")
+				 (bury-buffer
+				  "[Quit]" "Bury this buffer."))
+			     color-themes)))
+  (dolist (theme color-themes)
+    (let ((func (nth 0 theme))
+	  (name (nth 1 theme))
+	  (author (nth 2 theme))
+	  (library (nth 3 theme))
+	  (desc))
+      (when (or (not library) arg)
+	(setq desc (format "%-23s %s" 
+			   (if library (concat name " [lib]") name)
+			   author))
+	(put-text-property 0 (length desc) 'color-theme func desc)
+	(put-text-property 0 (length name) 'face 'bold desc)
+	(put-text-property 0 (length name) 'mouse-face 'highlight desc)
+	(insert desc)
+	(newline))))
+  (goto-char (point-min))
+  (setq buffer-read-only t)
+  (set-buffer-modified-p nil)
+  (color-theme-mode))
+
+(when (require 'easymenu)
+  (easy-menu-add-item nil color-theme-entry-path "--")
+  (easy-menu-add-item  nil color-theme-entry-path
+                       ["Color Themes" color-theme-select t]))
+
+(defun color-theme-mode ()
+  "Major mode to select and install color themes.
+
+Use \\[color-theme-install-at-point] to install a color theme on all frames.
+Use \\[color-theme-install-at-point-for-current-frame] to install a color theme for the current frame only.
+
+The changes are applied on top of your current setup.  This is a
+feature.
+
+Some of the themes should be considered extensions to the standard color
+theme: they modify only a limited number of faces and variables.  To
+verify the final look of a color theme, install the standard color
+theme, then install the other color theme.  This is a feature. It allows
+you to mix several color themes.
+
+Use \\[color-theme-describe] to read more about the color theme function at point.
+If you want to install the color theme permanently, put the call to the
+color theme function into your ~/.emacs:
+
+    \(require 'color-theme)
+    \(color-theme-gnome2)
+
+If you worry about the size of color-theme.el: You are right.  Use
+\\[color-theme-print] to print the current color theme and save the resulting buffer
+as ~/.emacs-color-theme.  Now you can install only this specific color
+theme in your .emacs:
+
+    \(load-file \"~/.emacs-color-theme\")
+    \(my-color-theme)
+
+The Emacs menu is not affected by color themes within Emacs.  Depending
+on the toolkit you used to compile Emacs, you might have to set specific
+X ressources.  See the info manual for more information.  Here is an
+example ~/.Xdefaults fragment:
+
+    emacs*Background: DarkSlateGray
+    emacs*Foreground: wheat
+
+\\{color-theme-mode-map}
+
+The color themes are listed in `color-themes', which see."
+  (kill-all-local-variables)
+  (setq major-mode 'color-theme-mode)
+  (setq mode-name "Color Themes")
+  (use-local-map color-theme-mode-map)
+  (when (functionp 'goto-address); Emacs
+    (goto-address))
+  (run-hooks 'color-theme-mode-hook))
+
+;;; Commands in Color Theme Selection mode
+
+;;;###autoload
+(defun color-theme-describe ()
+  "Describe color theme listed at point.
+This shows the documentation of the value of text-property color-theme
+at point.  The text-property color-theme should be a color theme
+function.  See `color-themes'."
+  (interactive)
+  (describe-function (get-text-property (point) 'color-theme)))
+
+;;;###autoload
+(defun color-theme-install-at-mouse (event)
+  "Install color theme clicked upon using the mouse.
+First argument EVENT is used to set point.  Then
+`color-theme-install-at-point' is called."
+  (interactive "e")
+  (save-excursion
+    (mouse-set-point event)
+    (color-theme-install-at-point)))
+
+;;;autoload
+(defun color-theme-install-at-point ()
+  "Install color theme at point.
+This calls the value of the text-property `color-theme' at point.
+The text-property `color-theme' should be a color theme function.
+See `color-themes'."
+  (interactive)
+  (let ((func (get-text-property (point) 'color-theme)))
+    ;; install theme
+    (if func
+	(funcall func))
+    ;; If goto-address is being used, remove all overlays in the current
+    ;; buffer and run it again.  The face used for the mail addresses in
+    ;; the the color theme selection buffer is based on the variable
+    ;; goto-address-mail-face.  Changes in that variable will not affect
+    ;; existing overlays, however, thereby confusing users.
+    (when (functionp 'goto-address); Emacs
+      (dolist (o (overlays-in (point-min) (point-max)))
+	(delete-overlay o))
+      (goto-address))))
+
+;;;###autoload
+(defun color-theme-install-at-point-for-current-frame ()
+  "Install color theme at point for current frame only.
+Binds `color-theme-is-global' to nil and calls
+`color-theme-install-at-point'."
+  (interactive)
+  (let ((color-theme-is-global nil))
+    (color-theme-install-at-point)))
+
+
+
+;; Taking a snapshot of the current color theme and pretty printing it.
+
+(defun color-theme-filter (old-list regexp &optional exclude)
+  "Filter OLD-LIST.
+The resulting list will be newly allocated and contains only elements
+with names matching REGEXP.  OLD-LIST may be a list or an alist.  If you
+want to filter a plist, use `color-theme-alist' to convert your plist to
+an alist, first.
+
+If the optional argument EXCLUDE is non-nil, then the sense is
+reversed: only non-matching elements will be retained."
+  (let (elem new-list)
+    (dolist (elem old-list)
+      (setq name (symbol-name (if (listp elem) (car elem) elem)))
+      (when (or (and (not exclude)
+		     (string-match regexp name))
+		(and exclude
+		     (not (string-match regexp name))))
+	;; Now make sure that if elem is a cons cell, and the cdr of
+	;; that cons cell is a string, then we need a *new* string in
+	;; the new list.  Having a new cons cell is of no use because
+	;; modify-frame-parameters will modify this string, thus
+	;; modifying our color theme functions!
+	(when (and (consp elem)
+		   (stringp (cdr elem)))
+	  (setq elem (cons (car elem)
+			   (copy-sequence (cdr elem)))))
+	;; Now store elem
+	(setq new-list (cons elem new-list))))
+    new-list))
+
+(defun color-theme-spec-filter (spec)
+  "Filter the attributes in SPEC.
+This makes sure that SPEC has the form ((t (PLIST ...))).
+Only properties not in `color-theme-illegal-default-attributes'
+are included in the SPEC returned."
+  (let ((props (cadar spec))
+	result prop val)
+    (while props
+      (setq prop (nth 0 props)
+	    val (nth 1 props)
+	    props (nthcdr 2 props))
+      (unless (memq prop color-theme-illegal-default-attributes)
+	(setq result (cons val (cons prop result)))))
+    `((t ,(nreverse result)))))
+
+;; (color-theme-spec-filter '((t (:background "blue3"))))
+;; (color-theme-spec-filter '((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed"))))
+
+(defun color-theme-plist-delete (plist prop)
+  "Delete property PROP from property list PLIST by side effect.
+This modifies PLIST."
+  ;; deal with prop at the start
+  (while (eq (car plist) prop)
+    (setq plist (cddr plist)))
+  ;; deal with empty plist
+  (when plist
+    (let ((lastcell (cdr plist))
+	  (l (cddr plist)))
+      (while l
+	(if (eq (car l) prop)
+	    (progn
+	      (setq l (cddr l))
+	      (setcdr lastcell l))
+	  (setq lastcell (cdr l)
+		l (cddr l))))))
+  plist)
+
+;; (color-theme-plist-delete '(a b c d e f g h) 'a)
+;; (color-theme-plist-delete '(a b c d e f g h) 'b)
+;; (color-theme-plist-delete '(a b c d e f g h) 'c)
+;; (color-theme-plist-delete '(a b c d e f g h) 'g)
+;; (color-theme-plist-delete '(a b c d c d e f g h) 'c)
+;; (color-theme-plist-delete '(a b c d e f c d g h) 'c)
+
+(if (or (featurep 'xemacs)
+	(< emacs-major-version 21))
+    (defalias 'color-theme-spec-compat 'identity)
+  (defun color-theme-spec-compat (spec)
+    "Filter the attributes in SPEC such that is is never invalid.
+Example: Eventhough :bold works in Emacs, it is not recognized by
+`customize-face' -- and then the face is uncustomizable.  This
+function replaces a :bold attribute with the corresponding :weight
+attribute, if there is no :weight, or deletes it.  This undoes the
+doings of `color-theme-spec-canonical-font', more or less."
+    (let ((props (cadar spec)))
+      (when (plist-member props :bold)
+	(setq props (color-theme-plist-delete props :bold))
+	(unless (plist-member props :weight)
+	  (setq props (plist-put props :weight 'bold))))
+      (when (plist-member props :italic)
+	(setq props (color-theme-plist-delete props :italic))
+	(unless (plist-member props :slant)
+	  (setq props (plist-put props :slant 'italic))))
+      `((t ,props)))))
+
+;; (color-theme-spec-compat '((t (:foreground "blue" :bold t))))
+;; (color-theme-spec-compat '((t (:bold t :foreground "blue" :weight extra-bold))))
+;; (color-theme-spec-compat '((t (:italic t :foreground "blue"))))
+;; (color-theme-spec-compat '((t (:slant oblique :italic t :foreground "blue"))))
+
+(defun color-theme-spec-canonical-font (atts)
+  "Add :bold and :italic attributes if necessary."
+  ;; add these to the front of atts -- this will keept the old value for
+  ;; customize-face in Emacs 21.
+  (when (and (memq (plist-get atts :weight)
+		   '(ultra-bold extra-bold bold semi-bold))
+	     (not (plist-get atts :bold)))
+    (setq atts (cons :bold (cons t atts))))
+  (when (and (not (memq (plist-get atts :slant)
+			'(normal nil)))
+	     (not (plist-get atts :italic)))
+    (setq atts (cons :italic (cons t atts))))
+  atts)
+;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'bold (selected-frame)))
+;; (defface foo '((t (:weight extra-bold))) "foo")
+;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'foo (selected-frame)))
+;; (face-spec-set 'foo '((t (:weight extra-bold))) nil)
+;; (face-spec-set 'foo '((t (:bold t))) nil)
+;; (face-spec-set 'foo '((t (:bold t :weight extra-bold))) nil)
+
+;; Handle :height according to NEWS file for Emacs 21
+(defun color-theme-spec-resolve-height (old new)
+  "Return the new height given OLD and NEW height.
+OLD is the current setting, NEW is the setting inherited from."
+  (cond ((not old)
+	 new)
+	((integerp old)
+	 old)
+	((and (floatp old)
+	      (integerp new))
+	 (round (* old new)))
+	((and (floatp old)
+	      (floatp new))
+	 (* old new))
+	((and (functionp old)
+	      (integerp new))
+	 (round (funcall old new)))
+	((and (functionp old)
+	      (float new))
+	 `(lambda (f) (* (funcall ,old f) ,new)))
+	((and (functionp old)
+	      (functionp new))
+	 `(lambda (f) (* (funcall ,old (funcall ,new f)))))
+	(t
+	 (error "Illegal :height attributes: %S or %S" old new))))
+;; (color-theme-spec-resolve-height 12 1.2)
+;; (color-theme-spec-resolve-height 1.2 1.2)
+;; (color-theme-spec-resolve-height 1.2 12)
+;; (color-theme-spec-resolve-height 1.2 'foo)
+;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 5)
+;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 2.0)
+;; the following lambda is the result from the above calculation
+;; (color-theme-spec-resolve-height (lambda (f) (* (funcall (lambda (f) (* 2 f)) f) 2.0)) 5)
+
+(defun color-theme-spec-resolve-inheritance (atts)
+  "Resolve all occurences of the :inherit attribute."
+  (let ((face (plist-get atts :inherit)))
+    ;; From the Emacs 21 NEWS file: "Attributes from inherited faces are
+    ;; merged into the face like an underlying face would be." --
+    ;; therefore properties of the inherited face only add missing
+    ;; attributes.
+    (when face
+      ;; remove :inherit face from atts -- this assumes only one
+      ;; :inherit attribute.
+      (setq atts (delq ':inherit (delq face atts)))
+      (let ((more-atts (color-theme-spec-resolve-inheritance
+			(color-theme-face-attr-construct
+			 face (selected-frame))))
+	    att val)
+	(while more-atts
+	  (setq att (car more-atts)
+		val (cadr more-atts)
+		more-atts (cddr more-atts))
+	  ;; Color-theme assumes that no value is ever 'unspecified.
+	  (cond ((eq att ':height); cumulative effect!
+		 (setq atts (plist-put atts 
+				       ':height 
+				       (color-theme-spec-resolve-height
+					(plist-get atts att) 
+					val))))
+		;; Default: Only put if it has not been specified before.
+		((not (plist-get atts att))
+		 (setq atts (cons att (cons val atts))))
+		  
+))))
+    atts))
+;; (color-theme-spec-resolve-inheritance '(:bold t))
+;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "blue"))
+;; (color-theme-face-attr-construct 'font-lock-comment-face (selected-frame))
+;; (color-theme-spec-resolve-inheritance '(:bold t :inherit font-lock-comment-face))
+;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "red" :inherit font-lock-comment-face))
+;; (color-theme-face-attr-construct 'Info-title-2-face (selected-frame))
+;; (color-theme-face-attr-construct 'Info-title-3-face (selected-frame))
+;; (color-theme-face-attr-construct 'Info-title-4-face (selected-frame))
+;; (color-theme-spec-resolve-inheritance '(:inherit Info-title-2-face))
+
+;; The :inverse-video attribute causes Emacs to swap foreground and
+;; background colors, XEmacs does not.  Therefore, if anybody chooses
+;; the inverse-video attribute, we 1. swap the colors ourselves in Emacs
+;; and 2. we remove the inverse-video attribute in Emacs and XEmacs.
+;; Inverse-video is only useful on a monochrome tty.
+(defun color-theme-spec-maybe-invert (atts)
+  "Remove the :inverse-video attribute from ATTS.
+If ATTS contains :inverse-video t, remove it and swap foreground and
+background color.  Return ATTS."
+  (let ((inv (plist-get atts ':inverse-video)))
+    (if inv
+	(let (result att)
+	  (while atts
+	    (setq att (car atts)
+		  atts (cdr atts))
+	    (cond ((and (eq att :foreground) (not color-theme-xemacs-p))
+		   (setq result (cons :background result)))
+		  ((and (eq att :background) (not color-theme-xemacs-p))
+		   (setq result (cons :foreground result)))
+		  ((eq att :inverse-video)
+		   (setq atts (cdr atts))); this prevents using dolist
+		  (t
+		   (setq result (cons att result)))))
+	  (nreverse result))
+      ;; else
+      atts)))
+;; (color-theme-spec-maybe-invert '(:bold t))
+;; (color-theme-spec-maybe-invert '(:foreground "blue"))
+;; (color-theme-spec-maybe-invert '(:background "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :foreground "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red" :foreground "blue" :bold t))
+;; (color-theme-spec-maybe-invert '(:inverse-video nil :background "red" :foreground "blue" :bold t))
+
+(defun color-theme-spec (face)
+  "Return a list for FACE which has the form (FACE SPEC).
+See `defface' for the format of SPEC.  In this case we use only one
+DISPLAY, t, and determine ATTS using `color-theme-face-attr-construct'.
+If ATTS is nil, (nil) is used  instead.
+
+If ATTS contains :inverse-video t, we remove it and swap foreground and
+background color using `color-theme-spec-maybe-invert'.  We do this
+because :inverse-video is handled differently in Emacs and XEmacs.  We
+will loose on a tty without colors, because in that situation,
+:inverse-video means something."
+  (let ((atts
+	 (color-theme-spec-canonical-font
+	  (color-theme-spec-maybe-invert
+	   (color-theme-spec-resolve-inheritance
+	    (color-theme-face-attr-construct face (selected-frame)))))))
+    (if atts
+	`(,face ((t ,atts)))
+      `(,face ((t (nil)))))))
+
+(defun color-theme-get-params ()
+  "Return a list of frame parameter settings usable in a color theme.
+Such an alist may be installed by `color-theme-install-frame-params'.  The
+frame parameters returned must match `color-theme-legal-frame-parameters'."
+  (let ((params (color-theme-filter (frame-parameters (selected-frame))
+				    color-theme-legal-frame-parameters)))
+    (sort params (lambda (a b) (string< (symbol-name (car a))
+					(symbol-name (car b)))))))
+
+(defun color-theme-get-vars ()
+  "Return a list of variable settings usable in a color theme.
+Such an alist may be installed by `color-theme-install-variables'.
+The variable names must match `color-theme-legal-variables', and the
+variable must be a user variable according to `user-variable-p'."
+  (let ((vars)
+	(val))
+    (mapatoms (lambda (v)
+		(and (boundp v)
+		     (user-variable-p v)
+		     (string-match color-theme-legal-variables
+				   (symbol-name v))
+		     (setq val (eval v))
+		     (add-to-list 'vars (cons v val)))))
+    (sort vars (lambda (a b) (string< (car a) (car b))))))
+
+(defun color-theme-print-alist (alist)
+  "Print ALIST."
+  (insert "\n     " (if alist "(" "nil"))
+  (dolist (elem alist)
+    (when (= (preceding-char) ?\))
+      (insert "\n      "))
+    (prin1 elem (current-buffer)))
+  (when (= (preceding-char) ?\)) (insert ")")))
+
+(defun color-theme-get-faces ()
+  "Return a list of faces usable in a color theme.
+Such an alist may be installed by `color-theme-install-faces'.  The
+faces returned must not match `color-theme-illegal-faces'."
+  (let ((faces (color-theme-filter (face-list) color-theme-illegal-faces t)))
+    ;; default face must come first according to comments in
+    ;; custom-save-faces, the rest is to be sorted by name
+    (cons 'default (sort (delq 'default faces) 'string-lessp))))
+
+(defun color-theme-get-face-definitions ()
+  "Return face settings usable in a color-theme."
+  (let ((faces (color-theme-get-faces)))
+    (mapcar 'color-theme-spec faces)))
+
+(defun color-theme-print-faces (faces)
+  "Print face settings for all faces returned by `color-theme-get-faces'."
+  (when faces
+    (insert "\n     "))
+  (dolist (face faces)
+    (when (= (preceding-char) ?\))
+      (insert "\n     "))
+    (prin1 face (current-buffer))))
+
+(defun color-theme-reset-faces ()
+  "Reset face settings for all faces returned by `color-theme-get-faces'."
+  (let ((faces (color-theme-get-faces))
+	(face) (spec) (entry)
+	(frame (if color-theme-is-global nil (selected-frame))))
+    (while faces
+      (setq entry (color-theme-spec (car faces)))
+      (setq face (nth 0 entry))
+      (setq spec '((t (nil))))
+      (setq faces (cdr faces))
+      (if (functionp 'face-spec-reset-face)
+	  (face-spec-reset-face face frame)
+	(face-spec-set face spec frame)
+	(if color-theme-is-global
+	    (put face 'face-defface-spec spec))))))
+
+(defun color-theme-print-theme (func doc params vars faces)
+  "Print a theme into the current buffer.
+FUNC is the function name, DOC the doc string, PARAMS the
+frame parameters, VARS the variable bindings, and FACES
+the list of faces and their specs."
+  (insert "(defun " (symbol-name func) " ()\n"
+	  "  \"" doc "\"\n"
+	  "  (interactive)\n"
+	  "  (color-theme-install\n"
+	  "   '(" (symbol-name func))
+  ;; alist of frame parameters
+  (color-theme-print-alist params)
+  ;; alist of variables
+  (color-theme-print-alist vars)
+  ;; remaining elements of snapshot: face specs
+  (color-theme-print-faces faces)
+  (insert ")))\n")
+  (insert "(add-to-list 'color-themes '(" (symbol-name func) " "
+          " \"THEME NAME\" \"YOUR NAME\"))")
+  (goto-char (point-min)))
+
+;;;###autoload
+(defun color-theme-print (&optional buf)
+  "Print the current color theme function.
+
+You can contribute this function to <URL:news:gnu.emacs.sources> or
+paste it into your .emacs file and call it.  That should recreate all
+the settings necessary for your color theme.
+
+Example:
+
+    \(require 'color-theme)
+    \(defun my-color-theme ()
+      \"Color theme by Alex Schroeder, created 2000-05-17.\"
+      \(interactive)
+      \(color-theme-install
+       '(...
+	 ...
+	 ...)))
+    \(my-color-theme)
+
+If you want to use a specific color theme function, you can call the
+color theme function in your .emacs directly.
+
+Example:
+
+    \(require 'color-theme)
+    \(color-theme-gnome2)"
+  (interactive)
+  (message "Pretty printing current color theme function...")
+  (switch-to-buffer (if buf
+			buf
+		      (get-buffer-create "*Color Theme*")))
+  (unless buf
+    (setq buffer-read-only nil)
+    (erase-buffer))
+  ;; insert defun
+  (insert "(eval-when-compile"
+          "    (require 'color-theme))\n")
+  (color-theme-print-theme 'my-color-theme
+			   (concat "Color theme by "
+				   (if (string= "" user-full-name)
+				       (user-login-name)
+				     user-full-name)
+				   ", created " (format-time-string "%Y-%m-%d") ".")
+			   (color-theme-get-params)
+			   (color-theme-get-vars)
+			   (mapcar 'color-theme-spec (color-theme-get-faces)))
+  (unless buf
+    (emacs-lisp-mode))
+  (goto-char (point-min))
+  (message "Pretty printing current color theme function... done"))
+
+(defun color-theme-analyze-find-theme (code)
+  "Find the sexpr that calls `color-theme-install'."
+  (let (theme)
+    (while (and (not theme) code)
+      (when (eq (car code) 'color-theme-install)
+	(setq theme code))
+      (when (listp (car code))
+	(setq theme (color-theme-analyze-find-theme (car code))))
+      (setq code (cdr code)))
+    theme))
+
+;; (equal (color-theme-analyze-find-theme
+;; 	'(defun color-theme-blue-eshell ()
+;; 	   "Color theme for eshell faces only."
+;; 	   (color-theme-install
+;; 	    '(color-theme-blue-eshell
+;; 	      nil
+;; 	      (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed"))))
+;; 	      (eshell-ls-backup-face ((t (:foreground "Grey"))))))))
+;;        '(color-theme-install
+;; 	 (quote
+;; 	  (color-theme-blue-eshell
+;; 	   nil
+;; 	   (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed"))))
+;; 	   (eshell-ls-backup-face ((t (:foreground "Grey")))))))))
+
+(defun color-theme-analyze-add-face (a b regexp faces)
+  "If only one of A or B are in FACES, the other is added, and FACES is returned.
+If REGEXP is given, this is only done if faces contains a match for regexps."
+  (when (or (not regexp)
+	    (catch 'found
+	      (dolist (face faces)
+		(when (string-match regexp (symbol-name (car face)))
+		  (throw 'found t)))))
+    (let ((face-a (assoc a faces))
+	  (face-b (assoc b faces)))
+      (if (and face-a (not face-b))
+	  (setq faces (cons (list b (nth 1 face-a))
+			    faces))
+	(if (and (not face-a) face-b)
+	    (setq faces (cons (list a (nth 1 face-b))
+			      faces))))))
+  faces)
+
+;; (equal (color-theme-analyze-add-face
+;; 	'blue 'violet nil
+;; 	'((blue ((t (:foreground "blue"))))
+;; 	  (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;; 	 (blue ((t (:foreground "blue"))))
+;; 	 (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;; 	'violet 'blue nil
+;; 	'((blue ((t (:foreground "blue"))))
+;; 	  (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;; 	 (blue ((t (:foreground "blue"))))
+;; 	 (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;; 	'violet 'blue "foo"
+;; 	'((blue ((t (:foreground "blue"))))
+;; 	  (bold ((t (:bold t))))))
+;;        '((blue ((t (:foreground "blue"))))
+;; 	 (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;; 	'violet 'blue "blue"
+;; 	'((blue ((t (:foreground "blue"))))
+;; 	  (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;; 	 (blue ((t (:foreground "blue"))))
+;; 	 (bold ((t (:bold t))))))
+
+(defun color-theme-analyze-add-faces (faces)
+  "Add missing faces to FACES and return it."
+  ;; The most important thing is to add missing faces for the other
+  ;; editor.  These are the most important faces to check.  The
+  ;; following rules list two faces, A and B.  If either of the two is
+  ;; part of the theme, the other must be, too.  The optional third
+  ;; argument specifies a regexp.  Only if an existing face name
+  ;; matches this regexp, is the rule applied.
+  (let ((rules '((font-lock-builtin-face font-lock-reference-face)
+		 (font-lock-doc-face font-lock-doc-string-face)
+		 (font-lock-constant-face font-lock-preprocessor-face)
+		 ;; In Emacs 21 `modeline' is just an alias for
+		 ;; `mode-line'.  I recommend the use of
+		 ;; `modeline' until further notice.
+		 (modeline mode-line)
+		 (modeline modeline-buffer-id)
+		 (modeline modeline-mousable)
+		 (modeline modeline-mousable-minor-mode)
+		 (region primary-selection)
+		 (region zmacs-region)
+		 (font-lock-string-face dired-face-boring "^dired")
+		 (font-lock-function-name-face dired-face-directory "^dired")
+		 (default dired-face-executable "^dired")
+		 (font-lock-warning-face dired-face-flagged "^dired")
+		 (font-lock-warning-face dired-face-marked "^dired")
+		 (default dired-face-permissions "^dired")
+		 (default dired-face-setuid "^dired")
+		 (default dired-face-socket "^dired")
+		 (font-lock-keyword-face dired-face-symlink "^dired")
+		 (tool-bar menu))))
+    (dolist (rule rules)
+      (setq faces (color-theme-analyze-add-face
+		   (nth 0 rule) (nth 1 rule) (nth 2 rule) faces))))
+  ;; The `fringe' face defines what the left and right borders of the
+  ;; frame look like in Emacs 21.  To give them default fore- and
+  ;; background colors, use (fringe ((t (nil)))) in your color theme.
+  ;; Usually it makes more sense to choose a color slightly lighter or
+  ;; darker from the default background.
+  (unless (assoc 'fringe faces)
+    (setq faces (cons '(fringe ((t (nil)))) faces)))
+  ;; The tool-bar should not be part of the frame-parameters, since it
+  ;; should not appear or disappear depending on the color theme.  The
+  ;; apppearance of the toolbar, however, can be changed by the color
+  ;; theme.  For Emacs 21, use the `tool-bar' face.  The easiest way
+  ;; to do this is to give it the default fore- and background colors.
+  ;; This can be achieved using (tool-bar ((t (nil)))) in the theme.
+  ;; Usually it makes more sense, however, to provide the same colors
+  ;; as used in the `menu' face, and to specify a :box attribute.  In
+  ;; order to alleviate potential Emacs/XEmacs incompatibilities,
+  ;; `toolbar' will be defined as an alias for `tool-bar' if it does
+  ;; not exist, and vice-versa.  This is done eventhough the face
+  ;; `toolbar' seems to have no effect on XEmacs.  If you look at
+  ;; XEmacs lisp/faces.el, however, you will find that it is in fact
+  ;; referenced for XPM stuff.
+  (unless (assoc 'tool-bar faces)
+    (setq faces (cons '(tool-bar ((t (nil)))) faces)))
+  ;; Move the default face back to the front, and sort the rest.
+  (unless (eq (caar faces) 'default)
+    (let ((face (assoc 'default faces)))
+      (setq faces (cons face
+			(sort (delete face faces)
+			      (lambda (a b)
+				(string-lessp (car a) (car b))))))))
+  faces)
+
+(defun color-theme-analyze-remove-heights (faces)
+  "Remove :height property where it is an integer and return FACES."
+  ;; I don't recommend making font sizes part of a color theme.  Most
+  ;; users would be surprised to see their font sizes change when they
+  ;; install a color-theme.  Therefore, remove all :height attributes
+  ;; if the value is an integer.  If the value is a float, this is ok
+  ;; -- the value is relative to the default height.  One notable
+  ;; exceptions is for a color-theme created for visually impaired
+  ;; people.  These *must* use a larger font in order to be usable.
+  (let (result)
+    (dolist (face faces)
+      (let ((props (cadar (nth 1 face))))
+	(if (and (plist-member props :height)
+		 (integerp (plist-get props :height)))
+	    (setq props (color-theme-plist-delete props :height)
+		  result (cons (list (car face) `((t ,props)))
+			       result))
+	  (setq result (cons face result)))))
+    (nreverse result)))
+
+;; (equal (color-theme-analyze-remove-heights
+;; 	'((blue ((t (:foreground "blue" :height 2))))
+;; 	  (bold ((t (:bold t :height 1.0))))))
+;;        '((blue ((t (:foreground "blue"))))
+;; 	 (bold ((t (:bold t :height 1.0))))))
+
+;;;###autoload
+(defun color-theme-analyze-defun ()
+  "Once you have a color-theme printed, check for missing faces.
+This is used by maintainers who receive a color-theme submission
+and want to make sure it follows the guidelines by the color-theme
+author."
+  ;; The support for :foreground and :background attributes works for
+  ;; Emacs 20 and 21 as well as for XEmacs.  :inverse-video is taken
+  ;; care of while printing color themes.
+  (interactive)
+  ;; Parse the stuff and find the call to color-theme-install
+  (save-excursion
+    (save-restriction
+      (narrow-to-defun)
+      ;; define the function
+      (eval-defun nil)
+      (goto-char (point-min))
+      (let* ((code (read (current-buffer)))
+	     (theme (color-theme-canonic
+		     (eval
+		      (cadr
+		       (color-theme-analyze-find-theme
+			code)))))
+	     (func (color-theme-function theme))
+	     (doc (documentation func t))
+	     (variables (color-theme-variables theme))
+	     (faces (color-theme-faces theme))
+	     (params (color-theme-frame-params theme)))
+	(setq faces (color-theme-analyze-remove-heights
+		     (color-theme-analyze-add-faces faces)))
+	;; Remove any variable bindings of faces that point to their
+	;; symbol?  Perhaps not, because another theme might want to
+	;; change this, so it is important to be able to reset them.
+	;; 	(let (result)
+	;; 	  (dolist (var variables)
+	;; 	    (unless (eq (car var) (cdr var))
+	;; 	      (setq result (cons var result))))
+	;; 	  (setq variables (nreverse result)))
+	;; Now modify the theme directly.
+	(setq theme (color-theme-analyze-find-theme code))
+	(setcdr (cadadr theme) (list params variables faces))
+	(message "Pretty printing analysed color theme function...")
+	(with-current-buffer (get-buffer-create "*Color Theme*")
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  ;; insert defun
+	  (color-theme-print-theme func doc params variables faces)
+	  (emacs-lisp-mode))
+	(message "Pretty printing analysed color theme function... done")
+	(ediff-buffers (current-buffer)
+		       (get-buffer "*Color Theme*"))))))
+
+;;; Creating a snapshot of the current color theme
+
+(defun color-theme-snapshot nil)
+
+;;;###autoload
+(defun color-theme-make-snapshot ()
+  "Return the definition of the current color-theme.
+The function returned will recreate the color-theme in use at the moment."
+  (eval `(lambda ()
+	   "The color theme in use when the selection buffer was created.
+\\[color-theme-select] creates the color theme selection buffer.  At the
+same time, this snapshot is created as a very simple undo mechanism.
+The snapshot is created via `color-theme-snapshot'."
+	   (interactive)
+	   (color-theme-install
+	    '(color-theme-snapshot
+	      ;; alist of frame parameters
+	      ,(color-theme-get-params)
+	      ;; alist of variables
+	      ,(color-theme-get-vars)
+	      ;; remaining elements of snapshot: face specs
+	      ,@(color-theme-get-face-definitions))))))
+
+
+
+;;; Handling the various parts of a color theme install
+
+(defvar color-theme-frame-param-frobbing-rules
+  '((foreground-color default foreground)
+    (background-color default background))
+  "List of rules to use when frobbing faces based on frame parameters.
+This is only necessary for XEmacs, because in Emacs 21 changing the
+frame paramters automatically affects the relevant faces.")
+
+;; fixme: silent the bytecompiler with set-face-property
+(defun color-theme-frob-faces (params)
+  "Change certain faces according to PARAMS.
+This uses `color-theme-frame-param-frobbing-rules'."
+  (dolist (rule color-theme-frame-param-frobbing-rules)
+    (let* ((param (nth 0 rule))
+	   (face (nth 1 rule))
+	   (prop (nth 2 rule))
+	   (val (cdr (assq param params)))
+	   (frame (if color-theme-is-global nil (selected-frame))))
+      (when val
+	(set-face-property face prop val frame)))))
+
+(defun color-theme-alist-reduce (old-list)
+  "Reduce OLD-LIST.
+The resulting list will be newly allocated and will not contain any elements
+with duplicate cars.  This will speed the installation of new themes by
+only installing unique attributes."
+  (let (new-list)
+    (dolist (elem old-list)
+      (when (not (assq (car elem) new-list))
+	(setq new-list (cons elem new-list))))
+    new-list))
+
+(defun color-theme-install-frame-params (params)
+  "Change frame parameters using alist PARAMETERS.
+
+If `color-theme-is-global' is non-nil, all frames are modified using
+`modify-frame-parameters' and the PARAMETERS are prepended to
+`default-frame-alist'.  The value of `initial-frame-alist' is not
+modified.  If `color-theme-is-global' is nil, only the selected frame is
+modified.  If `color-theme-is-cumulative' is nil, the frame parameters
+are restored from `color-theme-original-frame-alist'.
+
+If the current frame parameters have a parameter `minibuffer' with
+value `only', then the frame parameters are not installed, since this
+indicates a dedicated minibuffer frame.
+
+Called from `color-theme-install'."
+  (setq params (color-theme-filter
+		params color-theme-legal-frame-parameters))
+  ;; We have a new list in params now, therefore we may use
+  ;; destructive nconc.
+  (if color-theme-is-global
+      (let ((frames (frame-list)))
+	(if (or color-theme-is-cumulative
+		(null color-theme-original-frame-alist))
+	    (setq default-frame-alist
+		  (append params (color-theme-alist default-frame-alist))
+		  minibuffer-frame-alist
+		  (append params (color-theme-alist minibuffer-frame-alist)))
+	  (setq default-frame-alist
+		(append params color-theme-original-frame-alist)
+		minibuffer-frame-alist
+		(append params (color-theme-alist minibuffer-frame-alist))))
+	(setq default-frame-alist
+	      (color-theme-alist-reduce default-frame-alist)
+	      minibuffer-frame-alist
+	      (color-theme-alist-reduce minibuffer-frame-alist))
+	(dolist (frame frames)
+	  (let ((params (if (eq 'only (cdr (assq 'minibuffer (frame-parameters frame))))
+			    minibuffer-frame-alist
+			  default-frame-alist)))
+	    (condition-case var
+		(modify-frame-parameters frame params)
+	      (error (message "Error using params %S: %S" params var))))))
+    (condition-case var
+	(modify-frame-parameters (selected-frame) params)
+      (error (message "Error using params %S: %S" params var))))
+  (when color-theme-xemacs-p
+    (color-theme-frob-faces params)))
+
+;; (setq default-frame-alist (cons '(height . 30) default-frame-alist))
+
+(defun color-theme-install-variables (vars)
+  "Change variables using alist VARS.
+All variables matching `color-theme-legal-variables' are set.
+
+If `color-theme-is-global' and `color-theme-xemacs-p' are nil, variables
+are made frame-local before setting them.  Variables are set using `set'
+in either case.  This may lead to problems if changing the variable
+requires the usage of the function specified with the :set tag in
+defcustom declarations.
+
+Called from `color-theme-install'."
+  (let ((vars (color-theme-filter vars color-theme-legal-variables)))
+    (dolist (var vars)
+      (if (or color-theme-is-global color-theme-xemacs-p)
+	  (set (car var) (cdr var))
+	(make-variable-frame-local (car var))
+	(modify-frame-parameters (selected-frame) (list var))))))
+
+(defun color-theme-install-faces (faces)
+  "Change faces using FACES.
+
+Change faces for all frames and create any faces listed in FACES which
+don't exist.  The modified faces will be marked as \"unchanged from
+its standard setting\".  This is OK, since the changes made by
+installing a color theme should never by saved in .emacs by
+customization code.
+
+FACES should be a list where each entry has the form:
+
+  (FACE SPEC)
+
+See `defface' for the format of SPEC.
+
+If `color-theme-is-global' is non-nil, faces are modified on all frames
+using `face-spec-set'.  If `color-theme-is-global' is nil, faces are
+only modified on the selected frame.  Non-existing faces are created
+using `make-empty-face' in either case.  If `color-theme-is-cumulative'
+is nil, all faces are reset before installing the new faces.
+
+Called from `color-theme-install'."
+  ;; clear all previous faces
+  (when (not color-theme-is-cumulative)
+    (color-theme-reset-faces))
+  ;; install new faces
+  (let ((faces (color-theme-filter faces color-theme-illegal-faces t))
+	(frame (if color-theme-is-global nil (selected-frame))))
+    (dolist (entry faces)
+      (let ((face (nth 0 entry))
+	    (spec (nth 1 entry)))
+	(or (facep face)
+	    (make-empty-face face))
+	;; remove weird properties from the default face only
+	(when (eq face 'default)
+	  (setq spec (color-theme-spec-filter spec)))
+	;; Emacs/XEmacs customization issues: filter out :bold when
+	;; the spec contains :weight, etc, such that the spec remains
+	;; "valid" for custom.
+	(setq spec (color-theme-spec-compat spec))
+	;; using a spec of ((t (nil))) to reset a face doesn't work
+	;; in Emacs 21, we use the new function face-spec-reset-face
+	;; instead
+	(if (and (functionp 'face-spec-reset-face)
+		 (equal spec '((t (nil)))))
+	    (face-spec-reset-face face frame)
+	  (condition-case var
+	      (progn
+		(face-spec-set face spec frame)
+		(if color-theme-is-global
+		    (put face 'face-defface-spec spec)))
+	    (error (message "Error using spec %S: %S" spec var))))))))
+
+;; `custom-set-faces' is unusable here because it doesn't allow to set
+;; the faces for one frame only.
+
+;; Emacs `face-spec-set': If FRAME is nil, the face is created and
+;; marked as a customized face.  This is achieved by setting the
+;; `face-defface-spec' property.  If we don't, new frames will not be
+;; created using the face we installed because `face-spec-set' is
+;; broken: If given a FRAME of nil, it will not set the default faces;
+;; instead it will walk through all the frames and set modify the faces.
+;; If we do set a property (`saved-face' or `face-defface-spec'),
+;; `make-frame' will correctly use the faces we defined with our color
+;; theme.  If we used the property `saved-face',
+;; `customize-save-customized' will save all the faces installed as part
+;; of a color-theme in .emacs.  That's why we use the
+;; `face-defface-spec' property.
+
+
+
+;;; Theme accessor functions, canonicalization, merging, comparing
+
+(defun color-theme-canonic (theme)
+  "Return the canonic form of THEME.
+This deals with all the backwards compatibility stuff."
+  (let (function frame-params variables faces)
+    (when (functionp (car theme))
+      (setq function (car theme)
+	    theme (cdr theme)))
+    (setq frame-params (car theme)
+	  theme (cdr theme))
+    ;; optional variable defintions (for backwards compatibility)
+    (when (listp (caar theme))
+      (setq variables (car theme)
+	    theme (cdr theme)))
+    ;; face definitions
+    (setq faces theme)
+    (list function frame-params variables faces)))
+
+(defun color-theme-function (theme)
+  "Return function used to create THEME."
+  (nth 0 theme))
+
+(defun color-theme-frame-params (theme)
+  "Return frame-parameters defined by THEME."
+  (nth 1 theme))
+
+(defun color-theme-variables (theme)
+  "Return variables set by THEME."
+  (nth 2 theme))
+
+(defun color-theme-faces (theme)
+  "Return faces defined by THEME."
+  (nth 3 theme))
+
+(defun color-theme-merge-alists (&rest alists)
+  "Merges all the alist arguments into one alist.
+Only the first instance of every key will be part of the resulting
+alist.  Membership will be tested using `assq'."
+  (let (result)
+    (dolist (l alists)
+      (dolist (entry l)
+	(unless (assq (car entry) result)
+	  (setq result (cons entry result)))))
+    (nreverse result)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)))
+;; (color-theme-merge-alists '((a . 1) (b . 2) (a . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((a . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4) (b . 5)))
+
+;;;###autoload
+(defun color-theme-compare (theme-a theme-b)
+  "Compare two color themes.
+This will print the differences between installing THEME-A and
+installing THEME-B.  Note that the order is important: If a face is
+defined in THEME-A and not in THEME-B, then this will not show up as a
+difference, because there is no reset before installing THEME-B.  If a
+face is defined in THEME-B and not in THEME-A, then this will show up as
+a difference."
+  (interactive
+   (list
+    (intern
+     (completing-read "Theme A: "
+		      (mapcar (lambda (i) (list (symbol-name (car i))))
+			      color-themes)
+		      (lambda (i) (string-match "color-theme" (car i)))))
+    (intern
+     (completing-read "Theme B: "
+		      (mapcar (lambda (i) (list (symbol-name (car i))))
+			      color-themes)
+		      (lambda (i) (string-match "color-theme" (car i)))))))
+  ;; install the themes in a new frame and get the definitions
+  (let ((color-theme-is-global nil))
+    (select-frame (make-frame))
+    (funcall theme-a)
+    (setq theme-a (list theme-a
+			(color-theme-get-params)
+			(color-theme-get-vars)
+			(color-theme-get-face-definitions)))
+    (funcall theme-b)
+    (setq theme-b (list theme-b
+			(color-theme-get-params)
+			(color-theme-get-vars)
+			(color-theme-get-face-definitions)))
+    (delete-frame))
+  (let ((params (set-difference
+		 (color-theme-frame-params theme-b)
+		 (color-theme-frame-params theme-a)
+		 :test 'equal))
+	(vars (set-difference
+	       (color-theme-variables theme-b)
+	       (color-theme-variables theme-a)
+	       :test 'equal))
+	(faces (set-difference
+		(color-theme-faces theme-b)
+		(color-theme-faces theme-a)
+		:test 'equal)))
+    (list 'diff
+	  params
+	  vars
+	  faces)))
+
+
+
+;;; Installing a color theme
+;;;###autoload
+(defun color-theme-install (theme)
+  "Install a color theme defined by frame parameters, variables and faces.
+
+The theme is installed for all present and future frames; any missing
+faces are created.  See `color-theme-install-faces'.
+
+THEME is a color theme definition.  See below for more information.
+
+If you want to install a color theme from your .emacs, use the output
+generated by `color-theme-print'.  This produces color theme function
+which you can copy to your .emacs.
+
+A color theme definition is a list:
+\([FUNCTION] FRAME-PARAMETERS VARIABLE-SETTINGS FACE-DEFINITIONS)
+
+FUNCTION is the color theme function which called `color-theme-install'.
+This is no longer used.  There was a time when this package supported
+automatic factoring of color themes.  This has been abandoned.
+
+FRAME-PARAMETERS is an alist of frame parameters.  These are installed
+with `color-theme-install-frame-params'.  These are installed last such
+that any changes to the default face can be changed by the frame
+parameters.
+
+VARIABLE-DEFINITIONS is an alist of variable settings.  These are
+installed with `color-theme-install-variables'.
+
+FACE-DEFINITIONS is an alist of face definitions.  These are installed
+with `color-theme-install-faces'.
+
+If `color-theme-is-cumulative' is nil, a color theme will undo face and
+frame-parameter settings of previous color themes."
+  (setq theme (color-theme-canonic theme))
+  (color-theme-install-variables (color-theme-variables theme))
+  (color-theme-install-faces (color-theme-faces theme))
+  ;; frame parameters override faces
+  (color-theme-install-frame-params (color-theme-frame-params theme))
+  (when color-theme-history-max-length
+    (color-theme-add-to-history
+     (car theme))))
+
+
+
+;; Sharing your stuff
+;;;###autoload
+(defun color-theme-submit ()
+  "Submit your color-theme to the maintainer."
+  (interactive)
+  (require 'reporter)
+  (let ((reporter-eval-buffer (current-buffer))
+	final-resting-place
+	after-sep-pos
+	(reporter-status-message "Formatting buffer...")
+	(reporter-status-count 0)
+	(problem "Yet another color-theme")
+	(agent (reporter-compose-outgoing))
+	(mailbuf (current-buffer))
+	hookvar)
+    ;; do the work
+    (require 'sendmail)
+    ;; If mailbuf did not get made visible before, make it visible now.
+    (let (same-window-buffer-names same-window-regexps)
+      (pop-to-buffer mailbuf)
+      ;; Just in case the original buffer is not visible now, bring it
+      ;; back somewhere
+      (and pop-up-windows (display-buffer reporter-eval-buffer)))
+    (goto-char (point-min))
+    (mail-position-on-field "to")
+    (insert color-theme-maintainer-address)
+    (mail-position-on-field "subject")
+    (insert problem)
+    ;; move point to the body of the message
+    (mail-text)
+    (setq after-sep-pos (point))
+    (unwind-protect
+	(progn
+	  (setq final-resting-place (point-marker))
+	  (goto-char final-resting-place))
+      (color-theme-print (current-buffer))
+      (goto-char final-resting-place)
+      (insert "\n\n")
+      (goto-char final-resting-place)
+      (insert "Hello there!\n\nHere's my color theme named: ")
+      (set-marker final-resting-place nil))
+    ;; compose the minibuf message and display this.
+    (let* ((sendkey-whereis (where-is-internal
+			     (get agent 'sendfunc) nil t))
+	   (abortkey-whereis (where-is-internal
+			      (get agent 'abortfunc) nil t))
+	   (sendkey (if sendkey-whereis
+			(key-description sendkey-whereis)
+		      "C-c C-c")); TBD: BOGUS hardcode
+	   (abortkey (if abortkey-whereis
+			 (key-description abortkey-whereis)
+		       "M-x kill-buffer"))); TBD: BOGUS hardcode
+      (message "Enter a message and type %s to send or %s to abort."
+	       sendkey abortkey))))
+
+
+
+;; Use this to define themes
+(defmacro define-color-theme (name author description &rest forms)
+  (let ((n name))
+    `(progn 
+       (add-to-list 'color-themes
+                    (list ',n
+                          (upcase-initials
+			   (replace-regexp-in-string
+			    "-" " "
+			    (replace-regexp-in-string
+			     "^color-theme-" "" (symbol-name ',n))))
+                          ,author))
+       (defun ,n ()
+	 ,description
+	 (interactive)
+         ,@forms))))
+
+
+;;; FIXME: is this useful ??
+;;;###autoload
+(defun color-theme-initialize ()
+  "Initialize the color theme package by loading color-theme-libraries."
+  (interactive)
+
+  (cond ((and (not color-theme-load-all-themes)
+              color-theme-directory)
+         (setq color-theme-libraries 
+               (directory-files color-theme-directory t "^color-theme")))
+        (color-theme-directory
+         (push (cdr (directory-files color-theme-directory t "^color-theme")) 
+               color-theme-libraries)))
+  (dolist (library color-theme-libraries)
+    (load library)))
+
+(when nil
+  (setq color-theme-directory "themes/"
+        color-theme-load-all-themes nil)
+  (color-theme-initialize)
+)
+;; TODO: I don't like all those function names cluttering up my namespace.
+;; Instead, a hashtable for the color-themes should be created. Now that 
+;; define-color-theme is around, it should be easy to change in just the
+;; one place. 
+
+
+(provide 'color-theme)
+
+;;; color-theme.el ends here
diff --git a/emacs.d/lisp/color-theme.elc b/emacs.d/lisp/color-theme.elc
new file mode 100644
index 0000000..5e890a5
--- /dev/null
+++ b/emacs.d/lisp/color-theme.elc