| 1 | ;;; custom.el -- Tools for declaring and initializing options. |
| 2 | ;; |
| 3 | ;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc. |
| 4 | ;; |
| 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
| 6 | ;; Maintainer: FSF |
| 7 | ;; Keywords: help, faces |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 24 | ;; Boston, MA 02111-1307, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | ;; |
| 28 | ;; This file only contain the code needed to declare and initialize |
| 29 | ;; user options. The code to customize options is autoloaded from |
| 30 | ;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual. |
| 31 | |
| 32 | ;; The code implementing face declarations is in `cus-face.el' |
| 33 | |
| 34 | ;;; Code: |
| 35 | |
| 36 | (require 'widget) |
| 37 | |
| 38 | (defvar custom-define-hook nil |
| 39 | ;; Customize information for this option is in `cus-edit.el'. |
| 40 | "Hook called after defining each customize option.") |
| 41 | |
| 42 | ;;; The `defcustom' Macro. |
| 43 | |
| 44 | (defun custom-initialize-default (symbol value) |
| 45 | "Initialize SYMBOL with VALUE. |
| 46 | This will do nothing if symbol already has a default binding. |
| 47 | Otherwise, if symbol has a `saved-value' property, it will evaluate |
| 48 | the car of that and used as the default binding for symbol. |
| 49 | Otherwise, VALUE will be evaluated and used as the default binding for |
| 50 | symbol." |
| 51 | (unless (default-boundp symbol) |
| 52 | ;; Use the saved value if it exists, otherwise the standard setting. |
| 53 | (set-default symbol (if (get symbol 'saved-value) |
| 54 | (eval (car (get symbol 'saved-value))) |
| 55 | (eval value))))) |
| 56 | |
| 57 | (defun custom-initialize-set (symbol value) |
| 58 | "Initialize SYMBOL based on VALUE. |
| 59 | If the symbol doesn't have a default binding already, |
| 60 | then set it using its `:set' function (or `set-default' if it has none). |
| 61 | The value is either the value in the symbol's `saved-value' property, |
| 62 | if any, or VALUE." |
| 63 | (unless (default-boundp symbol) |
| 64 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 65 | symbol |
| 66 | (if (get symbol 'saved-value) |
| 67 | (eval (car (get symbol 'saved-value))) |
| 68 | (eval value))))) |
| 69 | |
| 70 | (defun custom-initialize-reset (symbol value) |
| 71 | "Initialize SYMBOL based on VALUE. |
| 72 | Set the symbol, using its `:set' function (or `set-default' if it has none). |
| 73 | The value is either the symbol's current value |
| 74 | \(as obtained using the `:get' function), if any, |
| 75 | or the value in the symbol's `saved-value' property if any, |
| 76 | or (last of all) VALUE." |
| 77 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 78 | symbol |
| 79 | (cond ((default-boundp symbol) |
| 80 | (funcall (or (get symbol 'custom-get) 'default-value) |
| 81 | symbol)) |
| 82 | ((get symbol 'saved-value) |
| 83 | (eval (car (get symbol 'saved-value)))) |
| 84 | (t |
| 85 | (eval value))))) |
| 86 | |
| 87 | (defun custom-initialize-changed (symbol value) |
| 88 | "Initialize SYMBOL with VALUE. |
| 89 | Like `custom-initialize-reset', but only use the `:set' function if the |
| 90 | not using the standard setting. |
| 91 | For the standard setting, use the `set-default'." |
| 92 | (cond ((default-boundp symbol) |
| 93 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 94 | symbol |
| 95 | (funcall (or (get symbol 'custom-get) 'default-value) |
| 96 | symbol))) |
| 97 | ((get symbol 'saved-value) |
| 98 | (funcall (or (get symbol 'custom-set) 'set-default) |
| 99 | symbol |
| 100 | (eval (car (get symbol 'saved-value))))) |
| 101 | (t |
| 102 | (set-default symbol (eval value))))) |
| 103 | |
| 104 | (defun custom-declare-variable (symbol default doc &rest args) |
| 105 | "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments. |
| 106 | DEFAULT should be an expression to evaluate to compute the default value, |
| 107 | not the default value itself." |
| 108 | ;; Remember the standard setting. |
| 109 | (put symbol 'standard-value (list default)) |
| 110 | ;; Maybe this option was rogue in an earlier version. It no longer is. |
| 111 | (when (get symbol 'force-value) |
| 112 | (put symbol 'force-value nil)) |
| 113 | (when doc |
| 114 | (put symbol 'variable-documentation doc)) |
| 115 | (let ((initialize 'custom-initialize-reset) |
| 116 | (requests nil)) |
| 117 | (while args |
| 118 | (let ((arg (car args))) |
| 119 | (setq args (cdr args)) |
| 120 | (unless (symbolp arg) |
| 121 | (error "Junk in args %S" args)) |
| 122 | (let ((keyword arg) |
| 123 | (value (car args))) |
| 124 | (unless args |
| 125 | (error "Keyword %s is missing an argument" keyword)) |
| 126 | (setq args (cdr args)) |
| 127 | (cond ((eq keyword :initialize) |
| 128 | (setq initialize value)) |
| 129 | ((eq keyword :set) |
| 130 | (put symbol 'custom-set value)) |
| 131 | ((eq keyword :get) |
| 132 | (put symbol 'custom-get value)) |
| 133 | ((eq keyword :require) |
| 134 | (setq requests (cons value requests))) |
| 135 | ((eq keyword :type) |
| 136 | (put symbol 'custom-type (purecopy value))) |
| 137 | ((eq keyword :options) |
| 138 | (if (get symbol 'custom-options) |
| 139 | ;; Slow safe code to avoid duplicates. |
| 140 | (mapc (lambda (option) |
| 141 | (custom-add-option symbol option)) |
| 142 | value) |
| 143 | ;; Fast code for the common case. |
| 144 | (put symbol 'custom-options (copy-sequence value)))) |
| 145 | (t |
| 146 | (custom-handle-keyword symbol keyword value |
| 147 | 'custom-variable)))))) |
| 148 | (put symbol 'custom-requests requests) |
| 149 | ;; Do the actual initialization. |
| 150 | (funcall initialize symbol default)) |
| 151 | (setq current-load-list (cons symbol current-load-list)) |
| 152 | (run-hooks 'custom-define-hook) |
| 153 | symbol) |
| 154 | |
| 155 | (defmacro defcustom (symbol value doc &rest args) |
| 156 | "Declare SYMBOL as a customizable variable that defaults to VALUE. |
| 157 | DOC is the variable documentation. |
| 158 | |
| 159 | Neither SYMBOL nor VALUE needs to be quoted. |
| 160 | If SYMBOL is not already bound, initialize it to VALUE. |
| 161 | The remaining arguments should have the form |
| 162 | |
| 163 | [KEYWORD VALUE]... |
| 164 | |
| 165 | The following keywords are meaningful: |
| 166 | |
| 167 | :type VALUE should be a widget type for editing the symbols value. |
| 168 | The default is `sexp'. |
| 169 | :options VALUE should be a list of valid members of the widget type. |
| 170 | :group VALUE should be a customization group. |
| 171 | Add SYMBOL to that group. |
| 172 | :initialize |
| 173 | VALUE should be a function used to initialize the |
| 174 | variable. It takes two arguments, the symbol and value |
| 175 | given in the `defcustom' call. The default is |
| 176 | `custom-initialize-default' |
| 177 | :set VALUE should be a function to set the value of the symbol. |
| 178 | It takes two arguments, the symbol to set and the value to |
| 179 | give it. The default choice of function is `custom-set-default'. |
| 180 | :get VALUE should be a function to extract the value of symbol. |
| 181 | The function takes one argument, a symbol, and should return |
| 182 | the current value for that symbol. The default choice of function |
| 183 | is `custom-default-value'. |
| 184 | :require |
| 185 | VALUE should be a feature symbol. If you save a value |
| 186 | for this option, then when your `.emacs' file loads the value, |
| 187 | it does (require VALUE) first. |
| 188 | :version |
| 189 | VALUE should be a string specifying that the variable was |
| 190 | first introduced, or its default value was changed, in Emacs |
| 191 | version VERSION. |
| 192 | |
| 193 | Read the section about customization in the Emacs Lisp manual for more |
| 194 | information." |
| 195 | ;; It is better not to use backquote in this file, |
| 196 | ;; because that makes a bootstrapping problem |
| 197 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 198 | (nconc (list 'custom-declare-variable |
| 199 | (list 'quote symbol) |
| 200 | (list 'quote value) |
| 201 | doc) |
| 202 | args)) |
| 203 | |
| 204 | ;;; The `defface' Macro. |
| 205 | |
| 206 | (defmacro defface (face spec doc &rest args) |
| 207 | "Declare FACE as a customizable face that defaults to SPEC. |
| 208 | FACE does not need to be quoted. |
| 209 | |
| 210 | Third argument DOC is the face documentation. |
| 211 | |
| 212 | If FACE has been set with `custom-set-face', set the face attributes |
| 213 | as specified by that function, otherwise set the face attributes |
| 214 | according to SPEC. |
| 215 | |
| 216 | The remaining arguments should have the form |
| 217 | |
| 218 | [KEYWORD VALUE]... |
| 219 | |
| 220 | The following KEYWORDs are defined: |
| 221 | |
| 222 | :group VALUE should be a customization group. |
| 223 | Add FACE to that group. |
| 224 | |
| 225 | SPEC should be an alist of the form ((DISPLAY ATTS)...). |
| 226 | |
| 227 | The first element of SPEC where the DISPLAY matches the frame |
| 228 | is the one that takes effect in that frame. The ATTRs in this |
| 229 | element take effect; the other elements are ignored, on that frame. |
| 230 | |
| 231 | ATTS is a list of face attributes followed by their values: |
| 232 | (ATTR VALUE ATTR VALUE...) |
| 233 | |
| 234 | The possible attributes are `:family', `:width', `:height', `:weight', |
| 235 | `:slant', `:underline', `:overline', `:strike-through', `:box', |
| 236 | `:foreground', `:background', `:stipple', and `:inverse-video'. |
| 237 | |
| 238 | DISPLAY can either be the symbol t, which will match all frames, or an |
| 239 | alist of the form \((REQ ITEM...)...). For the DISPLAY to match a |
| 240 | FRAME, the REQ property of the frame must match one of the ITEM. The |
| 241 | following REQ are defined: |
| 242 | |
| 243 | `type' (the value of `window-system') |
| 244 | Under X, in addition to the values `window-system' can take, |
| 245 | `motif', `lucid' and `x-toolkit' are allowed, and match when |
| 246 | the Motif toolkit, Lucid toolkit, or any X toolkit is in use. |
| 247 | |
| 248 | `class' (the frame's color support) |
| 249 | Should be one of `color', `grayscale', or `mono'. |
| 250 | |
| 251 | `background' (what color is used for the background text) |
| 252 | Should be one of `light' or `dark'. |
| 253 | |
| 254 | Read the section about customization in the Emacs Lisp manual for more |
| 255 | information." |
| 256 | ;; It is better not to use backquote in this file, |
| 257 | ;; because that makes a bootstrapping problem |
| 258 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 259 | (nconc (list 'custom-declare-face (list 'quote face) spec doc) args)) |
| 260 | |
| 261 | ;;; The `defgroup' Macro. |
| 262 | |
| 263 | (defun custom-declare-group (symbol members doc &rest args) |
| 264 | "Like `defgroup', but SYMBOL is evaluated as a normal argument." |
| 265 | (while members |
| 266 | (apply 'custom-add-to-group symbol (car members)) |
| 267 | (setq members (cdr members))) |
| 268 | (put symbol 'custom-group (nconc members (get symbol 'custom-group))) |
| 269 | (when doc |
| 270 | ;; This text doesn't get into DOC. |
| 271 | (put symbol 'group-documentation (purecopy doc))) |
| 272 | (while args |
| 273 | (let ((arg (car args))) |
| 274 | (setq args (cdr args)) |
| 275 | (unless (symbolp arg) |
| 276 | (error "Junk in args %S" args)) |
| 277 | (let ((keyword arg) |
| 278 | (value (car args))) |
| 279 | (unless args |
| 280 | (error "Keyword %s is missing an argument" keyword)) |
| 281 | (setq args (cdr args)) |
| 282 | (cond ((eq keyword :prefix) |
| 283 | (put symbol 'custom-prefix value)) |
| 284 | (t |
| 285 | (custom-handle-keyword symbol keyword value |
| 286 | 'custom-group)))))) |
| 287 | (run-hooks 'custom-define-hook) |
| 288 | symbol) |
| 289 | |
| 290 | (defmacro defgroup (symbol members doc &rest args) |
| 291 | "Declare SYMBOL as a customization group containing MEMBERS. |
| 292 | SYMBOL does not need to be quoted. |
| 293 | |
| 294 | Third arg DOC is the group documentation. |
| 295 | |
| 296 | MEMBERS should be an alist of the form ((NAME WIDGET)...) where |
| 297 | NAME is a symbol and WIDGET is a widget for editing that symbol. |
| 298 | Useful widgets are `custom-variable' for editing variables, |
| 299 | `custom-face' for edit faces, and `custom-group' for editing groups. |
| 300 | |
| 301 | The remaining arguments should have the form |
| 302 | |
| 303 | [KEYWORD VALUE]... |
| 304 | |
| 305 | The following KEYWORDs are defined: |
| 306 | |
| 307 | :group VALUE should be a customization group. |
| 308 | Add SYMBOL to that group. |
| 309 | |
| 310 | :version VALUE should be a string specifying that the group was introduced |
| 311 | in Emacs version VERSION. |
| 312 | |
| 313 | Read the section about customization in the Emacs Lisp manual for more |
| 314 | information." |
| 315 | ;; It is better not to use backquote in this file, |
| 316 | ;; because that makes a bootstrapping problem |
| 317 | ;; if you need to recompile all the Lisp files using interpreted code. |
| 318 | (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args)) |
| 319 | |
| 320 | (defun custom-add-to-group (group option widget) |
| 321 | "To existing GROUP add a new OPTION of type WIDGET. |
| 322 | If there already is an entry for OPTION and WIDGET, nothing is done." |
| 323 | (let ((members (get group 'custom-group)) |
| 324 | (entry (list option widget))) |
| 325 | (unless (member entry members) |
| 326 | (put group 'custom-group (nconc members (list entry)))))) |
| 327 | |
| 328 | ;;; Properties. |
| 329 | |
| 330 | (defun custom-handle-all-keywords (symbol args type) |
| 331 | "For customization option SYMBOL, handle keyword arguments ARGS. |
| 332 | Third argument TYPE is the custom option type." |
| 333 | (while args |
| 334 | (let ((arg (car args))) |
| 335 | (setq args (cdr args)) |
| 336 | (unless (symbolp arg) |
| 337 | (error "Junk in args %S" args)) |
| 338 | (let ((keyword arg) |
| 339 | (value (car args))) |
| 340 | (unless args |
| 341 | (error "Keyword %s is missing an argument" keyword)) |
| 342 | (setq args (cdr args)) |
| 343 | (custom-handle-keyword symbol keyword value type))))) |
| 344 | |
| 345 | (defun custom-handle-keyword (symbol keyword value type) |
| 346 | "For customization option SYMBOL, handle KEYWORD with VALUE. |
| 347 | Fourth argument TYPE is the custom option type." |
| 348 | (if purify-flag |
| 349 | (setq value (purecopy value))) |
| 350 | (cond ((eq keyword :group) |
| 351 | (custom-add-to-group value symbol type)) |
| 352 | ((eq keyword :version) |
| 353 | (custom-add-version symbol value)) |
| 354 | ((eq keyword :link) |
| 355 | (custom-add-link symbol value)) |
| 356 | ((eq keyword :load) |
| 357 | (custom-add-load symbol value)) |
| 358 | ((eq keyword :tag) |
| 359 | (put symbol 'custom-tag value)) |
| 360 | ((eq keyword :set-after) |
| 361 | (custom-add-dependencies symbol value)) |
| 362 | (t |
| 363 | (error "Unknown keyword %s" keyword)))) |
| 364 | |
| 365 | (defun custom-add-dependencies (symbol value) |
| 366 | "To the custom option SYMBOL, add dependencies specified by VALUE. |
| 367 | VALUE should be a list of symbols. For each symbol in that list, |
| 368 | this specifies that SYMBOL should be set after the specified symbol, if |
| 369 | both appear in constructs like `custom-set-variables'." |
| 370 | (unless (listp value) |
| 371 | (error "Invalid custom dependency `%s'" value)) |
| 372 | (let* ((deps (get symbol 'custom-dependencies)) |
| 373 | (new-deps deps)) |
| 374 | (while value |
| 375 | (let ((dep (car value))) |
| 376 | (unless (symbolp dep) |
| 377 | (error "Invalid custom dependency `%s'" dep)) |
| 378 | (unless (memq dep new-deps) |
| 379 | (setq new-deps (cons dep new-deps))) |
| 380 | (setq value (cdr value)))) |
| 381 | (unless (eq deps new-deps) |
| 382 | (put symbol 'custom-dependencies new-deps)))) |
| 383 | |
| 384 | (defun custom-add-option (symbol option) |
| 385 | "To the variable SYMBOL add OPTION. |
| 386 | |
| 387 | If SYMBOL is a hook variable, OPTION should be a hook member. |
| 388 | For other types variables, the effect is undefined." |
| 389 | (let ((options (get symbol 'custom-options))) |
| 390 | (unless (member option options) |
| 391 | (put symbol 'custom-options (cons option options))))) |
| 392 | |
| 393 | (defun custom-add-link (symbol widget) |
| 394 | "To the custom option SYMBOL add the link WIDGET." |
| 395 | (let ((links (get symbol 'custom-links))) |
| 396 | (unless (member widget links) |
| 397 | (put symbol 'custom-links (cons (purecopy widget) links))))) |
| 398 | |
| 399 | (defun custom-add-version (symbol version) |
| 400 | "To the custom option SYMBOL add the version VERSION." |
| 401 | (put symbol 'custom-version (purecopy version))) |
| 402 | |
| 403 | (defun custom-add-load (symbol load) |
| 404 | "To the custom option SYMBOL add the dependency LOAD. |
| 405 | LOAD should be either a library file name, or a feature name." |
| 406 | (let ((loads (get symbol 'custom-loads))) |
| 407 | (unless (member load loads) |
| 408 | (put symbol 'custom-loads (cons (purecopy load) loads))))) |
| 409 | |
| 410 | ;;; Initializing. |
| 411 | |
| 412 | (defvar custom-local-buffer nil |
| 413 | "Non-nil, in a Customization buffer, means customize a specific buffer. |
| 414 | If this variable is non-nil, it should be a buffer, |
| 415 | and it means customize the local bindings of that buffer. |
| 416 | This variable is a permanent local, and it normally has a local binding |
| 417 | in every Customization buffer.") |
| 418 | (put 'custom-local-buffer 'permanent-local t) |
| 419 | |
| 420 | (defun custom-set-variables (&rest args) |
| 421 | "Initialize variables according to user preferences. |
| 422 | |
| 423 | The arguments should be a list where each entry has the form: |
| 424 | |
| 425 | (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) |
| 426 | |
| 427 | The unevaluated VALUE is stored as the saved value for SYMBOL. |
| 428 | If NOW is present and non-nil, VALUE is also evaluated and bound as |
| 429 | the default value for the SYMBOL. |
| 430 | REQUEST is a list of features we must require for SYMBOL. |
| 431 | COMMENT is a comment string about SYMBOL." |
| 432 | (setq args |
| 433 | (sort args |
| 434 | (lambda (a1 a2) |
| 435 | (let* ((sym1 (car a1)) |
| 436 | (sym2 (car a2)) |
| 437 | (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) |
| 438 | (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) |
| 439 | (cond ((and 1-then-2 2-then-1) |
| 440 | (error "Circular custom dependency between `%s' and `%s'" |
| 441 | sym1 sym2)) |
| 442 | (2-then-1 nil) |
| 443 | (t t)))))) |
| 444 | (while args |
| 445 | (let ((entry (car args))) |
| 446 | (if (listp entry) |
| 447 | (let* ((symbol (nth 0 entry)) |
| 448 | (value (nth 1 entry)) |
| 449 | (now (nth 2 entry)) |
| 450 | (requests (nth 3 entry)) |
| 451 | (comment (nth 4 entry)) |
| 452 | set) |
| 453 | (when requests |
| 454 | (put symbol 'custom-requests requests) |
| 455 | (mapc 'require requests)) |
| 456 | (setq set (or (get symbol 'custom-set) 'custom-set-default)) |
| 457 | (put symbol 'saved-value (list value)) |
| 458 | (put symbol 'saved-variable-comment comment) |
| 459 | ;; Allow for errors in the case where the setter has |
| 460 | ;; changed between versions, say, but let the user know. |
| 461 | (condition-case data |
| 462 | (cond (now |
| 463 | ;; Rogue variable, set it now. |
| 464 | (put symbol 'force-value t) |
| 465 | (funcall set symbol (eval value))) |
| 466 | ((default-boundp symbol) |
| 467 | ;; Something already set this, overwrite it. |
| 468 | (funcall set symbol (eval value)))) |
| 469 | (error |
| 470 | (message "Error setting %s: %s" symbol data))) |
| 471 | (setq args (cdr args)) |
| 472 | (and (or now (default-boundp symbol)) |
| 473 | (put symbol 'variable-comment comment))) |
| 474 | ;; Old format, a plist of SYMBOL VALUE pairs. |
| 475 | (message "Warning: old format `custom-set-variables'") |
| 476 | (ding) |
| 477 | (sit-for 2) |
| 478 | (let ((symbol (nth 0 args)) |
| 479 | (value (nth 1 args))) |
| 480 | (put symbol 'saved-value (list value))) |
| 481 | (setq args (cdr (cdr args))))))) |
| 482 | |
| 483 | (defun custom-set-default (variable value) |
| 484 | "Default :set function for a customizable variable. |
| 485 | Normally, this sets the default value of VARIABLE to VALUE, |
| 486 | but if `custom-local-buffer' is non-nil, |
| 487 | this sets the local binding in that buffer instead." |
| 488 | (if custom-local-buffer |
| 489 | (with-current-buffer custom-local-buffer |
| 490 | (set variable value)) |
| 491 | (set-default variable value))) |
| 492 | |
| 493 | ;;; The End. |
| 494 | |
| 495 | ;; Process the defcustoms for variables loaded before this file. |
| 496 | (while custom-declare-variable-list |
| 497 | (apply 'custom-declare-variable (car custom-declare-variable-list)) |
| 498 | (setq custom-declare-variable-list (cdr custom-declare-variable-list))) |
| 499 | |
| 500 | (provide 'custom) |
| 501 | |
| 502 | ;;; custom.el ends here |