X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fcustom.el;h=fb6f8cd730775c820dc03b86928b21b60f10da72;hb=b28454eed83f245c4160228b076134ce930b320a;hp=bd2894715977f21d634d7f60fcedd47c8d981271;hpb=aaf0c1355c342b1452540cc0566787a3119c79a2;p=gnus diff --git a/lisp/custom.el b/lisp/custom.el index bd2894715..fb6f8cd73 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1,10 +1,10 @@ ;;; 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 ;; Keywords: help, faces -;; Version: 1.02 +;; Version: 1.55 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -13,72 +13,36 @@ ;; ;; 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 :options :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) -(autoload 'customize-customized "custom-edit" nil t) -(autoload 'custom-buffer-create "custom-edit") - -;;; Compatibility. - -(unless (fboundp 'x-color-values) - ;; Emacs function missing in XEmacs 19.14. - (defun x-color-values (color) - "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is (65280 65280 65280) or (65535 65535 65535). -If FRAME is omitted or nil, use the selected frame." - (color-instance-rgb-components (make-color-instance color)))) - -(unless (fboundp 'frame-property) - ;; XEmacs function missing in Emacs 19.34. - (defun frame-property (frame property &optional default) - "Return FRAME's value for property PROPERTY." - (or (cdr (assq property (frame-parameters frame))) - default))) - -(defun custom-background-mode () - "Kludge to detext background mode." - (let* ((bg-resource - (condition-case () - (x-get-resource ".backgroundMode" "BackgroundMode" 'string) - (error nil))) - color - (mode (cond (bg-resource - (intern (downcase bg-resource))) - ((and (setq color (condition-case () - (or (frame-property - (selected-frame) - 'background-color) - (color-instance-name - (specifier-instance - (face-background 'default)))) - (error nil))) - (< (apply '+ (x-color-values color)) - (/ (apply '+ (x-color-values "white")) - 3))) - 'dark) - (t 'light)))) - (modify-frame-parameters (selected-frame) - (list (cons 'background-mode mode))) - mode)) + +(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." + "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) @@ -87,7 +51,7 @@ If FRAME is omitted or nil, use the selected frame." (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) @@ -107,13 +71,12 @@ If FRAME is omitted or nil, use the selected frame." value) ;; Fast code for the common case. (put symbol 'custom-options (copy-list value)))) - ((eq keyword :group) - (custom-add-to-group value symbol 'custom-variable)) (t - (error "Unknown keyword %s" symbol)))))) - (run-hooks 'custom-define-hook)) + (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. @@ -122,13 +85,13 @@ 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: :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. +:group VALUE should be a customization group. Add SYMBOL to that group. Read the section about customization in the emacs lisp manual for more @@ -138,35 +101,6 @@ information." ;;; 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) - (when (fboundp 'facep) - (unless (and (facep face) - (not (get face 'saved-face))) - ;; If the user has already created the face, respect that. - (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)))))) - (run-hooks 'custom-define-hook)) - -;;;###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. @@ -216,13 +150,12 @@ information." ;;; 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) @@ -230,15 +163,16 @@ information." (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)))))) - (run-hooks 'custom-define-hook)) + (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. @@ -252,7 +186,7 @@ symbol. Useful widgets are `custom-variable' for editing variables, The remaining arguments should have the form - [KEYWORD VALUE]... + [KEYWORD VALUE]... The following KEYWORD's are defined: @@ -263,7 +197,6 @@ Read the section about customization in the emacs lisp manual for more 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." @@ -273,7 +206,36 @@ 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))))))) -;;; Options +;;; 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. @@ -284,156 +246,23 @@ For other types variables, the effect is undefined." (unless (member option options) (put symbol 'custom-options (cons option options))))) -;;; 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 'copy-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 really should use specifiers! - (unless frame - (setq frame (selected-frame))) - (if (eq display t) - t - (let ((match t)) - (while (and display match) - (let* ((entry (car display)) - (req (car entry)) - (options (cdr entry))) - (setq display (cdr display)) - (cond ((eq req 'type) - (let ((type (if (fboundp 'device-type) - (device-type (frame-device frame)) - window-system))) - (setq match (memq type options)))) - ((eq req 'class) - (let ((class (if (fboundp 'device-class) - (device-class (frame-device frame)) - (frame-property frame 'display-type)))) - (setq match (memq class options)))) - ((eq req 'background) - (let ((background (or custom-background-mode - (frame-property frame 'background-mode) - (custom-background-mode)))) - (setq match (memq background options)))) - (t - (error "Unknown req `%S' with options `%S'" req options))))) - match))) - -(defconst 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.") - -(when (string-match "XEmacs" emacs-version) - ;; Support for special XEmacs font attributes. - (require 'font) - - (unless (fboundp 'face-font-name) - (defun face-font-name (face &rest args) - (apply 'face-font face args))) - - (defun set-face-font-size (face size &rest args) - "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-size fontobj size) - (apply 'set-face-font face fontobj args))) - - (defun set-face-font-family (face family &rest args) - "Set the font of FACE to FAMILY" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-family fontobj family) - (apply 'set-face-font face fontobj args))) - - (nconc custom-face-attributes - '((:family (editable-field :format "Family: %v") - set-face-font-family) - (:size (editable-field :format "Size: %v") - set-face-font-size)))) - -(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))) - (condition-case nil - (funcall fun face value) - (error nil))))) - -(defun custom-set-face-bold (face value &optional frame) - "Set the bold property of FACE to VALUE." - (if value - (make-face-bold face frame) - (make-face-unbold face frame))) - -(defun custom-set-face-italic (face value &optional frame) - "Set the italic property of FACE to VALUE." - (if value - (make-face-italic face frame) - (make-face-unitalic face frame))) - -;;;###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)))))) +(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. + "Initialize variables according to user preferences. The arguments should be a list where each entry has the form: @@ -442,14 +271,14 @@ The arguments should be a list where each entry has the form: 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 + (while 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 + (when now (put symbol 'force-value t) (set-default symbol (eval value))) (setq args (cdr args))) @@ -459,43 +288,8 @@ the default value for the SYMBOL." (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 be a list where each entry has the form: - - (FACE SPEC [NOW]) - -SPEC will be stored as the saved value for FACE. If NOW is present -and non-nil, FACE will also be created according to SPEC. - -See `defface' for the format of SPEC." - (while args - (let ((entry (car args))) - (if (listp entry) - (let ((face (nth 0 entry)) - (spec (nth 1 entry)) - (now (nth 2 entry))) - (put face 'saved-face spec) - (when now - (put face 'force-face t) - (custom-face-display-set face spec)) - (setq args (cdr args))) - ;; Old format, a plist of FACE SPEC pairs. - (let ((face (nth 0 args)) - (spec (nth 1 args))) - (put face 'saved-face spec)) - (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 @@ -503,32 +297,6 @@ See `defface' for the format of SPEC." ;;; Menu support -(defcustom custom-menu-nesting 2 - "Maximum nesting in custom menus." - :type 'integer - :group 'customize) - -(defun custom-menu-create-entry (entry) - "Create a easy menu entry for customization option ENTRY. - -ENTRY should be list whose first element is a symbol, and second -element is a widget type used to customize the symbol. The widget -type `custom-group' is recognized, and will return a submenu -specification containing the group members. - -The maximum nesting in the submenu is specified by `custom-menu-nesting'." - (let ((item (vector (symbol-name (nth 0 entry)) - `(custom-buffer-create (list (quote ,entry))) - t))) - (if (and (> custom-menu-nesting 0) - (eq (nth 1 entry) 'custom-group)) - (let ((custom-menu-nesting (1- custom-menu-nesting)) - (symbol (nth 0 entry))) - `(,(symbol-name symbol) - ,item - ,@(mapcar 'custom-menu-create-entry (get symbol 'custom-group)))) - item))) - (defconst custom-help-menu '("Customize" ["Update menu..." custom-menu-update t] ["Group..." customize t] @@ -541,27 +309,14 @@ The maximum nesting in the submenu is specified by `custom-menu-nesting'." (defun custom-menu-reset () "Reset customize menu." (remove-hook 'custom-define-hook 'custom-menu-reset) - (if (fboundp 'add-submenu) - (add-submenu '("Help") custom-help-menu) + (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)))))) -(defun custom-menu-update () - "Update customize menu." - (interactive) - (add-hook 'custom-define-hook 'custom-menu-reset) - (let ((menu `(,(car custom-help-menu) - ,(custom-menu-create-entry '(emacs custom-group)) - ,@(cdr (cdr custom-help-menu))))) - (if (fboundp 'add-submenu) - (add-submenu '("Help") menu) - (define-key global-map [menu-bar help-menu customize-menu] - (cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu))))))) - -(custom-menu-reset) - ;;; The End. (provide 'custom)