| 1 | ;;; custom.el --- tools for declaring and initializing options |
| 2 | ;; |
| 3 | ;; Copyright (C) 1996, 1997, 1999, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006 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. |
| 45 | That is used for the sake of `custom-make-dependencies'. |
| 46 | Users 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. |
| 55 | This will do nothing if symbol already has a default binding. |
| 56 | Otherwise, if symbol has a `saved-value' property, it will evaluate |
| 57 | the car of that and use it as the default binding for symbol. |
| 58 | Otherwise, VALUE will be evaluated and used as the default binding for |
| 59 | symbol." |
| 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. |
| 68 | If the symbol doesn't have a default binding already, |
| 69 | then set it using its `:set' function (or `set-default' if it has none). |
| 70 | The value is either the value in the symbol's `saved-value' property, |
| 71 | if 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. |
| 81 | If an error occurs during initialization, SYMBOL is set to nil |
| 82 | and no error is thrown. This is meant for use in pre-loaded files |
| 83 | where some variables or functions used to compute VALUE may not yet |
| 84 | be defined. You can then re-evaluate VALUE in startup.el, for instance |
| 85 | using `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. |
| 92 | If an error occurs during initialization, SYMBOL is set to nil |
| 93 | and no error is thrown. This is meant for use in pre-loaded files |
| 94 | where some variables or functions used to compute VALUE may not yet |
| 95 | be defined. You can then re-evaluate VALUE in startup.el, for instance |
| 96 | using `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. |
| 103 | Set the symbol, using its `:set' function (or `set-default' if it has none). |
| 104 | The value is either the symbol's current value |
| 105 | \(as obtained using the `:get' function), if any, |
| 106 | or the value in the symbol's `saved-value' property if any, |
| 107 | or (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. |
| 120 | Like `custom-initialize-reset', but only use the `:set' function if |
| 121 | not using the standard setting. |
| 122 | For 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. |
| 137 | DEFAULT should be an expression to evaluate to compute the default value, |
| 138 | not the default value itself. |
| 139 | |
| 140 | DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property |
| 141 | `standard-value'. At the same time, SYMBOL's property `force-value' is |
| 142 | set 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. |
| 194 | DOC is the variable documentation. |
| 195 | |
| 196 | Neither SYMBOL nor VALUE need to be quoted. |
| 197 | If SYMBOL is not already bound, initialize it to VALUE. |
| 198 | The remaining arguments should have the form |
| 199 | |
| 200 | [KEYWORD VALUE]... |
| 201 | |
| 202 | The 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 `custom-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 `custom-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 | |
| 223 | The 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 | |
| 294 | If SYMBOL has a local binding, then this form affects the local |
| 295 | binding. This is normally not what you want. Thus, if you need |
| 296 | to 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 | |
| 301 | See Info node `(elisp) Customization' in the Emacs Lisp manual |
| 302 | for 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. |
| 317 | FACE does not need to be quoted. |
| 318 | |
| 319 | Third argument DOC is the face documentation. |
| 320 | |
| 321 | If FACE has been set with `custom-set-faces', set the face attributes |
| 322 | as specified by that function, otherwise set the face attributes |
| 323 | according to SPEC. |
| 324 | |
| 325 | The remaining arguments should have the form |
| 326 | |
| 327 | [KEYWORD VALUE]... |
| 328 | |
| 329 | For a list of valid keywords, see the common keywords listed in |
| 330 | `defcustom'. |
| 331 | |
| 332 | SPEC should be an alist of the form ((DISPLAY ATTS)...). |
| 333 | |
| 334 | In the first element, DISPLAY can be :default. The ATTS in that |
| 335 | element then act as defaults for all the following elements. |
| 336 | |
| 337 | Aside from that, DISPLAY specifies conditions to match some or |
| 338 | all frames. For each frame, the first element of SPEC where the |
| 339 | DISPLAY conditions are satisfied is the one that applies to that |
| 340 | frame. The ATTRs in this element take effect, and the following |
| 341 | elements are ignored, on that frame. |
| 342 | |
| 343 | In the last element, DISPLAY can be t. That element applies to a |
| 344 | frame if none of the previous elements (except the :default if |
| 345 | any) did. |
| 346 | |
| 347 | ATTS is a list of face attributes followed by their values: |
| 348 | (ATTR VALUE ATTR VALUE...) |
| 349 | |
| 350 | The possible attributes are `:family', `:width', `:height', `:weight', |
| 351 | `:slant', `:underline', `:overline', `:strike-through', `:box', |
| 352 | `:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'. |
| 353 | |
| 354 | DISPLAY can be `:default' (only in the first element), the symbol |
| 355 | t (only in the last element) to match all frames, or an alist of |
| 356 | conditions of the form \(REQ ITEM...). For such an alist to |
| 357 | match a frame, each of the conditions must be satisfied, meaning |
| 358 | that the REQ property of the frame must match one of the |
| 359 | corresponding 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 | |
| 381 | See Info node `(elisp) Customization' in the Emacs Lisp manual |
| 382 | for 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. |
| 426 | SYMBOL does not need to be quoted. |
| 427 | |
| 428 | Third arg DOC is the group documentation. |
| 429 | |
| 430 | MEMBERS should be an alist of the form ((NAME WIDGET)...) where |
| 431 | NAME is a symbol and WIDGET is a widget for editing that symbol. |
| 432 | Useful widgets are `custom-variable' for editing variables, |
| 433 | `custom-face' for edit faces, and `custom-group' for editing groups. |
| 434 | |
| 435 | The remaining arguments should have the form |
| 436 | |
| 437 | [KEYWORD VALUE]... |
| 438 | |
| 439 | For a list of valid keywords, see the common keywords listed in |
| 440 | `defcustom'. |
| 441 | |
| 442 | See Info node `(elisp) Customization' in the Emacs Lisp manual |
| 443 | for 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. |
| 452 | If 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. |
| 460 | If 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. |
| 473 | Third 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. |
| 490 | Fourth 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. |
| 512 | VALUE should be a list of symbols. For each symbol in that list, |
| 513 | this specifies that SYMBOL should be set after the specified symbol, if |
| 514 | both 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 | |
| 532 | If SYMBOL's custom type is a hook, OPTION should be a hook member. |
| 533 | If SYMBOL's custom type is an alist, OPTION specifies a symbol |
| 534 | to offer to the user as a possible key in the alist. |
| 535 | For 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 | |
| 540 | (defun custom-add-link (symbol widget) |
| 541 | "To the custom option SYMBOL add the link WIDGET." |
| 542 | (let ((links (get symbol 'custom-links))) |
| 543 | (unless (member widget links) |
| 544 | (put symbol 'custom-links (cons (purecopy widget) links))))) |
| 545 | |
| 546 | (defun custom-add-version (symbol version) |
| 547 | "To the custom option SYMBOL add the version VERSION." |
| 548 | (put symbol 'custom-version (purecopy version))) |
| 549 | |
| 550 | (defun custom-add-package-version (symbol version) |
| 551 | "To the custom option SYMBOL add the package version VERSION." |
| 552 | (put symbol 'custom-package-version (purecopy version))) |
| 553 | |
| 554 | (defun custom-add-load (symbol load) |
| 555 | "To the custom option SYMBOL add the dependency LOAD. |
| 556 | LOAD should be either a library file name, or a feature name." |
| 557 | (let ((loads (get symbol 'custom-loads))) |
| 558 | (unless (member load loads) |
| 559 | (put symbol 'custom-loads (cons (purecopy load) loads))))) |
| 560 | |
| 561 | (defun custom-autoload (symbol load &optional noset) |
| 562 | "Mark SYMBOL as autoloaded custom variable and add dependency LOAD. |
| 563 | If NOSET is non-nil, don't bother autoloading LOAD when setting the variable." |
| 564 | (put symbol 'custom-autoload (if noset 'noset t)) |
| 565 | (custom-add-load symbol load)) |
| 566 | |
| 567 | ;; This test is also in the C code of `user-variable-p'. |
| 568 | (defun custom-variable-p (variable) |
| 569 | "Return non-nil if VARIABLE is a custom variable. |
| 570 | This recursively follows aliases." |
| 571 | (setq variable (indirect-variable variable)) |
| 572 | (or (get variable 'standard-value) |
| 573 | (get variable 'custom-autoload))) |
| 574 | |
| 575 | ;;; Loading files needed to customize a symbol. |
| 576 | ;;; This is in custom.el because menu-bar.el needs it for toggle cmds. |
| 577 | |
| 578 | (defvar custom-load-recursion nil |
| 579 | "Hack to avoid recursive dependencies.") |
| 580 | |
| 581 | (defun custom-load-symbol (symbol) |
| 582 | "Load all dependencies for SYMBOL." |
| 583 | (unless custom-load-recursion |
| 584 | (let ((custom-load-recursion t)) |
| 585 | ;; Load these files if not already done, |
| 586 | ;; to make sure we know all the dependencies of SYMBOL. |
| 587 | (condition-case nil |
| 588 | (require 'cus-load) |
| 589 | (error nil)) |
| 590 | (condition-case nil |
| 591 | (require 'cus-start) |
| 592 | (error nil)) |
| 593 | (dolist (load (get symbol 'custom-loads)) |
| 594 | (cond ((symbolp load) (condition-case nil (require load) (error nil))) |
| 595 | ;; This is subsumed by the test below, but it's much faster. |
| 596 | ((assoc load load-history)) |
| 597 | ;; This was just (assoc (locate-library load) load-history) |
| 598 | ;; but has been optimized not to load locate-library |
| 599 | ;; if not necessary. |
| 600 | ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load) |
| 601 | "\\(\\'\\|\\.\\)")) |
| 602 | (found nil)) |
| 603 | (dolist (loaded load-history) |
| 604 | (and (stringp (car loaded)) |
| 605 | (string-match regexp (car loaded)) |
| 606 | (setq found t))) |
| 607 | found)) |
| 608 | ;; Without this, we would load cus-edit recursively. |
| 609 | ;; We are still loading it when we call this, |
| 610 | ;; and it is not in load-history yet. |
| 611 | ((equal load "cus-edit")) |
| 612 | (t (condition-case nil (load load) (error nil)))))))) |
| 613 | \f |
| 614 | (defvar custom-local-buffer nil |
| 615 | "Non-nil, in a Customization buffer, means customize a specific buffer. |
| 616 | If this variable is non-nil, it should be a buffer, |
| 617 | and it means customize the local bindings of that buffer. |
| 618 | This variable is a permanent local, and it normally has a local binding |
| 619 | in every Customization buffer.") |
| 620 | (put 'custom-local-buffer 'permanent-local t) |
| 621 | |
| 622 | (defun custom-set-default (variable value) |
| 623 | "Default :set function for a customizable variable. |
| 624 | Normally, this sets the default value of VARIABLE to VALUE, |
| 625 | but if `custom-local-buffer' is non-nil, |
| 626 | this sets the local binding in that buffer instead." |
| 627 | (if custom-local-buffer |
| 628 | (with-current-buffer custom-local-buffer |
| 629 | (set variable value)) |
| 630 | (set-default variable value))) |
| 631 | |
| 632 | (defun custom-set-minor-mode (variable value) |
| 633 | ":set function for minor mode variables. |
| 634 | Normally, this sets the default value of VARIABLE to nil if VALUE |
| 635 | is nil and to t otherwise, |
| 636 | but if `custom-local-buffer' is non-nil, |
| 637 | this sets the local binding in that buffer instead." |
| 638 | (if custom-local-buffer |
| 639 | (with-current-buffer custom-local-buffer |
| 640 | (funcall variable (if value 1 0))) |
| 641 | (funcall variable (if value 1 0)))) |
| 642 | |
| 643 | (defun custom-quote (sexp) |
| 644 | "Quote SEXP iff it is not self quoting." |
| 645 | (if (or (memq sexp '(t nil)) |
| 646 | (keywordp sexp) |
| 647 | (and (listp sexp) |
| 648 | (memq (car sexp) '(lambda))) |
| 649 | (stringp sexp) |
| 650 | (numberp sexp) |
| 651 | (vectorp sexp) |
| 652 | ;;; (and (fboundp 'characterp) |
| 653 | ;;; (characterp sexp)) |
| 654 | ) |
| 655 | sexp |
| 656 | (list 'quote sexp))) |
| 657 | |
| 658 | (defun customize-mark-to-save (symbol) |
| 659 | "Mark SYMBOL for later saving. |
| 660 | |
| 661 | If the default value of SYMBOL is different from the standard value, |
| 662 | set the `saved-value' property to a list whose car evaluates to the |
| 663 | default value. Otherwise, set it to nil. |
| 664 | |
| 665 | To actually save the value, call `custom-save-all'. |
| 666 | |
| 667 | Return non-nil iff the `saved-value' property actually changed." |
| 668 | (custom-load-symbol symbol) |
| 669 | (let* ((get (or (get symbol 'custom-get) 'default-value)) |
| 670 | (value (funcall get symbol)) |
| 671 | (saved (get symbol 'saved-value)) |
| 672 | (standard (get symbol 'standard-value)) |
| 673 | (comment (get symbol 'customized-variable-comment))) |
| 674 | ;; Save default value iff different from standard value. |
| 675 | (if (or (null standard) |
| 676 | (not (equal value (condition-case nil |
| 677 | (eval (car standard)) |
| 678 | (error nil))))) |
| 679 | (put symbol 'saved-value (list (custom-quote value))) |
| 680 | (put symbol 'saved-value nil)) |
| 681 | ;; Clear customized information (set, but not saved). |
| 682 | (put symbol 'customized-value nil) |
| 683 | ;; Save any comment that might have been set. |
| 684 | (when comment |
| 685 | (put symbol 'saved-variable-comment comment)) |
| 686 | (not (equal saved (get symbol 'saved-value))))) |
| 687 | |
| 688 | (defun customize-mark-as-set (symbol) |
| 689 | "Mark current value of SYMBOL as being set from customize. |
| 690 | |
| 691 | If the default value of SYMBOL is different from the saved value if any, |
| 692 | or else if it is different from the standard value, set the |
| 693 | `customized-value' property to a list whose car evaluates to the |
| 694 | default value. Otherwise, set it to nil. |
| 695 | |
| 696 | Return non-nil iff the `customized-value' property actually changed." |
| 697 | (custom-load-symbol symbol) |
| 698 | (let* ((get (or (get symbol 'custom-get) 'default-value)) |
| 699 | (value (funcall get symbol)) |
| 700 | (customized (get symbol 'customized-value)) |
| 701 | (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) |
| 702 | ;; Mark default value as set iff different from old value. |
| 703 | (if (not (and old |
| 704 | (equal value (condition-case nil |
| 705 | (eval (car old)) |
| 706 | (error nil))))) |
| 707 | (progn (put symbol 'customized-value (list (custom-quote value))) |
| 708 | (custom-push-theme 'theme-value symbol 'user 'set |
| 709 | (custom-quote value))) |
| 710 | (put symbol 'customized-value nil)) |
| 711 | ;; Changed? |
| 712 | (not (equal customized (get symbol 'customized-value))))) |
| 713 | |
| 714 | (defun custom-reevaluate-setting (symbol) |
| 715 | "Reset the value of SYMBOL by re-evaluating its saved or standard value. |
| 716 | Use the :set function to do so. This is useful for customizable options |
| 717 | that are defined before their standard value can really be computed. |
| 718 | E.g. dumped variables whose default depends on run-time information." |
| 719 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 720 | symbol |
| 721 | (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) |
| 722 | |
| 723 | \f |
| 724 | ;;; Custom Themes |
| 725 | |
| 726 | ;; Custom themes are collections of settings that can be enabled or |
| 727 | ;; disabled as a unit. |
| 728 | |
| 729 | ;; Each Custom theme is defined by a symbol, called the theme name. |
| 730 | ;; The `theme-settings' property of the theme name records the |
| 731 | ;; variable and face settings of the theme. This property is a list |
| 732 | ;; of elements, each of the form |
| 733 | ;; |
| 734 | ;; (PROP SYMBOL THEME VALUE) |
| 735 | ;; |
| 736 | ;; - PROP is either `theme-value' or `theme-face' |
| 737 | ;; - SYMBOL is the face or variable name |
| 738 | ;; - THEME is the theme name (redundant, but simplifies the code) |
| 739 | ;; - VALUE is an expression that gives the theme's setting for SYMBOL. |
| 740 | ;; |
| 741 | ;; The theme name also has a `theme-feature' property, whose value is |
| 742 | ;; specified when the theme is defined (see `custom-declare-theme'). |
| 743 | ;; Usually, this is just a symbol named THEME-theme. This lets |
| 744 | ;; external libraries call (require 'foo-theme). |
| 745 | |
| 746 | ;; In addition, each symbol (either a variable or a face) affected by |
| 747 | ;; an *enabled* theme has a `theme-value' or `theme-face' property, |
| 748 | ;; which is a list of elements each of the form |
| 749 | ;; |
| 750 | ;; (THEME VALUE) |
| 751 | ;; |
| 752 | ;; which have the same meanings as in `theme-settings'. |
| 753 | ;; |
| 754 | ;; The `theme-value' and `theme-face' lists are ordered by decreasing |
| 755 | ;; theme precedence. Thus, the first element is always the one that |
| 756 | ;; is in effect. |
| 757 | |
| 758 | ;; Each theme is stored in a theme file, with filename THEME-theme.el. |
| 759 | ;; Loading a theme basically involves calling (load "THEME-theme") |
| 760 | ;; This is done by the function `load-theme'. Loading a theme |
| 761 | ;; automatically enables it. |
| 762 | ;; |
| 763 | ;; When a theme is enabled, the `theme-value' and `theme-face' |
| 764 | ;; properties for the affected symbols are set. When a theme is |
| 765 | ;; disabled, its settings are removed from the `theme-value' and |
| 766 | ;; `theme-face' properties, but the theme's own `theme-settings' |
| 767 | ;; property remains unchanged. |
| 768 | |
| 769 | (defvar custom-known-themes '(user changed) |
| 770 | "Themes that have been defined with `deftheme'. |
| 771 | The default value is the list (user changed). The theme `changed' |
| 772 | contains the settings before custom themes are applied. The |
| 773 | theme `user' contains all the settings the user customized and saved. |
| 774 | Additional themes declared with the `deftheme' macro will be added to |
| 775 | the front of this list.") |
| 776 | |
| 777 | (defsubst custom-theme-p (theme) |
| 778 | "Non-nil when THEME has been defined." |
| 779 | (memq theme custom-known-themes)) |
| 780 | |
| 781 | (defsubst custom-check-theme (theme) |
| 782 | "Check whether THEME is valid, and signal an error if it is not." |
| 783 | (unless (custom-theme-p theme) |
| 784 | (error "Unknown theme `%s'" theme))) |
| 785 | |
| 786 | (defun custom-push-theme (prop symbol theme mode &optional value) |
| 787 | "Record VALUE for face or variable SYMBOL in custom theme THEME. |
| 788 | PROP is `theme-face' for a face, `theme-value' for a variable. |
| 789 | |
| 790 | MODE can be either the symbol `set' or the symbol `reset'. If it is the |
| 791 | symbol `set', then VALUE is the value to use. If it is the symbol |
| 792 | `reset', then SYMBOL will be removed from THEME (VALUE is ignored). |
| 793 | |
| 794 | See `custom-known-themes' for a list of known themes." |
| 795 | (unless (memq prop '(theme-value theme-face)) |
| 796 | (error "Unknown theme property")) |
| 797 | (let* ((old (get symbol prop)) |
| 798 | (setting (assq theme old)) ; '(theme value) |
| 799 | (theme-settings ; '(prop symbol theme value) |
| 800 | (get theme 'theme-settings))) |
| 801 | (if (eq mode 'reset) |
| 802 | ;; Remove a setting. |
| 803 | (when setting |
| 804 | (let (res) |
| 805 | (dolist (theme-setting theme-settings) |
| 806 | (if (and (eq (car theme-setting) prop) |
| 807 | (eq (cadr theme-setting) symbol)) |
| 808 | (setq res theme-setting))) |
| 809 | (put theme 'theme-settings (delq res theme-settings))) |
| 810 | (put symbol prop (delq setting old))) |
| 811 | (if setting |
| 812 | ;; Alter an existing setting. |
| 813 | (let (res) |
| 814 | (dolist (theme-setting theme-settings) |
| 815 | (if (and (eq (car theme-setting) prop) |
| 816 | (eq (cadr theme-setting) symbol)) |
| 817 | (setq res theme-setting))) |
| 818 | (put theme 'theme-settings |
| 819 | (cons (list prop symbol theme value) |
| 820 | (delq res theme-settings))) |
| 821 | (setcar (cdr setting) value)) |
| 822 | ;; Add a new setting. |
| 823 | ;; If the user changed the value outside of Customize, we |
| 824 | ;; first save the current value to a fake theme, `changed'. |
| 825 | ;; This ensures that the user-set value comes back if the |
| 826 | ;; theme is later disabled. |
| 827 | (if (null old) |
| 828 | (if (and (eq prop 'theme-value) |
| 829 | (boundp symbol)) |
| 830 | (let ((sv (get symbol 'standard-value))) |
| 831 | (unless (and sv |
| 832 | (equal (eval (car sv)) (symbol-value symbol))) |
| 833 | (setq old (list (list 'changed (symbol-value symbol)))))) |
| 834 | (if (and (facep symbol) |
| 835 | (not (face-spec-match-p symbol (get symbol 'face-defface-spec)))) |
| 836 | (setq old (list (list 'changed (list |
| 837 | (append '(t) (custom-face-attributes-get symbol nil))))))))) |
| 838 | (put symbol prop (cons (list theme value) old)) |
| 839 | (put theme 'theme-settings |
| 840 | (cons (list prop symbol theme value) |
| 841 | theme-settings)))))) |
| 842 | |
| 843 | \f |
| 844 | (defun custom-set-variables (&rest args) |
| 845 | "Install user customizations of variable values specified in ARGS. |
| 846 | These settings are registered as theme `user'. |
| 847 | The arguments should each be a list of the form: |
| 848 | |
| 849 | (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) |
| 850 | |
| 851 | This stores EXP (without evaluating it) as the saved value for SYMBOL. |
| 852 | If NOW is present and non-nil, then also evaluate EXP and set |
| 853 | the default value for the SYMBOL to the value of EXP. |
| 854 | |
| 855 | REQUEST is a list of features we must require in order to |
| 856 | handle SYMBOL properly. |
| 857 | COMMENT is a comment string about SYMBOL." |
| 858 | (apply 'custom-theme-set-variables 'user args)) |
| 859 | |
| 860 | (defun custom-theme-set-variables (theme &rest args) |
| 861 | "Initialize variables for theme THEME according to settings in ARGS. |
| 862 | Each of the arguments in ARGS should be a list of this form: |
| 863 | |
| 864 | (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) |
| 865 | |
| 866 | This stores EXP (without evaluating it) as the saved value for SYMBOL. |
| 867 | If NOW is present and non-nil, then also evaluate EXP and set |
| 868 | the default value for the SYMBOL to the value of EXP. |
| 869 | |
| 870 | REQUEST is a list of features we must require in order to |
| 871 | handle SYMBOL properly. |
| 872 | COMMENT is a comment string about SYMBOL. |
| 873 | |
| 874 | EXP itself is saved unevaluated as SYMBOL property `saved-value' and |
| 875 | in SYMBOL's list property `theme-value' \(using `custom-push-theme')." |
| 876 | (custom-check-theme theme) |
| 877 | |
| 878 | ;; Process all the needed autoloads before anything else, so that the |
| 879 | ;; subsequent code has all the info it needs (e.g. which var corresponds |
| 880 | ;; to a minor mode), regardless of the ordering of the variables. |
| 881 | (dolist (entry args) |
| 882 | (let* ((symbol (indirect-variable (nth 0 entry)))) |
| 883 | (unless (or (get symbol 'standard-value) |
| 884 | (memq (get symbol 'custom-autoload) '(nil noset))) |
| 885 | ;; This symbol needs to be autoloaded, even just for a `set'. |
| 886 | (custom-load-symbol symbol)))) |
| 887 | |
| 888 | ;; Move minor modes and variables with explicit requires to the end. |
| 889 | (setq args |
| 890 | (sort args |
| 891 | (lambda (a1 a2) |
| 892 | (let* ((sym1 (car a1)) |
| 893 | (sym2 (car a2)) |
| 894 | (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) |
| 895 | (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) |
| 896 | (cond ((and 1-then-2 2-then-1) |
| 897 | (error "Circular custom dependency between `%s' and `%s'" |
| 898 | sym1 sym2)) |
| 899 | (2-then-1 nil) |
| 900 | ;; Put minor modes and symbols with :require last. |
| 901 | ;; Putting minor modes last ensures that the mode |
| 902 | ;; function will see other customized values rather |
| 903 | ;; than default values. |
| 904 | (t (or (nth 3 a2) |
| 905 | (eq (get sym2 'custom-set) |
| 906 | 'custom-set-minor-mode)))))))) |
| 907 | (while args |
| 908 | (let ((entry (car args))) |
| 909 | (if (listp entry) |
| 910 | (let* ((symbol (indirect-variable (nth 0 entry))) |
| 911 | (value (nth 1 entry)) |
| 912 | (now (nth 2 entry)) |
| 913 | (requests (nth 3 entry)) |
| 914 | (comment (nth 4 entry)) |
| 915 | set) |
| 916 | (when requests |
| 917 | (put symbol 'custom-requests requests) |
| 918 | (mapc 'require requests)) |
| 919 | (setq set (or (get symbol 'custom-set) 'custom-set-default)) |
| 920 | (put symbol 'saved-value (list value)) |
| 921 | (put symbol 'saved-variable-comment comment) |
| 922 | (custom-push-theme 'theme-value symbol theme 'set value) |
| 923 | ;; Allow for errors in the case where the setter has |
| 924 | ;; changed between versions, say, but let the user know. |
| 925 | (condition-case data |
| 926 | (cond (now |
| 927 | ;; Rogue variable, set it now. |
| 928 | (put symbol 'force-value t) |
| 929 | (funcall set symbol (eval value))) |
| 930 | ((default-boundp symbol) |
| 931 | ;; Something already set this, overwrite it. |
| 932 | (funcall set symbol (eval value)))) |
| 933 | (error |
| 934 | (message "Error setting %s: %s" symbol data))) |
| 935 | (setq args (cdr args)) |
| 936 | (and (or now (default-boundp symbol)) |
| 937 | (put symbol 'variable-comment comment))) |
| 938 | ;; I believe this is dead-code, because the `sort' code above would |
| 939 | ;; have burped before we could get here. --Stef |
| 940 | ;; Old format, a plist of SYMBOL VALUE pairs. |
| 941 | (message "Warning: old format `custom-set-variables'") |
| 942 | (ding) |
| 943 | (sit-for 2) |
| 944 | (let ((symbol (indirect-variable (nth 0 args))) |
| 945 | (value (nth 1 args))) |
| 946 | (put symbol 'saved-value (list value)) |
| 947 | (custom-push-theme 'theme-value symbol theme 'set value)) |
| 948 | (setq args (cdr (cdr args))))))) |
| 949 | |
| 950 | \f |
| 951 | ;;; Defining themes. |
| 952 | |
| 953 | ;; A theme file should be named `THEME-theme.el' (where THEME is the theme |
| 954 | ;; name), and found in either `custom-theme-directory' or the load path. |
| 955 | ;; It has the following format: |
| 956 | ;; |
| 957 | ;; (deftheme THEME |
| 958 | ;; DOCSTRING) |
| 959 | ;; |
| 960 | ;; (custom-theme-set-variables |
| 961 | ;; 'THEME |
| 962 | ;; [THEME-VARIABLES]) |
| 963 | ;; |
| 964 | ;; (custom-theme-set-faces |
| 965 | ;; 'THEME |
| 966 | ;; [THEME-FACES]) |
| 967 | ;; |
| 968 | ;; (provide-theme 'THEME) |
| 969 | |
| 970 | |
| 971 | ;; The IGNORED arguments to deftheme come from the XEmacs theme code, where |
| 972 | ;; they were used to supply keyword-value pairs like `:immediate', |
| 973 | ;; `:variable-reset-string', etc. We don't use any of these, so ignore them. |
| 974 | |
| 975 | (defmacro deftheme (theme &optional doc &rest ignored) |
| 976 | "Declare THEME to be a Custom theme. |
| 977 | The optional argument DOC is a doc string describing the theme. |
| 978 | |
| 979 | Any theme `foo' should be defined in a file called `foo-theme.el'; |
| 980 | see `custom-make-theme-feature' for more information." |
| 981 | (let ((feature (custom-make-theme-feature theme))) |
| 982 | ;; It is better not to use backquote in this file, |
| 983 | ;; because that makes a bootstrapping problem |
| 984 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 985 | (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) |
| 986 | |
| 987 | (defun custom-declare-theme (theme feature &optional doc &rest ignored) |
| 988 | "Like `deftheme', but THEME is evaluated as a normal argument. |
| 989 | FEATURE is the feature this theme provides. Normally, this is a symbol |
| 990 | created from THEME by `custom-make-theme-feature'." |
| 991 | (if (memq theme '(user changed)) |
| 992 | (error "Custom theme cannot be named %S" theme)) |
| 993 | (add-to-list 'custom-known-themes theme) |
| 994 | (put theme 'theme-feature feature) |
| 995 | (when doc (put theme 'theme-documentation doc))) |
| 996 | |
| 997 | (defun custom-make-theme-feature (theme) |
| 998 | "Given a symbol THEME, create a new symbol by appending \"-theme\". |
| 999 | Store this symbol in the `theme-feature' property of THEME. |
| 1000 | Calling `provide-theme' to provide THEME actually puts `THEME-theme' |
| 1001 | into `features'. |
| 1002 | |
| 1003 | This allows for a file-name convention for autoloading themes: |
| 1004 | Every theme X has a property `provide-theme' whose value is \"X-theme\". |
| 1005 | \(load-theme X) then attempts to load the file `X-theme.el'." |
| 1006 | (intern (concat (symbol-name theme) "-theme"))) |
| 1007 | \f |
| 1008 | ;;; Loading themes. |
| 1009 | |
| 1010 | (defcustom custom-theme-directory |
| 1011 | (if (eq system-type 'ms-dos) |
| 1012 | ;; MS-DOS cannot have initial dot. |
| 1013 | "~/_emacs.d/" |
| 1014 | "~/.emacs.d/") |
| 1015 | "Directory in which Custom theme files should be written. |
| 1016 | `load-theme' searches this directory in addition to load-path. |
| 1017 | The command `customize-create-theme' writes the files it produces |
| 1018 | into this directory." |
| 1019 | :type 'string |
| 1020 | :group 'customize |
| 1021 | :version "22.1") |
| 1022 | |
| 1023 | (defun provide-theme (theme) |
| 1024 | "Indicate that this file provides THEME. |
| 1025 | This calls `provide' to provide the feature name stored in THEME's |
| 1026 | property `theme-feature' (which is usually a symbol created by |
| 1027 | `custom-make-theme-feature')." |
| 1028 | (if (memq theme '(user changed)) |
| 1029 | (error "Custom theme cannot be named %S" theme)) |
| 1030 | (custom-check-theme theme) |
| 1031 | (provide (get theme 'theme-feature)) |
| 1032 | ;; Loading a theme also enables it. |
| 1033 | (push theme custom-enabled-themes) |
| 1034 | ;; `user' must always be the highest-precedence enabled theme. |
| 1035 | ;; Make that remain true. (This has the effect of making user settings |
| 1036 | ;; override the ones just loaded, too.) |
| 1037 | (let ((custom-enabling-themes t)) |
| 1038 | (enable-theme 'user))) |
| 1039 | |
| 1040 | (defun load-theme (theme) |
| 1041 | "Load a theme's settings from its file. |
| 1042 | This also enables the theme; use `disable-theme' to disable it." |
| 1043 | ;; Note we do no check for validity of the theme here. |
| 1044 | ;; This allows to pull in themes by a file-name convention |
| 1045 | (interactive "SCustom theme name: ") |
| 1046 | ;; If reloading, clear out the old theme settings. |
| 1047 | (when (custom-theme-p theme) |
| 1048 | (disable-theme theme) |
| 1049 | (put theme 'theme-settings nil) |
| 1050 | (put theme 'theme-feature nil) |
| 1051 | (put theme 'theme-documentation nil)) |
| 1052 | (let ((load-path (if (file-directory-p custom-theme-directory) |
| 1053 | (cons custom-theme-directory load-path) |
| 1054 | load-path))) |
| 1055 | (load (symbol-name (custom-make-theme-feature theme))))) |
| 1056 | \f |
| 1057 | ;;; Enabling and disabling loaded themes. |
| 1058 | |
| 1059 | (defvar custom-enabling-themes nil) |
| 1060 | |
| 1061 | (defun enable-theme (theme) |
| 1062 | "Reenable all variable and face settings defined by THEME. |
| 1063 | The newly enabled theme gets the highest precedence (after `user'). |
| 1064 | If it is already enabled, just give it highest precedence (after `user'). |
| 1065 | |
| 1066 | If THEME does not specify any theme settings, this tries to load |
| 1067 | the theme from its theme file, by calling `load-theme'." |
| 1068 | (interactive "SEnable Custom theme: ") |
| 1069 | (if (not (custom-theme-p theme)) |
| 1070 | (load-theme theme) |
| 1071 | ;; This could use a bit of optimization -- cyd |
| 1072 | (let ((settings (get theme 'theme-settings))) |
| 1073 | (dolist (s settings) |
| 1074 | (let* ((prop (car s)) |
| 1075 | (symbol (cadr s)) |
| 1076 | (spec-list (get symbol prop))) |
| 1077 | (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) |
| 1078 | (if (eq prop 'theme-value) |
| 1079 | (custom-theme-recalc-variable symbol) |
| 1080 | (custom-theme-recalc-face symbol))))) |
| 1081 | (unless (eq theme 'user) |
| 1082 | (setq custom-enabled-themes |
| 1083 | (cons theme (delq theme custom-enabled-themes))) |
| 1084 | (unless custom-enabling-themes |
| 1085 | (enable-theme 'user))))) |
| 1086 | |
| 1087 | (defcustom custom-enabled-themes nil |
| 1088 | "List of enabled Custom Themes, highest precedence first. |
| 1089 | |
| 1090 | This does not include the `user' theme, which is set by Customize, |
| 1091 | and always takes precedence over other Custom Themes." |
| 1092 | :group 'customize |
| 1093 | :type '(repeat symbol) |
| 1094 | :set (lambda (symbol themes) |
| 1095 | ;; Avoid an infinite loop when custom-enabled-themes is |
| 1096 | ;; defined in a theme (e.g. `user'). Enabling the theme sets |
| 1097 | ;; custom-enabled-themes, which enables the theme... |
| 1098 | (unless custom-enabling-themes |
| 1099 | (let ((custom-enabling-themes t) failures) |
| 1100 | (setq themes (delq 'user (delete-dups themes))) |
| 1101 | (if (boundp symbol) |
| 1102 | (dolist (theme (symbol-value symbol)) |
| 1103 | (if (not (memq theme themes)) |
| 1104 | (disable-theme theme)))) |
| 1105 | (dolist (theme (reverse themes)) |
| 1106 | (condition-case nil |
| 1107 | (enable-theme theme) |
| 1108 | (error (progn (push theme failures) |
| 1109 | (setq themes (delq theme themes)))))) |
| 1110 | (enable-theme 'user) |
| 1111 | (custom-set-default symbol themes) |
| 1112 | (if failures |
| 1113 | (message "Failed to enable themes: %s" |
| 1114 | (mapconcat 'symbol-name failures " "))))))) |
| 1115 | |
| 1116 | (defsubst custom-theme-enabled-p (theme) |
| 1117 | "Return non-nil if THEME is enabled." |
| 1118 | (memq theme custom-enabled-themes)) |
| 1119 | |
| 1120 | (defun disable-theme (theme) |
| 1121 | "Disable all variable and face settings defined by THEME. |
| 1122 | See `custom-enabled-themes' for a list of enabled themes." |
| 1123 | (interactive (list (intern |
| 1124 | (completing-read |
| 1125 | "Disable Custom theme: " |
| 1126 | (mapcar 'symbol-name custom-enabled-themes) |
| 1127 | nil t)))) |
| 1128 | (when (custom-theme-enabled-p theme) |
| 1129 | (let ((settings (get theme 'theme-settings))) |
| 1130 | (dolist (s settings) |
| 1131 | (let* ((prop (car s)) |
| 1132 | (symbol (cadr s)) |
| 1133 | (spec-list (get symbol prop))) |
| 1134 | (put symbol prop (assq-delete-all theme spec-list)) |
| 1135 | (if (eq prop 'theme-value) |
| 1136 | (custom-theme-recalc-variable symbol) |
| 1137 | (custom-theme-recalc-face symbol))))) |
| 1138 | (setq custom-enabled-themes |
| 1139 | (delq theme custom-enabled-themes)))) |
| 1140 | |
| 1141 | (defun custom-variable-theme-value (variable) |
| 1142 | "Return (list VALUE) indicating the custom theme value of VARIABLE. |
| 1143 | That is to say, it specifies what the value should be according to |
| 1144 | currently enabled custom themes. |
| 1145 | |
| 1146 | This function returns nil if no custom theme specifies a value for VARIABLE." |
| 1147 | (let* ((theme-value (get variable 'theme-value))) |
| 1148 | (if theme-value |
| 1149 | (cdr (car theme-value))))) |
| 1150 | |
| 1151 | (defun custom-theme-recalc-variable (variable) |
| 1152 | "Set VARIABLE according to currently enabled custom themes." |
| 1153 | (let ((valspec (custom-variable-theme-value variable))) |
| 1154 | (if valspec |
| 1155 | (put variable 'saved-value valspec) |
| 1156 | (setq valspec (get variable 'standard-value))) |
| 1157 | (if (and valspec |
| 1158 | (or (get variable 'force-value) |
| 1159 | (default-boundp variable))) |
| 1160 | (funcall (or (get variable 'custom-set) 'set-default) variable |
| 1161 | (eval (car valspec)))))) |
| 1162 | |
| 1163 | (defun custom-theme-recalc-face (face) |
| 1164 | "Set FACE according to currently enabled custom themes." |
| 1165 | (if (facep face) |
| 1166 | (let ((theme-faces (reverse (get face 'theme-face)))) |
| 1167 | (dolist (spec theme-faces) |
| 1168 | (face-spec-set face (cadr spec)))))) |
| 1169 | \f |
| 1170 | ;;; XEmacs compability functions |
| 1171 | |
| 1172 | ;; In XEmacs, when you reset a Custom Theme, you have to specify the |
| 1173 | ;; theme to reset it to. We just apply the next available theme, so |
| 1174 | ;; just ignore the IGNORED arguments. |
| 1175 | |
| 1176 | (defun custom-theme-reset-variables (theme &rest args) |
| 1177 | "Reset some variable settings in THEME to their values in other themes. |
| 1178 | Each of the arguments ARGS has this form: |
| 1179 | |
| 1180 | (VARIABLE IGNORED) |
| 1181 | |
| 1182 | This means reset VARIABLE. (The argument IGNORED is ignored)." |
| 1183 | (custom-check-theme theme) |
| 1184 | (dolist (arg args) |
| 1185 | (custom-push-theme 'theme-value (car arg) theme 'reset))) |
| 1186 | |
| 1187 | (defun custom-reset-variables (&rest args) |
| 1188 | "Reset the specs of some variables to their values in other themes. |
| 1189 | This creates settings in the `user' theme. |
| 1190 | |
| 1191 | Each of the arguments ARGS has this form: |
| 1192 | |
| 1193 | (VARIABLE IGNORED) |
| 1194 | |
| 1195 | This means reset VARIABLE. (The argument IGNORED is ignored)." |
| 1196 | (apply 'custom-theme-reset-variables 'user args)) |
| 1197 | |
| 1198 | ;;; The End. |
| 1199 | |
| 1200 | ;; Process the defcustoms for variables loaded before this file. |
| 1201 | (while custom-declare-variable-list |
| 1202 | (apply 'custom-declare-variable (car custom-declare-variable-list)) |
| 1203 | (setq custom-declare-variable-list (cdr custom-declare-variable-list))) |
| 1204 | |
| 1205 | (provide 'custom) |
| 1206 | |
| 1207 | ;; arch-tag: 041b6116-aabe-4f9a-902d-74092bc3dab2 |
| 1208 | ;;; custom.el ends here |