Mercurial > emacs
annotate lisp/custom.el @ 17530:9fb83ef40566
(sgml-transformation): Fix previous change.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 22 Apr 1997 04:32:00 +0000 |
parents | d74be66ca177 |
children | d6545cfb6c5a |
rev | line source |
---|---|
17334 | 1 ;;; custom.el -- Tools for declaring and initializing options. |
2 ;; | |
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. | |
4 ;; | |
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | |
6 ;; Keywords: help, faces | |
17415 | 7 ;; Version: 1.84 |
17334 | 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ |
9 | |
17520 | 10 ;; This file is part of GNU Emacs. |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
17334 | 27 ;;; Commentary: |
28 ;; | |
29 ;; If you want to use this code, please visit the URL above. | |
30 ;; | |
31 ;; This file only contain the code needed to declare and initialize | |
32 ;; user options. The code to customize options is autoloaded from | |
33 ;; `cus-edit.el'. | |
34 | |
35 ;; The code implementing face declarations is in `cus-face.el' | |
36 | |
37 ;;; Code: | |
38 | |
39 (require 'widget) | |
40 | |
41 (define-widget-keywords :prefix :tag :load :link :options :type :group) | |
42 | |
17415 | 43 (defvar custom-define-hook nil |
44 ;; Customize information for this option is in `cus-edit.el'. | |
45 "Hook called after defining each customize option.") | |
46 | |
17334 | 47 ;;; The `defcustom' Macro. |
48 | |
49 (defun custom-declare-variable (symbol value doc &rest args) | |
50 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." | |
17415 | 51 ;; Bind this variable unless it already is bound. |
52 (unless (default-boundp symbol) | |
53 ;; Use the saved value if it exists, otherwise the factory setting. | |
17334 | 54 (set-default symbol (if (get symbol 'saved-value) |
55 (eval (car (get symbol 'saved-value))) | |
56 (eval value)))) | |
17415 | 57 ;; Remember the factory setting. |
17334 | 58 (put symbol 'factory-value (list value)) |
17415 | 59 ;; Maybe this option was rogue in an earlier version. It no longer is. |
60 (when (get symbol 'force-value) | |
61 ;; It no longer is. | |
62 (put symbol 'force-value nil)) | |
17334 | 63 (when doc |
64 (put symbol 'variable-documentation doc)) | |
65 (while args | |
66 (let ((arg (car args))) | |
67 (setq args (cdr args)) | |
68 (unless (symbolp arg) | |
69 (error "Junk in args %S" args)) | |
70 (let ((keyword arg) | |
71 (value (car args))) | |
72 (unless args | |
73 (error "Keyword %s is missing an argument" keyword)) | |
74 (setq args (cdr args)) | |
75 (cond ((eq keyword :type) | |
76 (put symbol 'custom-type value)) | |
77 ((eq keyword :options) | |
78 (if (get symbol 'custom-options) | |
79 ;; Slow safe code to avoid duplicates. | |
80 (mapcar (lambda (option) | |
81 (custom-add-option symbol option)) | |
82 value) | |
83 ;; Fast code for the common case. | |
17529
d74be66ca177
(custom-declare-variable): Use copy-sequence, not copy-list.
Richard M. Stallman <rms@gnu.org>
parents:
17520
diff
changeset
|
84 (put symbol 'custom-options (copy-sequence value)))) |
17334 | 85 (t |
86 (custom-handle-keyword symbol keyword value | |
87 'custom-variable)))))) | |
88 (run-hooks 'custom-define-hook) | |
89 symbol) | |
90 | |
91 (defmacro defcustom (symbol value doc &rest args) | |
92 "Declare SYMBOL as a customizable variable that defaults to VALUE. | |
93 DOC is the variable documentation. | |
94 | |
95 Neither SYMBOL nor VALUE needs to be quoted. | |
96 If SYMBOL is not already bound, initialize it to VALUE. | |
97 The remaining arguments should have the form | |
98 | |
99 [KEYWORD VALUE]... | |
100 | |
101 The following KEYWORD's are defined: | |
102 | |
103 :type VALUE should be a widget type. | |
104 :options VALUE should be a list of valid members of the widget type. | |
105 :group VALUE should be a customization group. | |
106 Add SYMBOL to that group. | |
107 | |
17442 | 108 Read the section about customization in the Emacs Lisp manual for more |
17334 | 109 information." |
110 `(eval-and-compile | |
111 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))) | |
112 | |
113 ;;; The `defface' Macro. | |
114 | |
115 (defmacro defface (face spec doc &rest args) | |
116 "Declare FACE as a customizable face that defaults to SPEC. | |
117 FACE does not need to be quoted. | |
118 | |
119 Third argument DOC is the face documentation. | |
120 | |
121 If FACE has been set with `custom-set-face', set the face attributes | |
122 as specified by that function, otherwise set the face attributes | |
123 according to SPEC. | |
124 | |
125 The remaining arguments should have the form | |
126 | |
127 [KEYWORD VALUE]... | |
128 | |
129 The following KEYWORD's are defined: | |
130 | |
131 :group VALUE should be a customization group. | |
132 Add FACE to that group. | |
133 | |
134 SPEC should be an alist of the form ((DISPLAY ATTS)...). | |
135 | |
136 ATTS is a list of face attributes and their values. The possible | |
137 attributes are defined in the variable `custom-face-attributes'. | |
138 Alternatively, ATTS can be a face in which case the attributes of that | |
139 face is used. | |
140 | |
141 The ATTS of the first entry in SPEC where the DISPLAY matches the | |
142 frame should take effect in that frame. DISPLAY can either be the | |
143 symbol t, which will match all frames, or an alist of the form | |
144 \((REQ ITEM...)...) | |
145 | |
146 For the DISPLAY to match a FRAME, the REQ property of the frame must | |
147 match one of the ITEM. The following REQ are defined: | |
148 | |
149 `type' (the value of `window-system') | |
150 Should be one of `x' or `tty'. | |
151 | |
152 `class' (the frame's color support) | |
153 Should be one of `color', `grayscale', or `mono'. | |
154 | |
155 `background' (what color is used for the background text) | |
156 Should be one of `light' or `dark'. | |
157 | |
17442 | 158 Read the section about customization in the Emacs Lisp manual for more |
17334 | 159 information." |
160 `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) | |
161 | |
162 ;;; The `defgroup' Macro. | |
163 | |
164 (defun custom-declare-group (symbol members doc &rest args) | |
165 "Like `defgroup', but SYMBOL is evaluated as a normal argument." | |
166 (put symbol 'custom-group (nconc members (get symbol 'custom-group))) | |
167 (when doc | |
168 (put symbol 'group-documentation doc)) | |
169 (while args | |
170 (let ((arg (car args))) | |
171 (setq args (cdr args)) | |
172 (unless (symbolp arg) | |
173 (error "Junk in args %S" args)) | |
174 (let ((keyword arg) | |
175 (value (car args))) | |
176 (unless args | |
177 (error "Keyword %s is missing an argument" keyword)) | |
178 (setq args (cdr args)) | |
179 (cond ((eq keyword :prefix) | |
180 (put symbol 'custom-prefix value)) | |
181 (t | |
182 (custom-handle-keyword symbol keyword value | |
183 'custom-group)))))) | |
184 (run-hooks 'custom-define-hook) | |
185 symbol) | |
186 | |
187 (defmacro defgroup (symbol members doc &rest args) | |
188 "Declare SYMBOL as a customization group containing MEMBERS. | |
189 SYMBOL does not need to be quoted. | |
190 | |
191 Third arg DOC is the group documentation. | |
192 | |
193 MEMBERS should be an alist of the form ((NAME WIDGET)...) where | |
194 NAME is a symbol and WIDGET is a widget is a widget for editing that | |
195 symbol. Useful widgets are `custom-variable' for editing variables, | |
196 `custom-face' for edit faces, and `custom-group' for editing groups. | |
197 | |
198 The remaining arguments should have the form | |
199 | |
200 [KEYWORD VALUE]... | |
201 | |
202 The following KEYWORD's are defined: | |
203 | |
204 :group VALUE should be a customization group. | |
205 Add SYMBOL to that group. | |
206 | |
17442 | 207 Read the section about customization in the Emacs Lisp manual for more |
17334 | 208 information." |
209 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) | |
210 | |
211 (defun custom-add-to-group (group option widget) | |
212 "To existing GROUP add a new OPTION of type WIDGET. | |
213 If there already is an entry for that option, overwrite it." | |
214 (let* ((members (get group 'custom-group)) | |
215 (old (assq option members))) | |
216 (if old | |
217 (setcar (cdr old) widget) | |
218 (put group 'custom-group (nconc members (list (list option widget))))))) | |
219 | |
220 ;;; Properties. | |
221 | |
222 (defun custom-handle-all-keywords (symbol args type) | |
223 "For customization option SYMBOL, handle keyword arguments ARGS. | |
224 Third argument TYPE is the custom option type." | |
225 (while args | |
226 (let ((arg (car args))) | |
227 (setq args (cdr args)) | |
228 (unless (symbolp arg) | |
229 (error "Junk in args %S" args)) | |
230 (let ((keyword arg) | |
231 (value (car args))) | |
232 (unless args | |
233 (error "Keyword %s is missing an argument" keyword)) | |
234 (setq args (cdr args)) | |
235 (custom-handle-keyword symbol keyword value type))))) | |
236 | |
237 (defun custom-handle-keyword (symbol keyword value type) | |
238 "For customization option SYMBOL, handle KEYWORD with VALUE. | |
239 Fourth argument TYPE is the custom option type." | |
240 (cond ((eq keyword :group) | |
241 (custom-add-to-group value symbol type)) | |
242 ((eq keyword :link) | |
243 (custom-add-link symbol value)) | |
244 ((eq keyword :load) | |
245 (custom-add-load symbol value)) | |
246 ((eq keyword :tag) | |
247 (put symbol 'custom-tag value)) | |
248 (t | |
249 (error "Unknown keyword %s" symbol)))) | |
250 | |
251 (defun custom-add-option (symbol option) | |
252 "To the variable SYMBOL add OPTION. | |
253 | |
254 If SYMBOL is a hook variable, OPTION should be a hook member. | |
255 For other types variables, the effect is undefined." | |
256 (let ((options (get symbol 'custom-options))) | |
257 (unless (member option options) | |
258 (put symbol 'custom-options (cons option options))))) | |
259 | |
260 (defun custom-add-link (symbol widget) | |
261 "To the custom option SYMBOL add the link WIDGET." | |
262 (let ((links (get symbol 'custom-links))) | |
263 (unless (member widget links) | |
264 (put symbol 'custom-links (cons widget links))))) | |
265 | |
266 (defun custom-add-load (symbol load) | |
267 "To the custom option SYMBOL add the dependency LOAD. | |
268 LOAD should be either a library file name, or a feature name." | |
269 (let ((loads (get symbol 'custom-loads))) | |
270 (unless (member load loads) | |
271 (put symbol 'custom-loads (cons load loads))))) | |
272 | |
273 ;;; Initializing. | |
274 | |
275 (defun custom-set-variables (&rest args) | |
276 "Initialize variables according to user preferences. | |
277 | |
278 The arguments should be a list where each entry has the form: | |
279 | |
280 (SYMBOL VALUE [NOW]) | |
281 | |
282 The unevaluated VALUE is stored as the saved value for SYMBOL. | |
283 If NOW is present and non-nil, VALUE is also evaluated and bound as | |
284 the default value for the SYMBOL." | |
285 (while args | |
286 (let ((entry (car args))) | |
287 (if (listp entry) | |
288 (let ((symbol (nth 0 entry)) | |
289 (value (nth 1 entry)) | |
290 (now (nth 2 entry))) | |
291 (put symbol 'saved-value (list value)) | |
17415 | 292 (cond (now |
293 ;; Rogue variable, set it now. | |
294 (put symbol 'force-value t) | |
295 (set-default symbol (eval value))) | |
296 ((default-boundp symbol) | |
297 ;; Something already set this, overwrite it. | |
298 (set-default symbol (eval value)))) | |
17334 | 299 (setq args (cdr args))) |
300 ;; Old format, a plist of SYMBOL VALUE pairs. | |
17415 | 301 (message "Warning: old format `custom-set-variables'") |
302 (ding) | |
303 (sit-for 2) | |
17334 | 304 (let ((symbol (nth 0 args)) |
305 (value (nth 1 args))) | |
306 (put symbol 'saved-value (list value))) | |
307 (setq args (cdr (cdr args))))))) | |
308 | |
309 ;;; The End. | |
310 | |
311 (provide 'custom) | |
312 | |
313 ;; custom.el ends here |