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