custom.el 60.1 KB
Newer Older
1
;;; custom.el --- tools for declaring and initializing options  -*- lexical-binding: t -*-
2
;;
Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1996-1997, 1999, 2001-2019 Free Software Foundation,
4
;; Inc.
5 6
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
7
;; Maintainer: emacs-devel@gnu.org
8
;; Keywords: help, faces
9
;; Package: emacs
10 11 12

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
25 26 27

;;; Commentary:
;;
28
;; This file only contains the code needed to declare and initialize
29 30 31
;; user options.  The code to customize options is autoloaded from
;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual.

32
;; The code implementing face declarations is in `cus-face.el'.
33 34 35 36 37 38 39 40 41

;;; Code:

(require 'widget)

(defvar custom-define-hook nil
  ;; Customize information for this option is in `cus-edit.el'.
  "Hook called after defining each customize option.")

42 43 44 45 46
(defvar custom-dont-initialize nil
  "Non-nil means `defcustom' should not initialize the variable.
That is used for the sake of `custom-make-dependencies'.
Users should not set it.")

47 48 49
(defvar custom-current-group-alist nil
  "Alist of (FILE . GROUP) indicating the current group to use for FILE.")

50 51
;;; The `defcustom' Macro.

52 53
(defun custom-initialize-default (symbol exp)
  "Initialize SYMBOL with EXP.
54 55
This will do nothing if symbol already has a default binding.
Otherwise, if symbol has a `saved-value' property, it will evaluate
56
the car of that and use it as the default binding for symbol.
57
Otherwise, EXP will be evaluated and used as the default binding for
58
symbol."
59 60 61 62 63 64 65 66
  (condition-case nil
      (default-toplevel-value symbol)   ;Test presence of default value.
    (void-variable
     ;; The var is not initialized yet.
     (set-default-toplevel-value
      symbol (eval (let ((sv (get symbol 'saved-value)))
                     (if sv (car sv) exp))
                   t)))))
67

68 69
(defun custom-initialize-set (symbol exp)
  "Initialize SYMBOL based on EXP.
70 71 72
If the symbol doesn't have a default binding already,
then set it using its `:set' function (or `set-default' if it has none).
The value is either the value in the symbol's `saved-value' property,
73 74 75 76 77 78 79 80 81 82 83
if any, or the value of EXP."
  (condition-case nil
      (default-toplevel-value symbol)
    (error
     (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
              symbol
              (eval (let ((sv (get symbol 'saved-value)))
                      (if sv (car sv) exp)))))))

(defun custom-initialize-reset (symbol exp)
  "Initialize SYMBOL based on EXP.
84 85
Set the symbol, using its `:set' function (or `set-default' if it has none).
The value is either the symbol's current value
86
 (as obtained using the `:get' function), if any,
87
or the value in the symbol's `saved-value' property if any,
88 89
or (last of all) the value of EXP."
  (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
90
           symbol
91 92 93 94 95 96 97 98 99 100
           (condition-case nil
               (let ((def (default-toplevel-value symbol))
                     (getter (get symbol 'custom-get)))
                 (if getter (funcall getter symbol) def))
             (error
              (eval (let ((sv (get symbol 'saved-value)))
                      (if sv (car sv) exp)))))))

(defun custom-initialize-changed (symbol exp)
  "Initialize SYMBOL with EXP.
101 102 103
Like `custom-initialize-reset', but only use the `:set' function if
not using the standard setting.
For the standard setting, use `set-default'."
104 105 106 107 108 109 110 111 112 113 114 115 116 117
  (condition-case nil
      (let ((def (default-toplevel-value symbol)))
        (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
                 symbol
                 (let ((getter (get symbol 'custom-get)))
                   (if getter (funcall getter symbol) def))))
    (error
     (cond
      ((get symbol 'saved-value)
       (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
                symbol
                (eval (car (get symbol 'saved-value)))))
      (t
       (set-default symbol (eval exp)))))))
118

119 120 121
(defvar custom-delayed-init-variables nil
  "List of variables whose initialization is pending.")

122
(defun custom-initialize-delay (symbol _value)
123
  "Delay initialization of SYMBOL to the next Emacs start.
124 125 126 127 128 129 130 131 132
This is used in files that are preloaded (or for autoloaded
variables), so that the initialization is done in the run-time
context rather than the build-time context.  This also has the
side-effect that the (delayed) initialization is performed with
the :set function.

For variables in preloaded files, you can simply use this
function for the :initialize property.  For autoloaded variables,
you will also need to add an autoload stanza calling this
133 134 135
function, and another one setting the standard-value property.
Or you can wrap the defcustom in a progn, to force the autoloader
to include all of it."		   ; see eg vc-sccs-search-project-dir
136 137 138
  ;; No longer true:
  ;; "See `send-mail-function' in sendmail.el for an example."

139 140 141 142
  ;; Until the var is actually initialized, it is kept unbound.
  ;; This seemed to be at least as good as setting it to an arbitrary
  ;; value like nil (evaluating `value' is not an option because it
  ;; may have undesirable side-effects).
143 144
  (push symbol custom-delayed-init-variables))

145 146 147
(defun custom-declare-variable (symbol default doc &rest args)
  "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
DEFAULT should be an expression to evaluate to compute the default value,
148 149
not the default value itself.

150
DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property
151 152
`standard-value'.  At the same time, SYMBOL's property `force-value' is
set to nil, as the value is no longer rogue."
153
  (put symbol 'standard-value (purecopy (list default)))
154 155 156
  ;; Maybe this option was rogue in an earlier version.  It no longer is.
  (when (get symbol 'force-value)
    (put symbol 'force-value nil))
157 158
  (if (keywordp doc)
      (error "Doc string is missing"))
159
  (let ((initialize #'custom-initialize-reset)
160
	(requests nil))
161 162
    (unless (memq :group args)
      (custom-add-to-group (custom-current-group) symbol 'custom-variable))
163
    (while args
164 165
      (let ((keyword (pop args)))
	(unless (symbolp keyword)
166
	  (error "Junk in args %S" args))
167 168 169 170 171
        (unless args
          (error "Keyword %s is missing an argument" keyword))
	(let ((value (pop args)))
          ;; Can't use `pcase' because it is loaded after `custom.el'
          ;; during bootstrap.  See `loadup.el'.
172 173 174 175 176 177 178 179 180 181 182 183
	  (cond ((eq keyword :initialize)
		 (setq initialize value))
		((eq keyword :set)
		 (put symbol 'custom-set value))
		((eq keyword :get)
		 (put symbol 'custom-get value))
		((eq keyword :require)
		 (push value requests))
		((eq keyword :risky)
		 (put symbol 'risky-local-variable value))
		((eq keyword :safe)
		 (put symbol 'safe-local-variable value))
184 185 186 187 188
                ((eq keyword :local)
                 (when (memq value '(t permanent))
                   (make-variable-buffer-local symbol))
                 (when (eq value 'permanent)
                   (put symbol 'permanent-local t)))
189 190 191 192 193 194 195 196 197 198 199 200 201
		((eq keyword :type)
		 (put symbol 'custom-type (purecopy value)))
		((eq keyword :options)
		 (if (get symbol 'custom-options)
		     ;; Slow safe code to avoid duplicates.
		     (mapc (lambda (option)
			     (custom-add-option symbol option))
			   value)
		   ;; Fast code for the common case.
		   (put symbol 'custom-options (copy-sequence value))))
		(t
		 (custom-handle-keyword symbol keyword value
					'custom-variable))))))
202 203 204
    ;; Set the docstring, record the var on load-history, as well
    ;; as set the special-variable-p flag.
    (internal--define-uninitialized-variable symbol doc)
205 206
    (put symbol 'custom-requests requests)
    ;; Do the actual initialization.
207 208
    (unless custom-dont-initialize
      (funcall initialize symbol default)))
209 210 211
  (run-hooks 'custom-define-hook)
  symbol)

212 213
(defmacro defcustom (symbol standard doc &rest args)
  "Declare SYMBOL as a customizable variable.
214
SYMBOL is the variable name; it should not be quoted.
215 216
STANDARD is an expression specifying the variable's standard
value.  It should not be quoted.  It is evaluated once by
217
`defcustom', and the value is assigned to SYMBOL if the variable
218 219
is unbound.  The expression itself is also stored, so that
Customize can re-evaluate it later to get the standard value.
220 221
DOC is the variable documentation.

222 223 224 225 226
This macro uses `defvar' as a subroutine, which also marks the
variable as \"special\", so that it is always dynamically bound
even when `lexical-binding' is t.

The remaining arguments to `defcustom' should have the form
227 228 229 230 231

   [KEYWORD VALUE]...

The following keywords are meaningful:

Richard M. Stallman's avatar
Richard M. Stallman committed
232
:type	VALUE should be a widget type for editing the symbol's value.
233
	Every `defcustom' should specify a value for this keyword.
234
:options VALUE should be a list of valid members of the widget type.
235 236 237 238 239
:initialize
	VALUE should be a function used to initialize the
	variable.  It takes two arguments, the symbol and value
	given in the `defcustom' call.  The default is
	`custom-initialize-reset'.
240
:set	VALUE should be a function to set the value of the symbol
241 242 243 244
	when using the Customize user interface.  It takes two arguments,
	the symbol to set and the value to give it.  The function should
	not modify its value argument destructively.  The default choice
	of function is `set-default'.
245 246 247
:get	VALUE should be a function to extract the value of symbol.
	The function takes one argument, a symbol, and should return
	the current value for that symbol.  The default choice of function
Glenn Morris's avatar
Glenn Morris committed
248
	is `default-value'.
249 250
:require
	VALUE should be a feature symbol.  If you save a value
251
	for this option, then when your init file loads the value,
252
	it does (require VALUE) first.
253 254 255
:set-after VARIABLES
	Specifies that SYMBOL should be set after the list of variables
        VARIABLES when both have been customized.
256 257
:risky	Set SYMBOL's `risky-local-variable' property to VALUE.
:safe	Set SYMBOL's `safe-local-variable' property to VALUE.
258
        See Info node `(elisp) File Local Variables'.
259 260 261
:local  If VALUE is t, mark SYMBOL as automatically buffer-local.
        If VALUE is `permanent', also set SYMBOL's `permanent-local'
        property to t.
262 263 264

The following common keywords are also meaningful.

265
:group  VALUE should be a customization group.
266
        Add SYMBOL (or FACE with `defface') to that group.
267
:link LINK-DATA
268 269 270
        Include an external link after the documentation string for this
        item.  This is a sentence containing an active field which
        references some other documentation.
271

272
        There are several alternatives you can use for LINK-DATA:
273

274
        (custom-manual INFO-NODE)
275
             Link to an Info node; INFO-NODE is a string which specifies
276
             the node name, as in \"(emacs)Top\".
277

278
        (info-link INFO-NODE)
279 280
             Like `custom-manual' except that the link appears in the
             customization buffer with the Info node name.
281

282
        (url-link URL)
283
             Link to a web page; URL is a string which specifies the URL.
284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301

        (emacs-commentary-link LIBRARY)
             Link to the commentary section of LIBRARY.

        (emacs-library-link LIBRARY)
             Link to an Emacs Lisp LIBRARY file.

        (file-link FILE)
             Link to FILE.

        (function-link FUNCTION)
             Link to the documentation of FUNCTION.

        (variable-link VARIABLE)
             Link to the documentation of VARIABLE.

        (custom-group-link GROUP)
             Link to another customization GROUP.
302

303 304
        You can specify the text to use in the customization buffer by
        adding `:tag NAME' after the first element of the LINK-DATA; for
305
        example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the
306
        Emacs manual which appears in the buffer as `foo'.
307

308 309
        An item can have more than one external link; however, most items
        have none at all.
310 311 312 313
:version
        VALUE should be a string specifying that the variable was
        first introduced, or its default value was changed, in Emacs
        version VERSION.
314
:package-version
315
        VALUE should be a list with the form (PACKAGE . VERSION)
316 317
        specifying that the variable was first introduced, or its
        default value was changed, in PACKAGE version VERSION.  This
318 319
        keyword takes priority over :version.  For packages which
        are bundled with Emacs releases, the PACKAGE and VERSION
320
        must appear in the alist `customize-package-emacs-version-alist'.
321 322 323
        Since PACKAGE must be unique and the user might see it in an
        error message, a good choice is the official name of the
        package, such as MH-E or Gnus.
324 325
:tag LABEL
        Use LABEL, a string, instead of the item's name, to label the item
Pavel Janík's avatar
Pavel Janík committed
326
        in customization menus and buffers.
327 328
:load FILE
        Load file FILE (a string) before displaying this customization
329
        item.  Loading is done with `load', and only if the file is
330
        not already loaded.
331

Luc Teirlinck's avatar
Luc Teirlinck committed
332 333 334 335
If SYMBOL has a local binding, then this form affects the local
binding.  This is normally not what you want.  Thus, if you need
to load a file defining variables with this form, or with
`defvar' or `defconst', you should always load that file
336
_outside_ any bindings for these variables.  (`defvar' and
Luc Teirlinck's avatar
Luc Teirlinck committed
337 338
`defconst' behave similarly in this respect.)

339 340
See Info node `(elisp) Customization' in the Emacs Lisp manual
for more information."
341
  (declare (doc-string 3) (debug (name body)))
342 343 344
  ;; It is better not to use backquote in this file,
  ;; because that makes a bootstrapping problem
  ;; if you need to recompile all the Lisp files using interpreted code.
345 346 347
  `(custom-declare-variable
    ',symbol
    ,(if lexical-binding    ;FIXME: This is not reliable, but is all we have.
348 349 350 351 352 353 354
         ;; The STANDARD arg should be an expression that evaluates to
         ;; the standard value.  The use of `eval' for it is spread
         ;; over many different places and hence difficult to
         ;; eliminate, yet we want to make sure that the `standard'
         ;; expression is checked by the byte-compiler, and that
         ;; lexical-binding is obeyed, so quote the expression with
         ;; `lambda' rather than with `quote'.
355
         ``(funcall #',(lambda () ,standard))
356
       `',standard)
357 358
    ,doc
    ,@args))
359 360 361 362 363 364 365 366 367

;;; The `defface' Macro.

(defmacro defface (face spec doc &rest args)
  "Declare FACE as a customizable face that defaults to SPEC.
FACE does not need to be quoted.

Third argument DOC is the face documentation.

Chong Yidong's avatar
Chong Yidong committed
368
If FACE has been set with `custom-theme-set-faces', set the face
369 370
attributes as specified by that function, otherwise set the face
attributes according to SPEC.
371

372
The remaining arguments should have the form [KEYWORD VALUE]...
373 374
For a list of valid keywords, see the common keywords listed in
`defcustom'.
375

Chong Yidong's avatar
Chong Yidong committed
376
SPEC should be a \"face spec\", i.e., an alist of the form
377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423

   ((DISPLAY . ATTS)...)

where DISPLAY is a form specifying conditions to match certain
terminals and ATTS is a property list (ATTR VALUE ATTR VALUE...)
specifying face attributes and values for frames on those
terminals.  On each terminal, the first element with a matching
DISPLAY specification takes effect, and the remaining elements in
SPEC are disregarded.

As a special exception, in the first element of SPEC, DISPLAY can
be the special value `default'.  Then the ATTS in that element
act as defaults for all the following elements.

For backward compatibility, elements of SPEC can be written
as (DISPLAY ATTS) instead of (DISPLAY . ATTS).

Each DISPLAY can have the following values:
 - `default' (only in the first element).
 - The symbol t, which matches all terminals.
 - An alist of conditions.  Each alist element must have the form
   (REQ ITEM...).  A matching terminal must satisfy each
   specified condition by matching one of its ITEMs.  Each REQ
   must be one of the following:
   - `type' (the terminal type).
     Each ITEM must be one of the values returned by
     `window-system'.  Under X, additional allowed values are
     `motif', `lucid', `gtk' and `x-toolkit'.
   - `class' (the terminal's color support).
     Each ITEM should be one of `color', `grayscale', or `mono'.
   - `background' (what color is used for the background text)
     Each ITEM should be one of `light' or `dark'.
   - `min-colors' (the minimum number of supported colors)
     Each ITEM should be an integer, which is compared with the
     result of `display-color-cells'.
   - `supports' (match terminals supporting certain attributes).
     Each ITEM should be a list of face attributes.  See
     `display-supports-face-attributes-p' for more information on
     exactly how testing is done.

In the ATTS property list, possible attributes are `:family',
`:width', `:height', `:weight', `:slant', `:underline',
`:overline', `:strike-through', `:box', `:foreground',
`:background', `:stipple', `:inverse-video', and `:inherit'.

See Info node `(elisp) Faces' in the Emacs Lisp manual for more
information."
424
  (declare (doc-string 3))
425 426 427 428 429 430 431
  ;; It is better not to use backquote in this file,
  ;; because that makes a bootstrapping problem
  ;; if you need to recompile all the Lisp files using interpreted code.
  (nconc (list 'custom-declare-face (list 'quote face) spec doc) args))

;;; The `defgroup' Macro.

432 433 434
(defun custom-current-group ()
  (cdr (assoc load-file-name custom-current-group-alist)))

435 436 437
(defun custom-declare-group (symbol members doc &rest args)
  "Like `defgroup', but SYMBOL is evaluated as a normal argument."
  (while members
438
    (apply #'custom-add-to-group symbol (car members))
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
    (setq members (cdr members)))
  (when doc
    ;; This text doesn't get into DOC.
    (put symbol 'group-documentation (purecopy doc)))
  (while args
    (let ((arg (car args)))
      (setq args (cdr args))
      (unless (symbolp arg)
	(error "Junk in args %S" args))
      (let ((keyword arg)
	    (value (car args)))
	(unless args
	  (error "Keyword %s is missing an argument" keyword))
	(setq args (cdr args))
	(cond ((eq keyword :prefix)
454
	       (put symbol 'custom-prefix (purecopy value)))
455 456 457
	      (t
	       (custom-handle-keyword symbol keyword value
				      'custom-group))))))
458 459 460
  ;; Record the group on the `current' list.
  (let ((elt (assoc load-file-name custom-current-group-alist)))
    (if elt (setcdr elt symbol)
461
      (push (cons load-file-name symbol) custom-current-group-alist)))
462 463 464 465 466 467 468
  (run-hooks 'custom-define-hook)
  symbol)

(defmacro defgroup (symbol members doc &rest args)
  "Declare SYMBOL as a customization group containing MEMBERS.
SYMBOL does not need to be quoted.

Glenn Morris's avatar
Glenn Morris committed
469 470 471 472
Third argument DOC is the group documentation.  This should be a short
description of the group, beginning with a capital and ending with
a period.  Words other than the first should not be capitalized, if they
are not usually written so.
473 474 475 476

MEMBERS should be an alist of the form ((NAME WIDGET)...) where
NAME is a symbol and WIDGET is a widget for editing that symbol.
Useful widgets are `custom-variable' for editing variables,
Wieland Hoffmann's avatar
Wieland Hoffmann committed
477
`custom-face' for editing faces, and `custom-group' for editing groups.
478 479 480 481 482

The remaining arguments should have the form

   [KEYWORD VALUE]...

483 484
For a list of valid keywords, see the common keywords listed in
`defcustom'.
485

486 487
See Info node `(elisp) Customization' in the Emacs Lisp manual
for more information."
488
  (declare (doc-string 3))
489 490 491 492 493 494 495 496 497 498 499 500 501
  ;; It is better not to use backquote in this file,
  ;; because that makes a bootstrapping problem
  ;; if you need to recompile all the Lisp files using interpreted code.
  (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args))

(defun custom-add-to-group (group option widget)
  "To existing GROUP add a new OPTION of type WIDGET.
If there already is an entry for OPTION and WIDGET, nothing is done."
  (let ((members (get group 'custom-group))
	(entry (list option widget)))
    (unless (member entry members)
      (put group 'custom-group (nconc members (list entry))))))

502 503 504 505 506 507 508 509 510 511 512
(defun custom-group-of-mode (mode)
  "Return the custom group corresponding to the major or minor MODE.
If no such group is found, return nil."
  (or (get mode 'custom-mode-group)
      (if (or (get mode 'custom-group)
	      (and (string-match "-mode\\'" (symbol-name mode))
		   (get (setq mode (intern (substring (symbol-name mode)
						      0 (match-beginning 0))))
			'custom-group)))
	  mode)))

513 514 515 516 517
;;; Properties.

(defun custom-handle-all-keywords (symbol args type)
  "For customization option SYMBOL, handle keyword arguments ARGS.
Third argument TYPE is the custom option type."
518
  (unless (memq :group args)
519
    (custom-add-to-group (custom-current-group) symbol type))
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
  (while args
    (let ((arg (car args)))
      (setq args (cdr args))
      (unless (symbolp arg)
	(error "Junk in args %S" args))
      (let ((keyword arg)
	    (value (car args)))
	(unless args
	  (error "Keyword %s is missing an argument" keyword))
	(setq args (cdr args))
	(custom-handle-keyword symbol keyword value type)))))

(defun custom-handle-keyword (symbol keyword value type)
  "For customization option SYMBOL, handle KEYWORD with VALUE.
Fourth argument TYPE is the custom option type."
  (if purify-flag
      (setq value (purecopy value)))
  (cond ((eq keyword :group)
	 (custom-add-to-group value symbol type))
	((eq keyword :version)
	 (custom-add-version symbol value))
541 542
	((eq keyword :package-version)
	 (custom-add-package-version symbol value))
543 544 545 546 547 548 549 550 551 552 553 554 555 556
	((eq keyword :link)
	 (custom-add-link symbol value))
	((eq keyword :load)
	 (custom-add-load symbol value))
	((eq keyword :tag)
	 (put symbol 'custom-tag value))
	((eq keyword :set-after)
	 (custom-add-dependencies symbol value))
	(t
	 (error "Unknown keyword %s" keyword))))

(defun custom-add-dependencies (symbol value)
  "To the custom option SYMBOL, add dependencies specified by VALUE.
VALUE should be a list of symbols.  For each symbol in that list,
557 558
this specifies that SYMBOL should be set after the specified symbol,
if both appear in constructs like `custom-set-variables'."
559
  (unless (listp value)
560
    (error "Invalid custom dependency `%s'" value))
561 562 563 564 565
  (let* ((deps (get symbol 'custom-dependencies))
	 (new-deps deps))
    (while value
      (let ((dep (car value)))
	(unless (symbolp dep)
566
	  (error "Invalid custom dependency `%s'" dep))
567 568 569 570 571
	(unless (memq dep new-deps)
	  (setq new-deps (cons dep new-deps)))
	(setq value (cdr value))))
    (unless (eq deps new-deps)
      (put symbol 'custom-dependencies new-deps))))
572

573 574 575
(defun custom-add-option (symbol option)
  "To the variable SYMBOL add OPTION.

576 577 578 579
If SYMBOL's custom type is a hook, OPTION should be a hook member.
If SYMBOL's custom type is an alist, OPTION specifies a symbol
to offer to the user as a possible key in the alist.
For other custom types, this has no effect."
580 581 582
  (let ((options (get symbol 'custom-options)))
    (unless (member option options)
      (put symbol 'custom-options (cons option options)))))
583
(defalias 'custom-add-frequent-value 'custom-add-option)
584 585 586 587 588 589 590 591 592 593 594

(defun custom-add-link (symbol widget)
  "To the custom option SYMBOL add the link WIDGET."
  (let ((links (get symbol 'custom-links)))
    (unless (member widget links)
      (put symbol 'custom-links (cons (purecopy widget) links)))))

(defun custom-add-version (symbol version)
  "To the custom option SYMBOL add the version VERSION."
  (put symbol 'custom-version (purecopy version)))

595 596 597 598
(defun custom-add-package-version (symbol version)
  "To the custom option SYMBOL add the package version VERSION."
  (put symbol 'custom-package-version (purecopy version)))

599 600 601 602 603 604 605
(defun custom-add-load (symbol load)
  "To the custom option SYMBOL add the dependency LOAD.
LOAD should be either a library file name, or a feature name."
  (let ((loads (get symbol 'custom-loads)))
    (unless (member load loads)
      (put symbol 'custom-loads (cons (purecopy load) loads)))))

606 607 608 609
(defun custom-autoload (symbol load &optional noset)
  "Mark SYMBOL as autoloaded custom variable and add dependency LOAD.
If NOSET is non-nil, don't bother autoloading LOAD when setting the variable."
  (put symbol 'custom-autoload (if noset 'noset t))
610 611 612
  (custom-add-load symbol load))

(defun custom-variable-p (variable)
613 614 615 616
  "Return non-nil if VARIABLE is a customizable variable.
A customizable variable is either (i) a variable whose property
list contains a non-nil `standard-value' or `custom-autoload'
property, or (ii) an alias for another customizable variable."
617 618 619 620 621
  (when (symbolp variable)
    (setq variable (indirect-variable variable))
    (or (get variable 'standard-value)
	(get variable 'custom-autoload))))

622
(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
623

624 625 626 627 628
(defun custom-note-var-changed (variable)
  "Inform Custom that VARIABLE has been set (changed).
VARIABLE is a symbol that names a user option.
The result is that the change is treated as having been made through Custom."
  (put variable 'customized-value (list (custom-quote (eval variable)))))
629

630 631
;; Loading files needed to customize a symbol.
;; This is in custom.el because menu-bar.el needs it for toggle cmds.
632 633 634 635 636 637 638

(defvar custom-load-recursion nil
  "Hack to avoid recursive dependencies.")

(defun custom-load-symbol (symbol)
  "Load all dependencies for SYMBOL."
  (unless custom-load-recursion
639
    (let ((custom-load-recursion t))
640 641
      ;; Load these files if not already done,
      ;; to make sure we know all the dependencies of SYMBOL.
642 643 644 645
      (ignore-errors
        (require 'cus-load))
      (ignore-errors
        (require 'cus-start))
646
      (dolist (load (get symbol 'custom-loads))
647
        (cond ((symbolp load) (ignore-errors (require load)))
648
	      ;; This is subsumed by the test below, but it's much faster.
649 650 651 652
	      ((assoc load load-history))
	      ;; This was just (assoc (locate-library load) load-history)
	      ;; but has been optimized not to load locate-library
	      ;; if not necessary.
653 654 655
	      ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
				     "\\(\\'\\|\\.\\)"))
		     (found nil))
656
		 (dolist (loaded load-history)
657
		   (and (stringp (car loaded))
658
			(string-match-p regexp (car loaded))
659 660 661 662 663 664
			(setq found t)))
		 found))
	      ;; Without this, we would load cus-edit recursively.
	      ;; We are still loading it when we call this,
	      ;; and it is not in load-history yet.
	      ((equal load "cus-edit"))
665
              (t (ignore-errors (load load))))))))
666

667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696
(defvar custom-local-buffer nil
  "Non-nil, in a Customization buffer, means customize a specific buffer.
If this variable is non-nil, it should be a buffer,
and it means customize the local bindings of that buffer.
This variable is a permanent local, and it normally has a local binding
in every Customization buffer.")
(put 'custom-local-buffer 'permanent-local t)

(defun custom-set-default (variable value)
  "Default :set function for a customizable variable.
Normally, this sets the default value of VARIABLE to VALUE,
but if `custom-local-buffer' is non-nil,
this sets the local binding in that buffer instead."
  (if custom-local-buffer
      (with-current-buffer custom-local-buffer
	(set variable value))
    (set-default variable value)))

(defun custom-set-minor-mode (variable value)
  ":set function for minor mode variables.
Normally, this sets the default value of VARIABLE to nil if VALUE
is nil and to t otherwise,
but if `custom-local-buffer' is non-nil,
this sets the local binding in that buffer instead."
  (if custom-local-buffer
      (with-current-buffer custom-local-buffer
	(funcall variable (if value 1 0)))
    (funcall variable (if value 1 0))))

(defun custom-quote (sexp)
697
  "Quote SEXP if it is not self quoting."
698 699 700 701 702 703
  ;; Can't use `macroexp-quote' because it is loaded after `custom.el'
  ;; during bootstrap.  See `loadup.el'.
  (if (and (not (consp sexp))
           (or (keywordp sexp)
               (not (symbolp sexp))
               (booleanp sexp)))
704 705 706 707 708 709 710 711 712 713 714 715
      sexp
    (list 'quote sexp)))

(defun customize-mark-to-save (symbol)
  "Mark SYMBOL for later saving.

If the default value of SYMBOL is different from the standard value,
set the `saved-value' property to a list whose car evaluates to the
default value.  Otherwise, set it to nil.

To actually save the value, call `custom-save-all'.

716
Return non-nil if the `saved-value' property actually changed."
717
  (custom-load-symbol symbol)
718
  (let* ((get (or (get symbol 'custom-get) #'default-value))
719 720 721 722
	 (value (funcall get symbol))
	 (saved (get symbol 'saved-value))
	 (standard (get symbol 'standard-value))
	 (comment (get symbol 'customized-variable-comment)))
723
    ;; Save default value if different from standard value.
724 725 726 727
    (put symbol 'saved-value
         (unless (and standard
                      (equal value (ignore-errors (eval (car standard)))))
           (list (custom-quote value))))
728 729 730 731 732 733 734 735 736 737 738 739 740 741 742
    ;; Clear customized information (set, but not saved).
    (put symbol 'customized-value nil)
    ;; Save any comment that might have been set.
    (when comment
      (put symbol 'saved-variable-comment comment))
    (not (equal saved (get symbol 'saved-value)))))

(defun customize-mark-as-set (symbol)
  "Mark current value of SYMBOL as being set from customize.

If the default value of SYMBOL is different from the saved value if any,
or else if it is different from the standard value, set the
`customized-value' property to a list whose car evaluates to the
default value.  Otherwise, set it to nil.

743
Return non-nil if the `customized-value' property actually changed."
744
  (custom-load-symbol symbol)
745
  (let* ((get (or (get symbol 'custom-get) #'default-value))
746 747 748
	 (value (funcall get symbol))
	 (customized (get symbol 'customized-value))
	 (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
749
    ;; Mark default value as set if different from old value.
750
    (if (not (and old
751 752
                  (equal value (ignore-errors
                                 (eval (car old))))))
753 754 755
	(progn (put symbol 'customized-value (list (custom-quote value)))
	       (custom-push-theme 'theme-value symbol 'user 'set
				  (custom-quote value)))
756 757 758 759 760 761 762 763 764
      (put symbol 'customized-value nil))
    ;; Changed?
    (not (equal customized (get symbol 'customized-value)))))

(defun custom-reevaluate-setting (symbol)
  "Reset the value of SYMBOL by re-evaluating its saved or standard value.
Use the :set function to do so.  This is useful for customizable options
that are defined before their standard value can really be computed.
E.g. dumped variables whose default depends on run-time information."
765
  ;; If it has never been set at all, defvar it so as to mark it
Glenn Morris's avatar
Glenn Morris committed
766 767 768 769 770 771 772 773
  ;; special, etc (bug#25770).  This means we are initializing
  ;; the variable, and normally any :set function would not apply.
  ;; For custom-initialize-delay, however, it is documented that "the
  ;; (delayed) initialization is performed with the :set function".
  ;; This is needed by eg global-font-lock-mode, which uses
  ;; custom-initialize-delay but needs the :set function custom-set-minor-mode
  ;; to also run during initialization.  So, long story short, we
  ;; always do the funcall step, even if symbol was not bound before.
774
  (or (default-boundp symbol)
Glenn Morris's avatar
Glenn Morris committed
775
      (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
776
  (funcall (or (get symbol 'custom-set) #'set-default)
777 778
	   symbol
	   (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
779 780


781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826
;;; Custom Themes

;; Custom themes are collections of settings that can be enabled or
;; disabled as a unit.

;; Each Custom theme is defined by a symbol, called the theme name.
;; The `theme-settings' property of the theme name records the
;; variable and face settings of the theme.  This property is a list
;; of elements, each of the form
;;
;;     (PROP SYMBOL THEME VALUE)
;;
;;  - PROP is either `theme-value' or `theme-face'
;;  - SYMBOL is the face or variable name
;;  - THEME is the theme name (redundant, but simplifies the code)
;;  - VALUE is an expression that gives the theme's setting for SYMBOL.
;;
;; The theme name also has a `theme-feature' property, whose value is
;; specified when the theme is defined (see `custom-declare-theme').
;; Usually, this is just a symbol named THEME-theme.  This lets
;; external libraries call (require 'foo-theme).

;; In addition, each symbol (either a variable or a face) affected by
;; an *enabled* theme has a `theme-value' or `theme-face' property,
;; which is a list of elements each of the form
;;
;;     (THEME VALUE)
;;
;; which have the same meanings as in `theme-settings'.
;;
;; The `theme-value' and `theme-face' lists are ordered by decreasing
;; theme precedence.  Thus, the first element is always the one that
;; is in effect.

;; Each theme is stored in a theme file, with filename THEME-theme.el.
;; Loading a theme basically involves calling (load "THEME-theme")
;; This is done by the function `load-theme'.  Loading a theme
;; automatically enables it.
;;
;; When a theme is enabled, the `theme-value' and `theme-face'
;; properties for the affected symbols are set.  When a theme is
;; disabled, its settings are removed from the `theme-value' and
;; `theme-face' properties, but the theme's own `theme-settings'
;; property remains unchanged.

(defvar custom-known-themes '(user changed)
827
   "Themes that have been defined with `deftheme'.
828
The default value is the list (user changed).  The theme `changed'
829 830 831 832
contains the settings before custom themes are applied.  The theme
`user' contains all the settings the user customized and saved.
Additional themes declared with the `deftheme' macro will be added
to the front of this list.")
833 834 835 836 837 838 839 840

(defsubst custom-theme-p (theme)
  "Non-nil when THEME has been defined."
  (memq theme custom-known-themes))

(defsubst custom-check-theme (theme)
  "Check whether THEME is valid, and signal an error if it is not."
  (unless (custom-theme-p theme)
841
    (error "Unknown theme `%s'" theme)))
842

843 844 845 846 847
(defun custom--should-apply-setting (theme)
  (or (null custom--inhibit-theme-enable)
      (and (eq custom--inhibit-theme-enable 'apply-only-user)
           (eq theme 'user))))

848 849 850
(defun custom-push-theme (prop symbol theme mode &optional value)
  "Record VALUE for face or variable SYMBOL in custom theme THEME.
PROP is `theme-face' for a face, `theme-value' for a variable.
851 852 853

MODE can be either the symbol `set' or the symbol `reset'.  If it is the
symbol `set', then VALUE is the value to use.  If it is the symbol
854
`reset', then SYMBOL will be removed from THEME (VALUE is ignored).
855 856

See `custom-known-themes' for a list of known themes."
857
  (unless (memq prop '(theme-value theme-face))
858
    (error "Unknown theme property"))
859
  (let* ((old (get symbol prop))
860 861 862
	 (setting (assq theme old))  ; '(theme value)
	 (theme-settings             ; '(prop symbol theme value)
	  (get theme 'theme-settings)))
863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886
    (cond
     ;; Remove a setting:
     ((eq mode 'reset)
      (when setting
	(let (res)
	  (dolist (theme-setting theme-settings)
	    (if (and (eq (car  theme-setting) prop)
		     (eq (cadr theme-setting) symbol))
		(setq res theme-setting)))
	  (put theme 'theme-settings (delq res theme-settings)))
	(put symbol prop (delq setting old))))
     ;; Alter an existing setting:
     (setting
      (let (res)
	(dolist (theme-setting theme-settings)
	  (if (and (eq (car  theme-setting) prop)
		   (eq (cadr theme-setting) symbol))
	      (setq res theme-setting)))
	(put theme 'theme-settings
	     (cons (list prop symbol theme value)
		   (delq res theme-settings)))
	(setcar (cdr setting) value)))
     ;; Add a new setting:
     (t
887
      (when (custom--should-apply-setting theme)
888 889 890 891 892 893 894 895 896 897 898 899 900 901
	(unless old
	  ;; If the user changed a variable outside of Customize, save
	  ;; the value to a fake theme, `changed'.  If the theme is
	  ;; later disabled, we use this to bring back the old value.
	  ;;
	  ;; For faces, we just use `face-new-frame-defaults' to
	  ;; recompute when the theme is disabled.
	  (when (and (eq prop 'theme-value)
		     (boundp symbol))
	    (let ((sv  (get symbol 'standard-value))
		  (val (symbol-value symbol)))
	      (unless (and sv (equal (eval (car sv)) val))
		(setq old `((changed ,(custom-quote val))))))))
	(put symbol prop (cons (list theme value) old)))
902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930
      (put theme 'theme-settings
	   (cons (list prop symbol theme value) theme-settings))))))

(defun custom-fix-face-spec (spec)
  "Convert face SPEC, replacing obsolete :bold and :italic attributes.
Also change :reverse-video to :inverse-video."
  (when (listp spec)
    (if (or (memq :bold spec)
	    (memq :italic spec)
	    (memq :inverse-video spec))
	(let (result)
	  (while spec
	    (let ((key (car spec))
		  (val (car (cdr spec))))
	      (cond ((eq key :italic)
		     (push :slant result)
		     (push (if val 'italic 'normal) result))
		    ((eq key :bold)
		     (push :weight result)
		     (push (if val 'bold 'normal) result))
		    ((eq key :reverse-video)
		     (push :inverse-video result)
		     (push val result))
		    (t
		     (push key result)
		     (push val result))))
	    (setq spec (cddr spec)))
	  (nreverse result))
      spec)))
931

932
(defun custom-set-variables (&rest args)
933 934
  "Install user customizations of variable values specified in ARGS.
These settings are registered as theme `user'.
935
The arguments should each be a list of the form:
936

937
  (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
938

939 940 941
This stores EXP (without evaluating it) as the saved value for SYMBOL.
If NOW is present and non-nil, then also evaluate EXP and set
the default value for the SYMBOL to the value of EXP.
942

943 944
REQUEST is a list of features we must require in order to
handle SYMBOL properly.
945
COMMENT is a comment string about SYMBOL."
946
  (apply #'custom-theme-set-variables 'user args))
947 948

(defun custom-theme-set-variables (theme &rest args)
949 950
  "Initialize variables for theme THEME according to settings in ARGS.
Each of the arguments in ARGS should be a list of this form:
951

952
  (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
953

954 955 956 957
SYMBOL is the variable name, and EXP is an expression which
evaluates to the customized value.  EXP will also be stored,
without evaluating it, in SYMBOL's `saved-value' property, so
that it can be restored via the Customize interface.  It is also
958
added to the alist in SYMBOL's `theme-value' property (by
959
calling `custom-push-theme').
960

961 962 963 964 965 966
NOW, if present and non-nil, means to install the variable's
value directly now, even if its `defcustom' declaration has not
been executed.  This is for internal use only.

REQUEST is a list of features to `require' (which are loaded
prior to evaluating EXP).
967

968
COMMENT is a comment string about SYMBOL."
969
  (custom-check-theme theme)
970 971 972 973 974 975 976 977 978
  ;; Process all the needed autoloads before anything else, so that the
  ;; subsequent code has all the info it needs (e.g. which var corresponds
  ;; to a minor mode), regardless of the ordering of the variables.
  (dolist (entry args)
    (let* ((symbol (indirect-variable (nth 0 entry))))
      (unless (or (get symbol 'standard-value)
                  (memq (get symbol 'custom-autoload) '(nil noset)))
        ;; This symbol needs to be autoloaded, even just for a `set'.
        (custom-load-symbol symbol))))
979
  (setq args (custom--sort-vars args))
980 981 982 983 984 985
  (dolist (entry args)
    (unless (listp entry)
      (error "Incompatible Custom theme spec"))
    (let* ((symbol (indirect-variable (nth 0 entry)))
	   (value (nth 1 entry)))
      (custom-push-theme 'theme-value symbol theme 'set value)
986
      (when (custom--should-apply-setting theme)
987 988 989 990 991 992 993
	;; Now set the variable.
	(let* ((now (nth 2 entry))
	       (requests (nth 3 entry))
	       (comment (nth 4 entry))
	       set)
	  (when requests
	    (put symbol 'custom-requests requests)
994 995
            (mapc #'require requests))
          (setq set (or (get symbol 'custom-set) #'custom-set-default))
996
	  (put symbol 'saved-value (list value))
997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011
	  (put symbol 'saved-variable-comment comment)
	  ;; Allow for errors in the case where the setter has
	  ;; changed between versions, say, but let the user know.
	  (condition-case data
	      (cond (now
		     ;; Rogue variable, set it now.
		     (put symbol 'force-value t)
		     (funcall set symbol (eval value)))
		    ((default-boundp symbol)
		     ;; Something already set this, overwrite it.
		     (funcall set symbol (eval value))))
	    (error
	     (message "Error setting %s: %s" symbol data)))
	  (and (or now (default-boundp symbol))
	       (put symbol 'variable-comment comment)))))))
1012

1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058
(defvar custom--sort-vars-table)
(defvar custom--sort-vars-result)

(defun custom--sort-vars (vars)
  "Sort VARS based on custom dependencies.
VARS is a list whose elements have the same form as the ARGS
arguments to `custom-theme-set-variables'.  Return the sorted
list, in which A occurs before B if B was defined with a
`:set-after' keyword specifying A (see `defcustom')."
  (let ((custom--sort-vars-table (make-hash-table))
	(dependants (make-hash-table))
	(custom--sort-vars-result nil)
	last)
    ;; Construct a pair of tables keyed with the symbols of VARS.
    (dolist (var vars)
      (puthash (car var) (cons t var) custom--sort-vars-table)
      (puthash (car var) var dependants))
    ;; From the second table, remove symbols that are depended-on.
    (dolist (var vars)
      (dolist (dep (get (car var) 'custom-dependencies))
	(remhash dep dependants)))
    ;; If a variable is "stand-alone", put it last if it's a minor
    ;; mode or has a :require flag.  This is not really necessary, but
    ;; putting minor modes last helps ensure that the mode function
    ;; sees other customized values rather than default values.
    (maphash (lambda (sym var)
	       (when (and (null (get sym 'custom-dependencies))
			  (or (nth 3 var)
			      (eq (get sym 'custom-set)
				  'custom-set-minor-mode)))
		 (remhash sym dependants)
		 (push var last)))
	     dependants)
    ;; The remaining symbols depend on others but are not
    ;; depended-upon.  Do a depth-first topological sort.
    (maphash #'custom--sort-vars-1 dependants)
    (nreverse (append last custom--sort-vars-result))))

(defun custom--sort-vars-1 (sym &optional _ignored)
  (let ((elt (gethash sym custom--sort-vars-table)))
    ;; The car of the hash table value is nil if the variable has
    ;; already been processed, `dependant' if it is a dependant in the
    ;; current graph descent, and t otherwise.
    (when elt
      (cond
       ((eq (car elt) 'dependant)
1059
	(error "Circular custom dependency on `%s'" sym))
1060 1061 1062 1063 1064 1065 1066
       ((car elt)
	(setcar elt 'dependant)
	(dolist (dep (get sym 'custom-dependencies))
	  (custom--sort-vars-1 dep))
	(setcar elt nil)
	(push (cdr elt) custom--sort-vars-result))))))

1067 1068 1069

;;; Defining themes.

1070 1071
;; A theme file is named `THEME-theme.el' (where THEME is the theme
;; name) found in `custom-theme-load-path'.  It has this format:
1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084
;;
;;   (deftheme THEME
;;     DOCSTRING)
;;
;;   (custom-theme-set-variables
;;    'THEME
;;    [THEME-VARIABLES])
;;
;;   (custom-theme-set-faces
;;    'THEME
;;    [THEME-FACES])
;;
;;   (provide-theme 'THEME)
1085 1086


1087 1088 1089
;; The IGNORED arguments to deftheme come from the XEmacs theme code, where
;; they were used to supply keyword-value pairs like `:immediate',
;; `:variable-reset-string', etc.  We don't use any of these, so ignore them.
1090

1091
(defmacro deftheme (theme &optional doc &rest _ignored)
1092 1093
  "Declare THEME to be a Custom theme.
The optional argument DOC is a doc string describing the theme.
1094 1095 1096

Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
1097 1098
  (declare (doc-string 2)
           (advertised-calling-convention (theme &optional doc) "22.1"))
1099 1100 1101 1102
  (let ((feature (custom-make-theme-feature theme)))
    ;; It is better not to use backquote in this file,
    ;; because that makes a bootstrapping problem
    ;; if you need to recompile all the Lisp files using interpreted code.
1103
    (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
1104

1105
(defun custom-declare-theme (theme feature &optional doc &rest _ignored)
1106
  "Like `deftheme', but THEME is evaluated as a normal argument.
1107 1108
FEATURE is the feature this theme provides.  Normally, this is a symbol
created from THEME by `custom-make-theme-feature'."
1109
  (declare (advertised-calling-convention (theme feature &optional doc) "22.1"))
1110 1111
  (unless (custom-theme-name-valid-p theme)
    (error "Custom theme cannot be named %S" theme))
1112 1113
  (unless (memq theme custom-known-themes)
    (push theme custom-known-themes))
1114
  (put theme 'theme-feature feature)
1115
  (when doc (put theme 'theme-documentation doc)))
1116 1117 1118 1119 1120 1121 1122 1123 1124

(defun custom-make-theme-feature (theme)
  "Given a symbol THEME, create a new symbol by appending \"-theme\".
Store this symbol in the `theme-feature' property of THEME.
Calling `provide-theme' to provide THEME actually puts `THEME-theme'
into `features'.

This allows for a file-name convention for autoloading themes:
Every theme X has a property `provide-theme' whose value is \"X-theme\".
Chong Yidong's avatar
Chong Yidong committed
1125
\(load-theme X) then attempts to load the file `X-theme.el'."
1126 1127 1128 1129
  (intern (concat (symbol-name theme) "-theme")))

;;; Loading themes.

1130 1131 1132 1133 1134
(defcustom custom-theme-directory user-emacs-directory
  "Default user directory for storing custom theme files.
The command `customize-create-theme' writes theme files into this
directory.  By default, Emacs searches for custom themes in this
directory first---see `custom-theme-load-path'."
1135 1136 1137 1138
  :type 'string
  :group 'customize
  :version "22.1")

1139
(defvar custom-theme-load-path (list 'custom-theme-directory t)
1140
  "List of directories to search for custom theme files.
1141 1142
When loading custom themes (e.g. in `customize-themes' and
`load-theme'), Emacs searches for theme files in the specified
1143
order.  Each element in the list should be one of the following:
1144 1145 1146 1147
- the symbol `custom-theme-directory', meaning the value of
  `custom-theme-directory'.
- the symbol t, meaning the built-in theme directory (a directory
  named \"themes\" in `data-directory').
1148 1149
- a directory name (a string).

1150
Each theme file is named THEME-theme.el, where THEME is the theme
1151 1152 1153 1154 1155
name.

This variable is designed for use in lisp code (including
external packages).  For manual user customizations, use
`custom-theme-directory' instead.")
1156

1157
(defvar custom--inhibit-theme-enable 'apply-only-user
1158 1159 1160
  "Whether the custom-theme-set-* functions act immediately.
If nil, `custom-theme-set-variables' and `custom-theme-set-faces'
change the current values of the given variable or face.  If
1161 1162 1163
t, they just make a record of the theme settings.  If the
value is `apply-only-user', then apply setting to the
`user' theme immediately and defer other updates.")
1164

1165
(defun provide-theme (theme)
1166 1167 1168 1169
  "Indicate that this file provides THEME.
This calls `provide' to provide the feature name stored in THEME's
property `theme-feature' (which is usually a symbol created by
`custom-make-theme-feature')."
1170 1171
  (unless (custom-theme-name-valid-p theme)
    (error "Custom theme cannot be named %S" theme))
1172
  (custom-check-theme theme)
1173
  (provide (get theme 'theme-feature)))
1174

1175
(defcustom custom-safe-themes '(default)
1176
  "Themes that are considered safe to load.
1177
If the value is a list, each element should be either the SHA-256
1178 1179 1180 1181
hash of a safe theme file, or the symbol `default', which stands
for any theme in the built-in Emacs theme directory (a directory
named \"themes\" in `data-directory').

1182 1183 1184
If the value is t, Emacs treats all themes as safe.

This variable cannot be set in a Custom theme."
1185 1186 1187 1188
  :type '(choice (repeat :tag "List of safe themes"
			 (choice string
				 (const :tag "Built-in themes" default)))
		 (const :tag "All themes" t))
1189
  :group 'customize
1190
  :risky t
1191 1192
  :version "24.1")

1193
(defun load-theme (theme &optional no-confirm no-enable)
1194
  "Load Custom theme named THEME from its file and possibly enable it.
1195 1196
The theme file is named THEME-theme.el, in one of the directories
specified by `custom-theme-load-path'.
1197

1198 1199 1200 1201
If the theme is not considered safe by `custom-safe-themes',
prompt the user for confirmation before loading it.  But if
optional arg NO-CONFIRM is non-nil, load the theme without
prompting.
1202

1203 1204 1205
Normally, this function also enables THEME.  If optional arg
NO-ENABLE is non-nil, load the theme but don't enable it, unless
the theme was already enabled.
1206

1207 1208 1209 1210 1211
Note that enabling THEME does not disable any other
already-enabled themes.  If THEME is enabled, it has the highest
precedence (after `user') among enabled themes.  To disable other
themes, use `disable-theme'.

1212 1213 1214 1215 1216
This function is normally called through Customize when setting
`custom-enabled-themes'.  If used directly in your init file, it
should be called with a non-nil NO-CONFIRM argument, or after
`custom-safe-themes' has been loaded.

1217
Return t if THEME was successfully loaded, nil otherwise."
1218 1219 1220
  (interactive
   (list
    (intern (completing-read "Load custom theme: "
1221
                             (mapcar #'symbol-name
1222 1223
				     (custom-available-themes))))
    nil nil))
1224
  (unless (custom-theme-name-valid-p theme)
1225
    (error "Invalid theme name `%s'" theme))
1226 1227 1228 1229
  ;; If THEME is already enabled, re-enable it after loading, even if
  ;; NO-ENABLE is t.
  (if no-enable
      (setq no-enable (not (custom-theme-enabled-p theme))))
1230 1231 1232 1233 1234 1235
  ;; If reloading, clear out the old theme settings.
  (when (custom-theme-p theme)
    (disable-theme theme)
    (put theme 'theme-settings nil)
    (put theme 'theme-feature nil)
    (put theme 'theme-documentation nil))
1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276
  (let ((file (locate-file (concat (symbol-name theme) "-theme.el")
                           (custom-theme--load-path)
                           '("" "c")))
        (custom--inhibit-theme-enable t))
    ;; Check file safety with `custom-safe-themes', prompting the
    ;; user if necessary.
    (cond ((not file)
           (error "Unable to find theme file for `%s'" theme))
          ((or no-confirm
               (eq custom-safe-themes t)
               (and (memq 'default custom-safe-themes)
                    (equal (file-name-directory file)
                           (expand-file-name "themes/" data-directory))))
           ;; Theme is safe; load byte-compiled version if available.
           (load (file-name-sans-extension file) nil t nil t))
          ((with-temp-buffer
             (insert-file-contents file)
             (let ((hash (secure-hash 'sha256 (current-buffer))))
               (when (or (member hash custom-safe-themes)
                         (custom-theme-load-confirm hash))
                 (eval-buffer nil nil file)
                 t))))
          (t
           (error "Unable to load theme `%s'" theme))))
  ;; Optimization: if the theme changes the `default' face, put that
  ;; entry first.  This avoids some `frame-set-background-mode' rigmarole
  ;; by assigning the new background immediately.
  (let* ((settings (get theme 'theme-settings))
         (tail settings)
         found)
    (while (and tail (not found))
      (and (eq (nth 0 (car tail)) 'theme-face)
           (eq (nth 1 (car tail)) 'default)
           (setq found (car tail)))
      (setq tail (cdr tail)))
    (when found
      (put theme 'theme-settings (cons found (delq found settings)))))
  ;; Finally, enable the theme.
  (unless no-enable
    (enable-theme theme))
  t)
1277 1278 1279 1280 1281

(defun custom-theme-load-confirm (hash)
  "Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer.  If the user agrees,
query also about adding HASH to `custom-safe-themes'."
Chong Yidong's avatar
Chong Yidong committed
1282 1283 1284 1285
  (unless noninteractive
    (save-window-excursion
      (rename-buffer "*Custom Theme*" t)
      (emacs-lisp-mode)
1286
      (pop-to-buffer (current-buffer))
Chong Yidong's avatar
Chong Yidong committed
1287 1288 1289 1290 1291 1292 1293 1294
      (goto-char (point-min))
      (prog1 (when (y-or-n-p "Loading a theme can run Lisp code.  Really load? ")
	       ;; Offer to save to `custom-safe-themes'.
	       (and (or custom-file user-init-file)
		    (y-or-n-p "Treat this theme as safe in future sessions? ")
		    (customize-push-and-save 'custom-safe-themes (list hash)))
	       t)
	(quit-window)))))
1295 1296 1297 1298

(defun custom-theme-name-valid-p (name)
  "Return t if NAME is a valid name for a Custom theme, nil otherwise.
NAME should be a symbol."
1299 1300 1301
  (and (not (memq name '(nil user changed)))
       (symbolp name)
       (not (string= "" (symbol-name name)))))
1302 1303

(defun custom-available-themes ()
1304 1305 1306 1307 1308 1309 1310 1311
  "Return a list of Custom themes available for loading.
Search the directories specified by `custom-theme-load-path' for
files named FOO-theme.el, and return a list of FOO symbols.

The returned symbols may not correspond to themes that have been
loaded, and no effort is made to check that the files contain
valid Custom themes.  For a list of loaded themes, check the
variable `custom-known-themes'."
1312 1313
  (let ((suffix "-theme\\.el\\'")
        themes)
1314
    (dolist (dir (custom-theme--load-path))
1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325
      ;; `custom-theme--load-path' promises DIR exists and is a
      ;; directory, but `custom.el' is loaded too early during
      ;; bootstrap to use `cl-lib' macros, so guard with
      ;; `file-directory-p' instead of calling `cl-assert'.
      (dolist (file (and (file-directory-p dir)
                         (directory-files dir nil suffix)))
        (let ((theme (intern (substring file 0 (string-match-p suffix file)))))
          (and (custom-theme-name-valid-p theme)
               (not (memq theme themes))
               (push theme themes)))))
    (nreverse themes)))
1326 1327

(defun custom-theme--load-path ()
1328 1329 1330
  "Expand `custom-theme-load-path' into a list of directories.
Members of `custom-theme-load-path' that either don't exist or
are not directories are omitted from the expansion."
1331 1332 1333 1334 1335 1336 1337 1338 1339 1340
  (let (lpath)
    (dolist (f custom-theme-load-path)
      (cond ((eq f 'custom-theme-directory)
	     (setq f custom-theme-directory))
	    ((eq f t)
	     (setq f (expand-file-name "themes" data-directory))))
      (if (file-directory-p f)
	  (push f lpath)))
    (nreverse lpath)))

1341 1342 1343

;;; Enabling and disabling loaded themes.

Chong Yidong's avatar
Chong Yidong committed
1344
(defun enable-theme (theme)
1345
  "Reenable all variable and face settings defined by THEME.
1346
THEME should be either `user', or a theme loaded via `load-theme'.
1347

1348
After this function completes, THEME will have the highest
1349 1350 1351 1352
precedence (after `user') among enabled themes.

Note that any already-enabled themes remain enabled after this
function runs.  To disable other themes, use `disable-theme'."
1353 1354 1355
  (interactive (list (intern
		      (completing-read
		       "Enable custom theme: "
1356
		       obarray (lambda (sym) (get sym 'theme-settings)) t))))
1357 1358
  (unless (custom-theme-p theme)
    (error "Undefined Custom theme %s" theme))
1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369
  (let ((settings (get theme 'theme-settings)))
    ;; Loop through theme settings, recalculating vars/faces.
    (dolist (s settings)
      (let* ((prop (car s))
	     (symbol (cadr s))
	     (spec-list (get symbol prop)))
	(put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
	(cond
	 ((eq prop 'theme-face)
	  (custom-theme-recalc-face symbol))
	 ((eq prop 'theme-value)
1370 1371
	  ;; Ignore `custom-enabled-themes' and `custom-safe-themes'.
	  (unless (memq symbol '(custom-enabled-themes custom-safe-themes))
1372 1373 1374 1375 1376 1377
	    (custom-theme-recalc-variable symbol)))))))
  (unless (eq theme 'user)
    (setq custom-enabled-themes
	  (cons theme (delq theme custom-enabled-themes)))
    ;; Give the `user' theme the highest priority.
    (enable-theme 'user)))