Commit | Line | Data |
---|---|---|
3656dac0 RS |
1 | ;;; cus-theme.el -- custom theme creation user interface |
2 | ;; | |
0d30b337 | 3 | ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
3656dac0 RS |
4 | ;; |
5 | ;; Author: Alex Schroeder <alex@gnu.org> | |
6 | ;; Maintainer: FSF | |
7 | ;; Keywords: help, faces | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
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) | |
14 | ;; any later version. | |
15 | ||
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. | |
20 | ||
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 | |
086add15 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
3656dac0 RS |
25 | |
26 | ;;; Code: | |
27 | ||
28 | (require 'widget) | |
29 | (require 'cus-edit) | |
30 | ||
31 | (eval-when-compile | |
32 | (require 'wid-edit)) | |
33 | ||
077ad61c LT |
34 | (define-derived-mode custom-new-theme-mode nil "New-Theme" |
35 | "Major mode for the buffer created by `customize-create-theme'. | |
36 | Do not call this mode function yourself. It is only meant for internal | |
37 | use by `customize-create-theme'." | |
38 | (set-keymap-parent custom-new-theme-mode-map widget-keymap)) | |
39 | (put 'custom-new-theme-mode 'mode-class 'special) | |
40 | ||
41 | (defvar custom-theme-name) | |
42 | (defvar custom-theme-variables) | |
43 | (defvar custom-theme-faces) | |
44 | (defvar custom-theme-description) | |
45 | ||
87e391a9 | 46 | ;;;###autoload |
f560e69c | 47 | (defun customize-create-theme () |
3656dac0 RS |
48 | "Create a custom theme." |
49 | (interactive) | |
50 | (if (get-buffer "*New Custom Theme*") | |
51 | (kill-buffer "*New Custom Theme*")) | |
52 | (switch-to-buffer "*New Custom Theme*") | |
077ad61c LT |
53 | (let ((inhibit-read-only t)) |
54 | (erase-buffer)) | |
55 | (custom-new-theme-mode) | |
3656dac0 RS |
56 | (make-local-variable 'custom-theme-name) |
57 | (make-local-variable 'custom-theme-variables) | |
58 | (make-local-variable 'custom-theme-faces) | |
59 | (make-local-variable 'custom-theme-description) | |
3656dac0 | 60 | (widget-insert "This buffer helps you write a custom theme elisp file. |
077ad61c LT |
61 | This will help you share your customizations with other people. |
62 | ||
63 | Just insert the names of all variables and faces you want the theme | |
64 | to include. Then clicking mouse-2 or pressing RET on the [Done] button | |
65 | will write a theme file that sets all these variables and faces to their | |
66 | current global values. It will write that file into the directory given | |
67 | by the variable `custom-theme-directory', usually \"~/.emacs.d/\". | |
68 | ||
69 | To undo all your edits to the buffer, use the [Reset] button.\n\n") | |
3656dac0 RS |
70 | (widget-insert "Theme name: ") |
71 | (setq custom-theme-name | |
72 | (widget-create 'editable-field | |
73 | :size 10 | |
74 | user-login-name)) | |
75 | (widget-insert "\n\nDocumentation:\n") | |
76 | (setq custom-theme-description | |
71296446 | 77 | (widget-create 'text |
3656dac0 RS |
78 | :value (format-time-string "Created %Y-%m-%d."))) |
79 | (widget-insert "\nVariables:\n\n") | |
80 | (setq custom-theme-variables | |
81 | (widget-create 'editable-list | |
82 | :entry-format "%i %d %v" | |
83 | 'variable)) | |
84 | (widget-insert "\nFaces:\n\n") | |
85 | (setq custom-theme-faces | |
86 | (widget-create 'editable-list | |
87 | :entry-format "%i %d %v" | |
88 | 'face)) | |
89 | (widget-insert "\n") | |
90 | (widget-create 'push-button | |
91 | :notify (function custom-theme-write) | |
92 | "Done") | |
93 | (widget-insert " ") | |
94 | (widget-create 'push-button | |
95 | :notify (lambda (&rest ignore) | |
392cb21b | 96 | (customize-create-theme)) |
3656dac0 RS |
97 | "Reset") |
98 | (widget-insert " ") | |
99 | (widget-create 'push-button | |
100 | :notify (lambda (&rest ignore) | |
101 | (bury-buffer)) | |
102 | "Bury Buffer") | |
103 | (widget-insert "\n") | |
3656dac0 RS |
104 | (widget-setup)) |
105 | ||
106 | (defun custom-theme-write (&rest ignore) | |
107 | (let ((name (widget-value custom-theme-name)) | |
108 | (doc (widget-value custom-theme-description)) | |
109 | (variables (widget-value custom-theme-variables)) | |
110 | (faces (widget-value custom-theme-faces))) | |
111 | (switch-to-buffer (concat name "-theme.el")) | |
077ad61c LT |
112 | (emacs-lisp-mode) |
113 | (unless (file-exists-p custom-theme-directory) | |
114 | (make-directory (file-name-as-directory custom-theme-directory) t)) | |
115 | (setq default-directory custom-theme-directory) | |
3656dac0 RS |
116 | (setq buffer-file-name (expand-file-name (concat name "-theme.el"))) |
117 | (let ((inhibit-read-only t)) | |
118 | (erase-buffer)) | |
119 | (insert "(deftheme " name) | |
120 | (when doc | |
121 | (newline) | |
122 | (insert " \"" doc "\"")) | |
123 | (insert ")\n") | |
124 | (custom-theme-write-variables name variables) | |
125 | (custom-theme-write-faces name faces) | |
077ad61c LT |
126 | (insert "\n(provide-theme '" name ")\n") |
127 | (save-buffer))) | |
3656dac0 RS |
128 | |
129 | (defun custom-theme-write-variables (theme vars) | |
130 | "Write a `custom-theme-set-variables' command for THEME. | |
131 | It includes all variables in list VARS." | |
132 | ;; Most code is stolen from `custom-save-variables'. | |
133 | (when vars | |
134 | (let ((standard-output (current-buffer))) | |
135 | (princ "\n(custom-theme-set-variables\n") | |
136 | (princ " '") | |
137 | (princ theme) | |
138 | (princ "\n") | |
139 | (mapc (lambda (symbol) | |
140 | (when (boundp symbol) | |
141 | (unless (bolp) | |
142 | (princ "\n")) | |
143 | (princ " '(") | |
144 | (prin1 symbol) | |
145 | (princ " ") | |
bbeb3055 | 146 | (prin1 (custom-quote (symbol-value symbol))) |
3656dac0 RS |
147 | (princ ")"))) |
148 | vars) | |
149 | (if (bolp) | |
150 | (princ " ")) | |
151 | (princ ")") | |
152 | (unless (looking-at "\n") | |
153 | (princ "\n"))))) | |
154 | ||
155 | (defun custom-theme-write-faces (theme faces) | |
156 | "Write a `custom-theme-set-faces' command for THEME. | |
157 | It includes all faces in list FACES." | |
158 | (when faces | |
159 | (let ((standard-output (current-buffer))) | |
160 | (princ "\n(custom-theme-set-faces\n") | |
161 | (princ " '") | |
162 | (princ theme) | |
163 | (princ "\n") | |
164 | (mapc (lambda (symbol) | |
165 | (when (facep symbol) | |
166 | (unless (bolp) | |
167 | (princ "\n")) | |
168 | (princ " '(") | |
169 | (prin1 symbol) | |
170 | (princ " ") | |
79a0aa11 CY |
171 | (prin1 (list (append '(t) |
172 | (custom-face-attributes-get | |
173 | 'font-lock-comment-face nil)))) | |
3656dac0 RS |
174 | (princ ")"))) |
175 | faces) | |
176 | (if (bolp) | |
177 | (princ " ")) | |
178 | (princ ")") | |
179 | (unless (looking-at "\n") | |
180 | (princ "\n"))))) | |
181 | ||
ab5796a9 | 182 | ;;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344 |
3656dac0 | 183 | ;;; cus-theme.el ends here |