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