Difference between revision 5 and current revision
Summary: Rollback to 2008-09-05 00:16 UTCNo diff available.
;;; color-theme-maker.el --- install color themes ;; Copyright (C) 2002 Alex Schroeder <email@example.com> ;; Version: 1.0.1 ;; Keywords: faces ;; Author: Alex Schroeder <firstname.lastname@example.org> ;; Maintainer: Alex Schroeder <email@example.com> ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorThemeMaker ;; This file is not 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: ;; This package makes it easier to make subthemes. If you like the ;; jde faces of theme A, the erc faces from theme B, and generally ;; prefer theme color-theme-gray30, then proceed as follows: ;; Install theme A, call M-x color-theme-maker, provide "jde" as ;; regexp and "my-jde-subtheme" as name, then install theme B, call ;; M-x color-theme-maker, provide "erc" as regexp and ;; "my-erc-subtheme" as name. Save the two buffers as ;; my-jde-subtheme.el and my-erc-subtheme.el. In your .emacs, add: ;; ;; (require 'color-theme) ;; (color-theme-gray30) ;; (setq color-theme-is-cumulative t) ;; (require 'my-jde-subtheme) ;; (my-jde-subtheme) ;; (require 'my-erc-subtheme) ;; (my-erc-subtheme) ;;; Thanks ;; Girish Bharadwaj <firstname.lastname@example.org> for the idea. ;;; Code: (require 'widget) (eval-when-compile (require 'wid-edit)) (require 'color-theme) (defvar color-theme-maker-regexp nil) (defvar color-theme-maker-name nil) (defun color-theme-maker () "Interactively create color subthemes. Based on the faces currently defined, produce a color theme function that sets only the faces matching a regexp." (interactive) (switch-to-buffer "*Color Theme Maker*") (kill-all-local-variables) (make-local-variable 'color-theme-maker-regexp) (make-local-variable 'color-theme-maker-name) (let ((inhibit-read-only t)) (erase-buffer) (widget-insert "Welcome to the Color Theme Maker\n" "\n" "The Regexp will be used to filter all faces currently defined.\n" "\n" "Regexp: ") (setq color-theme-maker-regexp (widget-create 'editable-field)) (widget-insert "\n\n" "The name determines what the resulting color theme function will be called.\n" "\n" "Name: ") (setq color-theme-maker-name (widget-create 'editable-field)) (widget-insert "\n") (widget-create 'push-button :notify (lambda (&rest ignore) (color-theme-maker-print (widget-value color-theme-maker-regexp) (widget-value color-theme-maker-name))) "Done")) (use-local-map widget-keymap) (widget-setup) (goto-char (point-min)) (widget-forward 1)) (defun color-theme-maker-print (regexp func-name) "Create a color theme function FUNC-NAME with faces matching REGEXP." (message "Making subtheme...") (let ((faces (color-theme-filter (color-theme-get-faces) regexp))) (unless faces (error "No faces match %s" regexp)) (let ((buf (get-buffer-create (concat func-name ".el")))) (switch-to-buffer buf) (let ((inhibit-read-only t)) (erase-buffer) (insert "(defun " func-name " ()\n" " \"Color subtheme, created " (format-time-string "%Y-%m-%d") ".\"\n" " (interactive)\n" " (color-theme-install\n" " '(" func-name " nil nil") (when faces (insert "\n ")) (dolist (face faces) (when (= (preceding-char) ?\)) (insert "\n ")) (prin1 (color-theme-spec face) (current-buffer)))))) (insert ")))\n" "(provide '" func-name ")") (emacs-lisp-mode) (goto-char (point-min)) (message "Making subtheme... done")) (provide 'color-theme-maker) ;;; color-theme-maker.el ends here