Mercurial > emacs
annotate lisp/cus-theme.el @ 66846:4e016bc4dac4
(gud-menu-map): Move parentheses (again).
(gud-speedbar-buttons): Match on "const char *" too.
author | Nick Roberts <nickrob@snap.net.nz> |
---|---|
date | Sun, 13 Nov 2005 09:03:36 +0000 |
parents | 6990826a916f |
children | 5bf588b1a01e a3716f7538f2 |
rev | line source |
---|---|
48952 | 1 ;;; cus-theme.el -- custom theme creation user interface |
2 ;; | |
64762
41bb365f41c4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64091
diff
changeset
|
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
48952 | 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 | |
64091 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
48952 | 25 |
26 ;;; Code: | |
27 | |
28 (require 'widget) | |
29 (require 'cus-edit) | |
30 | |
31 (eval-when-compile | |
32 (require 'wid-edit)) | |
33 | |
63928
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
34 (define-derived-mode custom-new-theme-mode nil "New-Theme" |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
35 "Major mode for the buffer created by `customize-create-theme'. |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
36 Do not call this mode function yourself. It is only meant for internal |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
37 use by `customize-create-theme'." |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
38 (set-keymap-parent custom-new-theme-mode-map widget-keymap)) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
39 (put 'custom-new-theme-mode 'mode-class 'special) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
40 |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
41 (defvar custom-theme-name) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
42 (defvar custom-theme-variables) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
43 (defvar custom-theme-faces) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
44 (defvar custom-theme-description) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
45 |
50203
3803afb52e4f
(custom-theme-create): Add autoload cookie.
John Paul Wallington <jpw@pobox.com>
parents:
49588
diff
changeset
|
46 ;;;###autoload |
50287
51b6a93f7e19
(customize-create-theme): Rename from
John Paul Wallington <jpw@pobox.com>
parents:
50203
diff
changeset
|
47 (defun customize-create-theme () |
48952 | 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*") | |
63928
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
53 (let ((inhibit-read-only t)) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
54 (erase-buffer)) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
55 (custom-new-theme-mode) |
48952 | 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) | |
60 (widget-insert "This buffer helps you write a custom theme elisp file. | |
63928
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
61 This will help you share your customizations with other people. |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
62 |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
63 Just insert the names of all variables and faces you want the theme |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
64 to include. Then clicking mouse-2 or pressing RET on the [Done] button |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
65 will write a theme file that sets all these variables and faces to their |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
66 current global values. It will write that file into the directory given |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
67 by the variable `custom-theme-directory', usually \"~/.emacs.d/\". |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
68 |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
69 To undo all your edits to the buffer, use the [Reset] button.\n\n") |
48952 | 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 | |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48952
diff
changeset
|
77 (widget-create 'text |
48952 | 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) | |
51745
11d27dde6451
(customize-create-theme): Call `customize-create-theme' in
John Paul Wallington <jpw@pobox.com>
parents:
50287
diff
changeset
|
96 (customize-create-theme)) |
48952 | 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") | |
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")) | |
63928
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
112 (emacs-lisp-mode) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
113 (unless (file-exists-p custom-theme-directory) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
114 (make-directory (file-name-as-directory custom-theme-directory) t)) |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
115 (setq default-directory custom-theme-directory) |
48952 | 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) | |
63928
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
126 (insert "\n(provide-theme '" name ")\n") |
e559c2c766bc
(custom-new-theme-mode): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61603
diff
changeset
|
127 (save-buffer))) |
48952 | 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 " ") | |
61603
dbec9d2e3f52
(custom-theme-write-variables): Quote variables
David Kastrup <dak@gnu.org>
parents:
52401
diff
changeset
|
146 (prin1 (custom-quote (symbol-value symbol))) |
48952 | 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 " ") | |
65341
6990826a916f
Custom Theme bugfixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
64762
diff
changeset
|
171 (prin1 (list (append '(t) |
6990826a916f
Custom Theme bugfixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
64762
diff
changeset
|
172 (custom-face-attributes-get |
6990826a916f
Custom Theme bugfixes.
Chong Yidong <cyd@stupidchicken.com>
parents:
64762
diff
changeset
|
173 'font-lock-comment-face nil)))) |
48952 | 174 (princ ")"))) |
175 faces) | |
176 (if (bolp) | |
177 (princ " ")) | |
178 (princ ")") | |
179 (unless (looking-at "\n") | |
180 (princ "\n"))))) | |
181 | |
52401 | 182 ;;; arch-tag: cd6919bc-63af-410e-bae2-b6702e762344 |
48952 | 183 ;;; cus-theme.el ends here |