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