|
428
|
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 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
|
|
|
7 ;; Keywords: help, faces, dumped
|
|
|
8 ;; Version: 1.9960-x
|
|
|
9 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
|
|
10
|
|
|
11 ;; This file is part of XEmacs.
|
|
|
12
|
|
|
13 ;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
14 ;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; XEmacs is distributed in the hope that it will be useful,
|
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;; GNU General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;; Boston, MA 02111-1307, USA.
|
|
|
27
|
|
1333
|
28 ;;; Synched with: ??? Partially synched to 21.2 by Ben Wing.
|
|
|
29
|
|
428
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; This file is dumped with XEmacs.
|
|
|
33
|
|
|
34 ;; This file only contain the code needed to declare and initialize
|
|
|
35 ;; user options. The code to customize options is autoloaded from
|
|
|
36 ;; `cus-edit.el'.
|
|
|
37 ;;
|
|
|
38 ;; The code implementing face declarations is in `cus-face.el'
|
|
|
39
|
|
|
40 ;;; Code:
|
|
|
41
|
|
771
|
42 ;; it is now safe to put the `provide' anywhere. if an error occurs while
|
|
|
43 ;; loading, all provides (and fsets) will be undone. put it first to
|
|
|
44 ;; prevent require/provide loop with custom and cus-face.
|
|
|
45 (provide 'custom)
|
|
|
46
|
|
1333
|
47 ;; BEGIN SYNC WITH FSF 21.2
|
|
|
48
|
|
428
|
49 (eval-when-compile
|
|
771
|
50 (load "cl-macs" nil t)
|
|
|
51 ;; To elude warnings.
|
|
|
52 (require 'cus-face))
|
|
428
|
53
|
|
442
|
54 (autoload 'custom-declare-face "cus-face")
|
|
|
55 (autoload 'defun* "cl-macs")
|
|
428
|
56
|
|
|
57 (require 'widget)
|
|
|
58
|
|
|
59 (defvar custom-define-hook nil
|
|
|
60 ;; Customize information for this option is in `cus-edit.el'.
|
|
|
61 "Hook called after defining each customize option.")
|
|
|
62
|
|
|
63 ;;; The `defcustom' Macro.
|
|
|
64
|
|
|
65 (defun custom-initialize-default (symbol value)
|
|
|
66 "Initialize SYMBOL with VALUE.
|
|
|
67 This will do nothing if symbol already has a default binding.
|
|
|
68 Otherwise, if symbol has a `saved-value' property, it will evaluate
|
|
|
69 the car of that and used as the default binding for symbol.
|
|
|
70 Otherwise, VALUE will be evaluated and used as the default binding for
|
|
|
71 symbol."
|
|
|
72 (unless (default-boundp symbol)
|
|
|
73 ;; Use the saved value if it exists, otherwise the standard setting.
|
|
|
74 (set-default symbol (if (get symbol 'saved-value)
|
|
|
75 (eval (car (get symbol 'saved-value)))
|
|
|
76 (eval value)))))
|
|
|
77
|
|
|
78 (defun custom-initialize-set (symbol value)
|
|
|
79 "Initialize SYMBOL with VALUE.
|
|
1333
|
80 If the symbol doesn't have a default binding already,
|
|
|
81 then set it using its `:set' function (or `set-default' if it has none).
|
|
|
82 The value is either the value in the symbol's `saved-value' property,
|
|
|
83 if any, or VALUE.
|
|
|
84
|
|
|
85 This is like `custom-initialize-default', but uses the function specified by
|
|
428
|
86 `:set' to initialize SYMBOL."
|
|
|
87 (unless (default-boundp symbol)
|
|
|
88 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
89 symbol
|
|
|
90 (if (get symbol 'saved-value)
|
|
|
91 (eval (car (get symbol 'saved-value)))
|
|
|
92 (eval value)))))
|
|
|
93
|
|
|
94 (defun custom-initialize-reset (symbol value)
|
|
|
95 "Initialize SYMBOL with VALUE.
|
|
1333
|
96 Set the symbol, using its `:set' function (or `set-default' if it has none).
|
|
|
97 The value is either the symbol's current value
|
|
|
98 \(as obtained using the `:get' function), if any,
|
|
|
99 or the value in the symbol's `saved-value' property if any,
|
|
|
100 or (last of all) VALUE.
|
|
|
101
|
|
428
|
102 Like `custom-initialize-set', but use the function specified by
|
|
|
103 `:get' to reinitialize SYMBOL if it is already bound."
|
|
|
104 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
105 symbol
|
|
|
106 (cond ((default-boundp symbol)
|
|
|
107 (funcall (or (get symbol 'custom-get) 'default-value)
|
|
|
108 symbol))
|
|
|
109 ((get symbol 'saved-value)
|
|
|
110 (eval (car (get symbol 'saved-value))))
|
|
|
111 (t
|
|
|
112 (eval value)))))
|
|
|
113
|
|
|
114 (defun custom-initialize-changed (symbol value)
|
|
|
115 "Initialize SYMBOL with VALUE.
|
|
|
116 Like `custom-initialize-reset', but only use the `:set' function if the
|
|
1333
|
117 not using the standard setting.
|
|
|
118 For the standard setting, use `set-default'."
|
|
428
|
119 (cond ((default-boundp symbol)
|
|
|
120 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
121 symbol
|
|
|
122 (funcall (or (get symbol 'custom-get) 'default-value)
|
|
|
123 symbol)))
|
|
|
124 ((get symbol 'saved-value)
|
|
|
125 (funcall (or (get symbol 'custom-set) 'set-default)
|
|
|
126 symbol
|
|
|
127 (eval (car (get symbol 'saved-value)))))
|
|
|
128 (t
|
|
|
129 (set-default symbol (eval value)))))
|
|
|
130
|
|
1333
|
131 (defun custom-declare-variable (symbol default doc &rest args)
|
|
|
132 "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
|
|
|
133 DEFAULT should be an expression to evaluate to compute the default value,
|
|
|
134 not the default value itself."
|
|
428
|
135 ;; Remember the standard setting.
|
|
1333
|
136 (put symbol 'standard-value (list default))
|
|
428
|
137 ;; Maybe this option was rogue in an earlier version. It no longer is.
|
|
|
138 (when (eq (get symbol 'force-value) 'rogue)
|
|
|
139 ;; It no longer is.
|
|
|
140 (put symbol 'force-value nil))
|
|
|
141 (when doc
|
|
|
142 (put symbol 'variable-documentation doc))
|
|
|
143 (let ((initialize 'custom-initialize-reset)
|
|
|
144 (requests nil))
|
|
|
145 (while args
|
|
|
146 (let ((arg (car args)))
|
|
|
147 (setq args (cdr args))
|
|
|
148 (check-argument-type 'keywordp arg)
|
|
|
149 (let ((keyword arg)
|
|
|
150 (value (car args)))
|
|
|
151 (unless args
|
|
|
152 (signal 'error (list "Keyword is missing an argument" keyword)))
|
|
|
153 (setq args (cdr args))
|
|
|
154 (cond ((eq keyword :initialize)
|
|
|
155 (setq initialize value))
|
|
|
156 ((eq keyword :set)
|
|
|
157 (put symbol 'custom-set value))
|
|
|
158 ((eq keyword :get)
|
|
|
159 (put symbol 'custom-get value))
|
|
|
160 ((eq keyword :require)
|
|
|
161 (setq requests (cons value requests)))
|
|
|
162 ((eq keyword :type)
|
|
|
163 (put symbol 'custom-type value))
|
|
|
164 ((eq keyword :options)
|
|
|
165 (if (get symbol 'custom-options)
|
|
|
166 ;; Slow safe code to avoid duplicates.
|
|
|
167 (mapc (lambda (option)
|
|
|
168 (custom-add-option symbol option))
|
|
|
169 value)
|
|
|
170 ;; Fast code for the common case.
|
|
|
171 (put symbol 'custom-options (copy-sequence value))))
|
|
|
172 (t
|
|
|
173 (custom-handle-keyword symbol keyword value
|
|
|
174 'custom-variable))))))
|
|
|
175 (put symbol 'custom-requests requests)
|
|
|
176 ;; Do the actual initialization.
|
|
1333
|
177 (funcall initialize symbol default))
|
|
428
|
178 ;; #### This is a rough equivalent of LOADHIST_ATTACH. However,
|
|
|
179 ;; LOADHIST_ATTACH also checks for `initialized'.
|
|
|
180 (push symbol current-load-list)
|
|
|
181 (run-hooks 'custom-define-hook)
|
|
|
182 symbol)
|
|
|
183
|
|
|
184 (defmacro defcustom (symbol value doc &rest args)
|
|
|
185 "Declare SYMBOL as a customizable variable that defaults to VALUE.
|
|
|
186 DOC is the variable documentation.
|
|
|
187
|
|
|
188 Neither SYMBOL nor VALUE needs to be quoted.
|
|
|
189 If SYMBOL is not already bound, initialize it to VALUE.
|
|
|
190 The remaining arguments should have the form
|
|
|
191
|
|
|
192 [KEYWORD VALUE]...
|
|
|
193
|
|
1333
|
194 The following keywords are meaningful:
|
|
428
|
195
|
|
|
196 :type VALUE should be a widget type for editing the symbols value.
|
|
|
197 The default is `sexp'.
|
|
|
198 :options VALUE should be a list of valid members of the widget type.
|
|
|
199 :group VALUE should be a customization group.
|
|
|
200 Add SYMBOL to that group.
|
|
1333
|
201 :initialize
|
|
|
202 VALUE should be a function used to initialize the
|
|
428
|
203 variable. It takes two arguments, the symbol and value
|
|
|
204 given in the `defcustom' call. The default is
|
|
1333
|
205 `custom-initialize-reset'
|
|
|
206 :set VALUE should be a function to set the value of the symbol.
|
|
|
207 It takes two arguments, the symbol to set and the value to
|
|
|
208 give it. The default choice of function is `custom-set-default'.
|
|
428
|
209 :get VALUE should be a function to extract the value of symbol.
|
|
1333
|
210 The function takes one argument, a symbol, and should return
|
|
|
211 the current value for that symbol. The default choice of function
|
|
|
212 is `custom-default-value'. #### XEmacs used to say `default-value';
|
|
|
213 is that right?
|
|
|
214 :require
|
|
|
215 VALUE should be a feature symbol. If you save a value
|
|
|
216 for this option, then when your custom init file loads the value,
|
|
|
217 it does (require VALUE) first.
|
|
|
218 :version
|
|
|
219 VALUE should be a string specifying that the variable was
|
|
903
|
220 first introduced, or its default value was changed, in Emacs
|
|
|
221 version VERSION.
|
|
1333
|
222 :set-after VARIABLE
|
|
|
223 Specifies that SYMBOL should be set after VARIABLE when
|
|
903
|
224 both have been customized.
|
|
428
|
225
|
|
|
226 Read the section about customization in the Emacs Lisp manual for more
|
|
|
227 information."
|
|
|
228 `(custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))
|
|
|
229
|
|
1333
|
230 ;; END SYNC WITH FSF 21.2
|
|
|
231
|
|
428
|
232 ;;; The `defface' Macro.
|
|
|
233
|
|
|
234 (defmacro defface (face spec doc &rest args)
|
|
|
235 "Declare FACE as a customizable face that defaults to SPEC.
|
|
|
236 FACE does not need to be quoted.
|
|
|
237
|
|
|
238 Third argument DOC is the face documentation.
|
|
|
239
|
|
|
240 If FACE has been set with `custom-set-face', set the face attributes
|
|
|
241 as specified by that function, otherwise set the face attributes
|
|
|
242 according to SPEC.
|
|
|
243
|
|
|
244 The remaining arguments should have the form
|
|
|
245
|
|
|
246 [KEYWORD VALUE]...
|
|
|
247
|
|
|
248 The following KEYWORDs are defined:
|
|
|
249
|
|
|
250 :group VALUE should be a customization group.
|
|
|
251 Add FACE to that group.
|
|
|
252
|
|
|
253 SPEC should be an alist of the form ((DISPLAY ATTS)...).
|
|
|
254
|
|
|
255 ATTS is a list of face attributes and their values. The possible
|
|
|
256 attributes are defined in the variable `custom-face-attributes'.
|
|
|
257
|
|
|
258 The ATTS of the first entry in SPEC where the DISPLAY matches the
|
|
|
259 frame should take effect in that frame. DISPLAY can either be the
|
|
|
260 symbol t, which will match all frames, or an alist of the form
|
|
|
261 \((REQ ITEM...)...)
|
|
|
262
|
|
|
263 For the DISPLAY to match a FRAME, the REQ property of the frame must
|
|
|
264 match one of the ITEM. The following REQ are defined:
|
|
|
265
|
|
|
266 `type' (the value of `window-system')
|
|
442
|
267 Should be one of `x', `mswindows', or `tty'.
|
|
428
|
268
|
|
|
269 `class' (the frame's color support)
|
|
|
270 Should be one of `color', `grayscale', or `mono'.
|
|
|
271
|
|
|
272 `background' (what color is used for the background text)
|
|
|
273 Should be one of `light' or `dark'.
|
|
|
274
|
|
|
275 Read the section about customization in the Emacs Lisp manual for more
|
|
|
276 information."
|
|
|
277 `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
|
|
|
278
|
|
|
279 ;;; The `defgroup' Macro.
|
|
|
280
|
|
|
281 (defun custom-declare-group (symbol members doc &rest args)
|
|
|
282 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
|
|
|
283 (while members
|
|
|
284 (apply 'custom-add-to-group symbol (car members))
|
|
|
285 (pop members))
|
|
|
286 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
|
|
|
287 (when doc
|
|
|
288 (put symbol 'group-documentation doc))
|
|
|
289 (while args
|
|
|
290 (let ((arg (car args)))
|
|
|
291 (setq args (cdr args))
|
|
|
292 (check-argument-type 'keywordp arg)
|
|
|
293 (let ((keyword arg)
|
|
|
294 (value (car args)))
|
|
|
295 (unless args
|
|
|
296 (signal 'error (list "Keyword is missing an argument" keyword)))
|
|
|
297 (setq args (cdr args))
|
|
|
298 (cond ((eq keyword :prefix)
|
|
|
299 (put symbol 'custom-prefix value))
|
|
|
300 (t
|
|
|
301 (custom-handle-keyword symbol keyword value
|
|
|
302 'custom-group))))))
|
|
|
303 (run-hooks 'custom-define-hook)
|
|
|
304 symbol)
|
|
|
305
|
|
|
306 (defmacro defgroup (symbol members doc &rest args)
|
|
|
307 "Declare SYMBOL as a customization group containing MEMBERS.
|
|
|
308 SYMBOL does not need to be quoted.
|
|
|
309
|
|
|
310 Third arg DOC is the group documentation.
|
|
|
311
|
|
|
312 MEMBERS should be an alist of the form ((NAME WIDGET)...) where NAME
|
|
|
313 is a symbol and WIDGET is a widget for editing that symbol. Useful
|
|
|
314 widgets are `custom-variable' for editing variables, `custom-face' for
|
|
|
315 edit faces, and `custom-group' for editing groups.
|
|
|
316
|
|
|
317 The remaining arguments should have the form
|
|
|
318
|
|
|
319 [KEYWORD VALUE]...
|
|
|
320
|
|
|
321 The following KEYWORD's are defined:
|
|
|
322
|
|
|
323 :group VALUE should be a customization group.
|
|
|
324 Add SYMBOL to that group.
|
|
|
325
|
|
|
326 Read the section about customization in the Emacs Lisp manual for more
|
|
|
327 information."
|
|
|
328 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
|
|
|
329
|
|
|
330 (defvar custom-group-hash-table (make-hash-table :size 300 :test 'eq)
|
|
|
331 "Hash-table of non-empty groups.")
|
|
|
332
|
|
|
333 (defun custom-add-to-group (group option widget)
|
|
|
334 "To existing GROUP add a new OPTION of type WIDGET.
|
|
|
335 If there already is an entry for that option, overwrite it."
|
|
|
336 (let* ((members (get group 'custom-group))
|
|
|
337 (old (assq option members)))
|
|
|
338 (if old
|
|
|
339 (setcar (cdr old) widget)
|
|
|
340 (put group 'custom-group (nconc members (list (list option widget))))))
|
|
|
341 (puthash group t custom-group-hash-table))
|
|
|
342
|
|
|
343 ;;; Properties.
|
|
|
344
|
|
|
345 (defun custom-handle-all-keywords (symbol args type)
|
|
|
346 "For customization option SYMBOL, handle keyword arguments ARGS.
|
|
|
347 Third argument TYPE is the custom option type."
|
|
|
348 (while args
|
|
|
349 (let ((arg (car args)))
|
|
|
350 (setq args (cdr args))
|
|
|
351 (check-argument-type 'keywordp arg)
|
|
|
352 (let ((keyword arg)
|
|
|
353 (value (car args)))
|
|
|
354 (unless args
|
|
|
355 (signal 'error (list "Keyword is missing an argument" keyword)))
|
|
|
356 (setq args (cdr args))
|
|
|
357 (custom-handle-keyword symbol keyword value type)))))
|
|
|
358
|
|
|
359 (defun custom-handle-keyword (symbol keyword value type)
|
|
|
360 "For customization option SYMBOL, handle KEYWORD with VALUE.
|
|
|
361 Fourth argument TYPE is the custom option type."
|
|
|
362 (cond ((eq keyword :group)
|
|
903
|
363 (custom-add-to-group value symbol type))
|
|
|
364 ((eq keyword :version)
|
|
|
365 (custom-add-version symbol value))
|
|
|
366 ((eq keyword :link)
|
|
|
367 (custom-add-link symbol value))
|
|
|
368 ((eq keyword :load)
|
|
|
369 (custom-add-load symbol value))
|
|
|
370 ((eq keyword :tag)
|
|
|
371 (put symbol 'custom-tag value))
|
|
|
372 ((eq keyword :set-after)
|
|
|
373 (custom-add-dependencies symbol value))
|
|
|
374 (t
|
|
|
375 (signal 'error (list "Unknown keyword" keyword)))))
|
|
|
376
|
|
|
377 (defun custom-add-dependencies (symbol value)
|
|
|
378 "To the custom option SYMBOL, add dependencies specified by VALUE.
|
|
|
379 VALUE should be a list of symbols. For each symbol in that list,
|
|
|
380 this specifies that SYMBOL should be set after the specified symbol, if
|
|
|
381 both appear in constructs like `custom-set-variables'."
|
|
|
382 (unless (listp value)
|
|
|
383 (error "Invalid custom dependency `%s'" value))
|
|
|
384 (let* ((deps (get symbol 'custom-dependencies))
|
|
|
385 (new-deps deps))
|
|
|
386 (while value
|
|
|
387 (let ((dep (car value)))
|
|
|
388 (unless (symbolp dep)
|
|
|
389 (error "Invalid custom dependency `%s'" dep))
|
|
|
390 (unless (memq dep new-deps)
|
|
|
391 (setq new-deps (cons dep new-deps)))
|
|
|
392 (setq value (cdr value))))
|
|
|
393 (unless (eq deps new-deps)
|
|
|
394 (put symbol 'custom-dependencies new-deps))))
|
|
428
|
395
|
|
|
396 (defun custom-add-option (symbol option)
|
|
|
397 "To the variable SYMBOL add OPTION.
|
|
|
398
|
|
|
399 If SYMBOL is a hook variable, OPTION should be a hook member.
|
|
|
400 For other types variables, the effect is undefined."
|
|
|
401 (let ((options (get symbol 'custom-options)))
|
|
|
402 (unless (member option options)
|
|
|
403 (put symbol 'custom-options (cons option options)))))
|
|
|
404
|
|
|
405 (defun custom-add-link (symbol widget)
|
|
|
406 "To the custom option SYMBOL add the link WIDGET."
|
|
|
407 (let ((links (get symbol 'custom-links)))
|
|
|
408 (unless (member widget links)
|
|
|
409 (put symbol 'custom-links (cons widget links)))))
|
|
|
410
|
|
|
411 (defun custom-add-version (symbol version)
|
|
|
412 "To the custom option SYMBOL add the version VERSION."
|
|
|
413 (put symbol 'custom-version version))
|
|
|
414
|
|
|
415 (defun custom-add-load (symbol load)
|
|
|
416 "To the custom option SYMBOL add the dependency LOAD.
|
|
|
417 LOAD should be either a library file name, or a feature name."
|
|
|
418 (puthash symbol t custom-group-hash-table)
|
|
|
419 (let ((loads (get symbol 'custom-loads)))
|
|
|
420 (unless (member load loads)
|
|
|
421 (put symbol 'custom-loads (cons load loads)))))
|
|
|
422
|
|
|
423 ;;; deftheme macro
|
|
|
424
|
|
|
425 (defvar custom-known-themes '(user standard)
|
|
|
426 "Themes that have been defthemed.")
|
|
|
427
|
|
|
428 ;; #### add strings for group
|
|
|
429 ;; #### during bootstrap we cannot use cl-macs stuff
|
|
|
430 (defun* custom-define-theme (theme feature &optional doc
|
|
|
431 &key short-description immediate variable-reset-string
|
|
|
432 variable-set-string face-set-string face-reset-string
|
|
|
433 &allow-other-keys)
|
|
|
434 (push theme custom-known-themes)
|
|
|
435 (put theme 'theme-feature feature)
|
|
|
436 (put theme 'theme-documentation doc)
|
|
|
437 (if immediate (put theme 'theme-immediate immediate))
|
|
|
438 (if variable-reset-string
|
|
|
439 (put theme 'theme-variable-reset-string variable-reset-string ))
|
|
|
440 (if variable-set-string
|
|
|
441 (put theme 'theme-variable-set-string variable-set-string ))
|
|
|
442 (if face-reset-string
|
|
|
443 (put theme 'theme-face-reset-string face-reset-string ))
|
|
|
444 (if face-set-string
|
|
|
445 (put theme 'theme-face-set-string face-set-string ))
|
|
|
446 (if short-description
|
|
|
447 (put theme 'theme-short-description short-description )))
|
|
|
448
|
|
|
449 (defun custom-make-theme-feature (theme)
|
|
|
450 (intern (concat (symbol-name theme) "-theme")))
|
|
|
451
|
|
|
452 (defmacro deftheme (theme &rest body)
|
|
|
453 "(deftheme THEME &optional DOC &key KEYWORDS)
|
|
|
454
|
|
|
455 Define a theme labeled by SYMBOL THEME. The optional argument DOC is a
|
|
442
|
456 doc string describing the theme. It is optionally followed by the
|
|
444
|
457 following keyword arguments
|
|
428
|
458
|
|
|
459 :short-description DESC
|
|
|
460 DESC is a short (one line) description of the theme. If not given DOC
|
|
|
461 is used.
|
|
|
462 :immediate FLAG
|
|
|
463 If FLAG is non-nil variables set in this theme are bound
|
|
|
464 immediately when loading the theme.
|
|
|
465 :variable-set-string VARIABLE_-SET-STRING
|
|
|
466 A string used by the UI to indicate that the value takes it
|
|
|
467 setting from this theme. It is passed to FORMAT with the
|
|
|
468 name of the theme a additional argument.
|
|
|
469 If not given, a generic description is used.
|
|
|
470 :variable-reset-string VARIABLE-RESET-STRING
|
|
|
471 As above but used in the case the variable has been forced to
|
|
|
472 the value in this theme.
|
|
|
473 :face-set-string FACE-SET-STRING
|
|
|
474 :face-reset-string FACE-RESET-STRING
|
|
|
475 As above but for faces."
|
|
|
476 (let ((feature (custom-make-theme-feature theme)))
|
|
|
477 `(custom-define-theme (quote ,theme) (quote ,feature) ,@body)))
|
|
|
478
|
|
|
479 (defsubst custom-theme-p (theme)
|
|
|
480 "Non-nil when THEME has been defined."
|
|
|
481 (memq theme custom-known-themes))
|
|
|
482
|
|
|
483 (defsubst custom-check-theme (theme)
|
|
444
|
484 "Check whether THEME is valid and signal an error if NOT."
|
|
428
|
485 (unless (custom-theme-p theme)
|
|
|
486 (error "Unknown theme `%s'" theme)))
|
|
|
487
|
|
|
488
|
|
|
489 ; #### do we need to deftheme 'user and/or 'standard here to make the
|
|
|
490 ; code in cus-edit cleaner?.
|
|
|
491
|
|
|
492 ;;; Initializing.
|
|
|
493
|
|
|
494 (defun custom-push-theme (prop symbol theme mode value)
|
|
|
495 (let ((old (get symbol prop)))
|
|
|
496 (if (eq (car-safe (car-safe old)) theme)
|
|
|
497 (setq old (cdr old)))
|
|
|
498 (put symbol prop (cons (list theme mode value) old))))
|
|
|
499
|
|
988
|
500 (defvar custom-local-buffer nil
|
|
|
501 "Non-nil, in a Customization buffer, means customize a specific buffer.
|
|
|
502 If this variable is non-nil, it should be a buffer,
|
|
|
503 and it means customize the local bindings of that buffer.
|
|
|
504 This variable is a permanent local, and it normally has a local binding
|
|
|
505 in every Customization buffer.")
|
|
|
506 (put 'custom-local-buffer 'permanent-local t)
|
|
|
507
|
|
428
|
508 (defun custom-set-variables (&rest args)
|
|
|
509 "Initialize variables according to user preferences.
|
|
|
510 The settings are registered as theme `user'.
|
|
988
|
511 Each argument should be a list of the form:
|
|
428
|
512
|
|
|
513 (SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
|
|
|
514
|
|
|
515 The unevaluated VALUE is stored as the saved value for SYMBOL.
|
|
|
516 If NOW is present and non-nil, VALUE is also evaluated and bound as
|
|
|
517 the default value for the SYMBOL.
|
|
|
518 REQUEST is a list of features we must 'require for SYMBOL.
|
|
|
519 COMMENT is a comment string about SYMBOL."
|
|
|
520 (apply 'custom-theme-set-variables 'user args))
|
|
|
521
|
|
|
522 (defun custom-theme-set-variables (theme &rest args)
|
|
|
523 "Initialize variables according to settings specified by args.
|
|
|
524 Records the settings as belonging to THEME.
|
|
|
525
|
|
|
526 See `custom-set-variables' for a description of the arguments ARGS."
|
|
|
527 (custom-check-theme theme)
|
|
903
|
528 (setq args
|
|
|
529 (sort args
|
|
|
530 (lambda (a1 a2)
|
|
|
531 (let* ((sym1 (car a1))
|
|
|
532 (sym2 (car a2))
|
|
|
533 (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
|
|
|
534 (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
|
|
|
535 (cond ((and 1-then-2 2-then-1)
|
|
|
536 (error "Circular custom dependency between `%s' and `%s'"
|
|
|
537 sym1 sym2))
|
|
|
538 (1-then-2 t)
|
|
|
539 (2-then-1 nil)
|
|
|
540 ;; Put symbols with :require last. The macro
|
|
|
541 ;; define-minor-mode generates a defcustom
|
|
|
542 ;; with a :require and a :set, where the
|
|
|
543 ;; setter function calls the mode function.
|
|
|
544 ;; Putting symbols with :require last ensures
|
|
|
545 ;; that the mode function will see other
|
|
|
546 ;; customized values rather than default
|
|
|
547 ;; values.
|
|
|
548 (t (nth 3 a2)))))))
|
|
428
|
549 (let ((immediate (get theme 'theme-immediate)))
|
|
988
|
550 (while args
|
|
428
|
551 (let ((entry (car args)))
|
|
|
552 (if (listp entry)
|
|
|
553 (let* ((symbol (nth 0 entry))
|
|
|
554 (value (nth 1 entry))
|
|
|
555 (now (nth 2 entry))
|
|
|
556 (requests (nth 3 entry))
|
|
|
557 (comment (nth 4 entry))
|
|
988
|
558 (set (or (get symbol 'custom-set) 'custom-set-default)))
|
|
428
|
559 (put symbol 'saved-value (list value))
|
|
|
560 (custom-push-theme 'theme-value symbol theme 'set value)
|
|
|
561 (put symbol 'saved-variable-comment comment)
|
|
988
|
562 ;; Allow for errors in the case where the setter has
|
|
|
563 ;; changed between versions, say, but let the user know.
|
|
|
564 (condition-case data
|
|
428
|
565 (cond ((or now immediate)
|
|
|
566 ;; Rogue variable, set it now.
|
|
|
567 (put symbol 'force-value (if now 'rogue 'immediate))
|
|
|
568 (funcall set symbol (eval value)))
|
|
|
569 ((default-boundp symbol)
|
|
|
570 ;; Something already set this, overwrite it.
|
|
|
571 (funcall set symbol (eval value))))
|
|
988
|
572 (error
|
|
|
573 (message "Error setting %s: %s" symbol data)))
|
|
428
|
574 (and (or now (default-boundp symbol))
|
|
|
575 (put symbol 'variable-comment comment))
|
|
|
576 (when requests
|
|
|
577 (put symbol 'custom-requests requests)
|
|
|
578 (mapc 'require requests))
|
|
|
579 (setq args (cdr args)))
|
|
|
580 ;; Old format, a plist of SYMBOL VALUE pairs.
|
|
|
581 (message "Warning: old format `custom-set-variables'")
|
|
|
582 (ding)
|
|
|
583 (sit-for 2)
|
|
|
584 (let ((symbol (nth 0 args))
|
|
|
585 (value (nth 1 args)))
|
|
|
586 (put symbol 'saved-value (list value))
|
|
|
587 (custom-push-theme 'theme-value symbol theme 'set value))
|
|
|
588 (setq args (cdr (cdr args))))))))
|
|
|
589
|
|
|
590 (defvar custom-loaded-themes nil
|
|
|
591 "Themes in the order they are loaded.")
|
|
|
592
|
|
|
593 (defun custom-theme-loaded-p (theme)
|
|
|
594 "Return non-nil when THEME has been loaded."
|
|
|
595 (memq theme custom-loaded-themes))
|
|
|
596
|
|
|
597 (defun provide-theme (theme)
|
|
|
598 "Indicate that this file provides THEME."
|
|
|
599 (custom-check-theme theme)
|
|
|
600 (provide (get theme 'theme-feature))
|
|
|
601 (push theme custom-loaded-themes))
|
|
|
602
|
|
|
603 (defun require-theme (theme &optional soft)
|
|
|
604 "Try to load a theme by requiring its feature."
|
|
|
605 ;; Note we do no check for validity of the theme here.
|
|
|
606 ;; This allows to pull in themes by a file-name convention
|
|
|
607 (require (get theme 'theme-feature (custom-make-theme-feature theme))))
|
|
|
608
|
|
|
609 (defun custom-do-theme-reset (theme)
|
|
|
610 ; #### untested! slow!
|
|
|
611 (let (spec-list)
|
|
|
612 (mapatoms (lambda (symbol)
|
|
|
613 (setq spec-list (get symbol 'theme-value))
|
|
|
614 (when spec-list
|
|
|
615 (setq spec-list (delete-if (lambda (elt)
|
|
|
616 (eq (car elt) theme))
|
|
|
617 spec-list))
|
|
|
618 (put symbol 'theme-value spec-list)
|
|
|
619 (custom-theme-reset-internal symbol 'user))
|
|
|
620 (setq spec-list (get symbol 'theme-face))
|
|
|
621 (when spec-list
|
|
|
622 (setq spec-list (delete-if (lambda (elt)
|
|
|
623 (eq (car elt) theme))
|
|
|
624 spec-list))
|
|
|
625 (put symbol 'theme-face spec-list)
|
|
|
626 (custom-theme-reset-internal-face symbol 'user))))))
|
|
|
627
|
|
|
628 (defun custom-theme-load-themes (by-theme &rest body)
|
|
|
629 "Load the themes specified by BODY and record them as required by
|
|
442
|
630 theme BY-THEME. BODY is a sequence of
|
|
428
|
631 - a SYMBOL
|
|
|
632 require the theme SYMBOL
|
|
|
633 - a list (reset THEME)
|
|
|
634 Undo all the settings made by THEME.
|
|
|
635 - a list (hidden THEME)
|
|
|
636 require the THEME but hide it from the user."
|
|
|
637 (custom-check-theme by-theme)
|
|
|
638 (dolist (theme body)
|
|
|
639 (cond ((and (consp theme) (eq (car theme) 'reset))
|
|
|
640 (custom-do-theme-reset (cadr theme)))
|
|
|
641 ((and (consp theme) (eq (car theme) 'hidden))
|
|
|
642 (require-theme (cadr theme))
|
|
|
643 (unless (custom-theme-loaded-p (cadr theme))
|
|
|
644 (put (cadr theme) 'theme-hidden t)))
|
|
|
645 (t
|
|
|
646 (require-theme theme)
|
|
|
647 (remprop theme 'theme-hidden)))
|
|
|
648 (push theme (get by-theme 'theme-loads-themes))))
|
|
|
649
|
|
|
650 (defun custom-load-themes (&rest body)
|
|
|
651 "Load themes for the USER theme as specified by BODY.
|
|
|
652
|
|
|
653 BODY is as with custom-theme-load-themes."
|
|
|
654 (apply #'custom-theme-load-themes 'user body))
|
|
|
655
|
|
|
656
|
|
|
657
|
|
|
658
|
|
|
659 (defsubst copy-upto-last (elt list)
|
|
444
|
660 "Copy all the elements of the list upto the last occurrence of elt."
|
|
428
|
661 ;; Is it faster to do more work in C than to do less in elisp?
|
|
|
662 (nreverse (cdr (member elt (reverse list)))))
|
|
|
663
|
|
|
664 (defun custom-theme-value (theme theme-spec-list)
|
|
|
665 "Determine the value for THEME defined by THEME-SPEC-LIST.
|
|
|
666 Returns (list value) if found. Nil otherwise."
|
|
440
|
667 ;; Note we do _NOT_ signal an error if the theme is unknown
|
|
428
|
668 ;; it might have gone away without the user knowing.
|
|
|
669 (let ((theme-or-lower (memq theme (cons 'user custom-loaded-themes)))
|
|
|
670 value)
|
|
|
671 (mapc #'(lambda (theme-spec)
|
|
|
672 (when (member (car theme-spec) theme-or-lower)
|
|
|
673 (setq value (cdr theme-spec))
|
|
|
674 ;; We need to continue because if theme =A and we found
|
|
|
675 ;; B then if the load order is B A C B
|
|
|
676 ;; we actually want the value in C.
|
|
|
677 (setq theme-or-lower (copy-upto-last (car theme-spec)
|
|
|
678 theme-or-lower))
|
|
|
679 ;; We could should circuit if this is now nil.
|
|
|
680 ))
|
|
|
681 theme-spec-list)
|
|
|
682 (if value
|
|
|
683 (if (eq (car value) 'set)
|
|
|
684 (list (cadr value))
|
|
|
685 ;; Yet another reset spec. car value = reset
|
|
|
686 (custom-theme-value (cadr value) theme-spec-list)))))
|
|
|
687
|
|
|
688
|
|
|
689 (defun custom-theme-variable-value (variable theme)
|
|
|
690 "Return (list value) value of VARIABLE in THEME if the THEME modifies the
|
|
|
691 VARIABLE. Nil otherwise."
|
|
|
692 (custom-theme-value theme (get variable 'theme-value)))
|
|
|
693
|
|
|
694 (defun custom-theme-reset-internal (symbol to-theme)
|
|
|
695 (let ((value (custom-theme-variable-value symbol to-theme))
|
|
|
696 was-in-theme)
|
|
|
697 (setq was-in-theme value)
|
|
|
698 (setq value (or value (get symbol 'standard-value)))
|
|
|
699 (when value
|
|
|
700 (put symbol 'saved-value was-in-theme)
|
|
|
701 (if (or (get 'force-value symbol) (default-boundp symbol))
|
|
|
702 (funcall (get symbol 'custom-set 'set-default) symbol
|
|
|
703 (eval (car value)))))
|
|
|
704 value))
|
|
|
705
|
|
|
706
|
|
|
707 (defun custom-theme-reset-variables (theme &rest args)
|
|
|
708 "Reset the value of the variables to values previously defined.
|
|
442
|
709 Associate this setting with THEME.
|
|
428
|
710
|
|
|
711 ARGS is a list of lists of the form
|
|
|
712
|
|
|
713 (variable to-theme)
|
|
|
714
|
|
|
715 This means reset variable to its value in to-theme."
|
|
|
716 (custom-check-theme theme)
|
|
|
717 (mapc #'(lambda (arg)
|
|
|
718 (apply #'custom-theme-reset-internal arg)
|
|
|
719 (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg)))
|
|
|
720 args))
|
|
|
721
|
|
|
722 (defun custom-reset-variables (&rest args)
|
|
|
723 "Reset the value of the variables to values previously defined.
|
|
442
|
724 Associate this setting with the `user' theme.
|
|
428
|
725
|
|
|
726 The ARGS are as in `custom-theme-reset-variables'."
|
|
|
727 (apply #'custom-theme-reset-variables 'user args))
|
|
|
728
|
|
988
|
729 (defun custom-set-default (variable value)
|
|
|
730 "Default :set function for a customizable variable.
|
|
|
731 Normally, this sets the default value of VARIABLE to VALUE,
|
|
|
732 but if `custom-local-buffer' is non-nil,
|
|
|
733 this sets the local binding in that buffer instead."
|
|
|
734 (if custom-local-buffer
|
|
|
735 (with-current-buffer custom-local-buffer
|
|
|
736 (set variable value))
|
|
|
737 (set-default variable value)))
|
|
428
|
738
|
|
|
739 ;;; The End.
|
|
|
740
|
|
1333
|
741 ;; BEGIN SYNC WITH FSF 21.2
|
|
|
742
|
|
|
743 ;; Process the defcustoms for variables loaded before this file.
|
|
1336
|
744 ;; `custom-declare-variable-list' is defvar'd in subr.el. Utility programs
|
|
|
745 ;; run from temacs that do not load subr.el should defvar it themselves.
|
|
|
746 ;; (As of 21.5.11, make-docfile.el.)
|
|
1333
|
747 (while custom-declare-variable-list
|
|
|
748 (apply 'custom-declare-variable (car custom-declare-variable-list))
|
|
|
749 (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
|
|
|
750
|
|
|
751 ;; END SYNC WITH FSF 21.2
|
|
|
752
|
|
428
|
753 ;; custom.el ends here
|
