Fix race conditions involving setenv, gmtime, localtime, asctime.
[bpt/emacs.git] / lisp / custom.el
CommitLineData
55535639
PJ
1;;; custom.el --- tools for declaring and initializing options
2;;
acaf905b 3;; Copyright (C) 1996-1997, 1999, 2001-2012 Free Software Foundation, Inc.
55535639
PJ
4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Maintainer: FSF
7;; Keywords: help, faces
bd78fa1d 8;; Package: emacs
55535639
PJ
9
10;; This file is part of GNU Emacs.
11
eb3fa2cf 12;; GNU Emacs is free software: you can redistribute it and/or modify
55535639 13;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
55535639
PJ
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
eb3fa2cf 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
55535639
PJ
24
25;;; Commentary:
26;;
e6bb31f3 27;; This file only contains the code needed to declare and initialize
55535639
PJ
28;; user options. The code to customize options is autoloaded from
29;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual.
30
e6bb31f3 31;; The code implementing face declarations is in `cus-face.el'.
55535639
PJ
32
33;;; Code:
34
35(require 'widget)
36
37(defvar custom-define-hook nil
38 ;; Customize information for this option is in `cus-edit.el'.
39 "Hook called after defining each customize option.")
40
6da43544
RS
41(defvar custom-dont-initialize nil
42 "Non-nil means `defcustom' should not initialize the variable.
43That is used for the sake of `custom-make-dependencies'.
44Users should not set it.")
45
d3b80e9b
SM
46(defvar custom-current-group-alist nil
47 "Alist of (FILE . GROUP) indicating the current group to use for FILE.")
48
55535639
PJ
49;;; The `defcustom' Macro.
50
51(defun custom-initialize-default (symbol value)
52 "Initialize SYMBOL with VALUE.
53This will do nothing if symbol already has a default binding.
54Otherwise, if symbol has a `saved-value' property, it will evaluate
494bcd27 55the car of that and use it as the default binding for symbol.
55535639
PJ
56Otherwise, VALUE will be evaluated and used as the default binding for
57symbol."
d032d5e7
SM
58 (eval `(defvar ,symbol ,(if (get symbol 'saved-value)
59 (car (get symbol 'saved-value))
60 value))))
55535639
PJ
61
62(defun custom-initialize-set (symbol value)
63 "Initialize SYMBOL based on VALUE.
64If the symbol doesn't have a default binding already,
65then set it using its `:set' function (or `set-default' if it has none).
66The value is either the value in the symbol's `saved-value' property,
67if any, or VALUE."
68 (unless (default-boundp symbol)
69 (funcall (or (get symbol 'custom-set) 'set-default)
70 symbol
b3c7c12d
SM
71 (eval (if (get symbol 'saved-value)
72 (car (get symbol 'saved-value))
73 value)))))
55535639
PJ
74
75(defun custom-initialize-reset (symbol value)
76 "Initialize SYMBOL based on VALUE.
77Set the symbol, using its `:set' function (or `set-default' if it has none).
78The value is either the symbol's current value
79 \(as obtained using the `:get' function), if any,
80or the value in the symbol's `saved-value' property if any,
81or (last of all) VALUE."
d032d5e7
SM
82 (funcall (or (get symbol 'custom-set) 'set-default)
83 symbol
84 (cond ((default-boundp symbol)
85 (funcall (or (get symbol 'custom-get) 'default-value)
86 symbol))
87 ((get symbol 'saved-value)
88 (eval (car (get symbol 'saved-value))))
89 (t
90 (eval value)))))
55535639
PJ
91
92(defun custom-initialize-changed (symbol value)
93 "Initialize SYMBOL with VALUE.
94Like `custom-initialize-reset', but only use the `:set' function if
95not using the standard setting.
96For the standard setting, use `set-default'."
97 (cond ((default-boundp symbol)
98 (funcall (or (get symbol 'custom-set) 'set-default)
99 symbol
100 (funcall (or (get symbol 'custom-get) 'default-value)
101 symbol)))
102 ((get symbol 'saved-value)
103 (funcall (or (get symbol 'custom-set) 'set-default)
104 symbol
105 (eval (car (get symbol 'saved-value)))))
106 (t
107 (set-default symbol (eval value)))))
108
790d0270
SM
109(defvar custom-delayed-init-variables nil
110 "List of variables whose initialization is pending.")
111
06b60517 112(defun custom-initialize-delay (symbol _value)
790d0270 113 "Delay initialization of SYMBOL to the next Emacs start.
90a94603
GM
114This is used in files that are preloaded (or for autoloaded
115variables), so that the initialization is done in the run-time
116context rather than the build-time context. This also has the
117side-effect that the (delayed) initialization is performed with
118the :set function.
119
120For variables in preloaded files, you can simply use this
121function for the :initialize property. For autoloaded variables,
122you will also need to add an autoload stanza calling this
f042cfd8
AS
123function, and another one setting the standard-value property."
124 ;; No longer true:
125 ;; "See `send-mail-function' in sendmail.el for an example."
126
adba8116
SM
127 ;; Until the var is actually initialized, it is kept unbound.
128 ;; This seemed to be at least as good as setting it to an arbitrary
129 ;; value like nil (evaluating `value' is not an option because it
130 ;; may have undesirable side-effects).
790d0270
SM
131 (push symbol custom-delayed-init-variables))
132
55535639
PJ
133(defun custom-declare-variable (symbol default doc &rest args)
134 "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
135DEFAULT should be an expression to evaluate to compute the default value,
e1bab181
RS
136not the default value itself.
137
8989771d 138DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property
e1bab181
RS
139`standard-value'. At the same time, SYMBOL's property `force-value' is
140set to nil, as the value is no longer rogue."
b6f8ba09 141 (put symbol 'standard-value (purecopy (list default)))
55535639
PJ
142 ;; Maybe this option was rogue in an earlier version. It no longer is.
143 (when (get symbol 'force-value)
144 (put symbol 'force-value nil))
d032d5e7
SM
145 (if (keywordp doc)
146 (error "Doc string is missing"))
55535639
PJ
147 (let ((initialize 'custom-initialize-reset)
148 (requests nil))
d3b80e9b
SM
149 (unless (memq :group args)
150 (custom-add-to-group (custom-current-group) symbol 'custom-variable))
55535639
PJ
151 (while args
152 (let ((arg (car args)))
153 (setq args (cdr args))
154 (unless (symbolp arg)
155 (error "Junk in args %S" args))
156 (let ((keyword arg)
157 (value (car args)))
158 (unless args
159 (error "Keyword %s is missing an argument" keyword))
160 (setq args (cdr args))
161 (cond ((eq keyword :initialize)
162 (setq initialize value))
163 ((eq keyword :set)
164 (put symbol 'custom-set value))
165 ((eq keyword :get)
166 (put symbol 'custom-get value))
167 ((eq keyword :require)
6f0d61bf 168 (push value requests))
fd045a34
GM
169 ((eq keyword :risky)
170 (put symbol 'risky-local-variable value))
171 ((eq keyword :safe)
172 (put symbol 'safe-local-variable value))
55535639
PJ
173 ((eq keyword :type)
174 (put symbol 'custom-type (purecopy value)))
175 ((eq keyword :options)
176 (if (get symbol 'custom-options)
177 ;; Slow safe code to avoid duplicates.
178 (mapc (lambda (option)
179 (custom-add-option symbol option))
6f0d61bf 180 value)
55535639
PJ
181 ;; Fast code for the common case.
182 (put symbol 'custom-options (copy-sequence value))))
183 (t
184 (custom-handle-keyword symbol keyword value
185 'custom-variable))))))
186 (put symbol 'custom-requests requests)
187 ;; Do the actual initialization.
6da43544
RS
188 (unless custom-dont-initialize
189 (funcall initialize symbol default)))
d032d5e7
SM
190 ;; Use defvar to set the docstring as well as the special-variable-p flag.
191 ;; FIXME: We should reproduce more of `defvar's behavior, such as the warning
192 ;; when the var is currently let-bound.
193 (if (not (default-boundp symbol))
194 ;; Don't use defvar to avoid setting a default-value when undesired.
195 (when doc (put symbol 'variable-documentation doc))
196 (eval `(defvar ,symbol nil ,@(when doc (list doc)))))
80888260 197 (push symbol current-load-list)
55535639
PJ
198 (run-hooks 'custom-define-hook)
199 symbol)
200
f2475f97
CY
201(defmacro defcustom (symbol standard doc &rest args)
202 "Declare SYMBOL as a customizable variable.
9a6dd747 203SYMBOL is the variable name; it should not be quoted.
f2475f97
CY
204STANDARD is an expression specifying the variable's standard
205value. It should not be quoted. It is evaluated once by
9a6dd747 206`defcustom', and the value is assigned to SYMBOL if the variable
f2475f97
CY
207is unbound. The expression itself is also stored, so that
208Customize can re-evaluate it later to get the standard value.
55535639
PJ
209DOC is the variable documentation.
210
c3a70e2b
CY
211This macro uses `defvar' as a subroutine, which also marks the
212variable as \"special\", so that it is always dynamically bound
213even when `lexical-binding' is t.
214
215The remaining arguments to `defcustom' should have the form
55535639
PJ
216
217 [KEYWORD VALUE]...
218
219The following keywords are meaningful:
220
693d0bd3 221:type VALUE should be a widget type for editing the symbol's value.
55535639 222:options VALUE should be a list of valid members of the widget type.
81117bdd
BW
223:initialize
224 VALUE should be a function used to initialize the
225 variable. It takes two arguments, the symbol and value
226 given in the `defcustom' call. The default is
227 `custom-initialize-reset'.
8a20ca4c
LMI
228:set VALUE should be a function to set the value of the symbol
229 when using the Customize user interface.
81117bdd 230 It takes two arguments, the symbol to set and the value to
f2276b69 231 give it. The default choice of function is `set-default'.
81117bdd
BW
232:get VALUE should be a function to extract the value of symbol.
233 The function takes one argument, a symbol, and should return
234 the current value for that symbol. The default choice of function
f2276b69 235 is `default-value'.
81117bdd
BW
236:require
237 VALUE should be a feature symbol. If you save a value
238 for this option, then when your `.emacs' file loads the value,
239 it does (require VALUE) first.
03988c98
CY
240:set-after VARIABLES
241 Specifies that SYMBOL should be set after the list of variables
242 VARIABLES when both have been customized.
fd045a34
GM
243:risky Set SYMBOL's `risky-local-variable' property to VALUE.
244:safe Set SYMBOL's `safe-local-variable' property to VALUE.
d6e6f4b1 245 See Info node `(elisp) File Local Variables'.
81117bdd
BW
246
247The following common keywords are also meaningful.
248
55535639 249:group VALUE should be a customization group.
81117bdd 250 Add SYMBOL (or FACE with `defface') to that group.
3dc5f18e 251:link LINK-DATA
00644b82
EZ
252 Include an external link after the documentation string for this
253 item. This is a sentence containing an active field which
254 references some other documentation.
71296446 255
11ee7d4e 256 There are several alternatives you can use for LINK-DATA:
71296446 257
3dc5f18e 258 (custom-manual INFO-NODE)
00644b82 259 Link to an Info node; INFO-NODE is a string which specifies
11ee7d4e 260 the node name, as in \"(emacs)Top\".
71296446 261
3dc5f18e 262 (info-link INFO-NODE)
00644b82
EZ
263 Like `custom-manual' except that the link appears in the
264 customization buffer with the Info node name.
71296446 265
3dc5f18e 266 (url-link URL)
00644b82 267 Link to a web page; URL is a string which specifies the URL.
11ee7d4e
JL
268
269 (emacs-commentary-link LIBRARY)
270 Link to the commentary section of LIBRARY.
271
272 (emacs-library-link LIBRARY)
273 Link to an Emacs Lisp LIBRARY file.
274
275 (file-link FILE)
276 Link to FILE.
277
278 (function-link FUNCTION)
279 Link to the documentation of FUNCTION.
280
281 (variable-link VARIABLE)
282 Link to the documentation of VARIABLE.
283
284 (custom-group-link GROUP)
285 Link to another customization GROUP.
71296446 286
00644b82
EZ
287 You can specify the text to use in the customization buffer by
288 adding `:tag NAME' after the first element of the LINK-DATA; for
3dc5f18e 289 example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the
00644b82 290 Emacs manual which appears in the buffer as `foo'.
71296446 291
00644b82
EZ
292 An item can have more than one external link; however, most items
293 have none at all.
55535639
PJ
294:version
295 VALUE should be a string specifying that the variable was
296 first introduced, or its default value was changed, in Emacs
297 version VERSION.
4e9c705e 298:package-version
994019df 299 VALUE should be a list with the form (PACKAGE . VERSION)
4e9c705e
BW
300 specifying that the variable was first introduced, or its
301 default value was changed, in PACKAGE version VERSION. This
302 keyword takes priority over :version. The PACKAGE and VERSION
303 must appear in the alist `customize-package-emacs-version-alist'.
994019df
BW
304 Since PACKAGE must be unique and the user might see it in an
305 error message, a good choice is the official name of the
306 package, such as MH-E or Gnus.
00644b82
EZ
307:tag LABEL
308 Use LABEL, a string, instead of the item's name, to label the item
1c1da418 309 in customization menus and buffers.
00644b82
EZ
310:load FILE
311 Load file FILE (a string) before displaying this customization
29512a0f 312 item. Loading is done with `load', and only if the file is
00644b82 313 not already loaded.
55535639 314
19229e5e
LT
315If SYMBOL has a local binding, then this form affects the local
316binding. This is normally not what you want. Thus, if you need
317to load a file defining variables with this form, or with
318`defvar' or `defconst', you should always load that file
319_outside_ any bindings for these variables. \(`defvar' and
320`defconst' behave similarly in this respect.)
321
81117bdd
BW
322See Info node `(elisp) Customization' in the Emacs Lisp manual
323for more information."
98923800 324 (declare (doc-string 3) (debug (name body)))
55535639
PJ
325 ;; It is better not to use backquote in this file,
326 ;; because that makes a bootstrapping problem
327 ;; if you need to recompile all the Lisp files using interpreted code.
850256b5
SM
328 `(custom-declare-variable
329 ',symbol
330 ,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
f2475f97
CY
331 ;; The STANDARD arg should be an expression that evaluates to
332 ;; the standard value. The use of `eval' for it is spread
333 ;; over many different places and hence difficult to
334 ;; eliminate, yet we want to make sure that the `standard'
335 ;; expression is checked by the byte-compiler, and that
336 ;; lexical-binding is obeyed, so quote the expression with
337 ;; `lambda' rather than with `quote'.
338 `(list (lambda () ,standard))
339 `',standard)
850256b5
SM
340 ,doc
341 ,@args))
55535639
PJ
342
343;;; The `defface' Macro.
344
345(defmacro defface (face spec doc &rest args)
346 "Declare FACE as a customizable face that defaults to SPEC.
347FACE does not need to be quoted.
348
349Third argument DOC is the face documentation.
350
2a69edce 351If FACE has been set with `custom-set-faces', set the face attributes
55535639
PJ
352as specified by that function, otherwise set the face attributes
353according to SPEC.
354
355The remaining arguments should have the form
356
357 [KEYWORD VALUE]...
358
81117bdd
BW
359For a list of valid keywords, see the common keywords listed in
360`defcustom'.
55535639
PJ
361
362SPEC should be an alist of the form ((DISPLAY ATTS)...).
363
ebdaed17 364In the first element, DISPLAY can be `default'. The ATTS in that
9c27debd
RS
365element then act as defaults for all the following elements.
366
367Aside from that, DISPLAY specifies conditions to match some or
368all frames. For each frame, the first element of SPEC where the
369DISPLAY conditions are satisfied is the one that applies to that
370frame. The ATTRs in this element take effect, and the following
371elements are ignored, on that frame.
372
373In the last element, DISPLAY can be t. That element applies to a
ebdaed17 374frame if none of the previous elements (except the `default' if
9c27debd 375any) did.
55535639
PJ
376
377ATTS is a list of face attributes followed by their values:
378 (ATTR VALUE ATTR VALUE...)
379
380The possible attributes are `:family', `:width', `:height', `:weight',
381`:slant', `:underline', `:overline', `:strike-through', `:box',
3d58b15e 382`:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'.
55535639 383
ebdaed17 384DISPLAY can be `default' (only in the first element), the symbol
9c27debd
RS
385t (only in the last element) to match all frames, or an alist of
386conditions of the form \(REQ ITEM...). For such an alist to
387match a frame, each of the conditions must be satisfied, meaning
388that the REQ property of the frame must match one of the
389corresponding ITEMs. These are the defined REQ values:
55535639
PJ
390
391`type' (the value of `window-system')
392 Under X, in addition to the values `window-system' can take,
9b44aa8b
JD
393 `motif', `lucid', `gtk' and `x-toolkit' are allowed, and match when
394 the Motif toolkit, Lucid toolkit, GTK toolkit or any X toolkit is in use.
55535639
PJ
395
396`class' (the frame's color support)
397 Should be one of `color', `grayscale', or `mono'.
398
399`background' (what color is used for the background text)
400 Should be one of `light' or `dark'.
401
6e166990
EZ
402`min-colors' (the minimum number of colors the frame should support)
403 Should be an integer, it is compared with the result of
404 `display-color-cells'.
405
ec85856c
JL
406`supports' (only match frames that support the specified face attributes)
407 Should be a list of face attributes. See the documentation for
408 the function `display-supports-face-attributes-p' for more
409 information on exactly how testing is done.
410
81117bdd
BW
411See Info node `(elisp) Customization' in the Emacs Lisp manual
412for more information."
67a60caa 413 (declare (doc-string 3))
55535639
PJ
414 ;; It is better not to use backquote in this file,
415 ;; because that makes a bootstrapping problem
416 ;; if you need to recompile all the Lisp files using interpreted code.
417 (nconc (list 'custom-declare-face (list 'quote face) spec doc) args))
418
419;;; The `defgroup' Macro.
420
d3b80e9b
SM
421(defun custom-current-group ()
422 (cdr (assoc load-file-name custom-current-group-alist)))
423
55535639
PJ
424(defun custom-declare-group (symbol members doc &rest args)
425 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
426 (while members
427 (apply 'custom-add-to-group symbol (car members))
428 (setq members (cdr members)))
55535639
PJ
429 (when doc
430 ;; This text doesn't get into DOC.
431 (put symbol 'group-documentation (purecopy doc)))
432 (while args
433 (let ((arg (car args)))
434 (setq args (cdr args))
435 (unless (symbolp arg)
436 (error "Junk in args %S" args))
437 (let ((keyword arg)
438 (value (car args)))
439 (unless args
440 (error "Keyword %s is missing an argument" keyword))
441 (setq args (cdr args))
442 (cond ((eq keyword :prefix)
b6f8ba09 443 (put symbol 'custom-prefix (purecopy value)))
55535639
PJ
444 (t
445 (custom-handle-keyword symbol keyword value
446 'custom-group))))))
d3b80e9b
SM
447 ;; Record the group on the `current' list.
448 (let ((elt (assoc load-file-name custom-current-group-alist)))
449 (if elt (setcdr elt symbol)
af89cf77
DN
450 (push (cons (purecopy load-file-name) symbol)
451 custom-current-group-alist)))
55535639
PJ
452 (run-hooks 'custom-define-hook)
453 symbol)
454
455(defmacro defgroup (symbol members doc &rest args)
456 "Declare SYMBOL as a customization group containing MEMBERS.
457SYMBOL does not need to be quoted.
458
7a41cd7f
GM
459Third argument DOC is the group documentation. This should be a short
460description of the group, beginning with a capital and ending with
461a period. Words other than the first should not be capitalized, if they
462are not usually written so.
55535639
PJ
463
464MEMBERS should be an alist of the form ((NAME WIDGET)...) where
465NAME is a symbol and WIDGET is a widget for editing that symbol.
466Useful widgets are `custom-variable' for editing variables,
467`custom-face' for edit faces, and `custom-group' for editing groups.
468
469The remaining arguments should have the form
470
471 [KEYWORD VALUE]...
472
81117bdd
BW
473For a list of valid keywords, see the common keywords listed in
474`defcustom'.
55535639 475
81117bdd
BW
476See Info node `(elisp) Customization' in the Emacs Lisp manual
477for more information."
45aacac6 478 (declare (doc-string 3))
55535639
PJ
479 ;; It is better not to use backquote in this file,
480 ;; because that makes a bootstrapping problem
481 ;; if you need to recompile all the Lisp files using interpreted code.
482 (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args))
483
484(defun custom-add-to-group (group option widget)
485 "To existing GROUP add a new OPTION of type WIDGET.
486If there already is an entry for OPTION and WIDGET, nothing is done."
487 (let ((members (get group 'custom-group))
488 (entry (list option widget)))
489 (unless (member entry members)
490 (put group 'custom-group (nconc members (list entry))))))
491
29512a0f
SM
492(defun custom-group-of-mode (mode)
493 "Return the custom group corresponding to the major or minor MODE.
494If no such group is found, return nil."
495 (or (get mode 'custom-mode-group)
496 (if (or (get mode 'custom-group)
497 (and (string-match "-mode\\'" (symbol-name mode))
498 (get (setq mode (intern (substring (symbol-name mode)
499 0 (match-beginning 0))))
500 'custom-group)))
501 mode)))
502
55535639
PJ
503;;; Properties.
504
505(defun custom-handle-all-keywords (symbol args type)
506 "For customization option SYMBOL, handle keyword arguments ARGS.
507Third argument TYPE is the custom option type."
d3b80e9b 508 (unless (memq :group args)
9b6098b9 509 (custom-add-to-group (custom-current-group) symbol type))
55535639
PJ
510 (while args
511 (let ((arg (car args)))
512 (setq args (cdr args))
513 (unless (symbolp arg)
514 (error "Junk in args %S" args))
515 (let ((keyword arg)
516 (value (car args)))
517 (unless args
518 (error "Keyword %s is missing an argument" keyword))
519 (setq args (cdr args))
520 (custom-handle-keyword symbol keyword value type)))))
521
522(defun custom-handle-keyword (symbol keyword value type)
523 "For customization option SYMBOL, handle KEYWORD with VALUE.
524Fourth argument TYPE is the custom option type."
525 (if purify-flag
526 (setq value (purecopy value)))
527 (cond ((eq keyword :group)
528 (custom-add-to-group value symbol type))
529 ((eq keyword :version)
530 (custom-add-version symbol value))
4e9c705e
BW
531 ((eq keyword :package-version)
532 (custom-add-package-version symbol value))
55535639
PJ
533 ((eq keyword :link)
534 (custom-add-link symbol value))
535 ((eq keyword :load)
536 (custom-add-load symbol value))
537 ((eq keyword :tag)
538 (put symbol 'custom-tag value))
539 ((eq keyword :set-after)
540 (custom-add-dependencies symbol value))
541 (t
542 (error "Unknown keyword %s" keyword))))
543
544(defun custom-add-dependencies (symbol value)
545 "To the custom option SYMBOL, add dependencies specified by VALUE.
546VALUE should be a list of symbols. For each symbol in that list,
547this specifies that SYMBOL should be set after the specified symbol, if
548both appear in constructs like `custom-set-variables'."
549 (unless (listp value)
550 (error "Invalid custom dependency `%s'" value))
551 (let* ((deps (get symbol 'custom-dependencies))
552 (new-deps deps))
553 (while value
554 (let ((dep (car value)))
555 (unless (symbolp dep)
556 (error "Invalid custom dependency `%s'" dep))
557 (unless (memq dep new-deps)
558 (setq new-deps (cons dep new-deps)))
559 (setq value (cdr value))))
560 (unless (eq deps new-deps)
561 (put symbol 'custom-dependencies new-deps))))
e1bab181 562
55535639
PJ
563(defun custom-add-option (symbol option)
564 "To the variable SYMBOL add OPTION.
565
a4842ffa
RS
566If SYMBOL's custom type is a hook, OPTION should be a hook member.
567If SYMBOL's custom type is an alist, OPTION specifies a symbol
568to offer to the user as a possible key in the alist.
569For other custom types, this has no effect."
55535639
PJ
570 (let ((options (get symbol 'custom-options)))
571 (unless (member option options)
572 (put symbol 'custom-options (cons option options)))))
467064a4 573(defalias 'custom-add-frequent-value 'custom-add-option)
55535639
PJ
574
575(defun custom-add-link (symbol widget)
576 "To the custom option SYMBOL add the link WIDGET."
577 (let ((links (get symbol 'custom-links)))
578 (unless (member widget links)
579 (put symbol 'custom-links (cons (purecopy widget) links)))))
580
581(defun custom-add-version (symbol version)
582 "To the custom option SYMBOL add the version VERSION."
583 (put symbol 'custom-version (purecopy version)))
584
4e9c705e
BW
585(defun custom-add-package-version (symbol version)
586 "To the custom option SYMBOL add the package version VERSION."
587 (put symbol 'custom-package-version (purecopy version)))
588
55535639
PJ
589(defun custom-add-load (symbol load)
590 "To the custom option SYMBOL add the dependency LOAD.
591LOAD should be either a library file name, or a feature name."
592 (let ((loads (get symbol 'custom-loads)))
593 (unless (member load loads)
594 (put symbol 'custom-loads (cons (purecopy load) loads)))))
595
d54fbdfd
SM
596(defun custom-autoload (symbol load &optional noset)
597 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD.
598If NOSET is non-nil, don't bother autoloading LOAD when setting the variable."
599 (put symbol 'custom-autoload (if noset 'noset t))
1669290d
MR
600 (custom-add-load symbol load))
601
1669290d 602(defun custom-variable-p (variable)
0b21c100
CY
603 "Return non-nil if VARIABLE is a customizable variable.
604A customizable variable is either (i) a variable whose property
605list contains a non-nil `standard-value' or `custom-autoload'
606property, or (ii) an alias for another customizable variable."
b4d3bc10
CY
607 (when (symbolp variable)
608 (setq variable (indirect-variable variable))
609 (or (get variable 'standard-value)
610 (get variable 'custom-autoload))))
611
612(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.2")
1669290d 613
400b960e
RS
614(defun custom-note-var-changed (variable)
615 "Inform Custom that VARIABLE has been set (changed).
616VARIABLE is a symbol that names a user option.
617The result is that the change is treated as having been made through Custom."
400b960e 618 (put variable 'customized-value (list (custom-quote (eval variable)))))
06f5c483
JL
619
620\f
621;;; Custom Themes
400b960e 622
8f772dfd
RS
623;;; Loading files needed to customize a symbol.
624;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
625
626(defvar custom-load-recursion nil
627 "Hack to avoid recursive dependencies.")
628
629(defun custom-load-symbol (symbol)
630 "Load all dependencies for SYMBOL."
631 (unless custom-load-recursion
29512a0f 632 (let ((custom-load-recursion t))
a8c78057
RS
633 ;; Load these files if not already done,
634 ;; to make sure we know all the dependencies of SYMBOL.
635 (condition-case nil
636 (require 'cus-load)
637 (error nil))
638 (condition-case nil
639 (require 'cus-start)
640 (error nil))
29512a0f
SM
641 (dolist (load (get symbol 'custom-loads))
642 (cond ((symbolp load) (condition-case nil (require load) (error nil)))
643 ;; This is subsumed by the test below, but it's much faster.
8f772dfd
RS
644 ((assoc load load-history))
645 ;; This was just (assoc (locate-library load) load-history)
646 ;; but has been optimized not to load locate-library
647 ;; if not necessary.
29512a0f
SM
648 ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
649 "\\(\\'\\|\\.\\)"))
650 (found nil))
8f772dfd 651 (dolist (loaded load-history)
c3891447
RS
652 (and (stringp (car loaded))
653 (string-match regexp (car loaded))
8f772dfd
RS
654 (setq found t)))
655 found))
656 ;; Without this, we would load cus-edit recursively.
657 ;; We are still loading it when we call this,
658 ;; and it is not in load-history yet.
659 ((equal load "cus-edit"))
29512a0f 660 (t (condition-case nil (load load) (error nil))))))))
46ce5feb 661\f
c2e2f9be
CY
662(defvar custom-local-buffer nil
663 "Non-nil, in a Customization buffer, means customize a specific buffer.
664If this variable is non-nil, it should be a buffer,
665and it means customize the local bindings of that buffer.
666This variable is a permanent local, and it normally has a local binding
667in every Customization buffer.")
668(put 'custom-local-buffer 'permanent-local t)
669
670(defun custom-set-default (variable value)
671 "Default :set function for a customizable variable.
672Normally, this sets the default value of VARIABLE to VALUE,
673but if `custom-local-buffer' is non-nil,
674this sets the local binding in that buffer instead."
675 (if custom-local-buffer
676 (with-current-buffer custom-local-buffer
677 (set variable value))
678 (set-default variable value)))
679
680(defun custom-set-minor-mode (variable value)
681 ":set function for minor mode variables.
682Normally, this sets the default value of VARIABLE to nil if VALUE
683is nil and to t otherwise,
684but if `custom-local-buffer' is non-nil,
685this sets the local binding in that buffer instead."
686 (if custom-local-buffer
687 (with-current-buffer custom-local-buffer
688 (funcall variable (if value 1 0)))
689 (funcall variable (if value 1 0))))
690
691(defun custom-quote (sexp)
4837b516 692 "Quote SEXP if it is not self quoting."
c2e2f9be
CY
693 (if (or (memq sexp '(t nil))
694 (keywordp sexp)
695 (and (listp sexp)
696 (memq (car sexp) '(lambda)))
697 (stringp sexp)
698 (numberp sexp)
699 (vectorp sexp)
700;;; (and (fboundp 'characterp)
701;;; (characterp sexp))
702 )
703 sexp
704 (list 'quote sexp)))
705
706(defun customize-mark-to-save (symbol)
707 "Mark SYMBOL for later saving.
708
709If the default value of SYMBOL is different from the standard value,
710set the `saved-value' property to a list whose car evaluates to the
711default value. Otherwise, set it to nil.
712
713To actually save the value, call `custom-save-all'.
714
4837b516 715Return non-nil if the `saved-value' property actually changed."
ec9f0a62 716 (custom-load-symbol symbol)
c2e2f9be
CY
717 (let* ((get (or (get symbol 'custom-get) 'default-value))
718 (value (funcall get symbol))
719 (saved (get symbol 'saved-value))
720 (standard (get symbol 'standard-value))
721 (comment (get symbol 'customized-variable-comment)))
4837b516 722 ;; Save default value if different from standard value.
c2e2f9be
CY
723 (if (or (null standard)
724 (not (equal value (condition-case nil
725 (eval (car standard))
726 (error nil)))))
727 (put symbol 'saved-value (list (custom-quote value)))
728 (put symbol 'saved-value nil))
729 ;; Clear customized information (set, but not saved).
730 (put symbol 'customized-value nil)
731 ;; Save any comment that might have been set.
732 (when comment
733 (put symbol 'saved-variable-comment comment))
734 (not (equal saved (get symbol 'saved-value)))))
735
736(defun customize-mark-as-set (symbol)
737 "Mark current value of SYMBOL as being set from customize.
738
739If the default value of SYMBOL is different from the saved value if any,
740or else if it is different from the standard value, set the
741`customized-value' property to a list whose car evaluates to the
742default value. Otherwise, set it to nil.
743
4837b516 744Return non-nil if the `customized-value' property actually changed."
ec9f0a62 745 (custom-load-symbol symbol)
c2e2f9be
CY
746 (let* ((get (or (get symbol 'custom-get) 'default-value))
747 (value (funcall get symbol))
748 (customized (get symbol 'customized-value))
749 (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
4837b516 750 ;; Mark default value as set if different from old value.
d54fbdfd
SM
751 (if (not (and old
752 (equal value (condition-case nil
753 (eval (car old))
754 (error nil)))))
fccf2784
CY
755 (progn (put symbol 'customized-value (list (custom-quote value)))
756 (custom-push-theme 'theme-value symbol 'user 'set
757 (custom-quote value)))
c2e2f9be
CY
758 (put symbol 'customized-value nil))
759 ;; Changed?
760 (not (equal customized (get symbol 'customized-value)))))
761
762(defun custom-reevaluate-setting (symbol)
763 "Reset the value of SYMBOL by re-evaluating its saved or standard value.
764Use the :set function to do so. This is useful for customizable options
765that are defined before their standard value can really be computed.
766E.g. dumped variables whose default depends on run-time information."
767 (funcall (or (get symbol 'custom-set) 'set-default)
768 symbol
769 (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
770
771\f
d358aa10
CY
772;;; Custom Themes
773
774;; Custom themes are collections of settings that can be enabled or
775;; disabled as a unit.
776
777;; Each Custom theme is defined by a symbol, called the theme name.
778;; The `theme-settings' property of the theme name records the
779;; variable and face settings of the theme. This property is a list
780;; of elements, each of the form
781;;
782;; (PROP SYMBOL THEME VALUE)
783;;
784;; - PROP is either `theme-value' or `theme-face'
785;; - SYMBOL is the face or variable name
786;; - THEME is the theme name (redundant, but simplifies the code)
787;; - VALUE is an expression that gives the theme's setting for SYMBOL.
788;;
789;; The theme name also has a `theme-feature' property, whose value is
790;; specified when the theme is defined (see `custom-declare-theme').
791;; Usually, this is just a symbol named THEME-theme. This lets
792;; external libraries call (require 'foo-theme).
793
794;; In addition, each symbol (either a variable or a face) affected by
795;; an *enabled* theme has a `theme-value' or `theme-face' property,
796;; which is a list of elements each of the form
797;;
798;; (THEME VALUE)
799;;
800;; which have the same meanings as in `theme-settings'.
801;;
802;; The `theme-value' and `theme-face' lists are ordered by decreasing
803;; theme precedence. Thus, the first element is always the one that
804;; is in effect.
805
806;; Each theme is stored in a theme file, with filename THEME-theme.el.
807;; Loading a theme basically involves calling (load "THEME-theme")
808;; This is done by the function `load-theme'. Loading a theme
809;; automatically enables it.
810;;
811;; When a theme is enabled, the `theme-value' and `theme-face'
812;; properties for the affected symbols are set. When a theme is
813;; disabled, its settings are removed from the `theme-value' and
814;; `theme-face' properties, but the theme's own `theme-settings'
815;; property remains unchanged.
816
d358aa10 817(defvar custom-known-themes '(user changed)
9c4b6e94 818 "Themes that have been defined with `deftheme'.
d358aa10 819The default value is the list (user changed). The theme `changed'
171fc304
JB
820contains the settings before custom themes are applied. The theme
821`user' contains all the settings the user customized and saved.
822Additional themes declared with the `deftheme' macro will be added
823to the front of this list.")
e1bab181 824
e1bab181
RS
825(defsubst custom-theme-p (theme)
826 "Non-nil when THEME has been defined."
827 (memq theme custom-known-themes))
828
829(defsubst custom-check-theme (theme)
830 "Check whether THEME is valid, and signal an error if it is not."
831 (unless (custom-theme-p theme)
832 (error "Unknown theme `%s'" theme)))
833
d358aa10
CY
834(defun custom-push-theme (prop symbol theme mode &optional value)
835 "Record VALUE for face or variable SYMBOL in custom theme THEME.
836PROP is `theme-face' for a face, `theme-value' for a variable.
e1bab181
RS
837
838MODE can be either the symbol `set' or the symbol `reset'. If it is the
839symbol `set', then VALUE is the value to use. If it is the symbol
d358aa10 840`reset', then SYMBOL will be removed from THEME (VALUE is ignored).
e1bab181 841
e1bab181 842See `custom-known-themes' for a list of known themes."
b2a41d12 843 (unless (memq prop '(theme-value theme-face))
d820f1fb 844 (error "Unknown theme property"))
46ce5feb 845 (let* ((old (get symbol prop))
d358aa10
CY
846 (setting (assq theme old)) ; '(theme value)
847 (theme-settings ; '(prop symbol theme value)
848 (get theme 'theme-settings)))
05d22d02
CY
849 (cond
850 ;; Remove a setting:
851 ((eq mode 'reset)
852 (when setting
853 (let (res)
854 (dolist (theme-setting theme-settings)
855 (if (and (eq (car theme-setting) prop)
856 (eq (cadr theme-setting) symbol))
857 (setq res theme-setting)))
858 (put theme 'theme-settings (delq res theme-settings)))
859 (put symbol prop (delq setting old))))
860 ;; Alter an existing setting:
861 (setting
862 (let (res)
863 (dolist (theme-setting theme-settings)
864 (if (and (eq (car theme-setting) prop)
865 (eq (cadr theme-setting) symbol))
866 (setq res theme-setting)))
867 (put theme 'theme-settings
868 (cons (list prop symbol theme value)
869 (delq res theme-settings)))
870 (setcar (cdr setting) value)))
871 ;; Add a new setting:
872 (t
873 (unless old
1485f4c0
CY
874 ;; If the user changed a variable outside of Customize, save
875 ;; the value to a fake theme, `changed'. If the theme is
876 ;; later disabled, we use this to bring back the old value.
877 ;;
878 ;; For faces, we just use `face-new-frame-defaults' to
879 ;; recompute when the theme is disabled.
880 (when (and (eq prop 'theme-value)
881 (boundp symbol))
882 (let ((sv (get symbol 'standard-value))
883 (val (symbol-value symbol)))
884 (unless (and sv (equal (eval (car sv)) val))
885 (setq old `((changed ,(custom-quote val))))))))
05d22d02
CY
886 (put symbol prop (cons (list theme value) old))
887 (put theme 'theme-settings
888 (cons (list prop symbol theme value) theme-settings))))))
889
890(defun custom-fix-face-spec (spec)
891 "Convert face SPEC, replacing obsolete :bold and :italic attributes.
892Also change :reverse-video to :inverse-video."
893 (when (listp spec)
894 (if (or (memq :bold spec)
895 (memq :italic spec)
896 (memq :inverse-video spec))
897 (let (result)
898 (while spec
899 (let ((key (car spec))
900 (val (car (cdr spec))))
901 (cond ((eq key :italic)
902 (push :slant result)
903 (push (if val 'italic 'normal) result))
904 ((eq key :bold)
905 (push :weight result)
906 (push (if val 'bold 'normal) result))
907 ((eq key :reverse-video)
908 (push :inverse-video result)
909 (push val result))
910 (t
911 (push key result)
912 (push val result))))
913 (setq spec (cddr spec)))
914 (nreverse result))
915 spec)))
c2e2f9be 916\f
55535639 917(defun custom-set-variables (&rest args)
f1a262ed
RS
918 "Install user customizations of variable values specified in ARGS.
919These settings are registered as theme `user'.
64e9f9d9 920The arguments should each be a list of the form:
55535639 921
f1a262ed 922 (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
55535639 923
f1a262ed
RS
924This stores EXP (without evaluating it) as the saved value for SYMBOL.
925If NOW is present and non-nil, then also evaluate EXP and set
926the default value for the SYMBOL to the value of EXP.
e1bab181 927
f1a262ed
RS
928REQUEST is a list of features we must require in order to
929handle SYMBOL properly.
55535639 930COMMENT is a comment string about SYMBOL."
e1bab181
RS
931 (apply 'custom-theme-set-variables 'user args))
932
933(defun custom-theme-set-variables (theme &rest args)
f1a262ed
RS
934 "Initialize variables for theme THEME according to settings in ARGS.
935Each of the arguments in ARGS should be a list of this form:
e1bab181 936
f1a262ed 937 (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
e1bab181 938
81927dd2
CY
939SYMBOL is the variable name, and EXP is an expression which
940evaluates to the customized value. EXP will also be stored,
941without evaluating it, in SYMBOL's `saved-value' property, so
942that it can be restored via the Customize interface. It is also
943added to the alist in SYMBOL's `theme-value' property \(by
944calling `custom-push-theme').
e1bab181 945
81927dd2
CY
946NOW, if present and non-nil, means to install the variable's
947value directly now, even if its `defcustom' declaration has not
948been executed. This is for internal use only.
949
950REQUEST is a list of features to `require' (which are loaded
951prior to evaluating EXP).
e1bab181 952
81927dd2 953COMMENT is a comment string about SYMBOL."
e1bab181 954 (custom-check-theme theme)
05d22d02 955
9277ee6c
SM
956 ;; Process all the needed autoloads before anything else, so that the
957 ;; subsequent code has all the info it needs (e.g. which var corresponds
958 ;; to a minor mode), regardless of the ordering of the variables.
959 (dolist (entry args)
960 (let* ((symbol (indirect-variable (nth 0 entry))))
961 (unless (or (get symbol 'standard-value)
962 (memq (get symbol 'custom-autoload) '(nil noset)))
963 ;; This symbol needs to be autoloaded, even just for a `set'.
964 (custom-load-symbol symbol))))
1e281896 965
9277ee6c 966 ;; Move minor modes and variables with explicit requires to the end.
059290d6
SM
967 (setq args
968 (sort args
969 (lambda (a1 a2)
970 (let* ((sym1 (car a1))
971 (sym2 (car a2))
972 (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
973 (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
974 (cond ((and 1-then-2 2-then-1)
975 (error "Circular custom dependency between `%s' and `%s'"
976 sym1 sym2))
977 (2-then-1 nil)
3d0c2a29
GM
978 ;; 1 is a dependency of 2, so needs to be set first.
979 (1-then-2)
b6790c3e
SM
980 ;; Put minor modes and symbols with :require last.
981 ;; Putting minor modes last ensures that the mode
982 ;; function will see other customized values rather
983 ;; than default values.
984 (t (or (nth 3 a2)
985 (eq (get sym2 'custom-set)
986 'custom-set-minor-mode))))))))
6b09b5d1
CY
987
988 (dolist (entry args)
989 (unless (listp entry)
990 (error "Incompatible Custom theme spec"))
991 (let* ((symbol (indirect-variable (nth 0 entry)))
992 (value (nth 1 entry)))
993 (custom-push-theme 'theme-value symbol theme 'set value)
994 (unless custom--inhibit-theme-enable
995 ;; Now set the variable.
996 (let* ((now (nth 2 entry))
997 (requests (nth 3 entry))
998 (comment (nth 4 entry))
999 set)
1000 (when requests
1001 (put symbol 'custom-requests requests)
1002 (mapc 'require requests))
1003 (setq set (or (get symbol 'custom-set) 'custom-set-default))
059290d6 1004 (put symbol 'saved-value (list value))
6b09b5d1
CY
1005 (put symbol 'saved-variable-comment comment)
1006 ;; Allow for errors in the case where the setter has
1007 ;; changed between versions, say, but let the user know.
1008 (condition-case data
1009 (cond (now
1010 ;; Rogue variable, set it now.
1011 (put symbol 'force-value t)
1012 (funcall set symbol (eval value)))
1013 ((default-boundp symbol)
1014 ;; Something already set this, overwrite it.
1015 (funcall set symbol (eval value))))
1016 (error
1017 (message "Error setting %s: %s" symbol data)))
1018 (and (or now (default-boundp symbol))
1019 (put symbol 'variable-comment comment)))))))
55535639 1020
46ce5feb
RS
1021\f
1022;;; Defining themes.
1023
782b5e8d
CY
1024;; A theme file is named `THEME-theme.el' (where THEME is the theme
1025;; name) found in `custom-theme-load-path'. It has this format:
d358aa10
CY
1026;;
1027;; (deftheme THEME
1028;; DOCSTRING)
1029;;
1030;; (custom-theme-set-variables
1031;; 'THEME
1032;; [THEME-VARIABLES])
1033;;
1034;; (custom-theme-set-faces
1035;; 'THEME
1036;; [THEME-FACES])
1037;;
1038;; (provide-theme 'THEME)
46ce5feb 1039
46ce5feb 1040
d358aa10
CY
1041;; The IGNORED arguments to deftheme come from the XEmacs theme code, where
1042;; they were used to supply keyword-value pairs like `:immediate',
1043;; `:variable-reset-string', etc. We don't use any of these, so ignore them.
6d912ee1 1044
d358aa10
CY
1045(defmacro deftheme (theme &optional doc &rest ignored)
1046 "Declare THEME to be a Custom theme.
1047The optional argument DOC is a doc string describing the theme.
46ce5feb
RS
1048
1049Any theme `foo' should be defined in a file called `foo-theme.el';
1050see `custom-make-theme-feature' for more information."
1051 (let ((feature (custom-make-theme-feature theme)))
1052 ;; It is better not to use backquote in this file,
1053 ;; because that makes a bootstrapping problem
1054 ;; if you need to recompile all the Lisp files using interpreted code.
d358aa10 1055 (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
46ce5feb 1056
d358aa10 1057(defun custom-declare-theme (theme feature &optional doc &rest ignored)
46ce5feb 1058 "Like `deftheme', but THEME is evaluated as a normal argument.
d358aa10
CY
1059FEATURE is the feature this theme provides. Normally, this is a symbol
1060created from THEME by `custom-make-theme-feature'."
29a4c45b
CY
1061 (unless (custom-theme-name-valid-p theme)
1062 (error "Custom theme cannot be named %S" theme))
46ce5feb
RS
1063 (add-to-list 'custom-known-themes theme)
1064 (put theme 'theme-feature feature)
d358aa10 1065 (when doc (put theme 'theme-documentation doc)))
46ce5feb
RS
1066
1067(defun custom-make-theme-feature (theme)
1068 "Given a symbol THEME, create a new symbol by appending \"-theme\".
1069Store this symbol in the `theme-feature' property of THEME.
1070Calling `provide-theme' to provide THEME actually puts `THEME-theme'
1071into `features'.
1072
1073This allows for a file-name convention for autoloading themes:
1074Every theme X has a property `provide-theme' whose value is \"X-theme\".
87d737ae 1075\(load-theme X) then attempts to load the file `X-theme.el'."
46ce5feb
RS
1076 (intern (concat (symbol-name theme) "-theme")))
1077\f
1078;;; Loading themes.
1079
782b5e8d
CY
1080(defcustom custom-theme-directory user-emacs-directory
1081 "Default user directory for storing custom theme files.
1082The command `customize-create-theme' writes theme files into this
1083directory. By default, Emacs searches for custom themes in this
1084directory first---see `custom-theme-load-path'."
9c4b6e94
LT
1085 :type 'string
1086 :group 'customize
1087 :version "22.1")
1088
782b5e8d
CY
1089(defcustom custom-theme-load-path (list 'custom-theme-directory t)
1090 "List of directories to search for custom theme files.
29a4c45b
CY
1091When loading custom themes (e.g. in `customize-themes' and
1092`load-theme'), Emacs searches for theme files in the specified
782b5e8d 1093order. Each element in the list should be one of the following:
647bc502
CY
1094- the symbol `custom-theme-directory', meaning the value of
1095 `custom-theme-directory'.
1096- the symbol t, meaning the built-in theme directory (a directory
1097 named \"themes\" in `data-directory').
29a4c45b
CY
1098- a directory name (a string).
1099
171fc304 1100Each theme file is named THEME-theme.el, where THEME is the theme
29a4c45b 1101name."
782b5e8d
CY
1102 :type '(repeat (choice (const :tag "custom-theme-directory"
1103 custom-theme-directory)
1104 (const :tag "Built-in theme directory" t)
1105 directory))
1106 :group 'customize
1107 :version "24.1")
1108
6b09b5d1 1109(defvar custom--inhibit-theme-enable nil
fccee4ab
CY
1110 "Whether the custom-theme-set-* functions act immediately.
1111If nil, `custom-theme-set-variables' and `custom-theme-set-faces'
1112change the current values of the given variable or face. If
1113non-nil, they just make a record of the theme settings.")
6b09b5d1 1114
e1bab181 1115(defun provide-theme (theme)
d358aa10
CY
1116 "Indicate that this file provides THEME.
1117This calls `provide' to provide the feature name stored in THEME's
1118property `theme-feature' (which is usually a symbol created by
1119`custom-make-theme-feature')."
29a4c45b
CY
1120 (unless (custom-theme-name-valid-p theme)
1121 (error "Custom theme cannot be named %S" theme))
e1bab181 1122 (custom-check-theme theme)
fccee4ab 1123 (provide (get theme 'theme-feature)))
6b09b5d1 1124
b7617f6d 1125(defcustom custom-safe-themes '(default)
04c52e2f 1126 "Themes that are considered safe to load.
1de76afe 1127If the value is a list, each element should be either the SHA-256
04c52e2f
CY
1128hash of a safe theme file, or the symbol `default', which stands
1129for any theme in the built-in Emacs theme directory (a directory
1130named \"themes\" in `data-directory').
1131
04482335
CY
1132If the value is t, Emacs treats all themes as safe.
1133
1134This variable cannot be set in a Custom theme."
04c52e2f
CY
1135 :type '(choice (repeat :tag "List of safe themes"
1136 (choice string
1137 (const :tag "Built-in themes" default)))
1138 (const :tag "All themes" t))
278f6845 1139 :group 'customize
b7617f6d 1140 :risky t
278f6845
CY
1141 :version "24.1")
1142
658d8eb8 1143(defun load-theme (theme &optional no-confirm no-enable)
928f4e73 1144 "Load Custom theme named THEME from its file.
928f4e73
CY
1145The theme file is named THEME-theme.el, in one of the directories
1146specified by `custom-theme-load-path'.
278f6845 1147
abd1f678
CY
1148If the theme is not considered safe by `custom-safe-themes',
1149prompt the user for confirmation before loading it. But if
1150optional arg NO-CONFIRM is non-nil, load the theme without
1151prompting.
658d8eb8 1152
4125cb8b
CY
1153Normally, this function also enables THEME. If optional arg
1154NO-ENABLE is non-nil, load the theme but don't enable it, unless
1155the theme was already enabled.
658d8eb8
CY
1156
1157This function is normally called through Customize when setting
1158`custom-enabled-themes'. If used directly in your init file, it
1159should be called with a non-nil NO-CONFIRM argument, or after
1160`custom-safe-themes' has been loaded.
1161
928f4e73 1162Return t if THEME was successfully loaded, nil otherwise."
05d22d02
CY
1163 (interactive
1164 (list
1165 (intern (completing-read "Load custom theme: "
6b09b5d1 1166 (mapcar 'symbol-name
658d8eb8
CY
1167 (custom-available-themes))))
1168 nil nil))
6b09b5d1
CY
1169 (unless (custom-theme-name-valid-p theme)
1170 (error "Invalid theme name `%s'" theme))
4125cb8b
CY
1171 ;; If THEME is already enabled, re-enable it after loading, even if
1172 ;; NO-ENABLE is t.
1173 (if no-enable
1174 (setq no-enable (not (custom-theme-enabled-p theme))))
73e60f53
CY
1175 ;; If reloading, clear out the old theme settings.
1176 (when (custom-theme-p theme)
1177 (disable-theme theme)
1178 (put theme 'theme-settings nil)
1179 (put theme 'theme-feature nil)
1180 (put theme 'theme-documentation nil))
6b09b5d1 1181 (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
782b5e8d 1182 (custom-theme--load-path)
b7617f6d
CY
1183 '("" "c")))
1184 hash)
6b09b5d1 1185 (unless fn
171fc304 1186 (error "Unable to find theme file for `%s'" theme))
b7617f6d
CY
1187 (with-temp-buffer
1188 (insert-file-contents fn)
1de76afe 1189 (setq hash (secure-hash 'sha256 (current-buffer)))
928f4e73
CY
1190 ;; Check file safety with `custom-safe-themes', prompting the
1191 ;; user if necessary.
658d8eb8 1192 (when (or no-confirm
04c52e2f 1193 (eq custom-safe-themes t)
658d8eb8 1194 (and (memq 'default custom-safe-themes)
b7617f6d
CY
1195 (equal (file-name-directory fn)
1196 (expand-file-name "themes/" data-directory)))
1197 (member hash custom-safe-themes)
928f4e73 1198 (custom-theme-load-confirm hash))
fccee4ab
CY
1199 (let ((custom--inhibit-theme-enable t))
1200 (eval-buffer))
3b2ff876
CY
1201 ;; Optimization: if the theme changes the `default' face, put that
1202 ;; entry first. This avoids some `frame-set-background-mode' rigmarole
1203 ;; by assigning the new background immediately.
1204 (let* ((settings (get theme 'theme-settings))
1205 (tail settings)
1206 found)
1207 (while (and tail (not found))
1208 (and (eq (nth 0 (car tail)) 'theme-face)
1209 (eq (nth 1 (car tail)) 'default)
1210 (setq found (car tail)))
1211 (setq tail (cdr tail)))
1212 (if found
1213 (put theme 'theme-settings (cons found (delq found settings)))))
1214 ;; Finally, enable the theme.
fccee4ab
CY
1215 (unless no-enable
1216 (enable-theme theme))
1217 t))))
b7617f6d
CY
1218
1219(defun custom-theme-load-confirm (hash)
1220 "Query the user about loading a Custom theme that may not be safe.
1221The theme should be in the current buffer. If the user agrees,
1222query also about adding HASH to `custom-safe-themes'."
278f6845
CY
1223 (if noninteractive
1224 nil
b7617f6d 1225 (let ((exit-chars '(?y ?n ?\s))
928f4e73 1226 window prompt char)
278f6845 1227 (save-window-excursion
b7617f6d
CY
1228 (rename-buffer "*Custom Theme*" t)
1229 (emacs-lisp-mode)
928f4e73 1230 (setq window (display-buffer (current-buffer)))
b7617f6d 1231 (setq prompt
928f4e73
CY
1232 (format "Loading a theme can run Lisp code. Really load?%s"
1233 (if (and window
1234 (< (line-number-at-pos (point-max))
1235 (window-body-height)))
1236 " (y or n) "
b7617f6d 1237 (push ?\C-v exit-chars)
928f4e73 1238 "\nType y or n, or C-v to scroll: ")))
b7617f6d
CY
1239 (goto-char (point-min))
1240 (while (null char)
1241 (setq char (read-char-choice prompt exit-chars))
1242 (when (eq char ?\C-v)
928f4e73
CY
1243 (if window
1244 (with-selected-window window
1245 (condition-case nil
1246 (scroll-up)
1247 (error (goto-char (point-min))))))
b7617f6d
CY
1248 (setq char nil)))
1249 (when (memq char '(?\s ?y))
b7617f6d
CY
1250 ;; Offer to save to `custom-safe-themes'.
1251 (and (or custom-file user-init-file)
928f4e73 1252 (y-or-n-p "Treat this theme as safe in future sessions? ")
658d8eb8 1253 (customize-push-and-save 'custom-safe-themes (list hash)))
b7617f6d 1254 t)))))
6b09b5d1
CY
1255
1256(defun custom-theme-name-valid-p (name)
1257 "Return t if NAME is a valid name for a Custom theme, nil otherwise.
1258NAME should be a symbol."
1259 (and (symbolp name)
1260 name
1261 (not (or (zerop (length (symbol-name name)))
6b09b5d1
CY
1262 (eq name 'user)
1263 (eq name 'changed)))))
05d22d02
CY
1264
1265(defun custom-available-themes ()
6b09b5d1 1266 "Return a list of available Custom themes (symbols)."
171fc304 1267 (let (sym themes)
782b5e8d
CY
1268 (dolist (dir (custom-theme--load-path))
1269 (when (file-directory-p dir)
1270 (dolist (file (file-expand-wildcards
1271 (expand-file-name "*-theme.el" dir) t))
1272 (setq file (file-name-nondirectory file))
1273 (and (string-match "\\`\\(.+\\)-theme.el\\'" file)
1274 (setq sym (intern (match-string 1 file)))
1275 (custom-theme-name-valid-p sym)
1276 (push sym themes)))))
2bb5649e 1277 (nreverse (delete-dups themes))))
782b5e8d
CY
1278
1279(defun custom-theme--load-path ()
1280 (let (lpath)
1281 (dolist (f custom-theme-load-path)
1282 (cond ((eq f 'custom-theme-directory)
1283 (setq f custom-theme-directory))
1284 ((eq f t)
1285 (setq f (expand-file-name "themes" data-directory))))
1286 (if (file-directory-p f)
1287 (push f lpath)))
1288 (nreverse lpath)))
1289
46ce5feb
RS
1290\f
1291;;; Enabling and disabling loaded themes.
1292
87d737ae 1293(defun enable-theme (theme)
46ce5feb 1294 "Reenable all variable and face settings defined by THEME.
fccee4ab
CY
1295THEME should be either `user', or a theme loaded via `load-theme'.
1296After this function completes, THEME will have the highest
1297precedence (after `user')."
05d22d02
CY
1298 (interactive (list (intern
1299 (completing-read
1300 "Enable custom theme: "
fccee4ab 1301 obarray (lambda (sym) (get sym 'theme-settings)) t))))
d358aa10 1302 (if (not (custom-theme-p theme))
fccee4ab
CY
1303 (error "Undefined Custom theme %s" theme))
1304 (let ((settings (get theme 'theme-settings)))
1305 ;; Loop through theme settings, recalculating vars/faces.
1306 (dolist (s settings)
1307 (let* ((prop (car s))
1308 (symbol (cadr s))
1309 (spec-list (get symbol prop)))
1310 (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
1311 (cond
1312 ((eq prop 'theme-face)
1313 (custom-theme-recalc-face symbol))
1314 ((eq prop 'theme-value)
04482335
CY
1315 ;; Ignore `custom-enabled-themes' and `custom-safe-themes'.
1316 (unless (memq symbol '(custom-enabled-themes custom-safe-themes))
fccee4ab
CY
1317 (custom-theme-recalc-variable symbol)))))))
1318 (unless (eq theme 'user)
1319 (setq custom-enabled-themes
1320 (cons theme (delq theme custom-enabled-themes)))
1321 ;; Give the `user' theme the highest priority.
1322 (enable-theme 'user)))
b2a41d12
CY
1323
1324(defcustom custom-enabled-themes nil
1325 "List of enabled Custom Themes, highest precedence first.
fccee4ab
CY
1326This list does not include the `user' theme, which is set by
1327Customize and always takes precedence over other Custom Themes.
b2a41d12 1328
fccee4ab 1329This variable cannot be defined inside a Custom theme; there, it
658d8eb8
CY
1330is simply ignored.
1331
1332Setting this variable through Customize calls `enable-theme' or
1333`load-theme' for each theme in the list."
b2a41d12
CY
1334 :group 'customize
1335 :type '(repeat symbol)
928f4e73
CY
1336 :set-after '(custom-theme-directory custom-theme-load-path
1337 custom-safe-themes)
7fd8732d 1338 :risky t
b2a41d12 1339 :set (lambda (symbol themes)
fccee4ab
CY
1340 (let (failures)
1341 (setq themes (delq 'user (delete-dups themes)))
1342 ;; Disable all themes not in THEMES.
1343 (if (boundp symbol)
1344 (dolist (theme (symbol-value symbol))
1345 (if (not (memq theme themes))
1346 (disable-theme theme))))
1347 ;; Call `enable-theme' or `load-theme' on each of THEMES.
1348 (dolist (theme (reverse themes))
1349 (condition-case nil
1350 (if (custom-theme-p theme)
1351 (enable-theme theme)
1352 (load-theme theme))
1353 (error (setq failures (cons theme failures)
1354 themes (delq theme themes)))))
1355 (enable-theme 'user)
1356 (custom-set-default symbol themes)
1357 (if failures
1358 (message "Failed to enable theme: %s"
1359 (mapconcat 'symbol-name failures ", "))))))
b2a41d12 1360
d358aa10 1361(defsubst custom-theme-enabled-p (theme)
b2a41d12
CY
1362 "Return non-nil if THEME is enabled."
1363 (memq theme custom-enabled-themes))
46ce5feb 1364
87d737ae 1365(defun disable-theme (theme)
46ce5feb 1366 "Disable all variable and face settings defined by THEME.
b2a41d12 1367See `custom-enabled-themes' for a list of enabled themes."
d358aa10
CY
1368 (interactive (list (intern
1369 (completing-read
05d22d02 1370 "Disable custom theme: "
d358aa10
CY
1371 (mapcar 'symbol-name custom-enabled-themes)
1372 nil t))))
1373 (when (custom-theme-enabled-p theme)
8913f945
RS
1374 (let ((settings (get theme 'theme-settings)))
1375 (dolist (s settings)
05d22d02 1376 (let* ((prop (car s))
8913f945 1377 (symbol (cadr s))
05d22d02
CY
1378 (val (assq-delete-all theme (get symbol prop))))
1379 (put symbol prop val)
1380 (cond
1381 ((eq prop 'theme-value)
1382 (custom-theme-recalc-variable symbol))
1383 ((eq prop 'theme-face)
1384 ;; If the face spec specified by this theme is in the
1385 ;; saved-face property, reset that property.
1386 (when (equal (nth 3 s) (get symbol 'saved-face))
1485f4c0
CY
1387 (put symbol 'saved-face (and val (cadr (car val)))))))))
1388 ;; Recompute faces on all frames.
1389 (dolist (frame (frame-list))
1390 ;; We must reset the fg and bg color frame parameters, or
1391 ;; `face-set-after-frame-default' will use the existing
1392 ;; parameters, which could be from the disabled theme.
1393 (set-frame-parameter frame 'background-color
1394 (custom--frame-color-default
1395 frame :background "background" "Background"
1396 "unspecified-bg" "white"))
1397 (set-frame-parameter frame 'foreground-color
1398 (custom--frame-color-default
1399 frame :foreground "foreground" "Foreground"
1400 "unspecified-fg" "black"))
1401 (face-set-after-frame-default frame))
05d22d02
CY
1402 (setq custom-enabled-themes
1403 (delq theme custom-enabled-themes)))))
46ce5feb 1404
1485f4c0
CY
1405(defun custom--frame-color-default (frame attribute resource-attr resource-class
1406 tty-default x-default)
1407 (let ((col (face-attribute 'default attribute t)))
1408 (cond
1409 ((and col (not (eq col 'unspecified))) col)
1410 ((null (window-system frame)) tty-default)
1411 ((setq col (x-get-resource resource-attr resource-class)) col)
1412 (t x-default))))
1413
46ce5feb
RS
1414(defun custom-variable-theme-value (variable)
1415 "Return (list VALUE) indicating the custom theme value of VARIABLE.
1416That is to say, it specifies what the value should be according to
1417currently enabled custom themes.
1418
1419This function returns nil if no custom theme specifies a value for VARIABLE."
171fc304 1420 (let ((theme-value (get variable 'theme-value)))
46ce5feb 1421 (if theme-value
d358aa10 1422 (cdr (car theme-value)))))
46ce5feb 1423
46ce5feb
RS
1424(defun custom-theme-recalc-variable (variable)
1425 "Set VARIABLE according to currently enabled custom themes."
1426 (let ((valspec (custom-variable-theme-value variable)))
d358aa10
CY
1427 (if valspec
1428 (put variable 'saved-value valspec)
46ce5feb 1429 (setq valspec (get variable 'standard-value)))
d358aa10
CY
1430 (if (and valspec
1431 (or (get variable 'force-value)
1432 (default-boundp variable)))
1433 (funcall (or (get variable 'custom-set) 'set-default) variable
1434 (eval (car valspec))))))
46ce5feb
RS
1435
1436(defun custom-theme-recalc-face (face)
1437 "Set FACE according to currently enabled custom themes."
05d22d02
CY
1438 (if (get face 'face-alias)
1439 (setq face (get face 'face-alias)))
4983ddea
CY
1440 ;; Reset the faces for each frame.
1441 (dolist (frame (frame-list))
1442 (face-spec-recalc face frame)))
05d22d02 1443
46ce5feb 1444\f
9173deec 1445;;; XEmacs compatibility functions
d358aa10
CY
1446
1447;; In XEmacs, when you reset a Custom Theme, you have to specify the
1448;; theme to reset it to. We just apply the next available theme, so
1449;; just ignore the IGNORED arguments.
1450
e1bab181 1451(defun custom-theme-reset-variables (theme &rest args)
d358aa10 1452 "Reset some variable settings in THEME to their values in other themes.
46ce5feb 1453Each of the arguments ARGS has this form:
e1bab181 1454
d358aa10 1455 (VARIABLE IGNORED)
e1bab181 1456
7e8b9dc3 1457This means reset VARIABLE. (The argument IGNORED is ignored)."
e1bab181 1458 (custom-check-theme theme)
46ce5feb 1459 (dolist (arg args)
d358aa10 1460 (custom-push-theme 'theme-value (car arg) theme 'reset)))
e1bab181
RS
1461
1462(defun custom-reset-variables (&rest args)
d358aa10 1463 "Reset the specs of some variables to their values in other themes.
46ce5feb 1464This creates settings in the `user' theme.
e1bab181 1465
46ce5feb 1466Each of the arguments ARGS has this form:
e1bab181 1467
d358aa10 1468 (VARIABLE IGNORED)
e1bab181 1469
7e8b9dc3 1470This means reset VARIABLE. (The argument IGNORED is ignored)."
e1bab181
RS
1471 (apply 'custom-theme-reset-variables 'user args))
1472
55535639
PJ
1473;;; The End.
1474
1475;; Process the defcustoms for variables loaded before this file.
1476(while custom-declare-variable-list
1477 (apply 'custom-declare-variable (car custom-declare-variable-list))
1478 (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
1479
1480(provide 'custom)
1481
1482;;; custom.el ends here