X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bd042c030f6530726313e4ff55065df7e2ee41a9..85b5a0254674475e1fbd5b51c8ed8b5fa67f3c8e:/lisp/custom.el diff --git a/lisp/custom.el b/lisp/custom.el index 4e4cde95d9..fd90be477b 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -4,9 +4,26 @@ ;; ;; Author: Per Abrahamsen ;; 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. @@ -21,7 +38,9 @@ (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'. @@ -29,45 +48,115 @@ ;;; 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)) + (setq current-load-list (cons symbol current-load-list)) (run-hooks 'custom-define-hook) symbol) @@ -81,17 +170,40 @@ The remaining arguments should have the form [KEYWORD VALUE]... -The following KEYWORD's are defined: +The following keywords are meaningful: -: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 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'. +: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. + +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. @@ -109,25 +221,26 @@ The remaining arguments should have the form [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'. @@ -138,14 +251,20 @@ match one of the ITEM. The following REQ are defined: `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)) @@ -174,8 +293,8 @@ 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 @@ -187,9 +306,12 @@ The following KEYWORD's are defined: :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. @@ -222,6 +344,8 @@ Third argument TYPE is the custom option type." 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) @@ -246,6 +370,10 @@ For other types variables, the effect is undefined." (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." @@ -255,6 +383,14 @@ LOAD should be either a library file name, or a feature name." ;;; 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. @@ -268,17 +404,22 @@ the default value for the SYMBOL." (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) 'custom-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'") @@ -289,8 +430,23 @@ 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. +(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