comparison lisp/custom.el @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 17f7e9191c0b
children 7d06a8bf47d2
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
114 ((get symbol 'saved-value) 114 ((get symbol 'saved-value)
115 (eval (car (get symbol 'saved-value)))) 115 (eval (car (get symbol 'saved-value))))
116 (t 116 (t
117 (eval value))))) 117 (eval value)))))
118 118
119 (defun custom-initialize-changed (symbol value) 119 ;; XEmacs change; move to defsubst, since this is only called in one place
120 ;; and usage of it clusters.
121 (defsubst custom-initialize-changed (symbol value)
120 "Initialize SYMBOL with VALUE. 122 "Initialize SYMBOL with VALUE.
121 Like `custom-initialize-reset', but only use the `:set' function if the 123 Like `custom-initialize-reset', but only use the `:set' function if
122 not using the standard setting. 124 not using the standard setting.
123 For the standard setting, use `set-default'." 125 For the standard setting, use `set-default'."
124 (cond ((default-boundp symbol) 126 (cond ((default-boundp symbol)
125 (funcall (or (get symbol 'custom-set) 'set-default) 127 (funcall (or (get symbol 'custom-set) 'set-default)
126 symbol 128 symbol
140 142
141 DEFAULT is stored as SYMBOL's value in the standard theme. See 143 DEFAULT is stored as SYMBOL's value in the standard theme. See
142 `custom-known-themes' for a list of known themes. For backwards 144 `custom-known-themes' for a list of known themes. For backwards
143 compatibility, DEFAULT is also stored in SYMBOL's property 145 compatibility, DEFAULT is also stored in SYMBOL's property
144 `standard-value'. At the same time, SYMBOL's property `force-value' is 146 `standard-value'. At the same time, SYMBOL's property `force-value' is
145 set to nil, as the value is no longer rogue." 147 set to nil, as the value is no longer rogue.
148
149 The byte compiler adds an XEmacs-specific :default keyword and value to
150 `custom-declare-variable' calls when it byte-compiles the DEFAULT argument.
151 These describe what the custom UI shows when editing a customizable
152 variable's associated Lisp expression. We don't encourage use of this
153 keyword in your own programs. "
146 ;; Remember the standard setting. The value should be in the standard 154 ;; Remember the standard setting. The value should be in the standard
147 ;; theme, not in this property. However, his would require changeing 155 ;; theme, not in this property. However, this would require changing
148 ;; the C source of defvar and others as well... 156 ;; the C source of defvar and others as well...
149 (put symbol 'standard-value (list default)) 157 (put symbol 'standard-value (list default))
150 ;; Maybe this option was rogue in an earlier version. It no longer is. 158 ;; Maybe this option was rogue in an earlier version. It no longer is.
151 (when (eq (get symbol 'force-value) 'rogue) 159 (when (eq (get symbol 'force-value) 'rogue)
152 ;; It no longer is. 160 ;; It no longer is.
182 (mapc (lambda (option) 190 (mapc (lambda (option)
183 (custom-add-option symbol option)) 191 (custom-add-option symbol option))
184 value) 192 value)
185 ;; Fast code for the common case. 193 ;; Fast code for the common case.
186 (put symbol 'custom-options (copy-sequence value)))) 194 (put symbol 'custom-options (copy-sequence value))))
195 ;; In the event that the byte compile has compiled the init
196 ;; value, we want the value the UI sees to be uncompiled.
197 ((eq keyword :default)
198 (put symbol 'standard-value (list value)))
187 (t 199 (t
188 (custom-handle-keyword symbol keyword value 200 (custom-handle-keyword symbol keyword value
189 'custom-variable)))))) 201 'custom-variable))))))
190 (put symbol 'custom-requests requests) 202 (put symbol 'custom-requests requests)
191 ;; Do the actual initialization. 203 ;; Do the actual initialization.
192 (unless custom-dont-initialize 204 (unless custom-dont-initialize
193 (funcall initialize symbol default))) 205 (funcall initialize symbol default)))
194 ;; #### This is a rough equivalent of LOADHIST_ATTACH. However, 206 (push symbol current-load-list)
195 ;; LOADHIST_ATTACH also checks for `initialized'.
196 (push (cons 'defvar symbol) current-load-list)
197 (run-hooks 'custom-define-hook) 207 (run-hooks 'custom-define-hook)
198 symbol) 208 symbol)
199 209
200 (defmacro defcustom (symbol value doc &rest args) 210 (defmacro defcustom (symbol value doc &rest args)
201 "Declare SYMBOL as a customizable variable that defaults to VALUE. 211 "Declare SYMBOL as a customizable variable that defaults to VALUE.
500 (defun custom-autoload (symbol load) 510 (defun custom-autoload (symbol load)
501 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD." 511 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD."
502 (put symbol 'custom-autoload t) 512 (put symbol 'custom-autoload t)
503 (custom-add-load symbol load)) 513 (custom-add-load symbol load))
504 514
505 ;; This test is also in the C code of `user-variable-p'. 515 ;; XEmacs;
506 (defun custom-variable-p (variable) 516 ;; #'custom-variable-p is in symbols.c, since it's called from
507 "Return non-nil if VARIABLE is a custom variable." 517 ;; #'user-variable-p.
508 (or (get variable 'standard-value)
509 (get variable 'custom-autoload)))
510 518
511 ;;; Loading files needed to customize a symbol. 519 ;;; Loading files needed to customize a symbol.
512 ;;; This is in custom.el because menu-bar.el needs it for toggle cmds. 520 ;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
513 521
514 (defvar custom-load-recursion nil 522 (defvar custom-load-recursion nil
810 (if custom-local-buffer 818 (if custom-local-buffer
811 (with-current-buffer custom-local-buffer 819 (with-current-buffer custom-local-buffer
812 (set variable value)) 820 (set variable value))
813 (set-default variable value))) 821 (set-default variable value)))
814 822
815 (defun custom-quote (sexp) 823 ;; Now in C, but the old name is still used by some packages:
816 "Quote SEXP iff it is not self quoting." 824 (defalias 'custom-quote 'quote-maybe)
817 (if (or (memq sexp '(t nil))
818 (keywordp sexp)
819 (and (listp sexp)
820 (memq (car sexp) '(lambda)))
821 (stringp sexp)
822 (numberp sexp)
823 (vectorp sexp)
824 ;;; (and (fboundp 'characterp)
825 ;;; (characterp sexp))
826 )
827 sexp
828 (list 'quote sexp)))
829 825
830 (defun customize-mark-to-save (symbol) 826 (defun customize-mark-to-save (symbol)
831 "Mark SYMBOL for later saving. 827 "Mark SYMBOL for later saving.
832 828
833 If the default value of SYMBOL is different from the standard value, 829 If the default value of SYMBOL is different from the standard value,
845 ;; Save default value iff different from standard value. 841 ;; Save default value iff different from standard value.
846 (if (or (null standard) 842 (if (or (null standard)
847 (not (equal value (condition-case nil 843 (not (equal value (condition-case nil
848 (eval (car standard)) 844 (eval (car standard))
849 (error nil))))) 845 (error nil)))))
850 (put symbol 'saved-value (list (custom-quote value))) 846 (put symbol 'saved-value (list (quote-maybe value)))
851 (put symbol 'saved-value nil)) 847 (put symbol 'saved-value nil))
852 ;; Clear customized information (set, but not saved). 848 ;; Clear customized information (set, but not saved).
853 (put symbol 'customized-value nil) 849 (put symbol 'customized-value nil)
854 ;; Save any comment that might have been set. 850 ;; Save any comment that might have been set.
855 (when comment 851 (when comment
872 ;; Mark default value as set iff different from old value. 868 ;; Mark default value as set iff different from old value.
873 (if (or (null old) 869 (if (or (null old)
874 (not (equal value (condition-case nil 870 (not (equal value (condition-case nil
875 (eval (car old)) 871 (eval (car old))
876 (error nil))))) 872 (error nil)))))
877 (put symbol 'customized-value (list (custom-quote value))) 873 (put symbol 'customized-value (list (quote-maybe value)))
878 (put symbol 'customized-value nil)) 874 (put symbol 'customized-value nil))
879 ;; Changed? 875 ;; Changed?
880 (not (equal customized (get symbol 'customized-value))))) 876 (not (equal customized (get symbol 'customized-value)))))
881 877
882 ;;; Theme Manipulation 878 ;;; Theme Manipulation
1025 was-in-theme) 1021 was-in-theme)
1026 (setq was-in-theme value) 1022 (setq was-in-theme value)
1027 (setq value (or value (get symbol 'standard-value))) 1023 (setq value (or value (get symbol 'standard-value)))
1028 (when value 1024 (when value
1029 (put symbol 'saved-value was-in-theme) 1025 (put symbol 'saved-value was-in-theme)
1030 (if (or (get 'force-value symbol) (default-boundp symbol)) 1026 (if (or (get symbol 'force-value) (default-boundp symbol))
1031 (funcall (or (get symbol 'custom-set) 'set-default) symbol 1027 (funcall (or (get symbol 'custom-set) 'set-default) symbol
1032 (eval (car value))))) 1028 (eval (car value)))))
1033 value)) 1029 value))
1034 1030
1035 (defun custom-theme-reset-variables (theme &rest args) 1031 (defun custom-theme-reset-variables (theme &rest args)
1040 1036
1041 (VARIABLE TO-THEME) 1037 (VARIABLE TO-THEME)
1042 1038
1043 This means reset VARIABLE to its value in TO-THEME." 1039 This means reset VARIABLE to its value in TO-THEME."
1044 (custom-check-theme theme) 1040 (custom-check-theme theme)
1045 (mapcar '(lambda (arg) 1041 (mapcar #'(lambda (arg)
1046 (apply 'custom-theme-reset-internal arg) 1042 (apply 'custom-theme-reset-internal arg)
1047 (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg))) 1043 (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg)))
1048 args)) 1044 args))
1049 1045
1050 (defun custom-reset-variables (&rest args) 1046 (defun custom-reset-variables (&rest args)
1051 "Reset the value of the variables to values previously saved. 1047 "Reset the value of the variables to values previously saved.
1052 This is the setting associated the `user' theme. 1048 This is the setting associated the `user' theme.