Mercurial > emacs
annotate lisp/cus-theme.el @ 61414:9918f801db35
(archive-mode-map): Move initialization into
the declaration. Override *all* bindings of `undo'.
(archive-lemacs): Remove, use (featurep 'xemacs) instead.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sat, 09 Apr 2005 19:18:17 +0000 |
parents | 695cf19ef79e |
children | dbec9d2e3f52 375f2633d815 |
rev | line source |
---|---|
48952 | 1 ;;; cus-theme.el -- custom theme creation user interface |
2 ;; | |
3 ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
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 | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Code: | |
27 | |
28 (require 'widget) | |
29 (require 'cus-edit) | |
30 | |
31 (eval-when-compile | |
32 (require 'wid-edit)) | |
33 | |
50203
3803afb52e4f
(custom-theme-create): Add autoload cookie.
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
34 ;;;###autoload |
50287
51b6a93f7e19
(customize-create-theme): Rename from
John Paul Wallington <jpw@pobox.com>
parents:
50203
diff
changeset
|
35 (defun customize-create-theme () |
48952 | 36 "Create a custom theme." |
37 (interactive) | |
38 (if (get-buffer "*New Custom Theme*") | |
39 (kill-buffer "*New Custom Theme*")) | |
40 (switch-to-buffer "*New Custom Theme*") | |
41 (kill-all-local-variables) | |
42 (make-local-variable 'custom-theme-name) | |
43 (make-local-variable 'custom-theme-variables) | |
44 (make-local-variable 'custom-theme-faces) | |
45 (make-local-variable 'custom-theme-description) | |
46 (let ((inhibit-read-only t)) | |
47 (erase-buffer)) | |
48 (widget-insert "This buffer helps you write a custom theme elisp file. | |
49 This will help you share your customizations with other people.\n\n") | |
50 (widget-insert "Theme name: ") | |
51 (setq custom-theme-name | |
52 (widget-create 'editable-field | |
53 :size 10 | |
54 user-login-name)) | |
55 (widget-insert "\n\nDocumentation:\n") | |
56 (setq custom-theme-description | |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48952
diff
changeset
|
57 (widget-create 'text |
48952 | 58 :value (format-time-string "Created %Y-%m-%d."))) |
59 (widget-insert "\nVariables:\n\n") | |
60 (setq custom-theme-variables | |
61 (widget-create 'editable-list | |
62 :entry-format "%i %d %v" | |
63 'variable)) | |
64 (widget-insert "\nFaces:\n\n") | |
65 (setq custom-theme-faces | |
66 (widget-create 'editable-list | |
67 :entry-format "%i %d %v" | |
68 'face)) | |
69 (widget-insert "\n") | |
70 (widget-create 'push-button | |
71 :notify (function custom-theme-write) | |
72 "Done") | |
73 (widget-insert " ") | |
74 (widget-create 'push-button | |
75 :notify (lambda (&rest ignore) | |
51745
11d27dde6451
(customize-create-theme): Call `customize-create-theme' in
John Paul Wallington <jpw@pobox.com>
parents:
50287
diff
changeset
|
76 (customize-create-theme)) |
48952 | 77 "Reset") |
78 (widget-insert " ") | |
79 (widget-create 'push-button | |
80 :notify (lambda (&rest ignore) | |
81 (bury-buffer)) | |
82 "Bury Buffer") | |
83 (widget-insert "\n") | |
84 (use-local-map widget-keymap) | |
85 (widget-setup)) | |
86 | |
87 (defun custom-theme-write (&rest ignore) | |
88 (let ((name (widget-value custom-theme-name)) | |
89 (doc (widget-value custom-theme-description)) | |
90 (variables (widget-value custom-theme-variables)) | |
91 (faces (widget-value custom-theme-faces))) | |
92 (switch-to-buffer (concat name "-theme.el")) | |
93 (setq buffer-file-name (expand-file-name (concat name "-theme.el"))) | |
94 (let ((inhibit-read-only t)) | |
95 (erase-buffer)) | |
96 (insert "(deftheme " name) | |
97 (when doc | |
98 (newline) | |
99 (insert " \"" doc "\"")) | |
100 (insert ")\n") | |
101 (custom-theme-write-variables name variables) | |
102 (custom-theme-write-faces name faces) | |
103 (insert "\n(provide-theme '" name ")\n"))) | |
104 | |
105 (defun custom-theme-write-variables (theme vars) | |
106 "Write a `custom-theme-set-variables' command for THEME. | |
107 It includes all variables in list VARS." | |
108 ;; Most code is stolen from `custom-save-variables'. | |
109 (when vars | |
110 (let ((standard-output (current-buffer))) | |
111 (princ "\n(custom-theme-set-variables\n") | |
112 (princ " '") | |
113 (princ theme) | |
114 (princ "\n") | |
115 (mapc (lambda (symbol) | |
116 (when (boundp symbol) | |
117 (unless (bolp) | |
118 (princ "\n")) | |
119 (princ " '(") | |
120 (prin1 symbol) | |
121 (princ " ") | |
122 (prin1 (symbol-value symbol)) | |
123 (princ ")"))) | |
124 vars) | |
125 (if (bolp) | |
126 (princ " ")) | |
127 (princ ")") | |
128 (unless (looking-at "\n") | |
129 (princ "\n"))))) | |
130 | |
131 (defun custom-theme-write-faces (theme faces) | |
132 "Write a `custom-theme-set-faces' command for THEME. | |
133 It includes all faces in list FACES." | |
134 (when faces | |
135 (let ((standard-output (current-buffer))) | |
136 (princ "\n(custom-theme-set-faces\n") | |
137 (princ " '") | |
138 (princ theme) | |
139 (princ "\n") | |
140 (mapc (lambda (symbol) | |
141 (when (facep symbol) | |
142 (unless (bolp) | |
143 (princ "\n")) | |
144 (princ " '(") | |
145 (prin1 symbol) | |
146 (princ " ") | |
147 (prin1 (or (get symbol 'customized-face) | |
148 (get symbol 'face-defface-spec))) | |
149 (princ ")"))) | |
150 faces) | |
151 (if (bolp) | |
152 (princ " ")) | |
153 (princ ")") | |
154 (unless (looking-at "\n") | |
155 (princ "\n"))))) | |
156 | |
52401 | 157 ;;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344 |
48952 | 158 ;;; cus-theme.el ends here |