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