X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c743cc52aba26ecfbecda269a308c9c36383fdc5..6a70ef0d8173b57817bcc8a013eb86c8583e74fc:/lisp/custom.el diff --git a/lisp/custom.el b/lisp/custom.el index 1803585234..ea7afc45fc 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1,11 +1,10 @@ ;;; custom.el -- Tools for declaring and initializing options. ;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: FSF ;; Keywords: help, faces -;; Version: 1.9900 -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -26,11 +25,9 @@ ;;; Commentary: ;; -;; If you want to use this code, please visit the URL above. -;; ;; This file only contain the code needed to declare and initialize ;; user options. The code to customize options is autoloaded from -;; `cus-edit.el'. +;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual. ;; The code implementing face declarations is in `cus-face.el' @@ -38,10 +35,6 @@ (require 'widget) -(define-widget-keywords :initialize :set :get :require :prefix :tag - :load :link :options :type :group) - - (defvar custom-define-hook nil ;; Customize information for this option is in `cus-edit.el'. "Hook called after defining each customize option.") @@ -69,7 +62,7 @@ The value is either the value in the symbol's `saved-value' property, if any, or VALUE." (unless (default-boundp symbol) (funcall (or (get symbol 'custom-set) 'set-default) - symbol + symbol (if (get symbol 'saved-value) (eval (car (get symbol 'saved-value))) (eval value))))) @@ -82,7 +75,7 @@ The value is either the symbol's current value or the value in the symbol's `saved-value' property if any, or (last of all) VALUE." (funcall (or (get symbol 'custom-set) 'set-default) - symbol + symbol (cond ((default-boundp symbol) (funcall (or (get symbol 'custom-get) 'default-value) symbol)) @@ -93,7 +86,7 @@ or (last of all) VALUE." (defun custom-initialize-changed (symbol value) "Initialize SYMBOL with VALUE. -Like `custom-initialize-reset', but only use the `:set' function if the +Like `custom-initialize-reset', but only use the `:set' function if the not using the standard setting. For the standard setting, use the `set-default'." (cond ((default-boundp symbol) @@ -116,13 +109,12 @@ not the default value itself." (put symbol 'standard-value (list default)) ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) - ;; It no longer is. (put symbol 'force-value nil)) (when doc (put symbol 'variable-documentation doc)) (let ((initialize 'custom-initialize-reset) (requests nil)) - (while args + (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) @@ -141,7 +133,7 @@ not the default value itself." ((eq keyword :require) (setq requests (cons value requests))) ((eq keyword :type) - (put symbol 'custom-type value)) + (put symbol 'custom-type (purecopy value))) ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. @@ -156,6 +148,7 @@ not the default value itself." (put symbol 'custom-requests requests) ;; Do the actual initialization. (funcall initialize symbol default)) + (setq current-load-list (cons symbol current-load-list)) (run-hooks 'custom-define-hook) symbol) @@ -167,33 +160,46 @@ Neither SYMBOL nor VALUE needs to be quoted. If SYMBOL is not already bound, initialize it to VALUE. The remaining arguments should have the form - [KEYWORD VALUE]... + [KEYWORD VALUE]... -The following KEYWORD's are defined: +The following keywords are meaningful: :type VALUE should be a widget type for editing the symbols value. The default is `sexp'. :options VALUE should be a list of valid members of the widget type. -:group VALUE should be a customization group. +:group VALUE should be a customization group. Add SYMBOL to that group. -:initialize VALUE should be a function used to initialize the +:initialize + VALUE should be a function used to initialize the variable. It takes two arguments, the symbol and value given in the `defcustom' call. The default is - `custom-initialize-default' -:set VALUE should be a function to set the value of the symbol. + `custom-initialize-default' +:set VALUE should be a function to set the value of the symbol. It takes two arguments, the symbol to set and the value to - give it. The default is `set-default'. + give it. The default choice of function is `custom-set-default'. :get VALUE should be a function to extract the value of symbol. The function takes one argument, a symbol, and should return - the current value for that symbol. The default is - `default-value'. -:require VALUE should be a feature symbol. Each feature will be - required after initialization, of the the user have saved this - option. + the current value for that symbol. The default choice of function + is `custom-default-value'. +:require + VALUE should be a feature symbol. If you save a value + for this option, then when your `.emacs' file loads the value, + it does (require VALUE) first. +:version + VALUE should be a string specifying that the variable was + first introduced, or its default value was changed, in Emacs + version VERSION. Read the section about customization in the Emacs Lisp manual for more information." - `(custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)) + ;; It is better not to use backquote in this file, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. + (nconc (list 'custom-declare-variable + (list 'quote symbol) + (list 'quote value) + doc) + args)) ;;; The `defface' Macro. @@ -224,8 +230,10 @@ element take effect; the other elements are ignored, on that frame. ATTS is a list of face attributes followed by their values: (ATTR VALUE ATTR VALUE...) -The possible attributes are `:bold', `:italic', `:underline', -`:foreground', `:background', `:stipple' and `:inverse-video'. + +The possible attributes are `:family', `:width', `:height', `:weight', +`:slant', `:underline', `:overline', `:strike-through', `:box', +`:foreground', `:background', `:stipple', and `:inverse-video'. DISPLAY can either be the symbol t, which will match all frames, or an alist of the form \((REQ ITEM...)...). For the DISPLAY to match a @@ -233,7 +241,9 @@ FRAME, the REQ property of the frame must match one of the ITEM. The following REQ are defined: `type' (the value of `window-system') - Should be one of `x' or `tty'. + Under X, in addition to the values `window-system' can take, + `motif', `lucid' and `x-toolkit' are allowed, and match when + the Motif toolkit, Lucid toolkit, or any X toolkit is in use. `class' (the frame's color support) Should be one of `color', `grayscale', or `mono'. @@ -243,19 +253,23 @@ following REQ are defined: Read the section about customization in the Emacs Lisp manual for more information." - `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) + ;; It is better not to use backquote in this file, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. + (nconc (list 'custom-declare-face (list 'quote face) spec doc) args)) ;;; The `defgroup' Macro. (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." - (while members + (while members (apply 'custom-add-to-group symbol (car members)) (setq members (cdr members))) (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc - (put symbol 'group-documentation doc)) - (while args + ;; This text doesn't get into DOC. + (put symbol 'group-documentation (purecopy doc))) + (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) @@ -280,22 +294,28 @@ SYMBOL does not need to be quoted. Third arg DOC is the group documentation. MEMBERS should be an alist of the form ((NAME WIDGET)...) where -NAME is a symbol and WIDGET is a widget is a widget for editing that -symbol. Useful widgets are `custom-variable' for editing variables, +NAME is a symbol and WIDGET is a widget for editing that symbol. +Useful widgets are `custom-variable' for editing variables, `custom-face' for edit faces, and `custom-group' for editing groups. The remaining arguments should have the form - [KEYWORD VALUE]... + [KEYWORD VALUE]... + +The following KEYWORDs are defined: -The following KEYWORD's are defined: +:group VALUE should be a customization group. + Add SYMBOL to that group. -:group VALUE should be a customization group. - Add SYMBOL to that group. +:version VALUE should be a string specifying that the group was introduced + in Emacs version VERSION. Read the section about customization in the Emacs Lisp manual for more information." - `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) + ;; It is better not to use backquote in this file, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. + (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args)) (defun custom-add-to-group (group option widget) "To existing GROUP add a new OPTION of type WIDGET. @@ -311,7 +331,7 @@ If there already is an entry for that option, overwrite it." (defun custom-handle-all-keywords (symbol args type) "For customization option SYMBOL, handle keyword arguments ARGS. Third argument TYPE is the custom option type." - (while args + (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) @@ -321,11 +341,13 @@ Third argument TYPE is the custom option type." (unless args (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) - (custom-handle-keyword symbol keyword value type))))) + (custom-handle-keyword symbol keyword value type))))) (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. Fourth argument TYPE is the custom option type." + (if purify-flag + (setq value (purecopy value))) (cond ((eq keyword :group) (custom-add-to-group value symbol type)) ((eq keyword :version) @@ -336,9 +358,30 @@ Fourth argument TYPE is the custom option type." (custom-add-load symbol value)) ((eq keyword :tag) (put symbol 'custom-tag value)) + ((eq keyword :set-after) + (custom-add-dependencies symbol value)) (t - (error "Unknown keyword %s" symbol)))) - + (error "Unknown keyword %s" keyword)))) + +(defun custom-add-dependencies (symbol value) + "To the custom option SYMBOL, add dependencies specified by VALUE. +VALUE should be a list of symbols. For each symbol in that list, +this specifies that SYMBOL should be set after the specified symbol, if +both appear in constructs like `custom-set-variables'." + (unless (listp value) + (error "Invalid custom dependency `%s'" value)) + (let* ((deps (get symbol 'custom-dependencies)) + (new-deps deps)) + (while value + (let ((dep (car value))) + (unless (symbolp dep) + (error "Invalid custom dependency `%s'" dep)) + (unless (memq dep new-deps) + (setq new-deps (cons dep new-deps))) + (setq value (cdr value)))) + (unless (eq deps new-deps) + (put symbol 'custom-dependencies new-deps)))) + (defun custom-add-option (symbol option) "To the variable SYMBOL add OPTION. @@ -352,51 +395,83 @@ For other types variables, the effect is undefined." "To the custom option SYMBOL add the link WIDGET." (let ((links (get symbol 'custom-links))) (unless (member widget links) - (put symbol 'custom-links (cons widget links))))) + (put symbol 'custom-links (cons (purecopy widget) links))))) (defun custom-add-version (symbol version) "To the custom option SYMBOL add the version VERSION." - (put symbol 'custom-version version)) + (put symbol 'custom-version (purecopy version))) (defun custom-add-load (symbol load) "To the custom option SYMBOL add the dependency LOAD. LOAD should be either a library file name, or a feature name." (let ((loads (get symbol 'custom-loads))) (unless (member load loads) - (put symbol 'custom-loads (cons load loads))))) + (put symbol 'custom-loads (cons (purecopy load) loads))))) ;;; Initializing. +(defvar custom-local-buffer nil + "Non-nil, in a Customization buffer, means customize a specific buffer. +If this variable is non-nil, it should be a buffer, +and it means customize the local bindings of that buffer. +This variable is a permanent local, and it normally has a local binding +in every Customization buffer.") +(put 'custom-local-buffer 'permanent-local t) + (defun custom-set-variables (&rest args) - "Initialize variables according to user preferences. + "Initialize variables according to user preferences. The arguments should be a list where each entry has the form: - (SYMBOL VALUE [NOW]) + (SYMBOL VALUE [NOW [REQUEST [COMMENT]]]) The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as -the default value for the SYMBOL." - (while args +the default value for the SYMBOL. +REQUEST is a list of features we must require for SYMBOL. +COMMENT is a comment string about SYMBOL." + (setq args + (sort args + (lambda (a1 a2) + (let* ((sym1 (car a1)) + (sym2 (car a2)) + (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) + (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) + (cond ((and 1-then-2 2-then-1) + (error "Circular custom dependency between `%s' and `%s'" + sym1 sym2)) + (2-then-1 nil) + (t t)))))) + (while args (let ((entry (car args))) (if (listp entry) (let* ((symbol (nth 0 entry)) (value (nth 1 entry)) (now (nth 2 entry)) (requests (nth 3 entry)) - (set (or (get symbol 'custom-set) 'set-default))) - (put symbol 'saved-value (list value)) - (cond (now - ;; Rogue variable, set it now. - (put symbol 'force-value t) - (funcall set symbol (eval value))) - ((default-boundp symbol) - ;; Something already set this, overwrite it. - (funcall set symbol (eval value)))) + (comment (nth 4 entry)) + set) (when requests (put symbol 'custom-requests requests) (mapcar 'require requests)) - (setq args (cdr args))) + (setq set (or (get symbol 'custom-set) 'custom-set-default)) + (put symbol 'saved-value (list value)) + (put symbol 'saved-variable-comment comment) + ;; Allow for errors in the case where the setter has + ;; changed between versions, say, but let the user know. + (condition-case data + (cond (now + ;; Rogue variable, set it now. + (put symbol 'force-value t) + (funcall set symbol (eval value))) + ((default-boundp symbol) + ;; Something already set this, overwrite it. + (funcall set symbol (eval value)))) + (error + (message "Error setting %s: %s" symbol data))) + (setq args (cdr args)) + (and (or now (default-boundp symbol)) + (put symbol 'variable-comment comment))) ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") (ding) @@ -406,6 +481,16 @@ the default value for the SYMBOL." (put symbol 'saved-value (list value))) (setq args (cdr (cdr args))))))) +(defun custom-set-default (variable value) + "Default :set function for a customizable variable. +Normally, this sets the default value of VARIABLE to VALUE, +but if `custom-local-buffer' is non-nil, +this sets the local binding in that buffer instead." + (if custom-local-buffer + (with-current-buffer custom-local-buffer + (set variable value)) + (set-default variable value))) + ;;; The End. ;; Process the defcustoms for variables loaded before this file. @@ -415,4 +500,4 @@ the default value for the SYMBOL." (provide 'custom) -;; custom.el ends here +;;; custom.el ends here