lisp/custom.el

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