;;; custom.el -- Tools for declaring and initializing options.
;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 0.991
+;; Version: 1.55
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;;
;; This file only contain the code needed to declare and initialize
;; user options. The code to customize options is autoloaded from
-;; `custom-edit.el'.
+;; `cus-edit.el'.
+
+;; The code implementing face declarations is in `cus-face.el'
;;; Code:
(require 'widget)
-(define-widget-keywords :type :group)
+(define-widget-keywords :prefix :tag :load :link :options :type :group)
;; These autoloads should be deleted when the file is added to Emacs
-(autoload 'customize "custom-edit" nil t)
-(autoload 'customize-variable "custom-edit" nil t)
-(autoload 'customize-face "custom-edit" nil t)
-(autoload 'customize-apropos "custom-edit" nil t)
-
-;;; Compatibility.
-
-(fset 'custom-x-color-values
- (if (fboundp 'x-color-values)
- 'x-color-values
- (lambda (color)
- (color-instance-rgb-components
- (make-color-instance color)))))
-
-(defun custom-background-mode ()
- "Kludge to detext background mode."
- (let* ((bg-resource
- (condition-case ()
- (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
- (error nil)))
- (params (frame-parameters))
- (color (condition-case ()
- (or (assq 'background-color params)
- (color-instance-name
- (specifier-instance
- (face-background 'default))))
- (error nil))))
- (cond (bg-resource (intern (downcase bg-resource)))
- ((and color
- (< (apply '+ (custom-x-color-values color))
- (/ (apply '+ (custom-x-color-values "white")) 3)))
- 'dark)
- (t 'light))))
+
+(unless (fboundp 'load-gc)
+ ;; From cus-edit.el
+ (autoload 'customize "cus-edit" nil t)
+ (autoload 'customize-variable "cus-edit" nil t)
+ (autoload 'customize-face "cus-edit" nil t)
+ (autoload 'customize-apropos "cus-edit" nil t)
+ (autoload 'customize-customized "cus-edit" nil t)
+ (autoload 'custom-buffer-create "cus-edit")
+ (autoload 'custom-menu-update "cus-edit")
+ (autoload 'custom-make-dependencies "cus-edit")
+ ;; From cus-face.el
+ (autoload 'custom-declare-face "cus-face")
+ (autoload 'custom-set-faces "cus-face"))
;;; The `defcustom' Macro.
-;;;###autoload
(defun custom-declare-variable (symbol value doc &rest args)
- "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
- (unless (default-boundp symbol)
- (set-default symbol (eval value)))
+ "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
+ (unless (and (default-boundp symbol)
+ (not (get symbol 'saved-value)))
+ (set-default symbol (if (get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value)))
+ (eval value))))
(put symbol 'factory-value (list value))
(when doc
(put symbol 'variable-documentation doc))
- (while args
+ (while args
(let ((arg (car args)))
(setq args (cdr args))
(unless (symbolp arg)
(setq args (cdr args))
(cond ((eq keyword :type)
(put symbol 'custom-type value))
- ((eq keyword :group)
- (custom-add-to-group value symbol 'custom-variable))
+ ((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
- (error "Unknown keyword %s" symbol)))))))
+ (custom-handle-keyword symbol keyword value
+ 'custom-variable))))))
+ (run-hooks 'custom-define-hook)
+ symbol)
-;;;###autoload
(defmacro defcustom (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
DOC is the variable documentation.
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:
-:type VALUE should be a sexp widget.
-:group VALUE should be a customization group.
+:type VALUE should be a widget type.
+: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
;;; The `defface' Macro.
-;;;###autoload
-(defun custom-declare-face (face spec doc &rest args)
- "Like `defface', but FACE is evaluated as a normal argument."
- (put face 'factory-face spec)
- (let ((value (or (get face 'saved-face) spec)))
- (custom-face-display-set face value))
- (when doc
- (put face 'face-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" :type))
- (setq args (cdr args))
- (cond ((eq keyword :group)
- (custom-add-to-group value face 'custom-face))
- (t
- (error "Unknown keyword %s" face)))))))
-
-;;;###autoload
(defmacro defface (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
FACE does not need to be quoted.
;;; The `defgroup' Macro.
-;;;###autoload
(defun custom-declare-group (symbol members doc &rest args)
"Like `defgroup', but SYMBOL is evaluated as a normal argument."
(put symbol 'custom-group (nconc members (get symbol 'custom-group)))
(when doc
(put symbol 'group-documentation doc))
- (while args
+ (while args
(let ((arg (car args)))
(setq args (cdr args))
(unless (symbolp arg)
(let ((keyword arg)
(value (car args)))
(unless args
- (error "Keyword %s is missing an argument" :type))
+ (error "Keyword %s is missing an argument" keyword))
(setq args (cdr args))
- (cond ((eq keyword :group)
- (custom-add-to-group value symbol 'custom-group))
+ (cond ((eq keyword :prefix)
+ (put symbol 'custom-prefix value))
(t
- (error "Unknown keyword %s" symbol)))))))
+ (custom-handle-keyword symbol keyword value
+ 'custom-group))))))
+ (run-hooks 'custom-define-hook)
+ symbol)
-;;;###autoload
(defmacro defgroup (symbol members doc &rest args)
"Declare SYMBOL as a customization group containing MEMBERS.
SYMBOL does not need to be quoted.
The remaining arguments should have the form
- [KEYWORD VALUE]...
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
information."
`(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
-;;;###autoload
(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."
(setcar (cdr old) widget)
(put group 'custom-group (nconc members (list (list option widget)))))))
-;;; Face Utilities.
-
-(and (fboundp 'make-face)
- (make-face 'custom-face-empty))
-
-(defun custom-face-display-set (face spec &optional frame)
- "Set FACE to the attributes to the first matching entry in SPEC.
-Iff optional FRAME is non-nil, set it for that frame only.
-See `defface' for information about SPEC."
- (when (fboundp 'make-face)
- (make-face face)
- (copy-face 'custom-face-empty face)
- (while spec
- (let* ((entry (car spec))
- (display (nth 0 entry))
- (atts (nth 1 entry)))
- (setq spec (cdr spec))
- (when (custom-display-match-frame display frame)
- (apply 'custom-face-attribites-set face frame atts)
- (setq spec nil))))))
-
-(defcustom custom-background-mode nil
- "The brightness of the background.
-Set this to the symbol dark if your background color is dark, light if
-your background is light, or nil (default) if you want Emacs to
-examine the brightness for you."
- :group 'customize
- :type '(choice (choice-item dark)
- (choice-item light)
- (choice-item :tag "default" nil)))
-
-(defun custom-display-match-frame (display frame)
- "Non-nil iff DISPLAY matches FRAME.
-If FRAME is nil, the current FRAME is used."
- ;; This is a kludge to get started, we realle should use specifiers!
- (unless frame
- (setq frame (selected-frame)))
- (if (eq display t)
- t
- (let ((match t)
- (pars (frame-parameters frame)))
- (while (and display match)
- (let* ((entry (car display))
- (req (car entry))
- (options (cdr entry)))
- (setq display (cdr display))
- (cond ((eq req 'type)
- (setq match (if (fboundp 'device-type)
- (device-type frame)
- (memq window-system options))))
- ((eq req 'class)
- (let ((class (if (fboundp 'device-class)
- (device-class frame)
- (cdr (assq 'display-type pars)))))
- (setq match (memq class options))))
- ((eq req 'background)
- (let ((background (or custom-background-mode
- (cdr (assq 'background-mode pars))
- (custom-background-mode))))
- (setq match (memq background options))))
- (t
- (error "Unknown req `%S' with options `%S'" req options)))))
- match)))
-
-(defvar custom-face-attributes
- '((:bold (toggle :format "Bold: %v") custom-set-face-bold)
- (:italic (toggle :format "Italic: %v") custom-set-face-italic)
- (:underline
- (toggle :format "Underline: %v") set-face-underline-p)
- (:foreground (color :tag "Foreground") set-face-foreground)
- (:background (color :tag "Background") set-face-background)
- (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
- "Alist of face attributes.
-
-The elements are of the form (KEY TYPE SET) where KEY is a symbol
-identifying the attribute, TYPE is a widget type for editing the
-attibute, SET is a function for setting the attribute value.
-
-The SET function should take three arguments, the face to modify, the
-value of the attribute, and optionally the frame where the face should
-be changed.")
-
-(defun custom-face-attribites-set (face frame &rest atts)
- "For FACE on FRAME set the attributes [KEYWORD VALUE]....
-Each keyword should be listed in `custom-face-attributes'.
-
-If FRAME is nil, set the default face."
- (while atts
- (let* ((name (nth 0 atts))
- (value (nth 1 atts))
- (fun (nth 2 (assq name custom-face-attributes))))
- (setq atts (cdr (cdr atts)))
- (funcall fun face value))))
-
-(defun custom-set-face-bold (face value &optional frame)
- "Set the bold property of FACE to VALUE."
- (condition-case nil
- (if value
- (make-face-bold face frame)
- (make-face-unbold face frame))
- (error nil)))
-
-(defun custom-set-face-italic (face value &optional frame)
- "Set the italic property of FACE to VALUE."
- (condition-case nil
- (if value
- (make-face-italic face frame)
- (make-face-unitalic face frame))
- (error nil)))
-
-;;;###autoload
-(defun custom-initialize-faces (&optional frame)
- "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
- (mapatoms (lambda (symbol)
- (let ((spec (or (get symbol 'saved-face)
- (get symbol 'factory-face))))
- (when spec
- (custom-face-display-set symbol spec frame))))))
+;;; 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
+ (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))
+ (setq args (cdr args))
+ (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."
+ (cond ((eq keyword :group)
+ (custom-add-to-group value symbol type))
+ ((eq keyword :link)
+ (custom-add-link symbol value))
+ ((eq keyword :load)
+ (custom-add-load symbol value))
+ ((eq keyword :tag)
+ (put symbol 'custom-tag value))
+ (t
+ (error "Unknown keyword %s" symbol))))
+
+(defun custom-add-option (symbol option)
+ "To the variable SYMBOL add OPTION.
+
+If SYMBOL is a hook variable, OPTION should be a hook member.
+For other types variables, the effect is undefined."
+ (let ((options (get symbol 'custom-options)))
+ (unless (member option options)
+ (put symbol 'custom-options (cons option options)))))
+
+(defun custom-add-link (symbol widget)
+ "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)))))
+
+(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)))))
;;; Initializing.
-;;;###autoload
(defun custom-set-variables (&rest args)
- "Initialize variables according to user preferences.
-The arguments should have the form [SYMBOL VALUE]...
-For each symbol, VALUE is evaluated and bound as the default value for
-the symbol. The unevaluated VALUE is also stored as the saved value
-for that symbol."
- (while args
- (let ((symbol (nth 0 args))
- (value (nth 1 args)))
- (set-default symbol (eval value))
- (put symbol 'saved-value (list value)))
- (setq args (cdr (cdr args)))))
-
-;;;###autoload
-(defun custom-set-faces (&rest args)
- "Initialize faces according to user preferences.
-The arguments should have the form [SYMBOL SPEC]...
-For each symbol, a face with that name is created according to SPEC.
-See `defface' for the format of SPEC."
+ "Initialize variables according to user preferences.
+
+The arguments should be a list where each entry has the form:
+
+ (SYMBOL VALUE [NOW])
+
+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
- (let ((face (nth 0 args))
- (spec (nth 1 args)))
- (put face 'saved-face spec)
- (custom-face-display-set face spec))
- (setq args (cdr (cdr args)))))
+ (let ((entry (car args)))
+ (if (listp entry)
+ (let ((symbol (nth 0 entry))
+ (value (nth 1 entry))
+ (now (nth 2 entry)))
+ (put symbol 'saved-value (list value))
+ (when now
+ (put symbol 'force-value t)
+ (set-default symbol (eval value)))
+ (setq args (cdr args)))
+ ;; Old format, a plist of SYMBOL VALUE pairs.
+ (let ((symbol (nth 0 args))
+ (value (nth 1 args)))
+ (put symbol 'saved-value (list value)))
+ (setq args (cdr (cdr args)))))))
;;; Meta Customization
-(defgroup emacs nil
- "Customization of the One True Editor.")
-
-(defgroup customize nil
- "Customization of the Customization support."
- :group 'emacs)
+(defcustom custom-define-hook nil
+ "Hook called after defining each customize option."
+ :group 'customize
+ :type 'hook)
+
+;;; Menu support
+
+(defconst custom-help-menu '("Customize"
+ ["Update menu..." custom-menu-update t]
+ ["Group..." customize t]
+ ["Variable..." customize-variable t]
+ ["Face..." customize-face t]
+ ["Saved..." customize-customized t]
+ ["Apropos..." customize-apropos t])
+ "Customize menu")
+
+(defun custom-menu-reset ()
+ "Reset customize menu."
+ (remove-hook 'custom-define-hook 'custom-menu-reset)
+ (if (string-match "XEmacs" emacs-version)
+ (when (fboundp 'add-submenu)
+ (add-submenu '("Help") custom-help-menu))
+ (define-key global-map [menu-bar help-menu customize-menu]
+ (cons (car custom-help-menu)
+ (easy-menu-create-keymaps (car custom-help-menu)
+ (cdr custom-help-menu))))))
;;; The End.