;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.84
+;; Version: 1.9900
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
;;; Commentary:
;;
;; If you want to use this code, please visit the URL above.
(require 'widget)
-(define-widget-keywords :prefix :tag :load :link :options :type :group)
+(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'.
;;; The `defcustom' Macro.
-(defun custom-declare-variable (symbol value doc &rest args)
- "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
- ;; Bind this variable unless it already is bound.
+(defun custom-initialize-default (symbol value)
+ "Initialize SYMBOL with VALUE.
+This will do nothing if symbol already has a default binding.
+Otherwise, if symbol has a `saved-value' property, it will evaluate
+the car of that and used as the default binding for symbol.
+Otherwise, VALUE will be evaluated and used as the default binding for
+symbol."
(unless (default-boundp symbol)
- ;; Use the saved value if it exists, otherwise the factory setting.
+ ;; Use the saved value if it exists, otherwise the standard setting.
(set-default symbol (if (get symbol 'saved-value)
(eval (car (get symbol 'saved-value)))
- (eval value))))
- ;; Remember the factory setting.
- (put symbol 'factory-value (list value))
+ (eval value)))))
+
+(defun custom-initialize-set (symbol value)
+ "Initialize SYMBOL based on VALUE.
+If the symbol doesn't have a default binding already,
+then set it using its `:set' function (or `set-default' if it has none).
+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
+ (if (get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value)))
+ (eval value)))))
+
+(defun custom-initialize-reset (symbol value)
+ "Initialize SYMBOL based on VALUE.
+Set the symbol, using its `:set' function (or `set-default' if it has none).
+The value is either the symbol's current value
+ \(as obtained using the `:get' function), if any,
+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
+ (cond ((default-boundp symbol)
+ (funcall (or (get symbol 'custom-get) 'default-value)
+ symbol))
+ ((get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value))))
+ (t
+ (eval value)))))
+
+(defun custom-initialize-changed (symbol value)
+ "Initialize SYMBOL with VALUE.
+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)
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (funcall (or (get symbol 'custom-get) 'default-value)
+ symbol)))
+ ((get symbol 'saved-value)
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (eval (car (get symbol 'saved-value)))))
+ (t
+ (set-default symbol (eval value)))))
+
+(defun custom-declare-variable (symbol default doc &rest args)
+ "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
+DEFAULT should be an expression to evaluate to compute the default value,
+not the default value itself."
+ ;; Remember the standard setting.
+ (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))
- (while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
- (error "Junk in args %S" args))
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
+ (let ((initialize 'custom-initialize-reset)
+ (requests nil))
+ (while args
+ (let ((arg (car args)))
(setq args (cdr args))
- (cond ((eq keyword :type)
- (put symbol 'custom-type value))
- ((eq keyword :options)
- (if (get symbol 'custom-options)
- ;; Slow safe code to avoid duplicates.
- (mapcar (lambda (option)
- (custom-add-option symbol option))
- value)
- ;; Fast code for the common case.
- (put symbol 'custom-options (copy-list value))))
- (t
- (custom-handle-keyword symbol keyword value
- 'custom-variable))))))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (cond ((eq keyword :initialize)
+ (setq initialize value))
+ ((eq keyword :set)
+ (put symbol 'custom-set value))
+ ((eq keyword :get)
+ (put symbol 'custom-get value))
+ ((eq keyword :require)
+ (setq requests (cons value requests)))
+ ((eq keyword :type)
+ (put symbol 'custom-type value))
+ ((eq keyword :options)
+ (if (get symbol 'custom-options)
+ ;; Slow safe code to avoid duplicates.
+ (mapcar (lambda (option)
+ (custom-add-option symbol option))
+ value)
+ ;; Fast code for the common case.
+ (put symbol 'custom-options (copy-sequence value))))
+ (t
+ (custom-handle-keyword symbol keyword value
+ 'custom-variable))))))
+ (put symbol 'custom-requests requests)
+ ;; Do the actual initialization.
+ (funcall initialize symbol default))
(run-hooks 'custom-define-hook)
symbol)
The following KEYWORD's are defined:
-:type VALUE should be a widget type.
+: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.
Add SYMBOL to that group.
-
-Read the section about customization in the emacs lisp manual for more
+: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.
+ It takes two arguments, the symbol to set and the value to
+ give it. The default is `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.
+
+Read the section about customization in the Emacs Lisp manual for more
information."
- `(eval-and-compile
- (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.
[KEYWORD VALUE]...
-The following KEYWORD's are defined:
+The following KEYWORDs are defined:
:group VALUE should be a customization group.
Add FACE to that group.
SPEC should be an alist of the form ((DISPLAY ATTS)...).
-ATTS is a list of face attributes and their values. The possible
-attributes are defined in the variable `custom-face-attributes'.
-Alternatively, ATTS can be a face in which case the attributes of that
-face is used.
+The first element of SPEC where the DISPLAY matches the frame
+is the one that takes effect in that frame. The ATTRs in this
+element take effect; the other elements are ignored, on that frame.
-The ATTS of the first entry in SPEC where the DISPLAY matches the
-frame should take effect in that frame. DISPLAY can either be the
-symbol t, which will match all frames, or an alist of the form
-\((REQ ITEM...)...)
+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'.
-For the DISPLAY to match a FRAME, the REQ property of the frame must
-match one of the ITEM. The following REQ are defined:
+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
+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'.
`background' (what color is used for the background text)
Should be one of `light' or `dark'.
-Read the section about customization in the emacs lisp manual for more
+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
+ (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))
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
:group VALUE should be a customization group.
Add SYMBOL to that group.
-Read the section about customization in the emacs lisp manual for more
+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.
Fourth argument TYPE is the custom option type."
(cond ((eq keyword :group)
(custom-add-to-group value symbol type))
+ ((eq keyword :version)
+ (custom-add-version symbol value))
((eq keyword :link)
(custom-add-link symbol value))
((eq keyword :load)
(unless (member widget links)
(put symbol 'custom-links (cons widget links)))))
+(defun custom-add-version (symbol version)
+ "To the custom option SYMBOL add the version VERSION."
+ (put symbol 'custom-version 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."
(while args
(let ((entry (car args)))
(if (listp entry)
- (let ((symbol (nth 0 entry))
- (value (nth 1 entry))
- (now (nth 2 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)
- (set-default symbol (eval value)))
+ (funcall set symbol (eval value)))
((default-boundp symbol)
;; Something already set this, overwrite it.
- (set-default symbol (eval value))))
+ (funcall set symbol (eval value))))
+ (when requests
+ (put symbol 'custom-requests requests)
+ (mapcar 'require requests))
(setq args (cdr args)))
;; Old format, a plist of SYMBOL VALUE pairs.
(message "Warning: old format `custom-set-variables'")
;;; The End.
+;; Process the defcustoms for variables loaded before this file.
+(while custom-declare-variable-list
+ (apply 'custom-declare-variable (car custom-declare-variable-list))
+ (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
+
(provide 'custom)
;; custom.el ends here
HCoop / bpt / emacs.git / blobdiff