|
98
|
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
|
|
193
|
7 ;; Version: 1.9960
|
|
98
|
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
|
|
9
|
|
149
|
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
|
|
98
|
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
|
|
106
|
33 ;; `cus-edit.el'.
|
|
193
|
34 ;;
|
|
106
|
35 ;; The code implementing face declarations is in `cus-face.el'
|
|
193
|
36 ;;
|
|
|
37 ;; IMPORTANT: This version of custom is for Emacs 19.34 and XEmacs
|
|
|
38 ;; 19.15 - 20.2 only. If you use Emacs 20.1, XEmacs 20.3, or anything
|
|
|
39 ;; newer, please use the version of custom bundled with your emacs.
|
|
|
40 ;; If you use an older emacs, please upgrade.
|
|
98
|
41
|
|
|
42 ;;; Code:
|
|
|
43
|
|
|
44 (require 'widget)
|
|
|
45
|
|
149
|
46 (define-widget-keywords :initialize :set :get :require :prefix :tag
|
|
|
47 :load :link :options :type :group)
|
|
98
|
48
|
|
124
|
49 ;; These autoloads should be deleted eventually.
|
|
98
|
50 (unless (fboundp 'load-gc)
|
|
106
|
51 ;; From cus-edit.el
|
|
165
|
52 (autoload 'customize-set-value "cus-edit" nil t)
|
|
|
53 (autoload 'customize-set-variable "cus-edit" nil t)
|
|
106
|
54 (autoload 'customize "cus-edit" nil t)
|
|
163
|
55 (autoload 'customize-browse "cus-edit" nil t)
|
|
153
|
56 (autoload 'customize-group "cus-edit" nil t)
|
|
|
57 (autoload 'customize-group-other-window "cus-edit" nil t)
|
|
106
|
58 (autoload 'customize-variable "cus-edit" nil t)
|
|
124
|
59 (autoload 'customize-variable-other-window "cus-edit" nil t)
|
|
106
|
60 (autoload 'customize-face "cus-edit" nil t)
|
|
124
|
61 (autoload 'customize-face-other-window "cus-edit" nil t)
|
|
106
|
62 (autoload 'customize-apropos "cus-edit" nil t)
|
|
|
63 (autoload 'customize-customized "cus-edit" nil t)
|
|
149
|
64 (autoload 'customize-saved "cus-edit" nil t)
|
|
106
|
65 (autoload 'custom-buffer-create "cus-edit")
|
|
|
66 (autoload 'custom-make-dependencies "cus-edit")
|
|
124
|
67 (autoload 'custom-menu-create "cus-edit")
|
|
|
68 (autoload 'customize-menu-create "cus-edit")
|
|
|
69
|
|
106
|
70 ;; From cus-face.el
|
|
|
71 (autoload 'custom-declare-face "cus-face")
|
|
|
72 (autoload 'custom-set-faces "cus-face"))
|
|
98
|
73
|
|
124
|
74 (defvar custom-define-hook nil
|
|
|
75 ;; Customize information for this option is in `cus-edit.el'.
|
|
|
76 "Hook called after defining each customize option.")
|
|
|
77
|
|
98
|
78 ;;; The `defcustom' Macro.
|
|
|
79
|
|
149
|
80 (defun custom-initialize-default (symbol value)
|
|
|
81 "Initialize SYMBOL with VALUE.
|
|
|
82 This will do nothing if symbol already has a default binding.
|
|
|
83 Otherwise, if symbol has a `saved-value' property, it will evaluate
|
|
|
84 the car of that and used as the default binding for symbol.
|
|
|
85 Otherwise, VALUE will be evaluated and used as the default binding for
|
|
|
86 symbol."
|
|
120
|
87 (unless (default-boundp symbol)
|
|
153
|
88 ;; Use the saved value if it exists, otherwise the standard setting.
|
|
98
|
89 (set-default symbol (if (get symbol 'saved-value)
|
|
|
90 (eval (car (get symbol 'saved-value)))
|
|
149
|
91 (eval value)))))
|
|
|
92
|
|
|
93 (defun custom-initialize-set (symbol value)
|
|
|
94 "Initialize SYMBOL with VALUE.
|
|
|
95 Like `custom-initialize-default', but use the function specified by
|
|
|
96 `:set' to initialize SYMBOL."
|
|
|
97 (unless (default-boundp symbol)
|
|
|
98 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
99 symbol
|
|
|
100 (if (get symbol 'saved-value)
|
|
|
101 (eval (car (get symbol 'saved-value)))
|
|
|
102 (eval value)))))
|
|
|
103
|
|
|
104 (defun custom-initialize-reset (symbol value)
|
|
|
105 "Initialize SYMBOL with VALUE.
|
|
|
106 Like `custom-initialize-set', but use the function specified by
|
|
|
107 `:get' to reinitialize SYMBOL if it is already bound."
|
|
|
108 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
109 symbol
|
|
|
110 (cond ((default-boundp symbol)
|
|
|
111 (funcall (or (get symbol 'custom-get) 'default-value)
|
|
|
112 symbol))
|
|
|
113 ((get symbol 'saved-value)
|
|
|
114 (eval (car (get symbol 'saved-value))))
|
|
|
115 (t
|
|
|
116 (eval value)))))
|
|
|
117
|
|
|
118 (defun custom-initialize-changed (symbol value)
|
|
|
119 "Initialize SYMBOL with VALUE.
|
|
|
120 Like `custom-initialize-reset', but only use the `:set' function if the
|
|
153
|
121 not using the standard setting. Otherwise, use the `set-default'."
|
|
149
|
122 (cond ((default-boundp symbol)
|
|
|
123 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
124 symbol
|
|
|
125 (funcall (or (get symbol 'custom-get) 'default-value)
|
|
|
126 symbol)))
|
|
|
127 ((get symbol 'saved-value)
|
|
|
128 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
129 symbol
|
|
|
130 (eval (car (get symbol 'saved-value)))))
|
|
|
131 (t
|
|
|
132 (set-default symbol (eval value)))))
|
|
|
133
|
|
|
134 (defun custom-declare-variable (symbol value doc &rest args)
|
|
|
135 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
|
|
153
|
136 ;; Remember the standard setting.
|
|
|
137 (put symbol 'standard-value (list value))
|
|
120
|
138 ;; Maybe this option was rogue in an earlier version. It no longer is.
|
|
|
139 (when (get symbol 'force-value)
|
|
|
140 ;; It no longer is.
|
|
|
141 (put symbol 'force-value nil))
|
|
98
|
142 (when doc
|
|
|
143 (put symbol 'variable-documentation doc))
|
|
189
|
144 (let ((initialize 'custom-initialize-reset)
|
|
149
|
145 (requests nil))
|
|
|
146 (while args
|
|
|
147 (let ((arg (car args)))
|
|
98
|
148 (setq args (cdr args))
|
|
149
|
149 (unless (symbolp arg)
|
|
|
150 (error "Junk in args %S" args))
|
|
|
151 (let ((keyword arg)
|
|
|
152 (value (car args)))
|
|
|
153 (unless args
|
|
|
154 (error "Keyword %s is missing an argument" keyword))
|
|
|
155 (setq args (cdr args))
|
|
|
156 (cond ((eq keyword :initialize)
|
|
|
157 (setq initialize value))
|
|
|
158 ((eq keyword :set)
|
|
|
159 (put symbol 'custom-set value))
|
|
|
160 ((eq keyword :get)
|
|
|
161 (put symbol 'custom-get value))
|
|
|
162 ((eq keyword :require)
|
|
153
|
163 (setq requests (cons value requests)))
|
|
149
|
164 ((eq keyword :type)
|
|
|
165 (put symbol 'custom-type value))
|
|
|
166 ((eq keyword :options)
|
|
|
167 (if (get symbol 'custom-options)
|
|
|
168 ;; Slow safe code to avoid duplicates.
|
|
|
169 (mapcar (lambda (option)
|
|
|
170 (custom-add-option symbol option))
|
|
|
171 value)
|
|
|
172 ;; Fast code for the common case.
|
|
|
173 (put symbol 'custom-options (copy-sequence value))))
|
|
|
174 (t
|
|
|
175 (custom-handle-keyword symbol keyword value
|
|
|
176 'custom-variable))))))
|
|
|
177 (put symbol 'custom-requests requests)
|
|
|
178 ;; Do the actual initialization.
|
|
|
179 (funcall initialize symbol value))
|
|
98
|
180 (run-hooks 'custom-define-hook)
|
|
|
181 symbol)
|
|
|
182
|
|
|
183 (defmacro defcustom (symbol value doc &rest args)
|
|
|
184 "Declare SYMBOL as a customizable variable that defaults to VALUE.
|
|
|
185 DOC is the variable documentation.
|
|
|
186
|
|
|
187 Neither SYMBOL nor VALUE needs to be quoted.
|
|
|
188 If SYMBOL is not already bound, initialize it to VALUE.
|
|
|
189 The remaining arguments should have the form
|
|
|
190
|
|
|
191 [KEYWORD VALUE]...
|
|
|
192
|
|
|
193 The following KEYWORD's are defined:
|
|
|
194
|
|
149
|
195 :type VALUE should be a widget type for editing the symbols value.
|
|
|
196 The default is `sexp'.
|
|
98
|
197 :options VALUE should be a list of valid members of the widget type.
|
|
|
198 :group VALUE should be a customization group.
|
|
|
199 Add SYMBOL to that group.
|
|
149
|
200 :initialize VALUE should be a function used to initialize the
|
|
|
201 variable. It takes two arguments, the symbol and value
|
|
|
202 given in the `defcustom' call. The default is
|
|
173
|
203 `custom-initialize-set'
|
|
149
|
204 :set VALUE should be a function to set the value of the symbol.
|
|
|
205 It takes two arguments, the symbol to set and the value to
|
|
|
206 give it. The default is `set-default'.
|
|
|
207 :get VALUE should be a function to extract the value of symbol.
|
|
|
208 The function takes one argument, a symbol, and should return
|
|
|
209 the current value for that symbol. The default is
|
|
|
210 `default-value'.
|
|
|
211 :require VALUE should be a feature symbol. Each feature will be
|
|
|
212 required after initialization, of the the user have saved this
|
|
|
213 option.
|
|
98
|
214
|
|
149
|
215 Read the section about customization in the Emacs Lisp manual for more
|
|
98
|
216 information."
|
|
149
|
217 `(custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))
|
|
98
|
218
|
|
|
219 ;;; The `defface' Macro.
|
|
|
220
|
|
|
221 (defmacro defface (face spec doc &rest args)
|
|
|
222 "Declare FACE as a customizable face that defaults to SPEC.
|
|
|
223 FACE does not need to be quoted.
|
|
|
224
|
|
|
225 Third argument DOC is the face documentation.
|
|
|
226
|
|
|
227 If FACE has been set with `custom-set-face', set the face attributes
|
|
|
228 as specified by that function, otherwise set the face attributes
|
|
|
229 according to SPEC.
|
|
|
230
|
|
|
231 The remaining arguments should have the form
|
|
|
232
|
|
|
233 [KEYWORD VALUE]...
|
|
|
234
|
|
155
|
235 The following KEYWORDs are defined:
|
|
98
|
236
|
|
|
237 :group VALUE should be a customization group.
|
|
|
238 Add FACE to that group.
|
|
|
239
|
|
|
240 SPEC should be an alist of the form ((DISPLAY ATTS)...).
|
|
|
241
|
|
|
242 ATTS is a list of face attributes and their values. The possible
|
|
|
243 attributes are defined in the variable `custom-face-attributes'.
|
|
|
244
|
|
|
245 The ATTS of the first entry in SPEC where the DISPLAY matches the
|
|
|
246 frame should take effect in that frame. DISPLAY can either be the
|
|
118
|
247 symbol t, which will match all frames, or an alist of the form
|
|
98
|
248 \((REQ ITEM...)...)
|
|
|
249
|
|
|
250 For the DISPLAY to match a FRAME, the REQ property of the frame must
|
|
|
251 match one of the ITEM. The following REQ are defined:
|
|
|
252
|
|
118
|
253 `type' (the value of `window-system')
|
|
98
|
254 Should be one of `x' or `tty'.
|
|
|
255
|
|
|
256 `class' (the frame's color support)
|
|
|
257 Should be one of `color', `grayscale', or `mono'.
|
|
|
258
|
|
|
259 `background' (what color is used for the background text)
|
|
|
260 Should be one of `light' or `dark'.
|
|
|
261
|
|
149
|
262 Read the section about customization in the Emacs Lisp manual for more
|
|
98
|
263 information."
|
|
|
264 `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
|
|
|
265
|
|
|
266 ;;; The `defgroup' Macro.
|
|
|
267
|
|
|
268 (defun custom-declare-group (symbol members doc &rest args)
|
|
|
269 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
|
|
149
|
270 (while members
|
|
|
271 (apply 'custom-add-to-group symbol (car members))
|
|
|
272 (setq members (cdr members)))
|
|
98
|
273 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
|
|
|
274 (when doc
|
|
|
275 (put symbol 'group-documentation doc))
|
|
|
276 (while args
|
|
|
277 (let ((arg (car args)))
|
|
|
278 (setq args (cdr args))
|
|
|
279 (unless (symbolp arg)
|
|
|
280 (error "Junk in args %S" args))
|
|
|
281 (let ((keyword arg)
|
|
|
282 (value (car args)))
|
|
|
283 (unless args
|
|
|
284 (error "Keyword %s is missing an argument" keyword))
|
|
|
285 (setq args (cdr args))
|
|
|
286 (cond ((eq keyword :prefix)
|
|
|
287 (put symbol 'custom-prefix value))
|
|
|
288 (t
|
|
|
289 (custom-handle-keyword symbol keyword value
|
|
|
290 'custom-group))))))
|
|
|
291 (run-hooks 'custom-define-hook)
|
|
|
292 symbol)
|
|
|
293
|
|
|
294 (defmacro defgroup (symbol members doc &rest args)
|
|
|
295 "Declare SYMBOL as a customization group containing MEMBERS.
|
|
|
296 SYMBOL does not need to be quoted.
|
|
|
297
|
|
|
298 Third arg DOC is the group documentation.
|
|
|
299
|
|
177
|
300 MEMBERS should be an alist of the form ((NAME WIDGET)...) where NAME
|
|
|
301 is a symbol and WIDGET is a widget for editing that symbol. Useful
|
|
|
302 widgets are `custom-variable' for editing variables, `custom-face' for
|
|
|
303 edit faces, and `custom-group' for editing groups.
|
|
98
|
304
|
|
|
305 The remaining arguments should have the form
|
|
|
306
|
|
|
307 [KEYWORD VALUE]...
|
|
|
308
|
|
|
309 The following KEYWORD's are defined:
|
|
|
310
|
|
|
311 :group VALUE should be a customization group.
|
|
|
312 Add SYMBOL to that group.
|
|
|
313
|
|
149
|
314 Read the section about customization in the Emacs Lisp manual for more
|
|
98
|
315 information."
|
|
|
316 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
|
|
|
317
|
|
|
318 (defun custom-add-to-group (group option widget)
|
|
118
|
319 "To existing GROUP add a new OPTION of type WIDGET.
|
|
98
|
320 If there already is an entry for that option, overwrite it."
|
|
|
321 (let* ((members (get group 'custom-group))
|
|
|
322 (old (assq option members)))
|
|
|
323 (if old
|
|
|
324 (setcar (cdr old) widget)
|
|
|
325 (put group 'custom-group (nconc members (list (list option widget)))))))
|
|
|
326
|
|
|
327 ;;; Properties.
|
|
|
328
|
|
|
329 (defun custom-handle-all-keywords (symbol args type)
|
|
|
330 "For customization option SYMBOL, handle keyword arguments ARGS.
|
|
|
331 Third argument TYPE is the custom option type."
|
|
|
332 (while args
|
|
|
333 (let ((arg (car args)))
|
|
|
334 (setq args (cdr args))
|
|
|
335 (unless (symbolp arg)
|
|
|
336 (error "Junk in args %S" args))
|
|
|
337 (let ((keyword arg)
|
|
|
338 (value (car args)))
|
|
|
339 (unless args
|
|
|
340 (error "Keyword %s is missing an argument" keyword))
|
|
|
341 (setq args (cdr args))
|
|
|
342 (custom-handle-keyword symbol keyword value type)))))
|
|
|
343
|
|
|
344 (defun custom-handle-keyword (symbol keyword value type)
|
|
|
345 "For customization option SYMBOL, handle KEYWORD with VALUE.
|
|
|
346 Fourth argument TYPE is the custom option type."
|
|
|
347 (cond ((eq keyword :group)
|
|
|
348 (custom-add-to-group value symbol type))
|
|
|
349 ((eq keyword :link)
|
|
|
350 (custom-add-link symbol value))
|
|
|
351 ((eq keyword :load)
|
|
|
352 (custom-add-load symbol value))
|
|
|
353 ((eq keyword :tag)
|
|
|
354 (put symbol 'custom-tag value))
|
|
|
355 (t
|
|
|
356 (error "Unknown keyword %s" symbol))))
|
|
|
357
|
|
|
358 (defun custom-add-option (symbol option)
|
|
|
359 "To the variable SYMBOL add OPTION.
|
|
|
360
|
|
|
361 If SYMBOL is a hook variable, OPTION should be a hook member.
|
|
|
362 For other types variables, the effect is undefined."
|
|
|
363 (let ((options (get symbol 'custom-options)))
|
|
|
364 (unless (member option options)
|
|
|
365 (put symbol 'custom-options (cons option options)))))
|
|
|
366
|
|
|
367 (defun custom-add-link (symbol widget)
|
|
|
368 "To the custom option SYMBOL add the link WIDGET."
|
|
|
369 (let ((links (get symbol 'custom-links)))
|
|
|
370 (unless (member widget links)
|
|
|
371 (put symbol 'custom-links (cons widget links)))))
|
|
|
372
|
|
|
373 (defun custom-add-load (symbol load)
|
|
|
374 "To the custom option SYMBOL add the dependency LOAD.
|
|
|
375 LOAD should be either a library file name, or a feature name."
|
|
|
376 (let ((loads (get symbol 'custom-loads)))
|
|
|
377 (unless (member load loads)
|
|
|
378 (put symbol 'custom-loads (cons load loads)))))
|
|
|
379
|
|
|
380 ;;; Initializing.
|
|
|
381
|
|
|
382 (defun custom-set-variables (&rest args)
|
|
|
383 "Initialize variables according to user preferences.
|
|
|
384
|
|
|
385 The arguments should be a list where each entry has the form:
|
|
|
386
|
|
|
387 (SYMBOL VALUE [NOW])
|
|
|
388
|
|
|
389 The unevaluated VALUE is stored as the saved value for SYMBOL.
|
|
|
390 If NOW is present and non-nil, VALUE is also evaluated and bound as
|
|
|
391 the default value for the SYMBOL."
|
|
|
392 (while args
|
|
|
393 (let ((entry (car args)))
|
|
|
394 (if (listp entry)
|
|
149
|
395 (let* ((symbol (nth 0 entry))
|
|
|
396 (value (nth 1 entry))
|
|
|
397 (now (nth 2 entry))
|
|
|
398 (requests (nth 3 entry))
|
|
|
399 (set (or (get symbol 'custom-set) 'set-default)))
|
|
98
|
400 (put symbol 'saved-value (list value))
|
|
120
|
401 (cond (now
|
|
|
402 ;; Rogue variable, set it now.
|
|
|
403 (put symbol 'force-value t)
|
|
149
|
404 (funcall set symbol (eval value)))
|
|
120
|
405 ((default-boundp symbol)
|
|
|
406 ;; Something already set this, overwrite it.
|
|
149
|
407 (funcall set symbol (eval value))))
|
|
|
408 (when requests
|
|
|
409 (put symbol 'custom-requests requests)
|
|
|
410 (mapcar 'require requests))
|
|
98
|
411 (setq args (cdr args)))
|
|
|
412 ;; Old format, a plist of SYMBOL VALUE pairs.
|
|
124
|
413 (message "Warning: old format `custom-set-variables'")
|
|
|
414 (ding)
|
|
|
415 (sit-for 2)
|
|
98
|
416 (let ((symbol (nth 0 args))
|
|
|
417 (value (nth 1 args)))
|
|
|
418 (put symbol 'saved-value (list value)))
|
|
|
419 (setq args (cdr (cdr args)))))))
|
|
|
420
|
|
|
421 ;;; The End.
|
|
|
422
|
|
|
423 (provide 'custom)
|
|
|
424
|
|
|
425 ;; custom.el ends here
|
