1 ;;; cus-theme.el -- custom theme creation user interface
3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
5 ;; Author: Alex Schroeder <alex@gnu.org>
7 ;; Keywords: help, faces
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
34 (defun custom-theme-create ()
35 "Create a custom theme."
37 (if (get-buffer "*New Custom Theme*")
38 (kill-buffer "*New Custom Theme*"))
39 (switch-to-buffer "*New Custom Theme*")
40 (kill-all-local-variables)
41 (make-local-variable 'custom-theme-name)
42 (make-local-variable 'custom-theme-variables)
43 (make-local-variable 'custom-theme-faces)
44 (make-local-variable 'custom-theme-description)
45 (let ((inhibit-read-only t))
47 (widget-insert "This buffer helps you write a custom theme elisp file.
48 This will help you share your customizations with other people.\n\n")
49 (widget-insert "Theme name: ")
50 (setq custom-theme-name
51 (widget-create 'editable-field
54 (widget-insert "\n\nDocumentation:\n")
55 (setq custom-theme-description
57 :value (format-time-string "Created %Y-%m-%d.")))
58 (widget-insert "\nVariables:\n\n")
59 (setq custom-theme-variables
60 (widget-create 'editable-list
61 :entry-format "%i %d %v"
63 (widget-insert "\nFaces:\n\n")
64 (setq custom-theme-faces
65 (widget-create 'editable-list
66 :entry-format "%i %d %v"
69 (widget-create 'push-button
70 :notify (function custom-theme-write)
73 (widget-create 'push-button
74 :notify (lambda (&rest ignore)
75 (custom-theme-create))
78 (widget-create 'push-button
79 :notify (lambda (&rest ignore)
83 (use-local-map widget-keymap)
86 (defun custom-theme-write (&rest ignore)
87 (let ((name (widget-value custom-theme-name))
88 (doc (widget-value custom-theme-description))
89 (variables (widget-value custom-theme-variables))
90 (faces (widget-value custom-theme-faces)))
91 (switch-to-buffer (concat name "-theme.el"))
92 (setq buffer-file-name (expand-file-name (concat name "-theme.el")))
93 (let ((inhibit-read-only t))
95 (insert "(deftheme " name)
98 (insert " \"" doc "\""))
100 (custom-theme-write-variables name variables)
101 (custom-theme-write-faces name faces)
102 (insert "\n(provide-theme '" name ")\n")))
104 (defun custom-theme-write-variables (theme vars)
105 "Write a `custom-theme-set-variables' command for THEME.
106 It includes all variables in list VARS."
107 ;; Most code is stolen from `custom-save-variables'.
109 (let ((standard-output (current-buffer)))
110 (princ "\n(custom-theme-set-variables\n")
114 (mapc (lambda (symbol)
115 (when (boundp symbol)
121 (prin1 (symbol-value symbol))
127 (unless (looking-at "\n")
130 (defun custom-theme-write-faces (theme faces)
131 "Write a `custom-theme-set-faces' command for THEME.
132 It includes all faces in list FACES."
134 (let ((standard-output (current-buffer)))
135 (princ "\n(custom-theme-set-faces\n")
139 (mapc (lambda (symbol)
146 (prin1 (or (get symbol 'customized-face)
147 (get symbol 'face-defface-spec)))
153 (unless (looking-at "\n")
156 ;;; cus-theme.el ends here