1;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*- 2;; 3;; Copyright (C) 1996-1997, 1999, 2001-2021 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;; This file is part of GNU Emacs. 12 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;; the Free Software Foundation, either version 3 of the License, or 16;; (at your option) any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 26;;; Commentary: 27;; 28;; This file only contains the code needed to declare and initialize 29;; user options. The code to customize options is autoloaded from 30;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual. 31 32;; The code implementing face declarations is in `cus-face.el'. 33 34;;; Code: 35 36(require 'widget) 37 38(defvar custom-define-hook nil 39 ;; Customize information for this option is in `cus-edit.el'. 40 "Hook called after defining each customize option.") 41 42(defvar custom-dont-initialize nil 43 "Non-nil means `defcustom' should not initialize the variable. 44That is used for the sake of `custom-make-dependencies'. 45Users should not set it.") 46 47(defvar custom-current-group-alist nil 48 "Alist of (FILE . GROUP) indicating the current group to use for FILE.") 49 50;;; The `defcustom' Macro. 51 52(defun custom-initialize-default (symbol exp) 53 "Initialize SYMBOL with EXP. 54This will do nothing if symbol already has a default binding. 55Otherwise, if symbol has a `saved-value' property, it will evaluate 56the car of that and use it as the default binding for symbol. 57Otherwise, EXP will be evaluated and used as the default binding for 58symbol." 59 (condition-case nil 60 (default-toplevel-value symbol) ;Test presence of default value. 61 (void-variable 62 ;; The var is not initialized yet. 63 (set-default-toplevel-value 64 symbol (eval (let ((sv (get symbol 'saved-value))) 65 (if sv (car sv) exp)) 66 t))))) 67 68(defun custom-initialize-set (symbol exp) 69 "Initialize SYMBOL based on EXP. 70If the symbol doesn't have a default binding already, 71then set it using its `:set' function (or `set-default' if it has none). 72The value is either the value in the symbol's `saved-value' property, 73if any, or the value of EXP." 74 (condition-case nil 75 (default-toplevel-value symbol) 76 (error 77 (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value) 78 symbol 79 (eval (let ((sv (get symbol 'saved-value))) 80 (if sv (car sv) exp))))))) 81 82(defun custom-initialize-reset (symbol exp) 83 "Initialize SYMBOL based on EXP. 84Set the symbol, using its `:set' function (or `set-default' if it has none). 85The value is either the symbol's current value 86 (as obtained using the `:get' function), if any, 87or the value in the symbol's `saved-value' property if any, 88or (last of all) the value of EXP." 89 (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value) 90 symbol 91 (condition-case nil 92 (let ((def (default-toplevel-value symbol)) 93 (getter (get symbol 'custom-get))) 94 (if getter (funcall getter symbol) def)) 95 (error 96 (eval (let ((sv (get symbol 'saved-value))) 97 (if sv (car sv) exp))))))) 98 99(defun custom-initialize-changed (symbol exp) 100 "Initialize SYMBOL with EXP. 101Like `custom-initialize-reset', but only use the `:set' function if 102not using the standard setting. 103For the standard setting, use `set-default'." 104 (condition-case nil 105 (let ((def (default-toplevel-value symbol))) 106 (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value) 107 symbol 108 (let ((getter (get symbol 'custom-get))) 109 (if getter (funcall getter symbol) def)))) 110 (error 111 (cond 112 ((get symbol 'saved-value) 113 (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value) 114 symbol 115 (eval (car (get symbol 'saved-value))))) 116 (t 117 (set-default symbol (eval exp))))))) 118 119(defvar custom-delayed-init-variables nil 120 "List of variables whose initialization is pending until startup. 121Once this list has been processed, this var is set to a non-list value.") 122 123(defun custom-initialize-delay (symbol value) 124 "Delay initialization of SYMBOL to the next Emacs start. 125This is used in files that are preloaded (or for autoloaded 126variables), so that the initialization is done in the run-time 127context rather than the build-time context. This also has the 128side-effect that the (delayed) initialization is performed with 129the :set function." 130 ;; Defvar it so as to mark it special, etc (bug#25770). 131 (internal--define-uninitialized-variable symbol) 132 133 ;; Until the var is actually initialized, it is kept unbound. 134 ;; This seemed to be at least as good as setting it to an arbitrary 135 ;; value like nil (evaluating `value' is not an option because it 136 ;; may have undesirable side-effects). 137 (if (listp custom-delayed-init-variables) 138 (push symbol custom-delayed-init-variables) 139 ;; In case this is called after startup, there is no "later" to which to 140 ;; delay it, so initialize it "normally" (bug#47072). 141 (custom-initialize-reset symbol value))) 142 143(defun custom-declare-variable (symbol default doc &rest args) 144 "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. 145DEFAULT should be an expression to evaluate to compute the default value, 146not the default value itself. 147 148DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property 149`standard-value'. At the same time, SYMBOL's property `force-value' is 150set to nil, as the value is no longer rogue." 151 (put symbol 'standard-value (purecopy (list default))) 152 ;; Maybe this option was rogue in an earlier version. It no longer is. 153 (when (get symbol 'force-value) 154 (put symbol 'force-value nil)) 155 (if (keywordp doc) 156 (error "Doc string is missing")) 157 (let ((initialize #'custom-initialize-reset) 158 (requests nil) 159 ;; Whether automatically buffer-local. 160 buffer-local) 161 (unless (memq :group args) 162 (let ((cg (custom-current-group))) 163 (when cg 164 (custom-add-to-group cg symbol 'custom-variable)))) 165 (while args 166 (let ((keyword (pop args))) 167 (unless (symbolp keyword) 168 (error "Junk in args %S" args)) 169 (unless args 170 (error "Keyword %s is missing an argument" keyword)) 171 (let ((value (pop args))) 172 ;; Can't use `pcase' because it is loaded after `custom.el' 173 ;; during bootstrap. See `loadup.el'. 174 (cond ((eq keyword :initialize) 175 (setq initialize value)) 176 ((eq keyword :set) 177 (put symbol 'custom-set value)) 178 ((eq keyword :get) 179 (put symbol 'custom-get value)) 180 ((eq keyword :require) 181 (push value requests)) 182 ((eq keyword :risky) 183 (put symbol 'risky-local-variable value)) 184 ((eq keyword :safe) 185 (put symbol 'safe-local-variable value)) 186 ((eq keyword :local) 187 (when (memq value '(t permanent)) 188 (setq buffer-local t)) 189 (when (eq value 'permanent) 190 (put symbol 'permanent-local t))) 191 ((eq keyword :type) 192 (put symbol 'custom-type (purecopy value))) 193 ((eq keyword :options) 194 (if (get symbol 'custom-options) 195 ;; Slow safe code to avoid duplicates. 196 (mapc (lambda (option) 197 (custom-add-option symbol option)) 198 value) 199 ;; Fast code for the common case. 200 (put symbol 'custom-options (copy-sequence value)))) 201 (t 202 (custom-handle-keyword symbol keyword value 203 'custom-variable)))))) 204 ;; Set the docstring, record the var on load-history, as well 205 ;; as set the special-variable-p flag. 206 (internal--define-uninitialized-variable symbol doc) 207 (put symbol 'custom-requests requests) 208 ;; Do the actual initialization. 209 (unless custom-dont-initialize 210 (funcall initialize symbol default) 211 ;; If there is a value under saved-value that wasn't saved by the user, 212 ;; reset it: we used that property to stash the value, but we don't need 213 ;; it anymore. 214 ;; This can happen given the following: 215 ;; 1. The user loaded a theme that had a setting for an unbound 216 ;; variable, so we stashed the theme setting under the saved-value 217 ;; property in `custom-theme-recalc-variable'. 218 ;; 2. Then, Emacs evaluated the defcustom for the option 219 ;; (e.g., something required the file where the option is defined). 220 ;; If we don't reset it and the user later sets this variable via 221 ;; Customize, we might end up saving the theme setting in the custom-file. 222 ;; See the test `custom-test-no-saved-value-after-customizing-option'. 223 (let ((theme (caar (get symbol 'theme-value)))) 224 (when (and theme (not (eq theme 'user)) (get symbol 'saved-value)) 225 (put symbol 'saved-value nil)))) 226 (when buffer-local 227 (make-variable-buffer-local symbol))) 228 (run-hooks 'custom-define-hook) 229 symbol) 230 231(defmacro defcustom (symbol standard doc &rest args) 232 "Declare SYMBOL as a customizable variable. 233SYMBOL is the variable name; it should not be quoted. 234STANDARD is an expression specifying the variable's standard 235value. It should not be quoted. It is evaluated once by 236`defcustom', and the value is assigned to SYMBOL if the variable 237is unbound. The expression itself is also stored, so that 238Customize can re-evaluate it later to get the standard value. 239DOC is the variable documentation. 240 241This macro uses `defvar' as a subroutine, which also marks the 242variable as \"special\", so that it is always dynamically bound 243even when `lexical-binding' is t. 244 245The remaining arguments to `defcustom' should have the form 246 247 [KEYWORD VALUE]... 248 249The following keywords are meaningful: 250 251:type VALUE should be a widget type for editing the symbol's value. 252 Every `defcustom' should specify a value for this keyword. 253 See Info node `(elisp) Customization Types' for a list of 254 base types and useful composite types. 255:options VALUE should be a list of valid members of the widget type. 256:initialize 257 VALUE should be a function used to initialize the 258 variable. It takes two arguments, the symbol and value 259 given in the `defcustom' call. The default is 260 `custom-initialize-reset'. 261:set VALUE should be a function to set the value of the symbol 262 when using the Customize user interface. It takes two arguments, 263 the symbol to set and the value to give it. The function should 264 not modify its value argument destructively. The default choice 265 of function is `set-default'. 266:get VALUE should be a function to extract the value of symbol. 267 The function takes one argument, a symbol, and should return 268 the current value for that symbol. The default choice of function 269 is `default-value'. 270:require 271 VALUE should be a feature symbol. If you save a value 272 for this option, then when your init file loads the value, 273 it does (require VALUE) first. 274:set-after VARIABLES 275 Specifies that SYMBOL should be set after the list of variables 276 VARIABLES when both have been customized. 277:risky Set SYMBOL's `risky-local-variable' property to VALUE. 278:safe Set SYMBOL's `safe-local-variable' property to VALUE. 279 See Info node `(elisp) File Local Variables'. 280:local If VALUE is t, mark SYMBOL as automatically buffer-local. 281 If VALUE is `permanent', also set SYMBOL's `permanent-local' 282 property to t. 283 284The following common keywords are also meaningful. 285 286:group VALUE should be a customization group. 287 Add SYMBOL (or FACE with `defface') to that group. 288:link LINK-DATA 289 Include an external link after the documentation string for this 290 item. This is a sentence containing an active field which 291 references some other documentation. 292 293 There are several alternatives you can use for LINK-DATA: 294 295 (custom-manual INFO-NODE) 296 Link to an Info node; INFO-NODE is a string which specifies 297 the node name, as in \"(emacs)Top\". 298 299 (info-link INFO-NODE) 300 Like `custom-manual' except that the link appears in the 301 customization buffer with the Info node name. 302 303 (url-link URL) 304 Link to a web page; URL is a string which specifies the URL. 305 306 (emacs-commentary-link LIBRARY) 307 Link to the commentary section of LIBRARY. 308 309 (emacs-library-link LIBRARY) 310 Link to an Emacs Lisp LIBRARY file. 311 312 (file-link FILE) 313 Link to FILE. 314 315 (function-link FUNCTION) 316 Link to the documentation of FUNCTION. 317 318 (variable-link VARIABLE) 319 Link to the documentation of VARIABLE. 320 321 (custom-group-link GROUP) 322 Link to another customization GROUP. 323 324 You can specify the text to use in the customization buffer by 325 adding `:tag NAME' after the first element of the LINK-DATA; for 326 example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the 327 Emacs manual which appears in the buffer as `foo'. 328 329 An item can have more than one external link; however, most items 330 have none at all. 331:version 332 VALUE should be a string specifying that the variable was 333 first introduced, or its default value was changed, in Emacs 334 version VERSION. 335:package-version 336 VALUE should be a list with the form (PACKAGE . VERSION) 337 specifying that the variable was first introduced, or its 338 default value was changed, in PACKAGE version VERSION. This 339 keyword takes priority over :version. For packages which 340 are bundled with Emacs releases, the PACKAGE and VERSION 341 must appear in the alist `customize-package-emacs-version-alist'. 342 Since PACKAGE must be unique and the user might see it in an 343 error message, a good choice is the official name of the 344 package, such as MH-E or Gnus. 345:tag LABEL 346 Use LABEL, a string, instead of the item's name, to label the item 347 in customization menus and buffers. 348:load FILE 349 Load file FILE (a string) before displaying this customization 350 item. Loading is done with `load', and only if the file is 351 not already loaded. 352 353If SYMBOL has a local binding, then this form affects the local 354binding. This is normally not what you want. Thus, if you need 355to load a file defining variables with this form, or with 356`defvar' or `defconst', you should always load that file 357_outside_ any bindings for these variables. (`defvar' and 358`defconst' behave similarly in this respect.) 359 360This macro calls `custom-declare-variable'. If you want to 361programmatically alter a customizable variable (for instance, to 362write a package that extends the syntax of a variable), you can 363call that function directly. 364 365See Info node `(elisp) Customization' in the Emacs Lisp manual 366for more information." 367 (declare (doc-string 3) (debug (name body)) 368 (indent defun)) 369 ;; It is better not to use backquote in this file, 370 ;; because that makes a bootstrapping problem 371 ;; if you need to recompile all the Lisp files using interpreted code. 372 `(custom-declare-variable 373 ',symbol 374 ,(if lexical-binding 375 ;; The STANDARD arg should be an expression that evaluates to 376 ;; the standard value. The use of `eval' for it is spread 377 ;; over many different places and hence difficult to 378 ;; eliminate, yet we want to make sure that the `standard' 379 ;; expression is checked by the byte-compiler, and that 380 ;; lexical-binding is obeyed, so quote the expression with 381 ;; `lambda' rather than with `quote'. 382 ``(funcall #',(lambda () "" ,standard)) 383 `',standard) 384 ,doc 385 ,@args)) 386 387;;; The `defface' Macro. 388 389(defmacro defface (face spec doc &rest args) 390 "Declare FACE as a customizable face that defaults to SPEC. 391FACE does not need to be quoted. 392 393Third argument DOC is the face documentation. 394 395If FACE has been set with `custom-theme-set-faces', set the face 396attributes as specified by that function, otherwise set the face 397attributes according to SPEC. 398 399The remaining arguments should have the form [KEYWORD VALUE]... 400For a list of valid keywords, see the common keywords listed in 401`defcustom'. 402 403SPEC should be a \"face spec\", i.e., an alist of the form 404 405 ((DISPLAY . ATTS)...) 406 407where DISPLAY is a form specifying conditions to match certain 408terminals and ATTS is a property list (ATTR VALUE ATTR VALUE...) 409specifying face attributes and values for frames on those 410terminals. On each terminal, the first element with a matching 411DISPLAY specification takes effect, and the remaining elements in 412SPEC are disregarded. 413 414As a special exception, in the first element of SPEC, DISPLAY can 415be the special value `default'. Then the ATTS in that element 416act as defaults for all the following elements. 417 418For backward compatibility, elements of SPEC can be written 419as (DISPLAY ATTS) instead of (DISPLAY . ATTS). 420 421Each DISPLAY can have the following values: 422 - `default' (only in the first element). 423 - The symbol t, which matches all terminals. 424 - An alist of conditions. Each alist element must have the form 425 (REQ ITEM...). A matching terminal must satisfy each 426 specified condition by matching one of its ITEMs. Each REQ 427 must be one of the following: 428 - `type' (the terminal type). 429 Each ITEM must be one of the values returned by 430 `window-system'. Under X, additional allowed values are 431 `motif', `lucid', `gtk' and `x-toolkit'. 432 - `class' (the terminal's color support). 433 Each ITEM should be one of `color', `grayscale', or `mono'. 434 - `background' (what color is used for the background text) 435 Each ITEM should be one of `light' or `dark'. 436 - `min-colors' (the minimum number of supported colors) 437 Each ITEM should be an integer, which is compared with the 438 result of `display-color-cells'. 439 - `supports' (match terminals supporting certain attributes). 440 Each ITEM should be a list of face attributes. See 441 `display-supports-face-attributes-p' for more information on 442 exactly how testing is done. 443 444In the ATTS property list, possible attributes are `:family', 445`:width', `:height', `:weight', `:slant', `:underline', 446`:overline', `:strike-through', `:box', `:foreground', 447`:background', `:stipple', `:inverse-video', and `:inherit'. 448 449See Info node `(elisp) Faces' in the Emacs Lisp manual for more 450information." 451 (declare (doc-string 3) (indent defun)) 452 ;; It is better not to use backquote in this file, 453 ;; because that makes a bootstrapping problem 454 ;; if you need to recompile all the Lisp files using interpreted code. 455 (nconc (list 'custom-declare-face (list 'quote face) spec doc) args)) 456 457;;; The `defgroup' Macro. 458 459(defun custom-current-group () 460 (cdr (assoc load-file-name custom-current-group-alist))) 461 462(defun custom-declare-group (symbol members doc &rest args) 463 "Like `defgroup', but SYMBOL is evaluated as a normal argument." 464 (while members 465 (apply #'custom-add-to-group symbol (car members)) 466 (setq members (cdr members))) 467 (when doc 468 ;; This text doesn't get into DOC. 469 (put symbol 'group-documentation (purecopy doc))) 470 (while args 471 (let ((arg (car args))) 472 (setq args (cdr args)) 473 (unless (symbolp arg) 474 (error "Junk in args %S" args)) 475 (let ((keyword arg) 476 (value (car args))) 477 (unless args 478 (error "Keyword %s is missing an argument" keyword)) 479 (setq args (cdr args)) 480 (cond ((eq keyword :prefix) 481 (put symbol 'custom-prefix (purecopy value))) 482 (t 483 (custom-handle-keyword symbol keyword value 484 'custom-group)))))) 485 ;; Record the group on the `current' list. 486 (let ((elt (assoc load-file-name custom-current-group-alist))) 487 (if elt (setcdr elt symbol) 488 (push (cons load-file-name symbol) custom-current-group-alist))) 489 (run-hooks 'custom-define-hook) 490 symbol) 491 492(defmacro defgroup (symbol members doc &rest args) 493 "Declare SYMBOL as a customization group containing MEMBERS. 494SYMBOL does not need to be quoted. 495 496Third argument DOC is the group documentation. This should be a short 497description of the group, beginning with a capital and ending with 498a period. Words other than the first should not be capitalized, if they 499are not usually written so. 500 501MEMBERS should be an alist of the form ((NAME WIDGET)...) where 502NAME is a symbol and WIDGET is a widget for editing that symbol. 503Useful widgets are `custom-variable' for editing variables, 504`custom-face' for editing faces, and `custom-group' for editing groups. 505 506The remaining arguments should have the form 507 508 [KEYWORD VALUE]... 509 510For a list of valid keywords, see the common keywords listed in 511`defcustom'. The keyword :prefix can only be used for 512customization groups, and means that the given string should be 513removed from variable names before creating unlispified names, 514when the user option `custom-unlispify-remove-prefixes' is 515non-nil. 516 517See Info node `(elisp) Customization' in the Emacs Lisp manual 518for more information." 519 (declare (doc-string 3) (indent defun)) 520 ;; It is better not to use backquote in this file, 521 ;; because that makes a bootstrapping problem 522 ;; if you need to recompile all the Lisp files using interpreted code. 523 (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args)) 524 525(defun custom-add-to-group (group option widget) 526 "To existing GROUP add a new OPTION of type WIDGET. 527If there already is an entry for OPTION and WIDGET, nothing is done." 528 (let ((members (get group 'custom-group)) 529 (entry (list option widget))) 530 (unless (member entry members) 531 (put group 'custom-group (nconc members (list entry)))))) 532 533(defun custom-group-of-mode (mode) 534 "Return the custom group corresponding to the major or minor MODE. 535If no such group is found, return nil." 536 (or (get mode 'custom-mode-group) 537 (if (or (get mode 'custom-group) 538 (and (string-match "-mode\\'" (symbol-name mode)) 539 (get (setq mode (intern (substring (symbol-name mode) 540 0 (match-beginning 0)))) 541 'custom-group))) 542 mode))) 543 544;;; Properties. 545 546(defun custom-handle-all-keywords (symbol args type) 547 "For customization option SYMBOL, handle keyword arguments ARGS. 548Third argument TYPE is the custom option type." 549 (unless (memq :group args) 550 (let ((cg (custom-current-group))) 551 (when cg 552 (custom-add-to-group cg symbol type)))) 553 (while args 554 (let ((arg (car args))) 555 (setq args (cdr args)) 556 (unless (symbolp arg) 557 (error "Junk in args %S" args)) 558 (let ((keyword arg) 559 (value (car args))) 560 (unless args 561 (error "Keyword %s is missing an argument" keyword)) 562 (setq args (cdr args)) 563 (custom-handle-keyword symbol keyword value type))))) 564 565(defun custom-handle-keyword (symbol keyword value type) 566 "For customization option SYMBOL, handle KEYWORD with VALUE. 567Fourth argument TYPE is the custom option type." 568 (if purify-flag 569 (setq value (purecopy value))) 570 (cond ((eq keyword :group) 571 (custom-add-to-group value symbol type)) 572 ((eq keyword :version) 573 (custom-add-version symbol value)) 574 ((eq keyword :package-version) 575 (custom-add-package-version symbol value)) 576 ((eq keyword :link) 577 (custom-add-link symbol value)) 578 ((eq keyword :load) 579 (custom-add-load symbol value)) 580 ((eq keyword :tag) 581 (put symbol 'custom-tag value)) 582 ((eq keyword :set-after) 583 (custom-add-dependencies symbol value)) 584 (t 585 (error "Unknown keyword %s" keyword)))) 586 587(defun custom-add-dependencies (symbol value) 588 "To the custom option SYMBOL, add dependencies specified by VALUE. 589VALUE should be a list of symbols. For each symbol in that list, 590this specifies that SYMBOL should be set after the specified symbol, 591if both appear in constructs like `custom-set-variables'." 592 (unless (listp value) 593 (error "Invalid custom dependency `%s'" value)) 594 (let* ((deps (get symbol 'custom-dependencies)) 595 (new-deps deps)) 596 (while value 597 (let ((dep (car value))) 598 (unless (symbolp dep) 599 (error "Invalid custom dependency `%s'" dep)) 600 (unless (memq dep new-deps) 601 (setq new-deps (cons dep new-deps))) 602 (setq value (cdr value)))) 603 (unless (eq deps new-deps) 604 (put symbol 'custom-dependencies new-deps)))) 605 606(defun custom-add-option (symbol option) 607 "To the variable SYMBOL add OPTION. 608 609If SYMBOL's custom type is a hook, OPTION should be a hook member. 610If SYMBOL's custom type is an alist, OPTION specifies a symbol 611to offer to the user as a possible key in the alist. 612For other custom types, this has no effect." 613 (let ((options (get symbol 'custom-options))) 614 (unless (member option options) 615 (put symbol 'custom-options (cons option options))))) 616(defalias 'custom-add-frequent-value 'custom-add-option) 617 618(defun custom-add-link (symbol widget) 619 "To the custom option SYMBOL add the link WIDGET." 620 (let ((links (get symbol 'custom-links))) 621 (unless (member widget links) 622 (put symbol 'custom-links (cons (purecopy widget) links))))) 623 624(defun custom-add-version (symbol version) 625 "To the custom option SYMBOL add the version VERSION." 626 (put symbol 'custom-version (purecopy version))) 627 628(defun custom-add-package-version (symbol version) 629 "To the custom option SYMBOL add the package version VERSION." 630 (put symbol 'custom-package-version (purecopy version))) 631 632(defun custom-add-load (symbol load) 633 "To the custom option SYMBOL add the dependency LOAD. 634LOAD should be either a library file name, or a feature name." 635 (let ((loads (get symbol 'custom-loads))) 636 (unless (member load loads) 637 (put symbol 'custom-loads (cons (purecopy load) loads))))) 638 639(defun custom-autoload (symbol load &optional noset) 640 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD. 641If NOSET is non-nil, don't bother autoloading LOAD when setting the variable." 642 (put symbol 'custom-autoload (if noset 'noset t)) 643 (custom-add-load symbol load)) 644 645(defun custom-variable-p (variable) 646 "Return non-nil if VARIABLE is a customizable variable. 647A customizable variable is either (i) a variable whose property 648list contains a non-nil `standard-value' or `custom-autoload' 649property, or (ii) an alias for another customizable variable." 650 (when (symbolp variable) 651 (setq variable (indirect-variable variable)) 652 (or (get variable 'standard-value) 653 (get variable 'custom-autoload)))) 654 655(defun custom--standard-value (variable) 656 "Return the standard value of VARIABLE." 657 (eval (car (get variable 'standard-value)) t)) 658 659(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3") 660 661(defun custom-note-var-changed (variable) 662 "Inform Custom that VARIABLE has been set (changed). 663VARIABLE is a symbol that names a user option. 664The result is that the change is treated as having been made through Custom." 665 (put variable 'customized-value (list (custom-quote (eval variable))))) 666 667;; Loading files needed to customize a symbol. 668;; This is in custom.el because menu-bar.el needs it for toggle cmds. 669 670(defvar custom-load-recursion nil 671 "Hack to avoid recursive dependencies.") 672 673(defun custom-load-symbol (symbol) 674 "Load all dependencies for SYMBOL." 675 (unless custom-load-recursion 676 (let ((custom-load-recursion t)) 677 ;; Load these files if not already done, 678 ;; to make sure we know all the dependencies of SYMBOL. 679 (ignore-errors 680 (require 'cus-load)) 681 (ignore-errors 682 (require 'cus-start)) 683 (dolist (load (get symbol 'custom-loads)) 684 (cond ((symbolp load) (ignore-errors (require load))) 685 ;; This is subsumed by the test below, but it's much faster. 686 ((assoc load load-history)) 687 ;; This was just (assoc (locate-library load) load-history) 688 ;; but has been optimized not to load locate-library 689 ;; if not necessary. 690 ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load) 691 "\\(\\'\\|\\.\\)")) 692 (found nil)) 693 (dolist (loaded load-history) 694 (and (stringp (car loaded)) 695 (string-match-p regexp (car loaded)) 696 (setq found t))) 697 found)) 698 ;; Without this, we would load cus-edit recursively. 699 ;; We are still loading it when we call this, 700 ;; and it is not in load-history yet. 701 ((equal load "cus-edit")) 702 (t (ignore-errors (load load)))))))) 703 704(defvar custom-local-buffer nil 705 "Non-nil, in a Customization buffer, means customize a specific buffer. 706If this variable is non-nil, it should be a buffer, 707and it means customize the local bindings of that buffer. 708This variable is a permanent local, and it normally has a local binding 709in every Customization buffer.") 710(put 'custom-local-buffer 'permanent-local t) 711 712(defun custom-set-default (variable value) 713 "Default :set function for a customizable variable. 714Normally, this sets the default value of VARIABLE to VALUE, 715but if `custom-local-buffer' is non-nil, 716this sets the local binding in that buffer instead." 717 (if custom-local-buffer 718 (with-current-buffer custom-local-buffer 719 (set variable value)) 720 (set-default variable value))) 721 722(defun custom-set-minor-mode (variable value) 723 ":set function for minor mode variables. 724Normally, this sets the default value of VARIABLE to nil if VALUE 725is nil and to t otherwise, 726but if `custom-local-buffer' is non-nil, 727this sets the local binding in that buffer instead." 728 (if custom-local-buffer 729 (with-current-buffer custom-local-buffer 730 (funcall variable (if value 1 0))) 731 (funcall variable (if value 1 0)))) 732 733(defun custom-quote (sexp) 734 "Quote SEXP if it is not self quoting." 735 ;; Can't use `macroexp-quote' because it is loaded after `custom.el' 736 ;; during bootstrap. See `loadup.el'. 737 (if (and (not (consp sexp)) 738 (or (keywordp sexp) 739 (not (symbolp sexp)) 740 (booleanp sexp))) 741 sexp 742 (list 'quote sexp))) 743 744(defun customize-mark-to-save (symbol) 745 "Mark SYMBOL for later saving. 746 747If the default value of SYMBOL is different from the standard value, 748set the `saved-value' property to a list whose car evaluates to the 749default value. Otherwise, set it to nil. 750 751To actually save the value, call `custom-save-all'. 752 753Return non-nil if the `saved-value' property actually changed." 754 (custom-load-symbol symbol) 755 (let* ((get (or (get symbol 'custom-get) #'default-value)) 756 (value (funcall get symbol)) 757 (saved (get symbol 'saved-value)) 758 (standard (get symbol 'standard-value)) 759 (comment (get symbol 'customized-variable-comment))) 760 ;; Save default value if different from standard value. 761 (put symbol 'saved-value 762 (unless (and standard 763 (equal value (ignore-errors (eval (car standard))))) 764 (list (custom-quote value)))) 765 ;; Clear customized information (set, but not saved). 766 (put symbol 'customized-value nil) 767 ;; Save any comment that might have been set. 768 (when comment 769 (put symbol 'saved-variable-comment comment)) 770 (not (equal saved (get symbol 'saved-value))))) 771 772(defun customize-mark-as-set (symbol) 773 "Mark current value of SYMBOL as being set from customize. 774 775If the default value of SYMBOL is different from the saved value if any, 776or else if it is different from the standard value, set the 777`customized-value' property to a list whose car evaluates to the 778default value. Otherwise, set it to nil. 779 780Return non-nil if the `customized-value' property actually changed." 781 (custom-load-symbol symbol) 782 (let* ((get (or (get symbol 'custom-get) #'default-value)) 783 (value (funcall get symbol)) 784 (customized (get symbol 'customized-value)) 785 (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) 786 ;; Mark default value as set if different from old value. 787 (if (not (and old 788 (equal value (ignore-errors 789 (eval (car old)))))) 790 (progn (put symbol 'customized-value (list (custom-quote value))) 791 (custom-push-theme 'theme-value symbol 'user 'set 792 (custom-quote value))) 793 (custom-push-theme 'theme-value symbol 'user 794 (if (get symbol 'saved-value) 'set 'reset) 795 (custom-quote value)) 796 (put symbol 'customized-value nil)) 797 ;; Changed? 798 (not (equal customized (get symbol 'customized-value))))) 799 800(defun custom-reevaluate-setting (symbol) 801 "Reset the value of SYMBOL by re-evaluating its saved or standard value. 802Use the :set function to do so. This is useful for customizable options 803that are defined before their standard value can really be computed. 804E.g. dumped variables whose default depends on run-time information." 805 ;; We are initializing 806 ;; the variable, and normally any :set function would not apply. 807 ;; For custom-initialize-delay, however, it is documented that "the 808 ;; (delayed) initialization is performed with the :set function". 809 ;; This is needed by eg global-font-lock-mode, which uses 810 ;; custom-initialize-delay but needs the :set function custom-set-minor-mode 811 ;; to also run during initialization. So, long story short, we 812 ;; always do the funcall step, even if symbol was not bound before. 813 (funcall (or (get symbol 'custom-set) #'set-default) 814 symbol 815 (eval (car (or (get symbol 'saved-value) 816 (get symbol 'standard-value)))))) 817 818 819;;; Custom Themes 820 821;; Custom themes are collections of settings that can be enabled or 822;; disabled as a unit. 823 824;; Each Custom theme is defined by a symbol, called the theme name. 825;; The `theme-settings' property of the theme name records the 826;; variable and face settings of the theme. This property is a list 827;; of elements, each of the form 828;; 829;; (PROP SYMBOL THEME VALUE) 830;; 831;; - PROP is either `theme-value' or `theme-face' 832;; - SYMBOL is the face or variable name 833;; - THEME is the theme name (redundant, but simplifies the code) 834;; - VALUE is an expression that gives the theme's setting for SYMBOL. 835;; 836;; The theme name also has a `theme-feature' property, whose value is 837;; specified when the theme is defined (see `custom-declare-theme'). 838;; Usually, this is just a symbol named THEME-theme. This lets 839;; external libraries call (require 'foo-theme). 840 841;; In addition, each symbol (either a variable or a face) affected by 842;; an *enabled* theme has a `theme-value' or `theme-face' property, 843;; which is a list of elements each of the form 844;; 845;; (THEME VALUE) 846;; 847;; which have the same meanings as in `theme-settings'. 848;; 849;; The `theme-value' and `theme-face' lists are ordered by decreasing 850;; theme precedence. Thus, the first element is always the one that 851;; is in effect. 852 853;; Each theme is stored in a theme file, with filename THEME-theme.el. 854;; Loading a theme basically involves calling (load "THEME-theme") 855;; This is done by the function `load-theme'. Loading a theme 856;; automatically enables it. 857;; 858;; When a theme is enabled, the `theme-value' and `theme-face' 859;; properties for the affected symbols are set. When a theme is 860;; disabled, its settings are removed from the `theme-value' and 861;; `theme-face' properties, but the theme's own `theme-settings' 862;; property remains unchanged. 863 864(defvar custom-known-themes '(user changed) 865 "Themes that have been defined with `deftheme'. 866The default value is the list (user changed). The theme `changed' 867contains the settings before custom themes are applied. The theme 868`user' contains all the settings the user customized and saved. 869Additional themes declared with the `deftheme' macro will be added 870to the front of this list.") 871 872(defsubst custom-theme-p (theme) 873 "Non-nil when THEME has been defined." 874 (memq theme custom-known-themes)) 875 876(defsubst custom-check-theme (theme) 877 "Check whether THEME is valid, and signal an error if it is not." 878 (unless (custom-theme-p theme) 879 (error "Unknown theme `%s'" theme))) 880 881(defun custom--should-apply-setting (theme) 882 (or (null custom--inhibit-theme-enable) 883 (and (eq custom--inhibit-theme-enable 'apply-only-user) 884 (eq theme 'user)))) 885 886(defun custom-push-theme (prop symbol theme mode &optional value) 887 "Record VALUE for face or variable SYMBOL in custom theme THEME. 888PROP is `theme-face' for a face, `theme-value' for a variable. 889 890MODE can be either the symbol `set' or the symbol `reset'. If it is the 891symbol `set', then VALUE is the value to use. If it is the symbol 892`reset', then SYMBOL will be removed from THEME (VALUE is ignored). 893 894See `custom-known-themes' for a list of known themes." 895 (unless (memq prop '(theme-value theme-face)) 896 (error "Unknown theme property")) 897 (let* ((old (get symbol prop)) 898 (setting (assq theme old)) ; '(theme value) 899 (theme-settings ; '(prop symbol theme value) 900 (get theme 'theme-settings))) 901 (cond 902 ;; Remove a setting: 903 ((eq mode 'reset) 904 (when setting 905 (let (res) 906 (dolist (theme-setting theme-settings) 907 (if (and (eq (car theme-setting) prop) 908 (eq (cadr theme-setting) symbol)) 909 (setq res theme-setting))) 910 (put theme 'theme-settings (delq res theme-settings))) 911 (put symbol prop (delq setting old)))) 912 ;; Alter an existing setting: 913 (setting 914 (let (res) 915 (dolist (theme-setting theme-settings) 916 (if (and (eq (car theme-setting) prop) 917 (eq (cadr theme-setting) symbol)) 918 (setq res theme-setting))) 919 (put theme 'theme-settings 920 (cons (list prop symbol theme value) 921 (delq res theme-settings))) 922 ;; It's tempting to use setcar here, but that could 923 ;; inadvertently modify other properties in SYMBOL's proplist, 924 ;; if those just happen to share elements with the value of PROP. 925 (put symbol prop (cons (list theme value) (delq setting old))))) 926 ;; Add a new setting: 927 (t 928 (when (custom--should-apply-setting theme) 929 (unless old 930 ;; If the user changed a variable outside of Customize, save 931 ;; the value to a fake theme, `changed'. If the theme is 932 ;; later disabled, we use this to bring back the old value. 933 ;; 934 ;; For faces, we just use `face--new-frame-defaults' to 935 ;; recompute when the theme is disabled. 936 (when (and (eq prop 'theme-value) 937 (boundp symbol)) 938 (let ((sv (get symbol 'standard-value)) 939 (val (symbol-value symbol))) 940 (unless (or 941 ;; We only do this trick if the current value 942 ;; is different from the standard value. 943 (and sv (equal (eval (car sv)) val)) 944 ;; And we don't do it if we would end up recording 945 ;; the same value for the user theme. This way we avoid 946 ;; having ((user VALUE) (changed VALUE)). That would be 947 ;; useless, because we don't disable the user theme. 948 (and (eq theme 'user) (equal (custom-quote val) value))) 949 (setq old `((changed ,(custom-quote val)))))))) 950 (put symbol prop (cons (list theme value) old))) 951 (put theme 'theme-settings 952 (cons (list prop symbol theme value) theme-settings)))))) 953 954(defun custom-fix-face-spec (spec) 955 "Convert face SPEC, replacing obsolete :bold and :italic attributes. 956Also change :reverse-video to :inverse-video." 957 (when (listp spec) 958 (if (or (memq :bold spec) 959 (memq :italic spec) 960 (memq :inverse-video spec)) 961 (let (result) 962 (while spec 963 (let ((key (car spec)) 964 (val (car (cdr spec)))) 965 (cond ((eq key :italic) 966 (push :slant result) 967 (push (if val 'italic 'normal) result)) 968 ((eq key :bold) 969 (push :weight result) 970 (push (if val 'bold 'normal) result)) 971 ((eq key :reverse-video) 972 (push :inverse-video result) 973 (push val result)) 974 (t 975 (push key result) 976 (push val result)))) 977 (setq spec (cddr spec))) 978 (nreverse result)) 979 spec))) 980 981(defun custom-set-variables (&rest args) 982 "Install user customizations of variable values specified in ARGS. 983These settings are registered as theme `user'. 984The arguments should each be a list of the form: 985 986 (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) 987 988This stores EXP (without evaluating it) as the saved value for SYMBOL. 989If NOW is present and non-nil, then also evaluate EXP and set 990the default value for the SYMBOL to the value of EXP. 991 992REQUEST is a list of features we must require in order to 993handle SYMBOL properly. 994COMMENT is a comment string about SYMBOL." 995 (apply #'custom-theme-set-variables 'user args)) 996 997(defun custom-theme-set-variables (theme &rest args) 998 "Initialize variables for theme THEME according to settings in ARGS. 999Each of the arguments in ARGS should be a list of this form: 1000 1001 (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) 1002 1003SYMBOL is the variable name, and EXP is an expression which 1004evaluates to the customized value. EXP will also be stored, 1005without evaluating it, in SYMBOL's `saved-value' property, so 1006that it can be restored via the Customize interface. It is also 1007added to the alist in SYMBOL's `theme-value' property (by 1008calling `custom-push-theme'). 1009 1010NOW, if present and non-nil, means to install the variable's 1011value directly now, even if its `defcustom' declaration has not 1012been executed. This is for internal use only. 1013 1014REQUEST is a list of features to `require' (which are loaded 1015prior to evaluating EXP). 1016 1017COMMENT is a comment string about SYMBOL." 1018 (custom-check-theme theme) 1019 ;; Process all the needed autoloads before anything else, so that the 1020 ;; subsequent code has all the info it needs (e.g. which var corresponds 1021 ;; to a minor mode), regardless of the ordering of the variables. 1022 (dolist (entry args) 1023 (let* ((symbol (indirect-variable (nth 0 entry)))) 1024 (unless (or (get symbol 'standard-value) 1025 (memq (get symbol 'custom-autoload) '(nil noset))) 1026 ;; This symbol needs to be autoloaded, even just for a `set'. 1027 (custom-load-symbol symbol)))) 1028 (setq args (custom--sort-vars args)) 1029 (dolist (entry args) 1030 (unless (listp entry) 1031 (error "Incompatible Custom theme spec")) 1032 (let* ((symbol (indirect-variable (nth 0 entry))) 1033 (value (nth 1 entry))) 1034 (custom-push-theme 'theme-value symbol theme 'set value) 1035 (when (custom--should-apply-setting theme) 1036 ;; Now set the variable. 1037 (let* ((now (nth 2 entry)) 1038 (requests (nth 3 entry)) 1039 (comment (nth 4 entry)) 1040 set) 1041 (when requests 1042 (put symbol 'custom-requests requests) 1043 ;; Load any libraries that the setting has specified as 1044 ;; being required, but don't error out if the package has 1045 ;; been removed. 1046 (mapc (lambda (lib) (require lib nil t)) requests)) 1047 (setq set (or (get symbol 'custom-set) #'custom-set-default)) 1048 (put symbol 'saved-value (list value)) 1049 (put symbol 'saved-variable-comment comment) 1050 ;; Allow for errors in the case where the setter has 1051 ;; changed between versions, say, but let the user know. 1052 (condition-case data 1053 (cond (now 1054 ;; Rogue variable, set it now. 1055 (put symbol 'force-value t) 1056 (funcall set symbol (eval value))) 1057 ((default-boundp symbol) 1058 ;; Something already set this, overwrite it. 1059 (funcall set symbol (eval value)))) 1060 (error 1061 (message "Error setting %s: %s" symbol data))) 1062 (and (or now (default-boundp symbol)) 1063 (put symbol 'variable-comment comment))))))) 1064 1065(defvar custom--sort-vars-table) 1066(defvar custom--sort-vars-result) 1067 1068(defun custom--sort-vars (vars) 1069 "Sort VARS based on custom dependencies. 1070VARS is a list whose elements have the same form as the ARGS 1071arguments to `custom-theme-set-variables'. Return the sorted 1072list, in which A occurs before B if B was defined with a 1073`:set-after' keyword specifying A (see `defcustom')." 1074 (let ((custom--sort-vars-table (make-hash-table)) 1075 (dependants (make-hash-table)) 1076 (custom--sort-vars-result nil) 1077 last) 1078 ;; Construct a pair of tables keyed with the symbols of VARS. 1079 (dolist (var vars) 1080 (puthash (car var) (cons t var) custom--sort-vars-table) 1081 (puthash (car var) var dependants)) 1082 ;; From the second table, remove symbols that are depended-on. 1083 (dolist (var vars) 1084 (dolist (dep (get (car var) 'custom-dependencies)) 1085 (remhash dep dependants))) 1086 ;; If a variable is "stand-alone", put it last if it's a minor 1087 ;; mode or has a :require flag. This is not really necessary, but 1088 ;; putting minor modes last helps ensure that the mode function 1089 ;; sees other customized values rather than default values. 1090 (maphash (lambda (sym var) 1091 (when (and (null (get sym 'custom-dependencies)) 1092 (or (nth 3 var) 1093 (eq (get sym 'custom-set) 1094 'custom-set-minor-mode))) 1095 (remhash sym dependants) 1096 (push var last))) 1097 dependants) 1098 ;; The remaining symbols depend on others but are not 1099 ;; depended-upon. Do a depth-first topological sort. 1100 (maphash #'custom--sort-vars-1 dependants) 1101 (nreverse (append last custom--sort-vars-result)))) 1102 1103(defun custom--sort-vars-1 (sym &optional _ignored) 1104 (let ((elt (gethash sym custom--sort-vars-table))) 1105 ;; The car of the hash table value is nil if the variable has 1106 ;; already been processed, `dependant' if it is a dependant in the 1107 ;; current graph descent, and t otherwise. 1108 (when elt 1109 (cond 1110 ((eq (car elt) 'dependant) 1111 (error "Circular custom dependency on `%s'" sym)) 1112 ((car elt) 1113 (setcar elt 'dependant) 1114 (dolist (dep (get sym 'custom-dependencies)) 1115 (custom--sort-vars-1 dep)) 1116 (setcar elt nil) 1117 (push (cdr elt) custom--sort-vars-result)))))) 1118 1119 1120;;; Defining themes. 1121 1122;; A theme file is named `THEME-theme.el' (where THEME is the theme 1123;; name) found in `custom-theme-load-path'. It has this format: 1124;; 1125;; (deftheme THEME 1126;; DOCSTRING) 1127;; 1128;; (custom-theme-set-variables 1129;; 'THEME 1130;; [THEME-VARIABLES]) 1131;; 1132;; (custom-theme-set-faces 1133;; 'THEME 1134;; [THEME-FACES]) 1135;; 1136;; (provide-theme 'THEME) 1137 1138 1139(defmacro deftheme (theme &optional doc) 1140 "Declare THEME to be a Custom theme. 1141The optional argument DOC is a doc string describing the theme. 1142 1143Any theme `foo' should be defined in a file called `foo-theme.el'; 1144see `custom-make-theme-feature' for more information." 1145 (declare (doc-string 2) 1146 (indent 1)) 1147 (let ((feature (custom-make-theme-feature theme))) 1148 ;; It is better not to use backquote in this file, 1149 ;; because that makes a bootstrapping problem 1150 ;; if you need to recompile all the Lisp files using interpreted code. 1151 (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) 1152 1153(defun custom-declare-theme (theme feature &optional doc) 1154 "Like `deftheme', but THEME is evaluated as a normal argument. 1155FEATURE is the feature this theme provides. Normally, this is a symbol 1156created from THEME by `custom-make-theme-feature'." 1157 (unless (custom-theme-name-valid-p theme) 1158 (error "Custom theme cannot be named %S" theme)) 1159 (unless (memq theme custom-known-themes) 1160 (push theme custom-known-themes)) 1161 (put theme 'theme-feature feature) 1162 (when doc (put theme 'theme-documentation doc))) 1163 1164(defun custom-make-theme-feature (theme) 1165 "Given a symbol THEME, create a new symbol by appending \"-theme\". 1166Store this symbol in the `theme-feature' property of THEME. 1167Calling `provide-theme' to provide THEME actually puts `THEME-theme' 1168into `features'. 1169 1170This allows for a file-name convention for autoloading themes: 1171Every theme X has a property `provide-theme' whose value is \"X-theme\". 1172\(load-theme X) then attempts to load the file `X-theme.el'." 1173 (intern (concat (symbol-name theme) "-theme"))) 1174 1175;;; Loading themes. 1176 1177(defcustom custom-theme-directory user-emacs-directory 1178 "Default user directory for storing custom theme files. 1179The command `customize-create-theme' writes theme files into this 1180directory. By default, Emacs searches for custom themes in this 1181directory first---see `custom-theme-load-path'." 1182 :initialize #'custom-initialize-delay 1183 :type 'string 1184 :group 'customize 1185 :version "22.1") 1186 1187(defvar custom-theme-load-path (list 'custom-theme-directory t) 1188 "List of directories to search for custom theme files. 1189When loading custom themes (e.g. in `customize-themes' and 1190`load-theme'), Emacs searches for theme files in the specified 1191order. Each element in the list should be one of the following: 1192- the symbol `custom-theme-directory', meaning the value of 1193 `custom-theme-directory'. 1194- the symbol t, meaning the built-in theme directory (a directory 1195 named \"themes\" in `data-directory'). 1196- a directory name (a string). 1197 1198Each theme file is named THEME-theme.el, where THEME is the theme 1199name. 1200 1201This variable is designed for use in lisp code (including 1202external packages). For manual user customizations, use 1203`custom-theme-directory' instead.") 1204 1205(defvar custom--inhibit-theme-enable 'apply-only-user 1206 "Whether the custom-theme-set-* functions act immediately. 1207If nil, `custom-theme-set-variables' and `custom-theme-set-faces' 1208change the current values of the given variable or face. If 1209t, they just make a record of the theme settings. If the 1210value is `apply-only-user', then apply setting to the 1211`user' theme immediately and defer other updates.") 1212 1213(defun provide-theme (theme) 1214 "Indicate that this file provides THEME. 1215This calls `provide' to provide the feature name stored in THEME's 1216property `theme-feature' (which is usually a symbol created by 1217`custom-make-theme-feature')." 1218 (unless (custom-theme-name-valid-p theme) 1219 (error "Custom theme cannot be named %S" theme)) 1220 (custom-check-theme theme) 1221 (provide (get theme 'theme-feature))) 1222 1223(defun require-theme (feature &optional noerror) 1224 "Load FEATURE from a file along `custom-theme-load-path'. 1225 1226This function is like `require', but searches along 1227`custom-theme-load-path' instead of `load-path'. It can be used 1228by Custom themes to load supporting Lisp files when `require' is 1229unsuitable. 1230 1231If FEATURE is not already loaded, search for a file named FEATURE 1232with an added `.elc' or `.el' suffix, in that order, in the 1233directories specified by `custom-theme-load-path'. 1234 1235Return FEATURE if the file is successfully found and loaded, or 1236if FEATURE was already loaded. If the file fails to load, signal 1237an error. If optional argument NOERROR is non-nil, return nil 1238instead of signaling an error. If the file loads but does not 1239provide FEATURE, signal an error. This cannot be suppressed." 1240 (cond 1241 ((featurep feature) feature) 1242 ((let* ((path (custom-theme--load-path)) 1243 (file (locate-file (symbol-name feature) path '(".elc" ".el")))) 1244 (and file (require feature (file-name-sans-extension file) noerror)))) 1245 ((not noerror) 1246 (signal 'file-missing `("Cannot open load file" "No such file or directory" 1247 ,(symbol-name feature)))))) 1248 1249(defcustom custom-safe-themes '(default) 1250 "Themes that are considered safe to load. 1251If the value is a list, each element should be either the SHA-256 1252hash of a safe theme file, or the symbol `default', which stands 1253for any theme in the built-in Emacs theme directory (a directory 1254named \"themes\" in `data-directory'). 1255 1256If the value is t, Emacs treats all themes as safe. 1257 1258This variable cannot be set in a Custom theme." 1259 :type '(choice (repeat :tag "List of safe themes" 1260 (choice string 1261 (const :tag "Built-in themes" default))) 1262 (const :tag "All themes" t)) 1263 :group 'customize 1264 :risky t 1265 :version "24.1") 1266 1267(defun load-theme (theme &optional no-confirm no-enable) 1268 "Load Custom theme named THEME from its file and possibly enable it. 1269The theme file is named THEME-theme.el, in one of the directories 1270specified by `custom-theme-load-path'. 1271 1272If the theme is not considered safe by `custom-safe-themes', 1273prompt the user for confirmation before loading it. But if 1274optional arg NO-CONFIRM is non-nil, load the theme without 1275prompting. 1276 1277Normally, this function also enables THEME. If optional arg 1278NO-ENABLE is non-nil, load the theme but don't enable it, unless 1279the theme was already enabled. 1280 1281Note that enabling THEME does not disable any other 1282already-enabled themes. If THEME is enabled, it has the highest 1283precedence (after `user') among enabled themes. To disable other 1284themes, use `disable-theme'. 1285 1286This function is normally called through Customize when setting 1287`custom-enabled-themes'. If used directly in your init file, it 1288should be called with a non-nil NO-CONFIRM argument, or after 1289`custom-safe-themes' has been loaded. 1290 1291Return t if THEME was successfully loaded, nil otherwise." 1292 (interactive 1293 (list 1294 (intern (completing-read "Load custom theme: " 1295 (mapcar #'symbol-name 1296 (custom-available-themes)))) 1297 nil nil)) 1298 (unless (custom-theme-name-valid-p theme) 1299 (error "Invalid theme name `%s'" theme)) 1300 ;; If THEME is already enabled, re-enable it after loading, even if 1301 ;; NO-ENABLE is t. 1302 (if no-enable 1303 (setq no-enable (not (custom-theme-enabled-p theme)))) 1304 ;; If reloading, clear out the old theme settings. 1305 (when (custom-theme-p theme) 1306 (disable-theme theme) 1307 (put theme 'theme-settings nil) 1308 (put theme 'theme-feature nil) 1309 (put theme 'theme-documentation nil)) 1310 (let ((file (locate-file (concat (symbol-name theme) "-theme.el") 1311 (custom-theme--load-path) 1312 '("" "c"))) 1313 (custom--inhibit-theme-enable t)) 1314 ;; Check file safety with `custom-safe-themes', prompting the 1315 ;; user if necessary. 1316 (cond ((not file) 1317 (error "Unable to find theme file for `%s'" theme)) 1318 ((or no-confirm 1319 (eq custom-safe-themes t) 1320 (and (memq 'default custom-safe-themes) 1321 (equal (file-name-directory file) 1322 (expand-file-name "themes/" data-directory)))) 1323 ;; Theme is safe; load byte-compiled version if available. 1324 (load (file-name-sans-extension file) nil t nil t)) 1325 ((with-temp-buffer 1326 (insert-file-contents file) 1327 (let ((hash (secure-hash 'sha256 (current-buffer)))) 1328 (when (or (member hash custom-safe-themes) 1329 (custom-theme-load-confirm hash)) 1330 (eval-buffer nil nil file) 1331 t)))) 1332 (t 1333 (error "Unable to load theme `%s'" theme)))) 1334 (when-let ((obs (get theme 'byte-obsolete-info))) 1335 (display-warning 'initialization 1336 (format "The `%s' theme is obsolete%s" 1337 theme 1338 (if (nth 2 obs) 1339 (format " since Emacs %s" (nth 2 obs)) 1340 "")))) 1341 ;; Optimization: if the theme changes the `default' face, put that 1342 ;; entry first. This avoids some `frame-set-background-mode' rigmarole 1343 ;; by assigning the new background immediately. 1344 (let* ((settings (get theme 'theme-settings)) 1345 (tail settings) 1346 found) 1347 (while (and tail (not found)) 1348 (and (eq (nth 0 (car tail)) 'theme-face) 1349 (eq (nth 1 (car tail)) 'default) 1350 (setq found (car tail))) 1351 (setq tail (cdr tail))) 1352 (when found 1353 (put theme 'theme-settings (cons found (delq found settings))))) 1354 ;; Finally, enable the theme. 1355 (unless no-enable 1356 (enable-theme theme)) 1357 t) 1358 1359(defun custom-theme-load-confirm (hash) 1360 "Query the user about loading a Custom theme that may not be safe. 1361The theme should be in the current buffer. If the user agrees, 1362query also about adding HASH to `custom-safe-themes'." 1363 (unless noninteractive 1364 (save-window-excursion 1365 (rename-buffer "*Custom Theme*" t) 1366 (emacs-lisp-mode) 1367 (pop-to-buffer (current-buffer)) 1368 (goto-char (point-min)) 1369 (prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ") 1370 ;; Offer to save to `custom-safe-themes'. 1371 (and (or custom-file user-init-file) 1372 (y-or-n-p "Treat this theme as safe in future sessions? ") 1373 (customize-push-and-save 'custom-safe-themes (list hash))) 1374 t) 1375 (quit-window))))) 1376 1377(defun custom-theme-name-valid-p (name) 1378 "Return t if NAME is a valid name for a Custom theme, nil otherwise. 1379NAME should be a symbol." 1380 (and (not (memq name '(nil user changed))) 1381 (symbolp name) 1382 (not (string= "" (symbol-name name))))) 1383 1384(defun custom-available-themes () 1385 "Return a list of Custom themes available for loading. 1386Search the directories specified by `custom-theme-load-path' for 1387files named FOO-theme.el, and return a list of FOO symbols. 1388 1389The returned symbols may not correspond to themes that have been 1390loaded, and no effort is made to check that the files contain 1391valid Custom themes. For a list of loaded themes, check the 1392variable `custom-known-themes'." 1393 (let ((suffix "-theme\\.el\\'") 1394 themes) 1395 (dolist (dir (custom-theme--load-path)) 1396 ;; `custom-theme--load-path' promises DIR exists and is a 1397 ;; directory, but `custom.el' is loaded too early during 1398 ;; bootstrap to use `cl-lib' macros, so guard with 1399 ;; `file-directory-p' instead of calling `cl-assert'. 1400 (dolist (file (and (file-directory-p dir) 1401 (directory-files dir nil suffix))) 1402 (let ((theme (intern (substring file 0 (string-match-p suffix file))))) 1403 (and (custom-theme-name-valid-p theme) 1404 (not (memq theme themes)) 1405 (push theme themes))))) 1406 (nreverse themes))) 1407 1408(defun custom-theme--load-path () 1409 "Expand `custom-theme-load-path' into a list of directories. 1410Members of `custom-theme-load-path' that either don't exist or 1411are not directories are omitted from the expansion." 1412 (let (lpath) 1413 (dolist (f custom-theme-load-path) 1414 (cond ((eq f 'custom-theme-directory) 1415 (setq f custom-theme-directory)) 1416 ((eq f t) 1417 (setq f (expand-file-name "themes" data-directory)))) 1418 (if (file-directory-p f) 1419 (push f lpath))) 1420 (nreverse lpath))) 1421 1422 1423;;; Enabling and disabling loaded themes. 1424 1425(defun enable-theme (theme) 1426 "Reenable all variable and face settings defined by THEME. 1427THEME should be either `user', or a theme loaded via `load-theme'. 1428 1429After this function completes, THEME will have the highest 1430precedence (after `user') among enabled themes. 1431 1432Note that any already-enabled themes remain enabled after this 1433function runs. To disable other themes, use `disable-theme'." 1434 (interactive (list (intern 1435 (completing-read 1436 "Enable custom theme: " 1437 obarray (lambda (sym) (get sym 'theme-settings)) t)))) 1438 (unless (custom-theme-p theme) 1439 (error "Undefined Custom theme %s" theme)) 1440 (let ((settings (get theme 'theme-settings)) ; '(prop symbol theme value) 1441 ;; We are enabling the theme, so don't inhibit enabling it. (Bug#34027) 1442 (custom--inhibit-theme-enable nil)) 1443 ;; Loop through theme settings, recalculating vars/faces. 1444 (dolist (s settings) 1445 (let* ((prop (car s)) 1446 (symbol (cadr s)) 1447 (spec-list (get symbol prop)) 1448 (sv (get symbol 'standard-value)) 1449 (val (and (boundp symbol) (symbol-value symbol)))) 1450 ;; We can't call `custom-push-theme' when enabling the theme: it's not 1451 ;; that the theme settings have changed, it's just that we want to 1452 ;; enable those settings. But we might need to save a user setting 1453 ;; outside of Customize, in order to get back to it when disabling 1454 ;; the theme, just like in `custom-push-theme'. 1455 (when (and (custom--should-apply-setting theme) 1456 ;; Only do it for variables; for faces, using 1457 ;; `face-new-frame-defaults' is enough. 1458 (eq prop 'theme-value) 1459 (boundp symbol) 1460 (not (or spec-list 1461 ;; Only if the current value is different from 1462 ;; the standard value. 1463 (and sv (equal (eval (car sv)) val)) 1464 ;; And only if the changed value is different 1465 ;; from the new value under the user theme. 1466 (and (eq theme 'user) 1467 (equal (custom-quote val) (nth 3 s)))))) 1468 (setq spec-list `((changed ,(custom-quote val))))) 1469 (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) 1470 (cond 1471 ((eq prop 'theme-face) 1472 (custom-theme-recalc-face symbol)) 1473 ((eq prop 'theme-value) 1474 ;; Ignore `custom-enabled-themes' and `custom-safe-themes'. 1475 (unless (memq symbol '(custom-enabled-themes custom-safe-themes)) 1476 (custom-theme-recalc-variable symbol))))))) 1477 (unless (eq theme 'user) 1478 (setq custom-enabled-themes 1479 (cons theme (remq theme custom-enabled-themes))) 1480 ;; Give the `user' theme the highest priority. 1481 (enable-theme 'user))) 1482 1483(defcustom custom-enabled-themes nil 1484 "List of enabled Custom Themes, highest precedence first. 1485This list does not include the `user' theme, which is set by 1486Customize and always takes precedence over other Custom Themes. 1487 1488This variable cannot be defined inside a Custom theme; there, it 1489is simply ignored. 1490 1491Setting this variable through Customize calls `enable-theme' or 1492`load-theme' for each theme in the list." 1493 :group 'customize 1494 :type '(repeat symbol) 1495 :set-after '(custom-theme-directory custom-theme-load-path 1496 custom-safe-themes) 1497 :risky t 1498 :set (lambda (symbol themes) 1499 (let (failures) 1500 (setq themes (delq 'user (delete-dups themes))) 1501 ;; Disable all themes not in THEMES. 1502 (dolist (theme (and (boundp symbol) 1503 (symbol-value symbol))) 1504 (unless (memq theme themes) 1505 (disable-theme theme))) 1506 ;; Call `enable-theme' or `load-theme' on each of THEMES. 1507 (dolist (theme (reverse themes)) 1508 (condition-case nil 1509 (if (custom-theme-p theme) 1510 (enable-theme theme) 1511 (load-theme theme)) 1512 (error (push theme failures) 1513 (setq themes (delq theme themes))))) 1514 (enable-theme 'user) 1515 (custom-set-default symbol themes) 1516 (when failures 1517 (message "Failed to enable theme(s): %s" 1518 (mapconcat #'symbol-name failures ", ")))))) 1519 1520(defsubst custom-theme-enabled-p (theme) 1521 "Return non-nil if THEME is enabled." 1522 (memq theme custom-enabled-themes)) 1523 1524(defun disable-theme (theme) 1525 "Disable all variable and face settings defined by THEME. 1526See `custom-enabled-themes' for a list of enabled themes." 1527 (interactive (list (intern 1528 (completing-read 1529 "Disable custom theme: " 1530 (mapcar #'symbol-name custom-enabled-themes) 1531 nil t)))) 1532 (when (custom-theme-enabled-p theme) 1533 (let ((settings (get theme 'theme-settings))) 1534 (dolist (s settings) 1535 (let* ((prop (car s)) 1536 (symbol (cadr s)) 1537 (val (assq-delete-all theme (get symbol prop)))) 1538 (put symbol prop val) 1539 (cond 1540 ((eq prop 'theme-value) 1541 (custom-theme-recalc-variable symbol) 1542 ;; We might have to reset the stashed value of the variable, if 1543 ;; no other theme is customizing it. Without this, loading a theme 1544 ;; that has a setting for an unbound user option and then disabling 1545 ;; it will leave this lingering setting for the option, and if then 1546 ;; Emacs evaluates the defcustom the saved-value might be used to 1547 ;; set the variable. (Bug#20766) 1548 (unless (get symbol 'theme-value) 1549 (put symbol 'saved-value nil))) 1550 ((eq prop 'theme-face) 1551 ;; If the face spec specified by this theme is in the 1552 ;; saved-face property, reset that property. 1553 (when (equal (nth 3 s) (get symbol 'saved-face)) 1554 (put symbol 'saved-face (cadar val)))))))) 1555 ;; Recompute faces on all frames. 1556 (dolist (frame (frame-list)) 1557 ;; We must reset the fg and bg color frame parameters, or 1558 ;; `face-set-after-frame-default' will use the existing 1559 ;; parameters, which could be from the disabled theme. 1560 (set-frame-parameter frame 'background-color 1561 (custom--frame-color-default 1562 frame :background "background" "Background" 1563 "unspecified-bg" "white")) 1564 (set-frame-parameter frame 'foreground-color 1565 (custom--frame-color-default 1566 frame :foreground "foreground" "Foreground" 1567 "unspecified-fg" "black")) 1568 (face-set-after-frame-default frame)) 1569 (setq custom-enabled-themes 1570 (delq theme custom-enabled-themes)))) 1571 1572;; Only used if window-system not null. 1573(declare-function x-get-resource "frame.c" 1574 (attribute class &optional component subclass)) 1575 1576(defun custom--frame-color-default (frame attribute resource-attr resource-class 1577 tty-default x-default) 1578 (let ((col (face-attribute 'default attribute t))) 1579 (cond 1580 ((and col (not (eq col 'unspecified))) col) 1581 ((null (window-system frame)) tty-default) 1582 ((setq col (x-get-resource resource-attr resource-class)) col) 1583 (t x-default)))) 1584 1585(defun custom-variable-theme-value (variable) 1586 "Return (list VALUE) indicating the custom theme value of VARIABLE. 1587That is to say, it specifies what the value should be according to 1588currently enabled custom themes. 1589 1590This function returns nil if no custom theme specifies a value for VARIABLE." 1591 (let ((theme-value (get variable 'theme-value))) 1592 (if theme-value 1593 (cdr (car theme-value))))) 1594 1595(defun custom-theme-recalc-variable (variable) 1596 "Set VARIABLE according to currently enabled custom themes." 1597 (let ((valspec (custom-variable-theme-value variable))) 1598 ;; We used to save VALSPEC under the saved-value property unconditionally, 1599 ;; but that is a recipe for trouble because we might end up saving session 1600 ;; customizations if the user loads a theme. (Bug#21355) 1601 ;; It's better to only use the saved-value property to stash the value only 1602 ;; if we really need to stash it (i.e., VARIABLE is void). 1603 (condition-case nil 1604 (default-toplevel-value variable) ; See if it doesn't fail. 1605 (void-variable (when valspec 1606 (put variable 'saved-value valspec)))) 1607 (unless valspec 1608 (setq valspec (get variable 'standard-value))) 1609 (if (and valspec 1610 (or (get variable 'force-value) 1611 (default-boundp variable))) 1612 (funcall (or (get variable 'custom-set) #'set-default) variable 1613 (eval (car valspec)))))) 1614 1615(defun custom-theme-recalc-face (face) 1616 "Set FACE according to currently enabled custom themes. 1617If FACE is not initialized as a face, do nothing; otherwise call 1618`face-spec-recalc' to recalculate the face on all frames." 1619 (if (get face 'face-alias) 1620 (setq face (get face 'face-alias))) 1621 (if (facep face) 1622 ;; Reset the faces for each frame. 1623 (dolist (frame (frame-list)) 1624 (face-spec-recalc face frame)))) 1625 1626 1627;;; XEmacs compatibility functions 1628 1629;; In XEmacs, when you reset a Custom Theme, you have to specify the 1630;; theme to reset it to. We just apply the next available theme, so 1631;; just ignore the IGNORED arguments. 1632 1633(defun custom-theme-reset-variables (theme &rest args) 1634 "Reset some variable settings in THEME to their values in other themes. 1635Each of the arguments ARGS has this form: 1636 1637 (VARIABLE IGNORED) 1638 1639This means reset VARIABLE. (The argument IGNORED is ignored)." 1640 (custom-check-theme theme) 1641 (dolist (arg args) 1642 (custom-push-theme 'theme-value (car arg) theme 'reset))) 1643 1644(defun custom-reset-variables (&rest args) 1645 "Reset the specs of some variables to their values in other themes. 1646This creates settings in the `user' theme. 1647 1648Each of the arguments ARGS has this form: 1649 1650 (VARIABLE IGNORED) 1651 1652This means reset VARIABLE. (The argument IGNORED is ignored)." 1653 (apply #'custom-theme-reset-variables 'user args)) 1654 1655(defun custom-add-choice (variable choice) 1656 "Add CHOICE to the custom type of VARIABLE. 1657If a choice with the same tag already exists, no action is taken." 1658 (let ((choices (get variable 'custom-type))) 1659 (unless (eq (car choices) 'choice) 1660 (error "Not a choice type: %s" choices)) 1661 (unless (seq-find (lambda (elem) 1662 (equal (caddr (member :tag elem)) 1663 (caddr (member :tag choice)))) 1664 (cdr choices)) 1665 ;; Put the new choice at the end. 1666 (put variable 'custom-type 1667 (append choices (list choice)))))) 1668 1669(provide 'custom) 1670 1671;;; custom.el ends here 1672