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