| 1 | ;;; custom.el --- tools for declaring and initializing options |
| 2 | ;; |
| 3 | ;; Copyright (C) 1996, 1997, 1999, 2001, 2002, 2004 |
| 4 | ;; 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., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, 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-reset (symbol value) |
| 80 | "Initialize SYMBOL based on VALUE. |
| 81 | Set the symbol, using its `:set' function (or `set-default' if it has none). |
| 82 | The value is either the symbol's current value |
| 83 | \(as obtained using the `:get' function), if any, |
| 84 | or the value in the symbol's `saved-value' property if any, |
| 85 | or (last of all) VALUE." |
| 86 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 87 | symbol |
| 88 | (cond ((default-boundp symbol) |
| 89 | (funcall (or (get symbol 'custom-get) 'default-value) |
| 90 | symbol)) |
| 91 | ((get symbol 'saved-value) |
| 92 | (eval (car (get symbol 'saved-value)))) |
| 93 | (t |
| 94 | (eval value))))) |
| 95 | |
| 96 | (defun custom-initialize-changed (symbol value) |
| 97 | "Initialize SYMBOL with VALUE. |
| 98 | Like `custom-initialize-reset', but only use the `:set' function if |
| 99 | not using the standard setting. |
| 100 | For the standard setting, use `set-default'." |
| 101 | (cond ((default-boundp symbol) |
| 102 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 103 | symbol |
| 104 | (funcall (or (get symbol 'custom-get) 'default-value) |
| 105 | symbol))) |
| 106 | ((get symbol 'saved-value) |
| 107 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 108 | symbol |
| 109 | (eval (car (get symbol 'saved-value))))) |
| 110 | (t |
| 111 | (set-default symbol (eval value))))) |
| 112 | |
| 113 | (defun custom-declare-variable (symbol default doc &rest args) |
| 114 | "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. |
| 115 | DEFAULT should be an expression to evaluate to compute the default value, |
| 116 | not the default value itself. |
| 117 | |
| 118 | DEFAULT is stored as SYMBOL's value in the standard theme. See |
| 119 | `custom-known-themes' for a list of known themes. For backwards |
| 120 | compatibility, DEFAULT is also stored in SYMBOL's property |
| 121 | `standard-value'. At the same time, SYMBOL's property `force-value' is |
| 122 | set to nil, as the value is no longer rogue." |
| 123 | ;; Remember the standard setting. The value should be in the standard |
| 124 | ;; theme, not in this property. However, his would require changeing |
| 125 | ;; the C source of defvar and others as well... |
| 126 | (put symbol 'standard-value (list default)) |
| 127 | ;; Maybe this option was rogue in an earlier version. It no longer is. |
| 128 | (when (get symbol 'force-value) |
| 129 | (put symbol 'force-value nil)) |
| 130 | (when doc |
| 131 | (put symbol 'variable-documentation doc)) |
| 132 | (let ((initialize 'custom-initialize-reset) |
| 133 | (requests nil)) |
| 134 | (unless (memq :group args) |
| 135 | (custom-add-to-group (custom-current-group) symbol 'custom-variable)) |
| 136 | (while args |
| 137 | (let ((arg (car args))) |
| 138 | (setq args (cdr args)) |
| 139 | (unless (symbolp arg) |
| 140 | (error "Junk in args %S" args)) |
| 141 | (let ((keyword arg) |
| 142 | (value (car args))) |
| 143 | (unless args |
| 144 | (error "Keyword %s is missing an argument" keyword)) |
| 145 | (setq args (cdr args)) |
| 146 | (cond ((eq keyword :initialize) |
| 147 | (setq initialize value)) |
| 148 | ((eq keyword :set) |
| 149 | (put symbol 'custom-set value)) |
| 150 | ((eq keyword :get) |
| 151 | (put symbol 'custom-get value)) |
| 152 | ((eq keyword :require) |
| 153 | (push value requests)) |
| 154 | ((eq keyword :type) |
| 155 | (put symbol 'custom-type (purecopy value))) |
| 156 | ((eq keyword :options) |
| 157 | (if (get symbol 'custom-options) |
| 158 | ;; Slow safe code to avoid duplicates. |
| 159 | (mapc (lambda (option) |
| 160 | (custom-add-option symbol option)) |
| 161 | value) |
| 162 | ;; Fast code for the common case. |
| 163 | (put symbol 'custom-options (copy-sequence value)))) |
| 164 | (t |
| 165 | (custom-handle-keyword symbol keyword value |
| 166 | 'custom-variable)))))) |
| 167 | (put symbol 'custom-requests requests) |
| 168 | ;; Do the actual initialization. |
| 169 | (unless custom-dont-initialize |
| 170 | (funcall initialize symbol default))) |
| 171 | (push symbol current-load-list) |
| 172 | (run-hooks 'custom-define-hook) |
| 173 | symbol) |
| 174 | |
| 175 | (defmacro defcustom (symbol value doc &rest args) |
| 176 | "Declare SYMBOL as a customizable variable that defaults to VALUE. |
| 177 | DOC is the variable documentation. |
| 178 | |
| 179 | Neither SYMBOL nor VALUE need to be quoted. |
| 180 | If SYMBOL is not already bound, initialize it to VALUE. |
| 181 | The remaining arguments should have the form |
| 182 | |
| 183 | [KEYWORD VALUE]... |
| 184 | |
| 185 | The following keywords are meaningful: |
| 186 | |
| 187 | :type VALUE should be a widget type for editing the symbol's value. |
| 188 | :options VALUE should be a list of valid members of the widget type. |
| 189 | :group VALUE should be a customization group. |
| 190 | Add SYMBOL to that group. |
| 191 | :link LINK-DATA |
| 192 | Include an external link after the documentation string for this |
| 193 | item. This is a sentence containing an active field which |
| 194 | references some other documentation. |
| 195 | |
| 196 | There are three alternatives you can use for LINK-DATA: |
| 197 | |
| 198 | (custom-manual INFO-NODE) |
| 199 | Link to an Info node; INFO-NODE is a string which specifies |
| 200 | the node name, as in \"(emacs)Top\". The link appears as |
| 201 | `[manual]' in the customization buffer. |
| 202 | |
| 203 | (info-link INFO-NODE) |
| 204 | Like `custom-manual' except that the link appears in the |
| 205 | customization buffer with the Info node name. |
| 206 | |
| 207 | (url-link URL) |
| 208 | Link to a web page; URL is a string which specifies the URL. |
| 209 | The link appears in the customization buffer as URL. |
| 210 | |
| 211 | You can specify the text to use in the customization buffer by |
| 212 | adding `:tag NAME' after the first element of the LINK-DATA; for |
| 213 | example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the |
| 214 | Emacs manual which appears in the buffer as `foo'. |
| 215 | |
| 216 | An item can have more than one external link; however, most items |
| 217 | have none at all. |
| 218 | :initialize |
| 219 | VALUE should be a function used to initialize the |
| 220 | variable. It takes two arguments, the symbol and value |
| 221 | given in the `defcustom' call. The default is |
| 222 | `custom-initialize-reset'. |
| 223 | :set VALUE should be a function to set the value of the symbol. |
| 224 | It takes two arguments, the symbol to set and the value to |
| 225 | give it. The default choice of function is `custom-set-default'. |
| 226 | :get VALUE should be a function to extract the value of symbol. |
| 227 | The function takes one argument, a symbol, and should return |
| 228 | the current value for that symbol. The default choice of function |
| 229 | is `custom-default-value'. |
| 230 | :require |
| 231 | VALUE should be a feature symbol. If you save a value |
| 232 | for this option, then when your `.emacs' file loads the value, |
| 233 | it does (require VALUE) first. |
| 234 | :version |
| 235 | VALUE should be a string specifying that the variable was |
| 236 | first introduced, or its default value was changed, in Emacs |
| 237 | version VERSION. |
| 238 | :tag LABEL |
| 239 | Use LABEL, a string, instead of the item's name, to label the item |
| 240 | in customization menus and buffers. |
| 241 | :load FILE |
| 242 | Load file FILE (a string) before displaying this customization |
| 243 | item. Loading is done with `load', and only if the file is |
| 244 | not already loaded. |
| 245 | :set-after VARIABLES |
| 246 | Specifies that SYMBOL should be set after the list of variables |
| 247 | VARIABLES when both have been customized. |
| 248 | |
| 249 | If SYMBOL has a local binding, then this form affects the local |
| 250 | binding. This is normally not what you want. Thus, if you need |
| 251 | to load a file defining variables with this form, or with |
| 252 | `defvar' or `defconst', you should always load that file |
| 253 | _outside_ any bindings for these variables. \(`defvar' and |
| 254 | `defconst' behave similarly in this respect.) |
| 255 | |
| 256 | Read the section about customization in the Emacs Lisp manual for more |
| 257 | information." |
| 258 | ;; It is better not to use backquote in this file, |
| 259 | ;; because that makes a bootstrapping problem |
| 260 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 261 | (nconc (list 'custom-declare-variable |
| 262 | (list 'quote symbol) |
| 263 | (list 'quote value) |
| 264 | doc) |
| 265 | args)) |
| 266 | |
| 267 | ;;; The `defface' Macro. |
| 268 | |
| 269 | (defmacro defface (face spec doc &rest args) |
| 270 | "Declare FACE as a customizable face that defaults to SPEC. |
| 271 | FACE does not need to be quoted. |
| 272 | |
| 273 | Third argument DOC is the face documentation. |
| 274 | |
| 275 | If FACE has been set with `custom-set-faces', set the face attributes |
| 276 | as specified by that function, otherwise set the face attributes |
| 277 | according to SPEC. |
| 278 | |
| 279 | The remaining arguments should have the form |
| 280 | |
| 281 | [KEYWORD VALUE]... |
| 282 | |
| 283 | The following KEYWORDs are defined: |
| 284 | |
| 285 | :group VALUE should be a customization group. |
| 286 | Add FACE to that group. |
| 287 | |
| 288 | SPEC should be an alist of the form ((DISPLAY ATTS)...). |
| 289 | |
| 290 | The first element of SPEC where the DISPLAY matches the frame |
| 291 | is the one that takes effect in that frame. The ATTRs in this |
| 292 | element take effect; the other elements are ignored, on that frame. |
| 293 | |
| 294 | ATTS is a list of face attributes followed by their values: |
| 295 | (ATTR VALUE ATTR VALUE...) |
| 296 | |
| 297 | The possible attributes are `:family', `:width', `:height', `:weight', |
| 298 | `:slant', `:underline', `:overline', `:strike-through', `:box', |
| 299 | `:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'. |
| 300 | |
| 301 | DISPLAY can either be the symbol t, which will match all frames, or an |
| 302 | alist of elements of the form \(REQ ITEM...). For the DISPLAY to match a |
| 303 | FRAME, each of these elements must be satisfied, meaning that the |
| 304 | REQ property of the frame must match one of the corresponding ITEMs. |
| 305 | These are the defined REQ values: |
| 306 | |
| 307 | `type' (the value of `window-system') |
| 308 | Under X, in addition to the values `window-system' can take, |
| 309 | `motif', `lucid', `gtk' and `x-toolkit' are allowed, and match when |
| 310 | the Motif toolkit, Lucid toolkit, GTK toolkit or any X toolkit is in use. |
| 311 | |
| 312 | `class' (the frame's color support) |
| 313 | Should be one of `color', `grayscale', or `mono'. |
| 314 | |
| 315 | `background' (what color is used for the background text) |
| 316 | Should be one of `light' or `dark'. |
| 317 | |
| 318 | `min-colors' (the minimum number of colors the frame should support) |
| 319 | Should be an integer, it is compared with the result of |
| 320 | `display-color-cells'. |
| 321 | |
| 322 | `supports' (only match frames that support the specified face attributes) |
| 323 | Should be a list of face attributes. See the documentation for |
| 324 | the function `display-supports-face-attributes-p' for more |
| 325 | information on exactly how testing is done. |
| 326 | |
| 327 | Read the section about customization in the Emacs Lisp manual for more |
| 328 | information." |
| 329 | ;; It is better not to use backquote in this file, |
| 330 | ;; because that makes a bootstrapping problem |
| 331 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 332 | (nconc (list 'custom-declare-face (list 'quote face) spec doc) args)) |
| 333 | |
| 334 | ;;; The `defgroup' Macro. |
| 335 | |
| 336 | (defun custom-current-group () |
| 337 | (cdr (assoc load-file-name custom-current-group-alist))) |
| 338 | |
| 339 | (defun custom-declare-group (symbol members doc &rest args) |
| 340 | "Like `defgroup', but SYMBOL is evaluated as a normal argument." |
| 341 | (while members |
| 342 | (apply 'custom-add-to-group symbol (car members)) |
| 343 | (setq members (cdr members))) |
| 344 | (when doc |
| 345 | ;; This text doesn't get into DOC. |
| 346 | (put symbol 'group-documentation (purecopy doc))) |
| 347 | (while args |
| 348 | (let ((arg (car args))) |
| 349 | (setq args (cdr args)) |
| 350 | (unless (symbolp arg) |
| 351 | (error "Junk in args %S" args)) |
| 352 | (let ((keyword arg) |
| 353 | (value (car args))) |
| 354 | (unless args |
| 355 | (error "Keyword %s is missing an argument" keyword)) |
| 356 | (setq args (cdr args)) |
| 357 | (cond ((eq keyword :prefix) |
| 358 | (put symbol 'custom-prefix value)) |
| 359 | (t |
| 360 | (custom-handle-keyword symbol keyword value |
| 361 | 'custom-group)))))) |
| 362 | ;; Record the group on the `current' list. |
| 363 | (let ((elt (assoc load-file-name custom-current-group-alist))) |
| 364 | (if elt (setcdr elt symbol) |
| 365 | (push (cons load-file-name symbol) custom-current-group-alist))) |
| 366 | (run-hooks 'custom-define-hook) |
| 367 | symbol) |
| 368 | |
| 369 | (defmacro defgroup (symbol members doc &rest args) |
| 370 | "Declare SYMBOL as a customization group containing MEMBERS. |
| 371 | SYMBOL does not need to be quoted. |
| 372 | |
| 373 | Third arg DOC is the group documentation. |
| 374 | |
| 375 | MEMBERS should be an alist of the form ((NAME WIDGET)...) where |
| 376 | NAME is a symbol and WIDGET is a widget for editing that symbol. |
| 377 | Useful widgets are `custom-variable' for editing variables, |
| 378 | `custom-face' for edit faces, and `custom-group' for editing groups. |
| 379 | |
| 380 | The remaining arguments should have the form |
| 381 | |
| 382 | [KEYWORD VALUE]... |
| 383 | |
| 384 | The following KEYWORDs are defined: |
| 385 | |
| 386 | :group VALUE should be a customization group. |
| 387 | Add SYMBOL to that group. |
| 388 | |
| 389 | :version VALUE should be a string specifying that the group was introduced |
| 390 | in Emacs version VERSION. |
| 391 | |
| 392 | Read the section about customization in the Emacs Lisp manual for more |
| 393 | information." |
| 394 | ;; It is better not to use backquote in this file, |
| 395 | ;; because that makes a bootstrapping problem |
| 396 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 397 | (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args)) |
| 398 | |
| 399 | (defun custom-add-to-group (group option widget) |
| 400 | "To existing GROUP add a new OPTION of type WIDGET. |
| 401 | If there already is an entry for OPTION and WIDGET, nothing is done." |
| 402 | (let ((members (get group 'custom-group)) |
| 403 | (entry (list option widget))) |
| 404 | (unless (member entry members) |
| 405 | (put group 'custom-group (nconc members (list entry)))))) |
| 406 | |
| 407 | (defun custom-group-of-mode (mode) |
| 408 | "Return the custom group corresponding to the major or minor MODE. |
| 409 | If no such group is found, return nil." |
| 410 | (or (get mode 'custom-mode-group) |
| 411 | (if (or (get mode 'custom-group) |
| 412 | (and (string-match "-mode\\'" (symbol-name mode)) |
| 413 | (get (setq mode (intern (substring (symbol-name mode) |
| 414 | 0 (match-beginning 0)))) |
| 415 | 'custom-group))) |
| 416 | mode))) |
| 417 | |
| 418 | ;;; Properties. |
| 419 | |
| 420 | (defun custom-handle-all-keywords (symbol args type) |
| 421 | "For customization option SYMBOL, handle keyword arguments ARGS. |
| 422 | Third argument TYPE is the custom option type." |
| 423 | (unless (memq :group args) |
| 424 | (custom-add-to-group (custom-current-group) symbol type)) |
| 425 | (while args |
| 426 | (let ((arg (car args))) |
| 427 | (setq args (cdr args)) |
| 428 | (unless (symbolp arg) |
| 429 | (error "Junk in args %S" args)) |
| 430 | (let ((keyword arg) |
| 431 | (value (car args))) |
| 432 | (unless args |
| 433 | (error "Keyword %s is missing an argument" keyword)) |
| 434 | (setq args (cdr args)) |
| 435 | (custom-handle-keyword symbol keyword value type))))) |
| 436 | |
| 437 | (defun custom-handle-keyword (symbol keyword value type) |
| 438 | "For customization option SYMBOL, handle KEYWORD with VALUE. |
| 439 | Fourth argument TYPE is the custom option type." |
| 440 | (if purify-flag |
| 441 | (setq value (purecopy value))) |
| 442 | (cond ((eq keyword :group) |
| 443 | (custom-add-to-group value symbol type)) |
| 444 | ((eq keyword :version) |
| 445 | (custom-add-version symbol value)) |
| 446 | ((eq keyword :link) |
| 447 | (custom-add-link symbol value)) |
| 448 | ((eq keyword :load) |
| 449 | (custom-add-load symbol value)) |
| 450 | ((eq keyword :tag) |
| 451 | (put symbol 'custom-tag value)) |
| 452 | ((eq keyword :set-after) |
| 453 | (custom-add-dependencies symbol value)) |
| 454 | (t |
| 455 | (error "Unknown keyword %s" keyword)))) |
| 456 | |
| 457 | (defun custom-add-dependencies (symbol value) |
| 458 | "To the custom option SYMBOL, add dependencies specified by VALUE. |
| 459 | VALUE should be a list of symbols. For each symbol in that list, |
| 460 | this specifies that SYMBOL should be set after the specified symbol, if |
| 461 | both appear in constructs like `custom-set-variables'." |
| 462 | (unless (listp value) |
| 463 | (error "Invalid custom dependency `%s'" value)) |
| 464 | (let* ((deps (get symbol 'custom-dependencies)) |
| 465 | (new-deps deps)) |
| 466 | (while value |
| 467 | (let ((dep (car value))) |
| 468 | (unless (symbolp dep) |
| 469 | (error "Invalid custom dependency `%s'" dep)) |
| 470 | (unless (memq dep new-deps) |
| 471 | (setq new-deps (cons dep new-deps))) |
| 472 | (setq value (cdr value)))) |
| 473 | (unless (eq deps new-deps) |
| 474 | (put symbol 'custom-dependencies new-deps)))) |
| 475 | |
| 476 | (defun custom-add-option (symbol option) |
| 477 | "To the variable SYMBOL add OPTION. |
| 478 | |
| 479 | If SYMBOL is a hook variable, OPTION should be a hook member. |
| 480 | For other types variables, the effect is undefined." |
| 481 | (let ((options (get symbol 'custom-options))) |
| 482 | (unless (member option options) |
| 483 | (put symbol 'custom-options (cons option options))))) |
| 484 | |
| 485 | (defun custom-add-link (symbol widget) |
| 486 | "To the custom option SYMBOL add the link WIDGET." |
| 487 | (let ((links (get symbol 'custom-links))) |
| 488 | (unless (member widget links) |
| 489 | (put symbol 'custom-links (cons (purecopy widget) links))))) |
| 490 | |
| 491 | (defun custom-add-version (symbol version) |
| 492 | "To the custom option SYMBOL add the version VERSION." |
| 493 | (put symbol 'custom-version (purecopy version))) |
| 494 | |
| 495 | (defun custom-add-load (symbol load) |
| 496 | "To the custom option SYMBOL add the dependency LOAD. |
| 497 | LOAD should be either a library file name, or a feature name." |
| 498 | (let ((loads (get symbol 'custom-loads))) |
| 499 | (unless (member load loads) |
| 500 | (put symbol 'custom-loads (cons (purecopy load) loads))))) |
| 501 | |
| 502 | (defun custom-autoload (symbol load) |
| 503 | "Mark SYMBOL as autoloaded custom variable and add dependency LOAD." |
| 504 | (put symbol 'custom-autoload t) |
| 505 | (custom-add-load symbol load)) |
| 506 | |
| 507 | ;; This test is also in the C code of `user-variable-p'. |
| 508 | (defun custom-variable-p (variable) |
| 509 | "Return non-nil if VARIABLE is a custom variable." |
| 510 | (or (get variable 'standard-value) |
| 511 | (get variable 'custom-autoload))) |
| 512 | |
| 513 | ;;; Loading files needed to customize a symbol. |
| 514 | ;;; This is in custom.el because menu-bar.el needs it for toggle cmds. |
| 515 | |
| 516 | (defvar custom-load-recursion nil |
| 517 | "Hack to avoid recursive dependencies.") |
| 518 | |
| 519 | (defun custom-load-symbol (symbol) |
| 520 | "Load all dependencies for SYMBOL." |
| 521 | (unless custom-load-recursion |
| 522 | (let ((custom-load-recursion t)) |
| 523 | ;; Load these files if not already done, |
| 524 | ;; to make sure we know all the dependencies of SYMBOL. |
| 525 | (condition-case nil |
| 526 | (require 'cus-load) |
| 527 | (error nil)) |
| 528 | (condition-case nil |
| 529 | (require 'cus-start) |
| 530 | (error nil)) |
| 531 | (dolist (load (get symbol 'custom-loads)) |
| 532 | (cond ((symbolp load) (condition-case nil (require load) (error nil))) |
| 533 | ;; This is subsumed by the test below, but it's much faster. |
| 534 | ((assoc load load-history)) |
| 535 | ;; This was just (assoc (locate-library load) load-history) |
| 536 | ;; but has been optimized not to load locate-library |
| 537 | ;; if not necessary. |
| 538 | ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load) |
| 539 | "\\(\\'\\|\\.\\)")) |
| 540 | (found nil)) |
| 541 | (dolist (loaded load-history) |
| 542 | (and (stringp (car loaded)) |
| 543 | (string-match regexp (car loaded)) |
| 544 | (setq found t))) |
| 545 | found)) |
| 546 | ;; Without this, we would load cus-edit recursively. |
| 547 | ;; We are still loading it when we call this, |
| 548 | ;; and it is not in load-history yet. |
| 549 | ((equal load "cus-edit")) |
| 550 | (t (condition-case nil (load load) (error nil)))))))) |
| 551 | |
| 552 | (defvar custom-known-themes '(user standard) |
| 553 | "Themes that have been define with `deftheme'. |
| 554 | The default value is the list (user standard). The theme `standard' |
| 555 | contains the Emacs standard settings from the original Lisp files. The |
| 556 | theme `user' contains all the the settings the user customized and saved. |
| 557 | Additional themes declared with the `deftheme' macro will be added to |
| 558 | the front of this list.") |
| 559 | |
| 560 | (defun custom-declare-theme (theme feature &optional doc &rest args) |
| 561 | "Like `deftheme', but THEME is evaluated as a normal argument. |
| 562 | FEATURE is the feature this theme provides. This symbol is created |
| 563 | from THEME by `custom-make-theme-feature'." |
| 564 | (add-to-list 'custom-known-themes theme) |
| 565 | (put theme 'theme-feature feature) |
| 566 | (when doc |
| 567 | (put theme 'theme-documentation doc)) |
| 568 | (while args |
| 569 | (let ((arg (car args))) |
| 570 | (setq args (cdr args)) |
| 571 | (unless (symbolp arg) |
| 572 | (error "Junk in args %S" args)) |
| 573 | (let ((keyword arg) |
| 574 | (value (car args))) |
| 575 | (unless args |
| 576 | (error "Keyword %s is missing an argument" keyword)) |
| 577 | (setq args (cdr args)) |
| 578 | (cond ((eq keyword :short-description) |
| 579 | (put theme 'theme-short-description value)) |
| 580 | ((eq keyword :immediate) |
| 581 | (put theme 'theme-immediate value)) |
| 582 | ((eq keyword :variable-set-string) |
| 583 | (put theme 'theme-variable-set-string value)) |
| 584 | ((eq keyword :variable-reset-string) |
| 585 | (put theme 'theme-variable-reset-string value)) |
| 586 | ((eq keyword :face-set-string) |
| 587 | (put theme 'theme-face-set-string value)) |
| 588 | ((eq keyword :face-reset-string) |
| 589 | (put theme 'theme-face-reset-string value))))))) |
| 590 | |
| 591 | (defmacro deftheme (theme &optional doc &rest args) |
| 592 | "Declare custom theme THEME. |
| 593 | The optional argument DOC is a doc string describing the theme. |
| 594 | The remaining arguments should have the form |
| 595 | |
| 596 | [KEYWORD VALUE]... |
| 597 | |
| 598 | The following KEYWORD's are defined: |
| 599 | |
| 600 | :short-description |
| 601 | VALUE is a short (one line) description of the theme. If not |
| 602 | given, DOC is used. |
| 603 | :immediate |
| 604 | If VALUE is non-nil, variables specified in this theme are set |
| 605 | immediately when loading the theme. |
| 606 | :variable-set-string |
| 607 | VALUE is a string used to indicate that a variable takes its |
| 608 | setting from this theme. It is passed to FORMAT with the name |
| 609 | of the theme as an additional argument. If not given, a |
| 610 | generic description is used. |
| 611 | :variable-reset-string |
| 612 | VALUE is a string used in the case a variable has been forced |
| 613 | to its value in this theme. It is passed to FORMAT with the |
| 614 | name of the theme as an additional argument. If not given, a |
| 615 | generic description is used. |
| 616 | :face-set-string |
| 617 | VALUE is a string used to indicate that a face takes its |
| 618 | setting from this theme. It is passed to FORMAT with the name |
| 619 | of the theme as an additional argument. If not given, a |
| 620 | generic description is used. |
| 621 | :face-reset-string |
| 622 | VALUE is a string used in the case a face has been forced to |
| 623 | its value in this theme. It is passed to FORMAT with the name |
| 624 | of the theme as an additional argument. If not given, a |
| 625 | generic description is used. |
| 626 | |
| 627 | Any theme `foo' should be defined in a file called `foo-theme.el'; |
| 628 | see `custom-make-theme-feature' for more information." |
| 629 | (let ((feature (custom-make-theme-feature theme))) |
| 630 | ;; It is better not to use backquote in this file, |
| 631 | ;; because that makes a bootstrapping problem |
| 632 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 633 | (nconc (list 'custom-declare-theme |
| 634 | (list 'quote theme) |
| 635 | (list 'quote feature) |
| 636 | doc) args))) |
| 637 | |
| 638 | (defun custom-make-theme-feature (theme) |
| 639 | "Given a symbol THEME, create a new symbol by appending \"-theme\". |
| 640 | Store this symbol in the `theme-feature' property of THEME. |
| 641 | Calling `provide-theme' to provide THEME actually puts `THEME-theme' |
| 642 | into `features'. |
| 643 | |
| 644 | This allows for a file-name convention for autoloading themes: |
| 645 | Every theme X has a property `provide-theme' whose value is \"X-theme\". |
| 646 | \(require-theme X) then attempts to load the file `X-theme.el'." |
| 647 | (intern (concat (symbol-name theme) "-theme"))) |
| 648 | |
| 649 | (defsubst custom-theme-p (theme) |
| 650 | "Non-nil when THEME has been defined." |
| 651 | (memq theme custom-known-themes)) |
| 652 | |
| 653 | (defsubst custom-check-theme (theme) |
| 654 | "Check whether THEME is valid, and signal an error if it is not." |
| 655 | (unless (custom-theme-p theme) |
| 656 | (error "Unknown theme `%s'" theme))) |
| 657 | |
| 658 | ;;; Initializing. |
| 659 | |
| 660 | (defun custom-push-theme (prop symbol theme mode value) |
| 661 | "Add (THEME MODE VALUE) to the list in property PROP of SYMBOL. |
| 662 | If the first element in that list is already (THEME ...), |
| 663 | discard it first. |
| 664 | |
| 665 | MODE can be either the symbol `set' or the symbol `reset'. If it is the |
| 666 | symbol `set', then VALUE is the value to use. If it is the symbol |
| 667 | `reset', then VALUE is the mode to query instead. |
| 668 | |
| 669 | In the following example for the variable `goto-address-url-face', the |
| 670 | theme `subtle-hacker' uses the same value for the variable as the theme |
| 671 | `gnome2': |
| 672 | |
| 673 | \((standard set bold) |
| 674 | \(gnome2 set info-xref) |
| 675 | \(jonadab set underline) |
| 676 | \(subtle-hacker reset gnome2)) |
| 677 | |
| 678 | |
| 679 | If a value has been stored for themes A B and C, and a new value |
| 680 | is to be stored for theme C, then the old value of C is discarded. |
| 681 | If a new value is to be stored for theme B, however, the old value |
| 682 | of B is not discarded because B is not the car of the list. |
| 683 | |
| 684 | For variables, list property PROP is `theme-value'. |
| 685 | For faces, list property PROP is `theme-face'. |
| 686 | This is used in `custom-do-theme-reset', for example. |
| 687 | |
| 688 | The list looks the same in any case; the examples shows a possible |
| 689 | value of the `theme-face' property for the face `region': |
| 690 | |
| 691 | \((gnome2 set ((t (:foreground \"cyan\" :background \"dark cyan\")))) |
| 692 | \(standard set ((((class color) (background dark)) |
| 693 | \(:background \"blue\")) |
| 694 | \(t (:background \"gray\"))))) |
| 695 | |
| 696 | This records values for the `standard' and the `gnome2' themes. |
| 697 | The user has not customized the face; had he done that, |
| 698 | the list would contain an entry for the `user' theme, too. |
| 699 | See `custom-known-themes' for a list of known themes." |
| 700 | (let ((old (get symbol prop))) |
| 701 | (if (eq (car-safe (car-safe old)) theme) |
| 702 | (setq old (cdr old))) |
| 703 | (put symbol prop (cons (list theme mode value) old)))) |
| 704 | |
| 705 | (defvar custom-local-buffer nil |
| 706 | "Non-nil, in a Customization buffer, means customize a specific buffer. |
| 707 | If this variable is non-nil, it should be a buffer, |
| 708 | and it means customize the local bindings of that buffer. |
| 709 | This variable is a permanent local, and it normally has a local binding |
| 710 | in every Customization buffer.") |
| 711 | (put 'custom-local-buffer 'permanent-local t) |
| 712 | |
| 713 | (defun custom-set-variables (&rest args) |
| 714 | "Install user customizations of variable values specified in ARGS. |
| 715 | These settings are registered as theme `user'. |
| 716 | The arguments should each be a list of the form: |
| 717 | |
| 718 | (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) |
| 719 | |
| 720 | This stores EXP (without evaluating it) as the saved value for SYMBOL. |
| 721 | If NOW is present and non-nil, then also evaluate EXP and set |
| 722 | the default value for the SYMBOL to the value of EXP. |
| 723 | |
| 724 | REQUEST is a list of features we must require in order to |
| 725 | handle SYMBOL properly. |
| 726 | COMMENT is a comment string about SYMBOL." |
| 727 | (apply 'custom-theme-set-variables 'user args)) |
| 728 | |
| 729 | (defun custom-theme-set-variables (theme &rest args) |
| 730 | "Initialize variables for theme THEME according to settings in ARGS. |
| 731 | Each of the arguments in ARGS should be a list of this form: |
| 732 | |
| 733 | (SYMBOL EXP [NOW [REQUEST [COMMENT]]]) |
| 734 | |
| 735 | This stores EXP (without evaluating it) as the saved value for SYMBOL. |
| 736 | If NOW is present and non-nil, then also evaluate EXP and set |
| 737 | the default value for the SYMBOL to the value of EXP. |
| 738 | |
| 739 | REQUEST is a list of features we must require in order to |
| 740 | handle SYMBOL properly. |
| 741 | COMMENT is a comment string about SYMBOL. |
| 742 | |
| 743 | Several properties of THEME and SYMBOL are used in the process: |
| 744 | |
| 745 | If THEME's property `theme-immediate' is non-nil, this is equivalent of |
| 746 | providing the NOW argument to all symbols in the argument list: |
| 747 | evaluate each EXP and set the corresponding SYMBOL. However, |
| 748 | there's a difference in the handling of SYMBOL's property |
| 749 | `force-value': if NOW is non-nil, SYMBOL's property `force-value' is set to |
| 750 | the symbol `rogue', else if THEME's property `theme-immediate' is non-nil, |
| 751 | SYMBOL's property `force-value' is set to the symbol `immediate'. |
| 752 | |
| 753 | EXP itself is saved unevaluated as SYMBOL property `saved-value' and |
| 754 | in SYMBOL's list property `theme-value' \(using `custom-push-theme')." |
| 755 | (custom-check-theme theme) |
| 756 | (let ((immediate (get theme 'theme-immediate))) |
| 757 | (setq args |
| 758 | (sort args |
| 759 | (lambda (a1 a2) |
| 760 | (let* ((sym1 (car a1)) |
| 761 | (sym2 (car a2)) |
| 762 | (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) |
| 763 | (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) |
| 764 | (cond ((and 1-then-2 2-then-1) |
| 765 | (error "Circular custom dependency between `%s' and `%s'" |
| 766 | sym1 sym2)) |
| 767 | (2-then-1 nil) |
| 768 | ;; Put symbols with :require last. The macro |
| 769 | ;; define-minor-mode generates a defcustom |
| 770 | ;; with a :require and a :set, where the |
| 771 | ;; setter function calls the mode function. |
| 772 | ;; Putting symbols with :require last ensures |
| 773 | ;; that the mode function will see other |
| 774 | ;; customized values rather than default |
| 775 | ;; values. |
| 776 | (t (nth 3 a2))))))) |
| 777 | (while args |
| 778 | (let ((entry (car args))) |
| 779 | (if (listp entry) |
| 780 | (let* ((symbol (indirect-variable (nth 0 entry))) |
| 781 | (value (nth 1 entry)) |
| 782 | (now (nth 2 entry)) |
| 783 | (requests (nth 3 entry)) |
| 784 | (comment (nth 4 entry)) |
| 785 | set) |
| 786 | (when requests |
| 787 | (put symbol 'custom-requests requests) |
| 788 | (mapc 'require requests)) |
| 789 | (setq set (or (get symbol 'custom-set) 'custom-set-default)) |
| 790 | (put symbol 'saved-value (list value)) |
| 791 | (put symbol 'saved-variable-comment comment) |
| 792 | (custom-push-theme 'theme-value symbol theme 'set value) |
| 793 | ;; Allow for errors in the case where the setter has |
| 794 | ;; changed between versions, say, but let the user know. |
| 795 | (condition-case data |
| 796 | (cond (now |
| 797 | ;; Rogue variable, set it now. |
| 798 | (put symbol 'force-value t) |
| 799 | (funcall set symbol (eval value))) |
| 800 | ((default-boundp symbol) |
| 801 | ;; Something already set this, overwrite it. |
| 802 | (funcall set symbol (eval value)))) |
| 803 | (error |
| 804 | (message "Error setting %s: %s" symbol data))) |
| 805 | (setq args (cdr args)) |
| 806 | (and (or now (default-boundp symbol)) |
| 807 | (put symbol 'variable-comment comment))) |
| 808 | ;; Old format, a plist of SYMBOL VALUE pairs. |
| 809 | (message "Warning: old format `custom-set-variables'") |
| 810 | (ding) |
| 811 | (sit-for 2) |
| 812 | (let ((symbol (indirect-variable (nth 0 args))) |
| 813 | (value (nth 1 args))) |
| 814 | (put symbol 'saved-value (list value)) |
| 815 | (custom-push-theme 'theme-value symbol theme 'set value)) |
| 816 | (setq args (cdr (cdr args)))))))) |
| 817 | |
| 818 | (defun custom-set-default (variable value) |
| 819 | "Default :set function for a customizable variable. |
| 820 | Normally, this sets the default value of VARIABLE to VALUE, |
| 821 | but if `custom-local-buffer' is non-nil, |
| 822 | this sets the local binding in that buffer instead." |
| 823 | (if custom-local-buffer |
| 824 | (with-current-buffer custom-local-buffer |
| 825 | (set variable value)) |
| 826 | (set-default variable value))) |
| 827 | |
| 828 | (defun custom-set-minor-mode (variable value) |
| 829 | ":set function for minor mode variables. |
| 830 | Normally, this sets the default value of VARIABLE to nil if VALUE |
| 831 | is nil and to t otherwise, |
| 832 | but if `custom-local-buffer' is non-nil, |
| 833 | this sets the local binding in that buffer instead." |
| 834 | (if custom-local-buffer |
| 835 | (with-current-buffer custom-local-buffer |
| 836 | (funcall variable (or value 0))) |
| 837 | (funcall variable (or value 0)))) |
| 838 | |
| 839 | (defun custom-quote (sexp) |
| 840 | "Quote SEXP iff it is not self quoting." |
| 841 | (if (or (memq sexp '(t nil)) |
| 842 | (keywordp sexp) |
| 843 | (and (listp sexp) |
| 844 | (memq (car sexp) '(lambda))) |
| 845 | (stringp sexp) |
| 846 | (numberp sexp) |
| 847 | (vectorp sexp) |
| 848 | ;;; (and (fboundp 'characterp) |
| 849 | ;;; (characterp sexp)) |
| 850 | ) |
| 851 | sexp |
| 852 | (list 'quote sexp))) |
| 853 | |
| 854 | (defun customize-mark-to-save (symbol) |
| 855 | "Mark SYMBOL for later saving. |
| 856 | |
| 857 | If the default value of SYMBOL is different from the standard value, |
| 858 | set the `saved-value' property to a list whose car evaluates to the |
| 859 | default value. Otherwise, set it to nil. |
| 860 | |
| 861 | To actually save the value, call `custom-save-all'. |
| 862 | |
| 863 | Return non-nil iff the `saved-value' property actually changed." |
| 864 | (let* ((get (or (get symbol 'custom-get) 'default-value)) |
| 865 | (value (funcall get symbol)) |
| 866 | (saved (get symbol 'saved-value)) |
| 867 | (standard (get symbol 'standard-value)) |
| 868 | (comment (get symbol 'customized-variable-comment))) |
| 869 | ;; Save default value iff different from standard value. |
| 870 | (if (or (null standard) |
| 871 | (not (equal value (condition-case nil |
| 872 | (eval (car standard)) |
| 873 | (error nil))))) |
| 874 | (put symbol 'saved-value (list (custom-quote value))) |
| 875 | (put symbol 'saved-value nil)) |
| 876 | ;; Clear customized information (set, but not saved). |
| 877 | (put symbol 'customized-value nil) |
| 878 | ;; Save any comment that might have been set. |
| 879 | (when comment |
| 880 | (put symbol 'saved-variable-comment comment)) |
| 881 | (not (equal saved (get symbol 'saved-value))))) |
| 882 | |
| 883 | (defun customize-mark-as-set (symbol) |
| 884 | "Mark current value of SYMBOL as being set from customize. |
| 885 | |
| 886 | If the default value of SYMBOL is different from the saved value if any, |
| 887 | or else if it is different from the standard value, set the |
| 888 | `customized-value' property to a list whose car evaluates to the |
| 889 | default value. Otherwise, set it to nil. |
| 890 | |
| 891 | Return non-nil iff the `customized-value' property actually changed." |
| 892 | (let* ((get (or (get symbol 'custom-get) 'default-value)) |
| 893 | (value (funcall get symbol)) |
| 894 | (customized (get symbol 'customized-value)) |
| 895 | (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) |
| 896 | ;; Mark default value as set iff different from old value. |
| 897 | (if (or (null old) |
| 898 | (not (equal value (condition-case nil |
| 899 | (eval (car old)) |
| 900 | (error nil))))) |
| 901 | (put symbol 'customized-value (list (custom-quote value))) |
| 902 | (put symbol 'customized-value nil)) |
| 903 | ;; Changed? |
| 904 | (not (equal customized (get symbol 'customized-value))))) |
| 905 | |
| 906 | ;;; Theme Manipulation |
| 907 | |
| 908 | (defvar custom-loaded-themes nil |
| 909 | "Themes in the order they are loaded.") |
| 910 | |
| 911 | (defun custom-theme-loaded-p (theme) |
| 912 | "Return non-nil when THEME has been loaded." |
| 913 | (memq theme custom-loaded-themes)) |
| 914 | |
| 915 | (defun provide-theme (theme) |
| 916 | "Indicate that this file provides THEME. |
| 917 | Add THEME to `custom-loaded-themes' and `provide' whatever |
| 918 | is stored in THEME's property `theme-feature'. |
| 919 | |
| 920 | Usually the theme-feature property contains a symbol created |
| 921 | by `custom-make-theme-feature'." |
| 922 | (custom-check-theme theme) |
| 923 | (provide (get theme 'theme-feature)) |
| 924 | (setq custom-loaded-themes (nconc (list theme) custom-loaded-themes))) |
| 925 | |
| 926 | (defun require-theme (theme) |
| 927 | "Try to load a theme by requiring its feature. |
| 928 | THEME's feature is stored in THEME's `theme-feature' property. |
| 929 | |
| 930 | Usually the `theme-feature' property contains a symbol created |
| 931 | by `custom-make-theme-feature'." |
| 932 | ;; Note we do no check for validity of the theme here. |
| 933 | ;; This allows to pull in themes by a file-name convention |
| 934 | (require (or (get theme 'theme-feature) |
| 935 | (custom-make-theme-feature theme)))) |
| 936 | |
| 937 | (defun custom-remove-theme (spec-alist theme) |
| 938 | "Delete all elements from SPEC-ALIST whose car is THEME." |
| 939 | (let ((elt (assoc theme spec-alist))) |
| 940 | (while elt |
| 941 | (setq spec-alist (delete elt spec-alist) |
| 942 | elt (assoc theme spec-alist)))) |
| 943 | spec-alist) |
| 944 | |
| 945 | (defun custom-do-theme-reset (theme) |
| 946 | "Undo all settings defined by THEME. |
| 947 | |
| 948 | A variable remains unchanged if its property `theme-value' does not |
| 949 | contain a value for THEME. A face remains unchanged if its property |
| 950 | `theme-face' does not contain a value for THEME. In either case, all |
| 951 | settings for THEME are removed from the property and the variable or |
| 952 | face is set to the `user' theme. |
| 953 | |
| 954 | See `custom-known-themes' for a list of known themes." |
| 955 | (let (spec-list) |
| 956 | (mapatoms (lambda (symbol) |
| 957 | ;; This works even if symbol is both a variable and a |
| 958 | ;; face. |
| 959 | (setq spec-list (get symbol 'theme-value)) |
| 960 | (when spec-list |
| 961 | (put symbol 'theme-value (custom-remove-theme spec-list theme)) |
| 962 | (custom-theme-reset-internal symbol 'user)) |
| 963 | (setq spec-list (get symbol 'theme-face)) |
| 964 | (when spec-list |
| 965 | (put symbol 'theme-face (custom-remove-theme spec-list theme)) |
| 966 | (custom-theme-reset-internal-face symbol 'user)))))) |
| 967 | |
| 968 | (defun custom-theme-load-themes (by-theme &rest body) |
| 969 | "Load the themes specified by BODY. |
| 970 | Record them as required by theme BY-THEME. BODY is a sequence of either |
| 971 | |
| 972 | THEME |
| 973 | BY-THEME requires THEME |
| 974 | \(reset THEME) |
| 975 | Undo all the settings made by THEME |
| 976 | \(hidden THEME) |
| 977 | Require THEME but hide it from the user |
| 978 | |
| 979 | All the themes loaded for BY-THEME are recorded in BY-THEME's property |
| 980 | `theme-loads-themes'. Any theme loaded with the hidden predicate will |
| 981 | be given the property `theme-hidden' unless it has been loaded before. |
| 982 | Whether a theme has been loaded before is determined by the function |
| 983 | `custom-theme-loaded-p'." |
| 984 | (custom-check-theme by-theme) |
| 985 | (let ((theme) |
| 986 | (themes-loaded (get by-theme 'theme-loads-themes))) |
| 987 | (while theme |
| 988 | (setq theme (car body) |
| 989 | body (cdr body)) |
| 990 | (cond ((and (consp theme) (eq (car theme) 'reset)) |
| 991 | (custom-do-theme-reset (cadr theme))) |
| 992 | ((and (consp theme) (eq (car theme) 'hidden)) |
| 993 | (require-theme (cadr theme)) |
| 994 | (unless (custom-theme-loaded-p (cadr theme)) |
| 995 | (put (cadr theme) 'theme-hidden t))) |
| 996 | (t |
| 997 | (require-theme theme) |
| 998 | (put theme 'theme-hidden nil))) |
| 999 | (setq themes-loaded (nconc (list theme) themes-loaded))) |
| 1000 | (put by-theme 'theme-loads-themes themes-loaded))) |
| 1001 | |
| 1002 | (defun custom-load-themes (&rest body) |
| 1003 | "Load themes for the USER theme as specified by BODY. |
| 1004 | |
| 1005 | See `custom-theme-load-themes' for more information on BODY." |
| 1006 | (apply 'custom-theme-load-themes 'user body)) |
| 1007 | |
| 1008 | ; (defsubst copy-upto-last (elt list) |
| 1009 | ; "Copy all the elements of the list upto the last occurence of elt" |
| 1010 | ; ;; Is it faster to do more work in C than to do less in elisp? |
| 1011 | ; (nreverse (cdr (member elt (reverse list))))) |
| 1012 | |
| 1013 | (defun custom-theme-value (theme theme-spec-list) |
| 1014 | "Determine the value for THEME defined by THEME-SPEC-LIST. |
| 1015 | Returns a list with the original value if found; nil otherwise. |
| 1016 | |
| 1017 | THEME-SPEC-LIST is an alist with themes as its key. As new themes are |
| 1018 | installed, these are added to the front of THEME-SPEC-LIST. |
| 1019 | Each element has the form |
| 1020 | |
| 1021 | \(THEME MODE VALUE) |
| 1022 | |
| 1023 | MODE is either the symbol `set' or the symbol `reset'. See |
| 1024 | `custom-push-theme' for more information on the format of |
| 1025 | THEME-SPEC-LIST." |
| 1026 | ;; Note we do _NOT_ signal an error if the theme is unknown |
| 1027 | ;; it might have gone away without the user knowing. |
| 1028 | (let ((value (cdr (assoc theme theme-spec-list)))) |
| 1029 | (if value |
| 1030 | (if (eq (car value) 'set) |
| 1031 | (cdr value) |
| 1032 | (custom-theme-value (cadr value) theme-spec-list))))) |
| 1033 | |
| 1034 | (defun custom-theme-variable-value (variable theme) |
| 1035 | "Return (list value) indicating value of VARIABLE in THEME. |
| 1036 | If THEME does not define a value for VARIABLE, return nil. The value |
| 1037 | definitions per theme are stored in VARIABLE's property `theme-value'. |
| 1038 | The actual work is done by function `custom-theme-value', which see. |
| 1039 | See `custom-push-theme' for more information on how these definitions |
| 1040 | are stored." |
| 1041 | (custom-theme-value theme (get variable 'theme-value))) |
| 1042 | |
| 1043 | (defun custom-theme-reset-internal (symbol to-theme) |
| 1044 | "Reset SYMBOL to the value defined by TO-THEME. |
| 1045 | If SYMBOL is not defined in TO-THEME, reset SYMBOL to the standard |
| 1046 | value. See `custom-theme-variable-value'. The standard value is |
| 1047 | stored in SYMBOL's property `standard-value'." |
| 1048 | (let ((value (custom-theme-variable-value symbol to-theme)) |
| 1049 | was-in-theme) |
| 1050 | (setq was-in-theme value) |
| 1051 | (setq value (or value (get symbol 'standard-value))) |
| 1052 | (when value |
| 1053 | (put symbol 'saved-value was-in-theme) |
| 1054 | (if (or (get 'force-value symbol) (default-boundp symbol)) |
| 1055 | (funcall (or (get symbol 'custom-set) 'set-default) symbol |
| 1056 | (eval (car value))))) |
| 1057 | value)) |
| 1058 | |
| 1059 | (defun custom-theme-reset-variables (theme &rest args) |
| 1060 | "Reset the value of the variables to values previously defined. |
| 1061 | Associate this setting with THEME. |
| 1062 | |
| 1063 | ARGS is a list of lists of the form |
| 1064 | |
| 1065 | (VARIABLE TO-THEME) |
| 1066 | |
| 1067 | This means reset VARIABLE to its value in TO-THEME." |
| 1068 | (custom-check-theme theme) |
| 1069 | (mapcar '(lambda (arg) |
| 1070 | (apply 'custom-theme-reset-internal arg) |
| 1071 | (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) |
| 1072 | args)) |
| 1073 | |
| 1074 | (defun custom-reset-variables (&rest args) |
| 1075 | "Reset the value of the variables to values previously saved. |
| 1076 | This is the setting associated the `user' theme. |
| 1077 | |
| 1078 | ARGS is a list of lists of the form |
| 1079 | |
| 1080 | (VARIABLE TO-THEME) |
| 1081 | |
| 1082 | This means reset VARIABLE to its value in TO-THEME." |
| 1083 | (apply 'custom-theme-reset-variables 'user args)) |
| 1084 | |
| 1085 | ;;; The End. |
| 1086 | |
| 1087 | ;; Process the defcustoms for variables loaded before this file. |
| 1088 | (while custom-declare-variable-list |
| 1089 | (apply 'custom-declare-variable (car custom-declare-variable-list)) |
| 1090 | (setq custom-declare-variable-list (cdr custom-declare-variable-list))) |
| 1091 | |
| 1092 | (provide 'custom) |
| 1093 | |
| 1094 | ;;; arch-tag: 041b6116-aabe-4f9a-902d-74092bc3dab2 |
| 1095 | ;;; custom.el ends here |