;;; custom.el --- tools for declaring and initializing options
;;
-;; Copyright (C) 1996-1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999, 2001-2016 Free Software Foundation,
+;; Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
;;; The `defcustom' Macro.
-(defun custom-initialize-default (symbol value)
- "Initialize SYMBOL with VALUE.
+(defun custom-initialize-default (symbol exp)
+ "Initialize SYMBOL with EXP.
This will do nothing if symbol already has a default binding.
Otherwise, if symbol has a `saved-value' property, it will evaluate
the car of that and use it as the default binding for symbol.
-Otherwise, VALUE will be evaluated and used as the default binding for
+Otherwise, EXP will be evaluated and used as the default binding for
symbol."
- (eval `(defvar ,symbol ,(if (get symbol 'saved-value)
- (car (get symbol 'saved-value))
- value))))
+ (eval `(defvar ,symbol ,(let ((sv (get symbol 'saved-value)))
+ (if sv (car sv) exp)))))
-(defun custom-initialize-set (symbol value)
- "Initialize SYMBOL based on VALUE.
+(defun custom-initialize-set (symbol exp)
+ "Initialize SYMBOL based on EXP.
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,
-if any, or VALUE."
- (unless (default-boundp symbol)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (eval (if (get symbol 'saved-value)
- (car (get symbol 'saved-value))
- value)))))
-
-(defun custom-initialize-reset (symbol value)
- "Initialize SYMBOL based on VALUE.
+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.
Set the symbol, using its `:set' function (or `set-default' if it has none).
The value is either the symbol's current value
- \(as obtained using the `:get' function), if any,
+ (as obtained using the `:get' function), if any,
or the value in the symbol's `saved-value' property if any,
-or (last of all) VALUE."
- (funcall (or (get symbol 'custom-set) 'set-default)
+or (last of all) the value of EXP."
+ (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
symbol
- (cond ((default-boundp symbol)
- (funcall (or (get symbol 'custom-get) 'default-value)
- symbol))
- ((get symbol 'saved-value)
- (eval (car (get symbol 'saved-value))))
- (t
- (eval value)))))
-
-(defun custom-initialize-changed (symbol value)
- "Initialize SYMBOL with VALUE.
+ (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.
Like `custom-initialize-reset', but only use the `:set' function if
not using the standard setting.
For the standard setting, use `set-default'."
- (cond ((default-boundp symbol)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (funcall (or (get symbol 'custom-get) 'default-value)
- symbol)))
- ((get symbol 'saved-value)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (eval (car (get symbol 'saved-value)))))
- (t
- (set-default symbol (eval value)))))
+ (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)))))))
(defvar custom-delayed-init-variables nil
"List of variables whose initialization is pending.")
function for the :initialize property. For autoloaded variables,
you will also need to add an autoload stanza calling this
function, and another one setting the standard-value property.
-See `send-mail-function' in sendmail.el for an example."
+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
+ ;; No longer true:
+ ;; "See `send-mail-function' in sendmail.el for an example."
+
;; 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
(unless (memq :group args)
(custom-add-to-group (custom-current-group) symbol 'custom-variable))
(while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
+ (let ((keyword (pop args)))
+ (unless (symbolp keyword)
(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))
+ (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'.
(cond ((eq keyword :initialize)
(setq initialize value))
((eq keyword :set)
(run-hooks 'custom-define-hook)
symbol)
-(defmacro defcustom (symbol value doc &rest args)
- "Declare SYMBOL as a customizable variable that defaults to VALUE.
+(defmacro defcustom (symbol standard doc &rest args)
+ "Declare SYMBOL as a customizable variable.
+SYMBOL is the variable name; it should not be quoted.
+STANDARD is an expression specifying the variable's standard
+value. It should not be quoted. It is evaluated once by
+`defcustom', and the value is assigned to SYMBOL if the variable
+is unbound. The expression itself is also stored, so that
+Customize can re-evaluate it later to get the standard value.
DOC is the variable documentation.
-Neither SYMBOL nor VALUE need to be quoted.
-If SYMBOL is not already bound, initialize it to VALUE.
-The remaining arguments should have the form
+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
[KEYWORD VALUE]...
The following keywords are meaningful:
:type VALUE should be a widget type for editing the symbol's value.
+ Every `defcustom' should specify a value for this keyword.
:options VALUE should be a list of valid members of the widget type.
: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'.
-:set VALUE should be a function to set the value of the symbol.
- It takes two arguments, the symbol to set and the value to
- give it. The default choice of function is `set-default'.
+:set VALUE should be a function to set the value of the symbol
+ 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'.
: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
is `default-value'.
:require
VALUE should be a feature symbol. If you save a value
- for this option, then when your `.emacs' file loads the value,
+ for this option, then when your init file loads the value,
it does (require VALUE) first.
+:set-after VARIABLES
+ Specifies that SYMBOL should be set after the list of variables
+ VARIABLES when both have been customized.
:risky Set SYMBOL's `risky-local-variable' property to VALUE.
:safe Set SYMBOL's `safe-local-variable' property to VALUE.
+ See Info node `(elisp) File Local Variables'.
The following common keywords are also meaningful.
Load file FILE (a string) before displaying this customization
item. Loading is done with `load', and only if the file is
not already loaded.
-:set-after VARIABLES
- Specifies that SYMBOL should be set after the list of variables
- VARIABLES when both have been customized.
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
-_outside_ any bindings for these variables. \(`defvar' and
+_outside_ any bindings for these variables. (`defvar' and
`defconst' behave similarly in this respect.)
See Info node `(elisp) Customization' in the Emacs Lisp manual
`(custom-declare-variable
',symbol
,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
- ;; The `default' arg should be an expression that evaluates to
- ;; the value to use. 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 `value' expression is checked by the
- ;; byte-compiler, and that lexical-binding is obeyed, so quote the
- ;; expression with `lambda' rather than with `quote'.
- `(list (lambda () ,value))
- `',value)
+ ;; 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'.
+ ``(funcall #',(lambda () ,standard))
+ `',standard)
,doc
,@args))
Third argument DOC is the face documentation.
-If FACE has been set with `custom-set-faces', set the face attributes
-as specified by that function, otherwise set the face attributes
-according to SPEC.
-
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
+If FACE has been set with `custom-theme-set-faces', set the face
+attributes as specified by that function, otherwise set the face
+attributes according to SPEC.
+The remaining arguments should have the form [KEYWORD VALUE]...
For a list of valid keywords, see the common keywords listed in
`defcustom'.
-SPEC should be an alist of the form ((DISPLAY ATTS)...).
-
-In the first element, DISPLAY can be `default'. The ATTS in that
-element then act as defaults for all the following elements.
-
-Aside from that, DISPLAY specifies conditions to match some or
-all frames. For each frame, the first element of SPEC where the
-DISPLAY conditions are satisfied is the one that applies to that
-frame. The ATTRs in this element take effect, and the following
-elements are ignored, on that frame.
-
-In the last element, DISPLAY can be t. That element applies to a
-frame if none of the previous elements (except the `default' if
-any) did.
-
-ATTS is a list of face attributes followed by their values:
- (ATTR VALUE ATTR VALUE...)
-
-The possible attributes are `:family', `:width', `:height', `:weight',
-`:slant', `:underline', `:overline', `:strike-through', `:box',
-`:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'.
-
-DISPLAY can be `default' (only in the first element), the symbol
-t (only in the last element) to match all frames, or an alist of
-conditions of the form \(REQ ITEM...). For such an alist to
-match a frame, each of the conditions must be satisfied, meaning
-that the REQ property of the frame must match one of the
-corresponding ITEMs. These are the defined REQ values:
-
-`type' (the value of `window-system')
- Under X, in addition to the values `window-system' can take,
- `motif', `lucid', `gtk' and `x-toolkit' are allowed, and match when
- the Motif toolkit, Lucid toolkit, GTK toolkit or any X toolkit is in use.
-
-`class' (the frame's color support)
- Should be one of `color', `grayscale', or `mono'.
-
-`background' (what color is used for the background text)
- Should be one of `light' or `dark'.
-
-`min-colors' (the minimum number of colors the frame should support)
- Should be an integer, it is compared with the result of
- `display-color-cells'.
-
-`supports' (only match frames that support the specified face attributes)
- Should be a list of face attributes. See the documentation for
- the function `display-supports-face-attributes-p' for more
- information on exactly how testing is done.
-
-See Info node `(elisp) Customization' in the Emacs Lisp manual
-for more information."
+SPEC should be a \"face spec\", i.e., an alist of the form
+
+ ((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."
(declare (doc-string 3))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; Record the group on the `current' list.
(let ((elt (assoc load-file-name custom-current-group-alist)))
(if elt (setcdr elt symbol)
- (push (cons (purecopy load-file-name) symbol)
- custom-current-group-alist)))
+ (push (cons load-file-name symbol) custom-current-group-alist)))
(run-hooks 'custom-define-hook)
symbol)
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,
-`custom-face' for edit faces, and `custom-group' for editing groups.
+`custom-face' for editing faces, and `custom-group' for editing groups.
The remaining arguments should have the form
(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,
-this specifies that SYMBOL should be set after the specified symbol, if
-both appear in constructs like `custom-set-variables'."
+this specifies that SYMBOL should be set after the specified symbol,
+if both appear in constructs like `custom-set-variables'."
(unless (listp value)
(error "Invalid custom dependency `%s'" value))
(let* ((deps (get symbol 'custom-dependencies))
(put symbol 'custom-autoload (if noset 'noset t))
(custom-add-load symbol load))
-;; This test is also in the C code of `user-variable-p'.
(defun custom-variable-p (variable)
- "Return non-nil if VARIABLE is a custom variable.
-This recursively follows aliases."
- (setq variable (indirect-variable variable))
- (or (get variable 'standard-value)
- (get variable 'custom-autoload)))
+ "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."
+ (when (symbolp variable)
+ (setq variable (indirect-variable variable))
+ (or (get variable 'standard-value)
+ (get variable 'custom-autoload))))
+
+(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
(defun custom-note-var-changed (variable)
"Inform Custom that VARIABLE has been set (changed).
(found nil))
(dolist (loaded load-history)
(and (stringp (car loaded))
- (string-match regexp (car loaded))
+ (string-match-p regexp (car loaded))
(setq found t)))
found))
;; Without this, we would load cus-edit recursively.
(setcar (cdr setting) value)))
;; Add a new setting:
(t
- (unless old
- ;; If the user changed the value outside of Customize, we
- ;; first save the current value to a fake theme, `changed'.
- ;; This ensures that the user-set value comes back if the
- ;; theme is later disabled.
- (cond ((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)))))))
- ((and (facep symbol)
- (not (face-attr-match-p
- symbol
- (custom-fix-face-spec
- (face-spec-choose
- (get symbol 'face-defface-spec))))))
- (setq old `((changed
- (,(append '(t) (custom-face-attributes-get
- symbol nil)))))))))
- (put symbol prop (cons (list theme value) old))
+ (unless custom--inhibit-theme-enable
+ (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)))
(put theme 'theme-settings
(cons (list prop symbol theme value) theme-settings))))))
(SYMBOL EXP [NOW [REQUEST [COMMENT]]])
-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.
+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
+added to the alist in SYMBOL's `theme-value' property (by
+calling `custom-push-theme').
-REQUEST is a list of features we must require in order to
-handle SYMBOL properly.
-COMMENT is a comment string about SYMBOL.
+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.
-EXP itself is saved unevaluated as SYMBOL property `saved-value' and
-in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
- (custom-check-theme theme)
+REQUEST is a list of features to `require' (which are loaded
+prior to evaluating EXP).
+COMMENT is a comment string about SYMBOL."
+ (custom-check-theme theme)
;; 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.
(memq (get symbol 'custom-autoload) '(nil noset)))
;; This symbol needs to be autoloaded, even just for a `set'.
(custom-load-symbol symbol))))
-
- ;; Move minor modes and variables with explicit requires to the end.
- (setq args
- (sort args
- (lambda (a1 a2)
- (let* ((sym1 (car a1))
- (sym2 (car a2))
- (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
- (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
- (cond ((and 1-then-2 2-then-1)
- (error "Circular custom dependency between `%s' and `%s'"
- sym1 sym2))
- (2-then-1 nil)
- ;; 1 is a dependency of 2, so needs to be set first.
- (1-then-2)
- ;; Put minor modes and symbols with :require last.
- ;; Putting minor modes last ensures that the mode
- ;; function will see other customized values rather
- ;; than default values.
- (t (or (nth 3 a2)
- (eq (get sym2 'custom-set)
- 'custom-set-minor-mode))))))))
-
+ (setq args (custom--sort-vars args))
(dolist (entry args)
(unless (listp entry)
(error "Incompatible Custom theme spec"))
(and (or now (default-boundp symbol))
(put symbol 'variable-comment comment)))))))
+(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)
+ (error "Circular custom dependency on `%s'" sym))
+ ((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))))))
+
\f
;;; Defining themes.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
+ (declare (doc-string 2))
(let ((feature (custom-make-theme-feature theme)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
:group 'customize
:version "22.1")
-(defcustom custom-theme-load-path (list 'custom-theme-directory t)
+(defvar custom-theme-load-path (list 'custom-theme-directory t)
"List of directories to search for custom theme files.
When loading custom themes (e.g. in `customize-themes' and
`load-theme'), Emacs searches for theme files in the specified
- a directory name (a string).
Each theme file is named THEME-theme.el, where THEME is the theme
-name."
- :type '(repeat (choice (const :tag "custom-theme-directory"
- custom-theme-directory)
- (const :tag "Built-in theme directory" t)
- directory))
- :group 'customize
- :version "24.1")
+name.
+
+This variable is designed for use in lisp code (including
+external packages). For manual user customizations, use
+`custom-theme-directory' instead.")
(defvar custom--inhibit-theme-enable nil
"Whether the custom-theme-set-* functions act immediately.
(provide (get theme 'theme-feature)))
(defcustom custom-safe-themes '(default)
- "List of themes that are considered safe to load.
-Each list element should be the `sha1' hash of a 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')."
- :type '(repeat
- (choice string (const :tag "Built-in themes" default)))
+ "Themes that are considered safe to load.
+If the value is a list, each element should be either the SHA-256
+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').
+
+If the value is t, Emacs treats all themes as safe.
+
+This variable cannot be set in a Custom theme."
+ :type '(choice (repeat :tag "List of safe themes"
+ (choice string
+ (const :tag "Built-in themes" default)))
+ (const :tag "All themes" t))
:group 'customize
:risky t
:version "24.1")
-(defun load-theme (theme &optional no-enable)
+(defun load-theme (theme &optional no-confirm no-enable)
"Load Custom theme named THEME from its file.
-Normally, this also enables THEME. If optional arg NO-ENABLE is
-non-nil, load THEME but don't enable it.
-
The theme file is named THEME-theme.el, in one of the directories
specified by `custom-theme-load-path'.
+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.
+
+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.
+
+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.
+
Return t if THEME was successfully loaded, nil otherwise."
(interactive
(list
(intern (completing-read "Load custom theme: "
(mapcar 'symbol-name
- (custom-available-themes))))))
+ (custom-available-themes))))
+ nil nil))
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
+ ;; 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))))
;; If reloading, clear out the old theme settings.
(when (custom-theme-p theme)
(disable-theme theme)
(put theme 'theme-documentation nil))
(let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
- '("" "c")))
- hash)
+ '("" "c"))))
(unless fn
(error "Unable to find theme file for `%s'" theme))
(with-temp-buffer
(insert-file-contents fn)
- (setq hash (sha1 (current-buffer)))
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
- (when (or (and (memq 'default custom-safe-themes)
+ (when (or no-confirm
+ (eq custom-safe-themes t)
+ (and (memq 'default custom-safe-themes)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
- (member hash custom-safe-themes)
- (custom-theme-load-confirm hash))
- (let ((custom--inhibit-theme-enable t))
+ (let ((hash (secure-hash 'sha256 (current-buffer))))
+ (or (member hash custom-safe-themes)
+ (custom-theme-load-confirm hash))))
+ (let ((custom--inhibit-theme-enable t)
+ (buffer-file-name fn)) ;For load-history.
(eval-buffer))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
"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'."
- (if noninteractive
- nil
- (let ((exit-chars '(?y ?n ?\s))
- window prompt char)
- (save-window-excursion
- (rename-buffer "*Custom Theme*" t)
- (emacs-lisp-mode)
- (setq window (display-buffer (current-buffer)))
- (setq prompt
- (format "Loading a theme can run Lisp code. Really load?%s"
- (if (and window
- (< (line-number-at-pos (point-max))
- (window-body-height)))
- " (y or n) "
- (push ?\C-v exit-chars)
- "\nType y or n, or C-v to scroll: ")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars))
- (when (eq char ?\C-v)
- (if window
- (with-selected-window window
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))))
- (setq char nil)))
- (when (memq char '(?\s ?y))
- ;; 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? ")
- (let ((coding-system-for-read nil))
- (push hash custom-safe-themes)
- (customize-save-variable 'custom-safe-themes
- custom-safe-themes)))
- t)))))
+ (unless noninteractive
+ (save-window-excursion
+ (rename-buffer "*Custom Theme*" t)
+ (emacs-lisp-mode)
+ (pop-to-buffer (current-buffer))
+ (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)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.
(eq name 'changed)))))
(defun custom-available-themes ()
- "Return a list of available Custom themes (symbols)."
+ "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'."
(let (sym themes)
(dolist (dir (custom-theme--load-path))
(when (file-directory-p dir)
((eq prop 'theme-face)
(custom-theme-recalc-face symbol))
((eq prop 'theme-value)
- ;; Don't change `custom-enabled-themes'; that's special.
- (unless (eq symbol 'custom-enabled-themes)
+ ;; Ignore `custom-enabled-themes' and `custom-safe-themes'.
+ (unless (memq symbol '(custom-enabled-themes custom-safe-themes))
(custom-theme-recalc-variable symbol)))))))
(unless (eq theme 'user)
(setq custom-enabled-themes
Customize and always takes precedence over other Custom Themes.
This variable cannot be defined inside a Custom theme; there, it
-is simply ignored."
+is simply ignored.
+
+Setting this variable through Customize calls `enable-theme' or
+`load-theme' for each theme in the list."
:group 'customize
:type '(repeat symbol)
:set-after '(custom-theme-directory custom-theme-load-path
;; If the face spec specified by this theme is in the
;; saved-face property, reset that property.
(when (equal (nth 3 s) (get symbol 'saved-face))
- (put symbol 'saved-face (and val (cadr (car val)))))
- (custom-theme-recalc-face symbol)))))
+ (put symbol 'saved-face (and val (cadr (car val)))))))))
+ ;; Recompute faces on all frames.
+ (dolist (frame (frame-list))
+ ;; We must reset the fg and bg color frame parameters, or
+ ;; `face-set-after-frame-default' will use the existing
+ ;; parameters, which could be from the disabled theme.
+ (set-frame-parameter frame 'background-color
+ (custom--frame-color-default
+ frame :background "background" "Background"
+ "unspecified-bg" "white"))
+ (set-frame-parameter frame 'foreground-color
+ (custom--frame-color-default
+ frame :foreground "foreground" "Foreground"
+ "unspecified-fg" "black"))
+ (face-set-after-frame-default frame))
(setq custom-enabled-themes
(delq theme custom-enabled-themes)))))
+;; Only used if window-system not null.
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
+
+(defun custom--frame-color-default (frame attribute resource-attr resource-class
+ tty-default x-default)
+ (let ((col (face-attribute 'default attribute t)))
+ (cond
+ ((and col (not (eq col 'unspecified))) col)
+ ((null (window-system frame)) tty-default)
+ ((setq col (x-get-resource resource-attr resource-class)) col)
+ (t x-default))))
+
(defun custom-variable-theme-value (variable)
"Return (list VALUE) indicating the custom theme value of VARIABLE.
That is to say, it specifies what the value should be according to
(eval (car valspec))))))
(defun custom-theme-recalc-face (face)
- "Set FACE according to currently enabled custom themes."
+ "Set FACE according to currently enabled custom themes.
+If FACE is not initialized as a face, do nothing; otherwise call
+`face-spec-recalc' to recalculate the face on all frames."
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
- ;; Reset the faces for each frame.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame)))
+ (if (facep face)
+ ;; Reset the faces for each frame.
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame))))
\f
-;;; XEmacs compability functions
+;;; XEmacs compatibility functions
;; In XEmacs, when you reset a Custom Theme, you have to specify the
;; theme to reset it to. We just apply the next available theme, so
;;; The End.
-;; Process the defcustoms for variables loaded before this file.
-(while custom-declare-variable-list
- (apply 'custom-declare-variable (car custom-declare-variable-list))
- (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
-
(provide 'custom)
;;; custom.el ends here