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