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'." | |
8314bdb8 CY |
38 | (set-keymap-parent custom-new-theme-mode-map widget-keymap) |
39 | (set (make-local-variable 'widget-documentation-face) 'custom-documentation) | |
40 | (set (make-local-variable 'widget-button-face) custom-button) | |
41 | (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed) | |
42 | (if custom-raised-buttons | |
43 | (set (make-local-variable 'widget-mouse-face) custom-button)) | |
8314bdb8 CY |
44 | (when custom-raised-buttons |
45 | (set (make-local-variable 'widget-push-button-prefix) "") | |
46 | (set (make-local-variable 'widget-push-button-suffix) "") | |
47 | (set (make-local-variable 'widget-link-prefix) "") | |
48 | (set (make-local-variable 'widget-link-suffix) ""))) | |
077ad61c LT |
49 | (put 'custom-new-theme-mode 'mode-class 'special) |
50 | ||
51 | (defvar custom-theme-name) | |
52 | (defvar custom-theme-variables) | |
53 | (defvar custom-theme-faces) | |
54 | (defvar custom-theme-description) | |
55 | ||
87e391a9 | 56 | ;;;###autoload |
f560e69c | 57 | (defun customize-create-theme () |
3656dac0 RS |
58 | "Create a custom theme." |
59 | (interactive) | |
60 | (if (get-buffer "*New Custom Theme*") | |
61 | (kill-buffer "*New Custom Theme*")) | |
62 | (switch-to-buffer "*New Custom Theme*") | |
077ad61c LT |
63 | (let ((inhibit-read-only t)) |
64 | (erase-buffer)) | |
65 | (custom-new-theme-mode) | |
3656dac0 RS |
66 | (make-local-variable 'custom-theme-name) |
67 | (make-local-variable 'custom-theme-variables) | |
68 | (make-local-variable 'custom-theme-faces) | |
69 | (make-local-variable 'custom-theme-description) | |
3656dac0 | 70 | (widget-insert "This buffer helps you write a custom theme elisp file. |
077ad61c LT |
71 | This will help you share your customizations with other people. |
72 | ||
73 | Just insert the names of all variables and faces you want the theme | |
74 | to include. Then clicking mouse-2 or pressing RET on the [Done] button | |
75 | will write a theme file that sets all these variables and faces to their | |
76 | current global values. It will write that file into the directory given | |
77 | by the variable `custom-theme-directory', usually \"~/.emacs.d/\". | |
78 | ||
79 | To undo all your edits to the buffer, use the [Reset] button.\n\n") | |
3656dac0 RS |
80 | (widget-insert "Theme name: ") |
81 | (setq custom-theme-name | |
82 | (widget-create 'editable-field | |
83 | :size 10 | |
84 | user-login-name)) | |
85 | (widget-insert "\n\nDocumentation:\n") | |
86 | (setq custom-theme-description | |
71296446 | 87 | (widget-create 'text |
3656dac0 RS |
88 | :value (format-time-string "Created %Y-%m-%d."))) |
89 | (widget-insert "\nVariables:\n\n") | |
90 | (setq custom-theme-variables | |
91 | (widget-create 'editable-list | |
92 | :entry-format "%i %d %v" | |
93 | 'variable)) | |
94 | (widget-insert "\nFaces:\n\n") | |
95 | (setq custom-theme-faces | |
96 | (widget-create 'editable-list | |
97 | :entry-format "%i %d %v" | |
98 | 'face)) | |
99 | (widget-insert "\n") | |
100 | (widget-create 'push-button | |
101 | :notify (function custom-theme-write) | |
102 | "Done") | |
103 | (widget-insert " ") | |
104 | (widget-create 'push-button | |
105 | :notify (lambda (&rest ignore) | |
392cb21b | 106 | (customize-create-theme)) |
3656dac0 RS |
107 | "Reset") |
108 | (widget-insert " ") | |
109 | (widget-create 'push-button | |
110 | :notify (lambda (&rest ignore) | |
111 | (bury-buffer)) | |
112 | "Bury Buffer") | |
113 | (widget-insert "\n") | |
3656dac0 RS |
114 | (widget-setup)) |
115 | ||
116 | (defun custom-theme-write (&rest ignore) | |
117 | (let ((name (widget-value custom-theme-name)) | |
118 | (doc (widget-value custom-theme-description)) | |
119 | (variables (widget-value custom-theme-variables)) | |
120 | (faces (widget-value custom-theme-faces))) | |
121 | (switch-to-buffer (concat name "-theme.el")) | |
077ad61c LT |
122 | (emacs-lisp-mode) |
123 | (unless (file-exists-p custom-theme-directory) | |
124 | (make-directory (file-name-as-directory custom-theme-directory) t)) | |
125 | (setq default-directory custom-theme-directory) | |
3656dac0 RS |
126 | (setq buffer-file-name (expand-file-name (concat name "-theme.el"))) |
127 | (let ((inhibit-read-only t)) | |
128 | (erase-buffer)) | |
129 | (insert "(deftheme " name) | |
130 | (when doc | |
131 | (newline) | |
132 | (insert " \"" doc "\"")) | |
133 | (insert ")\n") | |
134 | (custom-theme-write-variables name variables) | |
135 | (custom-theme-write-faces name faces) | |
077ad61c LT |
136 | (insert "\n(provide-theme '" name ")\n") |
137 | (save-buffer))) | |
3656dac0 RS |
138 | |
139 | (defun custom-theme-write-variables (theme vars) | |
140 | "Write a `custom-theme-set-variables' command for THEME. | |
141 | It includes all variables in list VARS." | |
142 | ;; Most code is stolen from `custom-save-variables'. | |
143 | (when vars | |
144 | (let ((standard-output (current-buffer))) | |
145 | (princ "\n(custom-theme-set-variables\n") | |
146 | (princ " '") | |
147 | (princ theme) | |
148 | (princ "\n") | |
149 | (mapc (lambda (symbol) | |
150 | (when (boundp symbol) | |
151 | (unless (bolp) | |
152 | (princ "\n")) | |
153 | (princ " '(") | |
154 | (prin1 symbol) | |
155 | (princ " ") | |
bbeb3055 | 156 | (prin1 (custom-quote (symbol-value symbol))) |
3656dac0 RS |
157 | (princ ")"))) |
158 | vars) | |
159 | (if (bolp) | |
160 | (princ " ")) | |
161 | (princ ")") | |
162 | (unless (looking-at "\n") | |
163 | (princ "\n"))))) | |
164 | ||
165 | (defun custom-theme-write-faces (theme faces) | |
166 | "Write a `custom-theme-set-faces' command for THEME. | |
167 | It includes all faces in list FACES." | |
168 | (when faces | |
169 | (let ((standard-output (current-buffer))) | |
170 | (princ "\n(custom-theme-set-faces\n") | |
171 | (princ " '") | |
172 | (princ theme) | |
173 | (princ "\n") | |
174 | (mapc (lambda (symbol) | |
175 | (when (facep symbol) | |
176 | (unless (bolp) | |
177 | (princ "\n")) | |
178 | (princ " '(") | |
179 | (prin1 symbol) | |
180 | (princ " ") | |
79a0aa11 CY |
181 | (prin1 (list (append '(t) |
182 | (custom-face-attributes-get | |
183 | 'font-lock-comment-face nil)))) | |
3656dac0 RS |
184 | (princ ")"))) |
185 | faces) | |
186 | (if (bolp) | |
187 | (princ " ")) | |
188 | (princ ")") | |
189 | (unless (looking-at "\n") | |
190 | (princ "\n"))))) | |
191 | ||
ab5796a9 | 192 | ;;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344 |
3656dac0 | 193 | ;;; cus-theme.el ends here |