;;; 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 <abraham@dina.kvl.dk>
+;; Maintainer: FSF
;; Keywords: help, faces
-;; Version: 1.9900
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; This file is part of GNU Emacs.
;;; 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'
(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.")
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)))))
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))
(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)
(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)
((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.
- (mapcar (lambda (option)
- (custom-add-option symbol option))
+ (mapc (lambda (option)
+ (custom-add-option symbol option))
value)
;; Fast code for the common case.
(put symbol 'custom-options (copy-sequence value))))
If SYMBOL is not already bound, initialize it to VALUE.
The remaining arguments should have the form
- [KEYWORD VALUE]...
+ [KEYWORD VALUE]...
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
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 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 choice of function
- is `custom-default-value'.
+ 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."
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'.
(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)
The remaining arguments should have the form
- [KEYWORD VALUE]...
+ [KEYWORD VALUE]...
-The following KEYWORD's are defined:
+The following KEYWORDs 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."
(defun custom-add-to-group (group option widget)
"To existing GROUP add a new OPTION of type WIDGET.
-If there already is an entry for that option, overwrite it."
- (let* ((members (get group 'custom-group))
- (old (assq option members)))
- (if old
- (setcar (cdr old) widget)
- (put group 'custom-group (nconc members (list (list option widget)))))))
+If there already is an entry for OPTION and WIDGET, nothing is done."
+ (let ((members (get group 'custom-group))
+ (entry (list option widget)))
+ (unless (member entry members)
+ (put group 'custom-group (nconc members (list entry))))))
;;; Properties.
(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)
(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)
(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" 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.
"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.
(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))
+ (comment (nth 4 entry))
set)
(when requests
(put symbol 'custom-requests requests)
- (mapcar 'require requests))
+ (mapc 'require requests))
(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.
- (condition-case nil
+ ;; changed between versions, say, but let the user know.
+ (condition-case data
(cond (now
;; Rogue variable, set it now.
(put symbol 'force-value t)
((default-boundp symbol)
;; Something already set this, overwrite it.
(funcall set symbol (eval value))))
- (error nil))
- (setq args (cdr args)))
+ (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)
(provide 'custom)
-;; custom.el ends here
+;;; custom.el ends here
HCoop / bpt / emacs.git / blobdiff