Mercurial > hg > xemacs-beta
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. |